1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
|
;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-
;;; Code from Paradigms of Artificial Intelligence Programming
;;; Copyright (c) 1991 Peter Norvig
;;; File interp2.lisp: Tail-recursive Scheme interpreter.
(requires "interp1")
(defun interp (x &optional env)
"Evaluate the expression x in the environment env.
This version is properly tail-recursive."
(prog ()
:INTERP
(return
(cond
((symbolp x) (get-var x env))
((atom x) x)
((scheme-macro (first x))
(setf x (scheme-macro-expand x)) (go :INTERP))
((case (first x)
(QUOTE (second x))
(BEGIN (pop x) ; pop off the BEGIN to get at the args
;; Now interpret all but the last expression
(loop while (rest x) do (interp (pop x) env))
;; Finally, rename the last expression as x
(setf x (first x))
(GO :INTERP))
(SET! (set-var! (second x) (interp (third x) env) env))
(IF (setf x (if (interp (second x) env)
(third x)
(fourth x)))
;; That is, rename the right expression as x
(GO :INTERP))
(LAMBDA (make-proc :env env :parms (second x)
:code (maybe-add 'begin (rest2 x))))
(t ;; a procedure application
(let ((proc (interp (first x) env))
(args (mapcar #'(lambda (v) (interp v env))
(rest x))))
(if (proc-p proc)
;; Execute procedure with rename+goto
(progn
(setf x (proc-code proc))
(setf env (extend-env (proc-parms proc) args
(proc-env proc)))
(GO :INTERP))
;; else apply primitive procedure
(apply proc args))))))))))
(defstruct (proc (:print-function print-proc))
"Represent a Scheme procedure"
code (env nil) (name nil) (parms nil))
(defun print-proc (proc &optional (stream *standard-output*) depth)
(declare (ignore depth))
(format stream "{~a}" (or (proc-name proc) '??)))
|