(push-output '/dev/null)
; Lisp initialization file
; Don Hopkins

; Defmacro defines a macro. Name is the name of the macro, args is the
; argument list, and body is a list of expressions. When a macro is
; called, the arguments are bound and the expressions evaluated in
; order. The result of the evaluation of the last form is evaluated
; and returned. 

(setq defmacro
  (macro (name args . body)
    (list 'setq name (cons 'macro (cons args body)))))

; Defun defines a user function. Name is the name of the function,
; args is the argument list, and body is a list of expressions. When a
; function is called, the arguments are evaluated and bound, and the
; expressions evaluated in order. The result of the evaluation of the
; last form is returned.

(defmacro defun (name args . body)
  (list 'setq name (cons 'lambda (cons args body))))

; Defspecial defines a user special. Name is the name of the function,
; args is the argument list, and body is a list of expressions. When a 
; function is called, the arguments are bound, and the expressions
; evaluated in order. The result of the evaluation of the last form is
; returned. 

(defmacro defspecial (name args . body)
  (list 'setq name (cons 'special (cons args body))))

; Various list accessing functions.

(defun caar (l)
  (car (car l)))

(defun cadr (l)
  (car (cdr l)))

(defun cdar (l)
  (cdr (car l)))

(defun cddr (l)
  (cdr (cdr l)))

(defun caddr (l)
  (car (cddr l)))

(defun cdddr (l)
  (cdr (cddr l)))

(defun cadddr (l)
  (car (cdr l)))

; Calculate the difference a - b.

(defun difference (a b)
  (plus a (minus b)))

; Return t if a < b, or nil if a >= b.

(defun lessp (a b)
  (greaterp b a))

; Return a list of the results of applying fn to each element of l.

(defun into (fn l)
  (cond
    ((null l) nil)
    (t (cons (fn (car l))
	     (into fn (cdr l))))))

; Return a list of the results of applying fn to each top level cons
; node in l.

(defun onto (fn l)
  (cond
    ((null l) nil)
    (t (cons (fn l)
	     (onto fn (cdr l))))))

; Return t of a is nil, or nil if a is non-nil.

(defun null (a)
  (eq a nil))

; Not is the same as null.

(setq not null)

; Set the atom gotten by evaluating a to be the result of evaluating b.

(defmacro set (a b)
  (list setq (eval a) b))

; Return t if a is a cons node, else nil.

(defun consp (a)
  (eq (type a) 4))

; Return t if the structure of a and b are the same, else nil.

(defun equal (a b)
  (cond
    ((eq a b) t)
    ((and (consp a) (consp b))
      (and (equal (car a) (car b))
           (equal (cdr a) (cdr b))))
    (t nil)))

; Return the rest of l beginning with a if a is a member of l, else
; nil. Uses eq for comparison. 

(defun memq (a l)
  (cond
    ((null l) nil)
    ((eq a (car l)) l)
    (t (memq a (cdr l)))))

; Return the rest of l beginning with a if a is a member of l, else
; nil. Uses equal for comparison. 

(defun member (a l)
  (cond
    ((null l) nil)
    ((equal a (car l)) l)
    (t (member a (cdr l)))))

; Append two lists together.

(defun append (a b)
  (cond
    ((null a) b)
    (t (cons (car a)
	     (append (cdr a) b)))))

; Reverse a list.

(defun reverse (l)
  (cond
    ((null l) nil)
    (t (append (reverse (cdr l))
	       (cons (car l) nil)))))

; Return the length of a list.

(defun length (l)
  (cond
    ((null l) 0)
    (t (plus 1 (length (cdr l))))))

; Return the nth element of a list.
(defun nth (n l)
  (cond
    ((or (null l) (lessp n 0)) nil)
    ((zerop n) (car l))
    (t (nth (difference n 1) (cdr l)))))

; Replace all free variables of a function with their values. Returns
; a function. 

(defun bind (g)
  (eval
    (cons (car (body g))
      (cons (car (cdr (body g)))
	(list (evalx (car (cdr (cdr (body g))))
		(car (cdr (body g)))))))))

; Replace variables in the form b that are not in the arg list a and
; that aren't functions.

(defun evalx (b a)
  (cond
    ((null b) b)
    ((atom b) (subx b a))
    (t (cons (evalx (car b) a)
	     (evalx (cdr b) a)))))

; Substitute the value of a variable for that variable if it is not in
; the arg list, and is not a function. 

(defun subx (b a)
  (cond
    ((or
       (memq b a)
       (memq (type (eval b)) '(5 6 7 8 10 11))) b)
    (t (eval b))))

; Evaluate body with bindings bound. Bindings is a list of atoms or
; pairs consisting of an atom and a value. Atoms are bound to nil, and
; atoms in pairs are bound to the results of evaluating value. The
; forms in body are then evaluated in this environment. 

(defmacro let (bindings . body)
  (cons (cons 'lambda
	  (cons (into (lambda (var)
			(cond ((atom var) var)
			  (t (car var))))
		  bindings)
	    body))
    (into (lambda (var)
	    (cond ((atom var) nil)
	      (t (cadr var))))
      bindings)))

(pop-output)