Here is the scheme code for the interpreter:
(define interpret
((lambda (table) ;; Where the lookup table is
(lambda (prog) ;; The actual lambda bound to interpret
(if (number? prog) ;; Case by case, how to interpret prog...
prog
(if (boolean? prog)
prog
(if (symbol? prog)
(lookup prog table)
(if (null? prog)
null
(if (pair? prog) ;; pair? means built of cons cells
(if (definition? prog)
(add-definition! (def-name prog) ;; magic
(interpret (def-val prog))
table)
(if (conditional? prog)
(interpret-conditional (unless-pred prog)
(unless-then prog)
(unless-else prog))
(do-application (interpret (operator prog))
(interpret-list (op-args prog)))
)))))))))
(list (list 'NIL null) (list 'GT >) (list 'LT <) (list 'SAME eqv?) (list 'TRUTH true) (list 'LIE false) (list 'PLUS +) (list 'SUB -) (list 'MUL *) (list 'DIV /) (list 'ONE 1) (list 'TWO 2) (list 'THREE 3))))
(define operator first)
(define op-args rest)
(define definition?
(lambda (prog)
(eq? (first prog) 'DEF)))
(define def-name second)
(define dev-val third)
(define conditional?
(lambda (prog)
(eq? (first prog) 'UNLESS)))
(define unless-pred second)
(define unless-then third)
(define unless-else
(lambda (prog)
(if (< (length prog) 4)
true
(fourth prog))))
(define add-definition!
(lambda (sym val table)
(set-cdr! table (cons (list sym val) (cdr table)))
(display sym)
(display " defined\n")))
(define interpret-conditional
(lambda (pred then else)
(if (interpret pred)
(interpret else)
(interpret then))))
(define do-application
(lambda (proc args)
(if (primitive? proc)
(apply proc args)
(print "lambda not yet implemented"))))
(define lookup
(lambda (val table)
;; (display "looking up ")
;; (display val)
;; (display " in ")
;; (display table)
;; (newline)
(if (null? table)
null
(if (null? (first table))
null
(if (eq? val (first (first table)))
(second (first table))
(lookup val (rest table)))))))
(define interpret-list
(lambda (lst)
(map interpret lst)))Also, we changed two procedures to make this an infix language (ie., one where the operator goes in the middle):
(define operator second)
(define op-args
(lambda (prog)
(cons (car prog)
(cddr prog))))