;  (Metalinguistic Abstraction)
; Metacircular Evaluator with Jay (the magician).

; With case analysis
; and done in the wrong way...
; with much CAR and CDR.
(DEFINE EVAL
  (LAMBDA
   (EXP ENV)
   (COND ((NUMBER? EXP) EXP)
;;; SPECIAL FORMS
         ((SYMBOL? EXP) (LOOKUP EXP ENV))
         ((EQ? (CAR EXP) 'QUOTE) (CADR EXP))
         ((EQ? (CAR EXP) 'LAMBDA)
          (LIST 'CLOSURE (CDR EXP) ENV))
         ((EQ? (CAR EXP) 'COND)
          (EVCOND (CDR EXP) ENV))
;;; NORMAL FORM (COMBINATION)
         (ELSE (APPLY (EVAL (CAR EXP) EXP)
                      (EVLIST (CDR EXP) ENV))))))
(DEFINE APPLY
  (LAMBDA (PROC ARGS)
    (COND ((PRIMITIVE? PROC)
           (APPLY-PRIMOP PROC ARGS))
          ((EQ? (CAR PROC) 'CLOSURE)
           (EVAL (CADADR PROC)
                 (BIND (CAADR PROC)
                        ARGS
                        (CADDR PROC))))
          (ELSE ERROR))))
(DEFINE EVLIST
  (LAMBDA (L ENV)
    (COND ((EQ? L '()) '())
          (ELSE
            (CONS (EVAL (CAR L) ENV)
                  (EVLIST (CDR L) ENV))))))
(DEFINE EVCOND
  (LAMBDA (CLAUSES ENV)
    (COND ((EQ? CLAUSES '()) '())
          ((EQ? (CAAR CLAUSES) 'ELSE)
           (EVAL (CADAR CLAUSES) ENV))
          ((FALSE? (EVAL (CAAR CLAUSES) ENV))
           (EVCOND (CDR CLAUSES) ENV))
          (ELSE
            (EVAL (CADAR CLAUSES) ENV)))))
(DEFINE BIND
  (LAMBDA (VARS VALS ENV)
    (CONS (PAIR-UP VARS VALS)
          ENV)))
(DEFINE PAIR-UP
  (LAMBDA (VARS VALS)
    (COND
     ((EQ? VARS '())
      (COND ((EQ? VALS '()) '())
            (ELSE (ERROR TMA))))
     ((EQ? VALS '()) (ERROR TFA))
     (ELSE
      (CONS (CONS (CAR VARS)
                  (CAR VALS))
            (PAIR-UP (CDR VARS)
                     (CDR VALS)))))))
(DEFINE LOOKUP
  (LAMBDA (SYM ENV)
    (COND ((EQ? ENV '()) (ERROR UBV))
          (ELSE
           ((LAMBDA (VCELL)
              (COND ((EQ? VCELL '())
                     (LOOKUP SYM
                             (CDR ENV)))
                    (ELSE (CDR VCELL))))
            (ASSQ SYN (CAR ENV)))))))
(DEFINE ASSQ
  (LAMBDA (SYM ALIST)
    (COND ((EQ? ALIST '()) '())
          ((EQ? SYN (CAR ALIST))
           (CAR ALIST))
          (ELSE
           (ASSQ SYM (CDR ALIST))))))
; QUESTIONS? 7A:(35m45s) BREAK


; (EVAL '(((LAMBDA(X) (LAMBDA(Y) (+ X Y))) 3) 4) <e0>)
; (APPLY (EVAL '((LAMBDA(X) (LAMBDA(Y) (+ X Y)) 3) <e0>)
;        (EVLIST '(4) <e0>)))
; (APPLY (EVAL '((LAMBDA(X) (LAMBDA(Y) (+ X Y))) 3) <e0>)
;        (CONS (EVAL '4 <e0>)
;              (EVLIST '() <e0>)))
; (APPLY (EVAL '((LAMBDA(X) (LAMBDA(Y) (+ X Y))) 3) <e0>)
;        (CONS 4 '()))
; (APPLY (EVAL '((LAMBDA(X) (LAMBDA(Y) (+ X Y))) 3) <e0>)
;        '(4))
; (APPLY (APPLY (EVAL '(LAMBDA(X) (LAMBDA(Y) (+ X Y))) <e0>)
;               '(3))
;        '(4))
; (APPLY (APPLY '(CLOSURE((X) (LAMBDA(Y) (+ X Y))) <e0>)
;               '(3))
;        '(4))
; "We have to bind a new environment, because it is a procedure."
; <e1> => [x=3] => <e0>
; (APPLY (EVAL '(LAMBDA(Y) (+ X Y)) <e1>)
;        '(4))
; (APPLY '(CLOSURE((Y) (+ X Y)) <e1>)
;        '(4))
; <e2> => [y=4] => <e1>
; (EVAL '(+ X Y) <e2>)
; (APPLY (EVAL '+ <e2>)
;        (EVLIST '(X Y) <e2>))
; (APPLY '+-SYMBOL '(3 4))
; 7
; QUESTIONS 7A:(53m18s) BREAK

; Lisp defended in Self-Definition "The hot bubble of Air"
;   and the Y-combinator.
; 7A:(1h19m34s) The final Lisp.
; QUESTIONS, (END)