(define empty-env (lambda () '())) (define extend-env (lambda (syms vals env) (cons (cons syms (list->vector vals)) env))) (define extend-env-recur (lambda (syms vals env) (let* ([vec (list->vector vals)] [new-env (cons (cons syms vec) env)]) (for-each (lambda (item pos) (if (proc? item) (vector-set! vec pos (cases proc item [closure (ids bodies toss-env) (closure ids bodies new-env)] [list-closure (ids bodies toss-env) (list-closure ids bodies new-env)] [dotted-closure (ids bodies toss-env) (dotted-closure ids bodies new-env)] [primitive (id) item])))) vals (make-indices (- (length vals) 1) '())) new-env))) (define make-indices (lambda (n accu) (if (= n 0) (cons 0 accu) (make-indices (- n 1) (cons n accu))))) (define apply-env (lambda (env sym) (if (null? env) (apply-global-env sym) (let ([syms (caar env)] [vals (cdar env)] [env (cdr env)]) (let ((pos (find-position sym syms))) (if (number? pos) ; (vector-ref! vals pos) (let ([result (vector-ref vals pos)]) (if (and (pair? result) (eq? (car result) 'ref)) (apply-env (caddr result) (cadr result)) ;;; changed 1st arg from "env" result)) (apply-env env sym))))))) (define change-env (lambda (env sym val) (if (null? env) (change-global-env sym val) (let ([syms (caar env)] [vals (cdar env)] [env (cdr env)]) (let ((pos (find-position sym syms))) (if (number? pos) ; (vector-set! vals pos val) ; (if (and (pair? (vector-ref vals pos)) ; (eq? (car (vector-ref vals pos)) 'ref)) ; (change-env env (cadr (vector-ref vals pos)) val) ; (vector-set! vals pos val)) (let ([result (vector-ref vals pos)]) (if (and (pair? result) (eq? (car result) 'ref)) (change-env (caddr result) (cadr result) val) ;;; changed 1st arg from "env" (vector-set! vals pos val))) (change-env env sym val))))))) (define find-position (lambda (sym ls) (cond [(null? ls) #f] [(eq? sym (car ls)) 0] [else (let ([index (find-position sym (cdr ls))]) (if (number? index) (+ index 1) #f))]))) (define apply-global-env (lambda (sym) (let ([val (assq sym global-env)]) (if val (cdr val) (eopl:error 'apply-global-env "No binding for ~s" sym))))) (define change-global-env (lambda (sym new-val) (let ([val (assq sym global-env)]) (if val (set-cdr! val new-val) (eopl:error 'change-global-env "No binding for ~s" sym))))) (define extend-global-env (lambda (sym new-val) (let ([val (assq sym global-env)]) (if val (set-cdr! val new-val) (set! global-env (cons (cons sym new-val) global-env))))))