6.001 Lazy Metacircular Evaluator 6 (define the-global-environment (setup-environment)) (define (apply-primitive-procedure proc args) (apply (primitive-implementation proc) args)) The Read-Eval-Print Loop (define input-prompt";;; L-Eval input: " (define output-prompt ";;i L-Eval value: " (define(driver-loop) (prompt-for- (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (display output))) (driver-loop)) (defin ompt-f ut string) (newline)(newline)(display string)(newline)) (define (announce-output string) (newline)(display string)(newline)) Representing Thunks (define (delay-it exp env) (list 'thunk exp env)) (define (thunk? obj)(tagged-list? obj 'thunk)) define(thunk-exp thunk)(cadr thunk)) (define (thunk-env thunk)(caddr thunk)) (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) (set-cdr! (cdr obj)'O) ((evaluated-thunk? obj)(thunk-value obj)) (else obj))) (define (actual-value exp env) (force-it (l-eval exp env))) define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk))6.001 Lazy Metacircular Evaluator 6 (define the-global-environment (setup-environment)) (define (apply-primitive-procedure proc args) (apply (primitive-implementation proc) args)) The Read-Eval-Print Loop (define input-prompt ";;; L-Eval input:") (define output-prompt ";;; L-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (display output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) Representing Thunks (define (delay-it exp env) (list ’thunk exp env)) (define (thunk? obj) (tagged-list? obj ’thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk)) (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) (set-cdr! (cdr obj) ’()) result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) (define (actual-value exp env) (force-it (l-eval exp env))) (define (evaluated-thunk? obj) (tagged-list? obj ’evaluated-thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk))