(defun map (f l)
(cond ((null l) l)
(t (cons (apply f (car l)) (map f (cdr l))))))
(defun filter (p l)
(cond ((null l) nil)
((p (car l)) (cons (car l) (filter p (cdr l))))
(t (filter p (cdr l)))))
(defun ack (0 m) (+ m 1)
| ack (n 0) (ack (- n 1) 1)
| ack (n m) (ack (- n 1) (ack n (- m 1))))
(defun case-eq (e1 e2)
(cond ((eq e2 'else) t)
(t (eq e1 e2))))
(defun eq-alize (var)
(lambda (case)
(list (list 'case-eq var (car case)) (cadr case))))
(defmacro case (*cons* var (*cons* casefirst caserest))
(let (eqv (eq-alize var))
(cons 'cond (cons (eqv casefirst) (map eqv caserest))))
| case (*cons* x _)
(throw-ex "CASE -- ERROR in input." (conc "Input was " (str x)))
| case nil
(throw-ex "CASE -- ERROR in input." "Input was nil.")
)
(defun curry-add-4 (x)
(lexlambda (x')
(lexlambda (x'')
(lexlambda (x''')
(+ x (+ x' (+ x'' x''')))))))
(defstruct rps (sigma nil) (main nil))
(defstruct sub (name nil) (params nil) (body nil))
(defun labelsub (sub)
`(label ,(sub-name sub) (lambda ,(sub-params sub) ,(sub-body sub))))
(defun labelrps (rps raw_rps)
`(label ,(cadr raw_rps) (lambda () ,(rps-main rps))))
(defun rps_convert_1 (drps b)
(sequentially
(cond (b (eval drps)))
(let (srps ((cadr drps)))
(list (labelrps srps drps)
(map labelsub (rps-sigma srps)))
))
)
(defun process_sub (lsub)
`(setq ,(cadr lsub)
(make-sub :name ,(cons 'quote (list (cadr lsub)))
:params ,(cons 'quote (cdr (car (cdr (cdr lsub)))))
:body ,(cons 'quote (cdr (cdr (car (cdr (cdr lsub))))))))
)
(defun get_sub_names (lsubs)
(map '(lambda (lsub) (cadr lsub)) lsubs)
)
(defun rps_convert_2 (lrps)
(append (append `(defun ,(cadar lrps) ())
(map process_sub (cadr lrps)))
(list `(make-rps :main ,(cons 'quote (cddr (car (cddr (car lrps)))))
:sigma ,(cons 'list (get_sub_names (cadr lrps))))))
)
(defun bottleno (1) " bottle"
| bottleno _ " bottles")
(defun take-beer-down (0) (print "Go buy new beer!!!")
| take-beer-down (n) (print (conc (str n)
(conc (bottleno n) " of beer on the wall.")))
(print "Take one down, pass it around,")
(take-beer-down (- n 1)))