;;;;EVDATA.SCM ;;; Evaluator data structures for Chapter 5 ;;; Please ignore the following magic for the Scheme compiler. (declare (usual-integrations)) (define (true? x) (not (eq? x #f))) (define (false? x) (eq? x #f)) (define the-unspecified-value (list 'the-unspecified-value)) ;;; Primitive procedures are inherited from Scheme. (define primitive-procedure? procedure?) (define apply-primitive-procedure apply) ;;; Compound procedures (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? exp) (tagged-list? exp 'procedure)) (define (procedure-parameters p) (list-ref p 1)) (define (procedure-body p) (list-ref p 2)) (define (procedure-environment p) (list-ref p 3)) ;;; procedures with declarations are used with the ;;; cbn interpreter. (define (make-procedure-with-declarations vars bproc env) (list 'procedure-with-declarations vars bproc env)) (define (procedure-with-declarations? obj) (tagged-list? obj 'procedure-with-declarations)) ;;;; THE INITIAL ENVIRONMENT ;;; This switch controls whether we give the evaluator access to all ;;; Scheme variables, as in exercise 4.11, versus giving just a fixed ;;; list of primitives. Giving access to all Scheme variables is a ;;; little dangerous, since Scheme's primitive higher-order procedures ;;; (e.g., MAP) won't work when passed procedures from the MC ;;; evaluator. For class work, we'll stay with a fixed set of ;;; procedures, and use the other option for experimenting. (define access-entire-scheme-environment? false) ;;; Environments ;;; An ENVIRONMENT is a chain of FRAMES. (define the-empty-environment '()) (define (environment-parent env) (cdr env)) (define (first-frame env) (car env)) (define (environment-variables env) (car (first-frame env))) (define (environment-values env) (cdr (first-frame env))) (define (extend-environment variables values base-environment) (if (= (length variables) (length values)) (cons (cons variables values) base-environment) (if (< (length variables) (length values)) (error "Too many arguments supplied" variables values) (error "Too few arguments supplied" variables values)))) (define (make-initial-environment) (if access-entire-scheme-environment? (make-initial-environment-access-all-scheme) (make-initial-environment-restricted))) (define (make-initial-environment-access-all-scheme) (set! scheme-variable-cache '()) (extend-environment '() '() the-empty-environment)) (define (make-initial-environment-restricted) (extend-environment primitives-from-underlying-scheme (map (lambda (name) (eval name user-initial-environment)) primitives-from-underlying-scheme) the-empty-environment)) (define primitives-from-underlying-scheme '(+ - * / inc dec = < > zero? not true false cons car cdr pair? null? list symbol? eq? write-line)) (define the-global-environment (make-initial-environment)) (define (lookup-variable-value var env) (define (parent-loop env) (define (scan vars vals) (cond ((null? vars) (parent-loop (cdr env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (lookup-scheme-value var) (scan (caar env) (cdar env)))) (parent-loop env)) (define (set-variable-value! var val env) (define (parent-loop env) (define (scan vars vals) (cond ((null? vars) (parent-loop (cdr env))) ((eq? var (car vars)) (set-car! vals val) the-unspecified-value) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable -- SET!" var) (scan (caar env) (cdar env)))) (parent-loop env)) (define (define-variable! var val env) (define (scan vars vals) (cond ((null? vars) (set-car! (car env) (cons var (environment-variables env))) (set-cdr! (car env) (cons val (environment-values env))) the-unspecified-value) ((eq? var (car vars)) (set-car! vals val) the-unspecified-value) (else (scan (cdr vars) (cdr vals))))) (scan (environment-variables env) (environment-values env))) ;;; We speed up Scheme variable lookup by keeping ;;; a cache of the variables that we actually look up. (define lexical-unreferenceable? (make-primitive-procedure 'lexical-unreferenceable?)) (define lexical-reference (make-primitive-procedure 'lexical-reference)) (define scheme-variable-cache '()) (define (lookup-scheme-value var) (if access-entire-scheme-environment? (let ((vcell (assq var scheme-variable-cache))) (cond (vcell (cdr vcell)) ((not (lexical-unreferenceable? user-initial-environment var)) (let ((val (lexical-reference user-initial-environment var))) (set! scheme-variable-cache (cons (cons var val) scheme-variable-cache)) val)) (else (error "Unbound variable" var)))) (error "Unbound variable" var))) ;;; For eceval and compiler in chapter 5 (define (empty-arglist) '()) (define (adjoin-arg arg arglist) (append arglist (list arg))) ;;; Compiled procedure data structures. For compiler in section 5.3 (define (make-compiled-procedure entry env) (list 'compiled-procedure entry env)) (define (compiled-procedure? proc) (tagged-list? proc 'compiled-procedure)) (define (compiled-procedure-entry c-proc) (cadr c-proc)) (define (compiled-procedure-env c-proc) (caddr c-proc)) ;;;This is to keep the Scheme printer from going into an infinite loop ;;;if you try to print a circular data structure, such as an environment (set! *unparser-list-depth-limit* 10) (set! *unparser-list-breadth-limit* 10) ;;;This keeps ECEVAL from printing environments (define (user-print object) (cond ((compound-procedure? object) (write (list 'compound-procedure (procedure-parameters object) (procedure-body object) '))) ((compiled-procedure? object) (write ')) (else (write object))))