Some Example Code

Two well-known higher-order functions:

(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)))))

Ackermann defined via pattern-matching:

(defun ack (0 m) (+ m 1)
     | ack (n 0) (ack (- n 1) 1)
     | ack (n m) (ack (- n 1) (ack n (- m 1))))

A case macro which uses pattern-matching and throws exceptions:

(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.")

An example using lexical closures:

(defun curry-add-4 (x)
  (lexlambda (x')
    (lexlambda (x'')
      (lexlambda (x''')
        (+ x (+ x' (+ x'' x''')))))))

RPS handling functions for HIPPAL:

(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)
   (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))))))

99 bottles of beer:

(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)))