;; ---------------------------------------------------------------------------
;; This file implements the original Lisp interpreter in Lisp from Page 13 of
;; the Lisp 1.5 Reference Manual, from August 17, 1962.
;;
;; This is the first book on Lisp and the foundational document of
;; programming languages, akin to Maxwell's equations or the Magna Carta.
;; ---------------------------------------------------------------------------
;; An image of that page:
;;    http://www.cs.uni.edu/~wallingf/teaching/cs3540/
;;                              sessions/session28/img/lisp1.5-page13.jpg
;; A PDF of the manual:
;;    http://www.cs.uni.edu/~wallingf/teaching/cs3540/
;;                              resources/lisp1.5-programmers-manual.pdf
;; ---------------------------------------------------------------------------

#lang racket

;; ---------------------------------------------------------------------------
;; McCarthy's "universal Lisp interpreter" is implemented in Lisp and assumes
;; the existence of only a few forms:
;;    - the functions cons, car, cdr, atom, and eq?
;;    - the special forms lambda, quote, and cond
;;    - the values 't and nil
;; 't meant true, and nil meant both false and the empty list.  My code uses
;; #t and #f internally, but they don't appear in the code.
;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; Racket provides all of the required forms except for nil and atom.
;; ---------------------------------------------------------------------------

(define nil  '())
(define (atom x)
  (cond ((eq? x nil) #t)
        (else (not (pair? x)))))

;; ---------------------------------------------------------------------------
;; "evalquote is defined by using two main functions, called eval and apply.
;;  apply handles a function and its arguments, while eval handles forms.
;;  Each of these functions also has another argument that is used as an
;;  association list for storing the values of bound variables and function
;;  names."
;; ---------------------------------------------------------------------------

(define (evalquote fn x)
  (apply fn x '()))

;; ---------------------------------------------------------------------------
;; "where"
;; ---------------------------------------------------------------------------

(define (apply fn x a)
  (cond ((atom fn) (cond ((eq? fn 'car) (caar x))
                         ((eq? fn 'cdr) (cdar x))
                         ((eq? fn 'cons) (cons (car x) (cadr x)))
                         ((eq? fn 'atom) (atom (car x)))
                         ((eq? fn 'eq) (eq? (car x) (cadr x)))
                         (else (apply (eval fn a) x a))))
        ((eq? (car fn) 'lambda) (eval (caddr fn) (pairlis (cadr fn) x a)))
        ((eq? (car fn) 'label) (apply (caddr fn) x
                                      (cons (cons (cadr fn) (caddr fn)) a)))))

(define (eval e a)
  (cond ((atom e) (cdr (assoc e a)))
        ((atom (car e)) (cond ((eq? (car e) 'quote) (cadr e))
                              ((eq? (car e) 'cond) (evcon (cdr e) a))
                              (else (apply (car e) (evlis (cdr e) a) a))))
        (else (apply (car e) (evlis (cdr e) a) a))))

;; ---------------------------------------------------------------------------
;; "pairlis and assoc have been previously defined."
;; ---------------------------------------------------------------------------

(define (evcon c a)
  (cond ((eval (caar c) a) (eval (cadar c) a))
        (else (evcon (cdr c) a))))

;; ---------------------------------------------------------------------------
;; "and"
;; ---------------------------------------------------------------------------

(define (evlis m a)
  (cond ((eq? m nil) nil)
        (else (cons (eval (car m) a) (evlis (cdr m) a)))))

;; ---------------------------------------------------------------------------
;; That is all of Page 13.
;; 
;; pairlis and assoc were defined on Pages 11-12 of the Lisp 1.5 manual,
;; along with a few other helpful functions.  They were written using the same
;; minimal set of operators.
;;    - We have used Racket's primitive assoc function this semester, and
;;      could use it here.  I'll define it for completness.
;;    - We wrote and used pairlis this semester.  What did we call it? 
;; ---------------------------------------------------------------------------

(define pairlis
  (lambda (keys vals alist)
    (if (eq? keys nil)
        alist
        (cons (cons (car keys) (car vals))
              (pairlis (cdr keys) (cdr vals) alist)))))

(define assoc
   (lambda (x a)
      (cond ((eq? x (caar a)) (car a))
            (else (assoc x (cdr a))))))

;; ---------------------------------------------------------------------------
;; This is the example from the top of Page 13.
;; It is the first test for a Lisp interpreter!
;; ---------------------------------------------------------------------------

(evalquote '(lambda (x y) (cons (car x) y)) '((a b) (c d)))   ; = '(a c d)

;; ---------------------------------------------------------------------------
;; These examples appear on Page 96 of the LISP 1.5 Primer from June 14, 1965.
;; They show how to use the label form to create a recursive function.
;; ---------------------------------------------------------------------------

;; (evalquote '(label dummy (lambda (x)
;;                        (cond ((atom x) x)
;;                              ('t (dummy (car x))))))
;;            '( (a b c) ))
;; 
;; (evalquote '(label name (lambda (x)
;;                           (cond ((atom x) x)
;;                                 ('t (name (cdr x))))))
;;            '( ((x . y) . (x . z)) ))
;; 
;; (evalquote '(label name (lambda (x)
;;                           (cond ((atom x) x)
;;                                 ('t (name (cdr x))))))
;;            '( (a b c) ))

;; ---------------------------------------------------------------------------