93 lines
2.7 KiB
Scheme
93 lines
2.7 KiB
Scheme
;;;;LAZY EVALUATOR FROM SECTION 4.2 OF
|
|
;;;; STRUCTURE AND INTERPRETATION OF COMPUTER PROGRAMS
|
|
|
|
;;;;Matches code in ch4.scm
|
|
;;;; Also includes enlarged primitive-procedures list
|
|
|
|
;;;;This file can be loaded into Scheme as a whole.
|
|
;;;;**NOTE**This file loads the metacircular evaluator of
|
|
;;;; sections 4.1.1-4.1.4, since it uses the expression representation,
|
|
;;;; environment representation, etc.
|
|
;;;; You may need to change the (load ...) expression to work in your
|
|
;;;; version of Scheme.
|
|
;;;;**WARNING: Don't load mceval twice (or you'll lose the primitives
|
|
;;;; interface, due to renamings of apply).
|
|
|
|
;;;;Then you can initialize and start the evaluator by evaluating
|
|
;;;; the two lines at the end of the file ch4-mceval.scm
|
|
;;;; (setting up the global environment and starting the driver loop).
|
|
|
|
|
|
;;;; To run without memoization, reload the first version of force-it below
|
|
|
|
|
|
;;**implementation-dependent loading of evaluator file
|
|
;;Note: It is loaded first so that the section 4.2 definition
|
|
;; of eval overrides the definition from 4.1.1
|
|
|
|
;;;SECTION 4.2.2
|
|
|
|
;;; Modifying the evaluator
|
|
|
|
(define (actual-value exp env)
|
|
(force-it (eval exp env)))
|
|
|
|
(define (list-of-arg-values exps env)
|
|
(if (no-operands? exps)
|
|
'()
|
|
(cons (actual-value (first-operand exps) env)
|
|
(list-of-arg-values (rest-operands exps)
|
|
env))))
|
|
|
|
(define (list-of-delayed-args exps env)
|
|
(if (no-operands? exps)
|
|
'()
|
|
(cons (delay-it (first-operand exps) env)
|
|
(list-of-delayed-args (rest-operands exps)
|
|
env))))
|
|
|
|
(define (eval-if exp env)
|
|
(if (true? (actual-value (if-predicate exp) env))
|
|
(eval (if-consequent exp) env)
|
|
(eval (if-alternative exp) env)))
|
|
|
|
(define (force-it obj)
|
|
(if (thunk? obj)
|
|
(actual-value (thunk-exp obj) (thunk-env obj))
|
|
obj))
|
|
|
|
;; thunks
|
|
|
|
(define (delay-it exp env)
|
|
(list 'thunk exp env))
|
|
|
|
(define (thunk? obj)
|
|
(and (pair? obj)
|
|
(= (length obj) 3)
|
|
(tagged-list? obj 'thunk)))
|
|
|
|
(define (thunk-exp thunk) (cadr thunk))
|
|
(define (thunk-env thunk) (caddr thunk))
|
|
|
|
;; "thunk" that has been forced and is storing its (memoized) value
|
|
(define (evaluated-thunk? obj)
|
|
(tagged-list? obj 'evaluated-thunk))
|
|
|
|
(define (thunk-value evaluated-thunk) (cadr evaluated-thunk))
|
|
|
|
;; memoizing version of force-it
|
|
(define (force-it obj)
|
|
(cond ((thunk? obj)
|
|
(let ((result (actual-value
|
|
(thunk-exp obj)
|
|
(thunk-env obj))))
|
|
(set-car! obj 'evaluated-thunk)
|
|
(set-car! (cdr obj) result) ; replace exp with its value
|
|
(set-cdr! (cdr obj) '()) ; forget unneeded env
|
|
result))
|
|
((evaluated-thunk? obj)
|
|
(thunk-value obj))
|
|
(else obj)))
|
|
|
|
'LAZY-EVALUATOR-LOADED
|