Pasted

#lang racket
(require racket/mpair)
 
;;;;;;;;;;
;; 4.11 ;;
;;;;;;;;;;
 
;; A frame is a list of name-value pairs with a 'frame header.  Note that we can't
;; use the empty list for the empty frame; otherwise, the empty frame would have no
;; mcar or mcdr to mutate when we want to add a binding.  Hence the 'frame header.
 
(define the-empty-frame (mlist 'frame))
(define (empty-frame? frame)
  (empty? (frame-bindings frame)))
 
(define (make-frame vars vals)
  (mcons 'frame (mmap mcons vars vals)))
(define (frame-bindings frame) (mcdr frame))
(define (frame-variables frame) (mmap mcar (frame-bindings frame)))
(define (frame-values frame) (mmap mcdr (frame-bindings frame)))
 
(define (binding-variable binding) (mcar binding))
(define (binding-value binding) (mcdr binding))
(define (set-value! binding val) (set-mcdr! binding val))
 
(define (add-binding-to-frame! var val frame)
  (mappend! frame (mlist (mcons var val))))
 
;; TESTS FOR ADD-BINDING-TO-FRAME!
 
(define frame1 (make-frame (mlist 'a) (mlist 1)))
(add-binding-to-frame! 'b 2 frame1)
;; (mcons 'frame (mcons (mcons 'a 1) (mcons (mcons 'b 2) '())))
(equal? frame1 (make-frame (mlist 'a 'b) (mlist 1 2)))
;; #t
 
(define frame2 the-empty-frame)
(add-binding-to-frame! 'a 1 frame2)
;; (mcons 'frame (mcons (mcons 'a 1) '()))
(equal? frame2 (make-frame (mlist 'a) (mlist 1)))
;; #t
 
;; We also need to change set-variable-value! and define-variable!.
;; lookup-variable-value is OK as written for the new frame representation.
 
(define (find-binding-in-frame var frame)
  ; Return the var-val pair if present else false.
  (define (loop bindings)
    (cond [(empty? bindings) false]
          [else
            (define b (mcar bindings))
            (if (eq? var (binding-variable b))
              b
              (loop (mcdr bindings)))]))
  (loop (frame-bindings frame)))
 
(define (set-variable-value! var val env)
  (define (env-loop env)
    (cond [(eq? env the-empty-environment)
           (error "Unbound variable -- SET!" var)]
          [else
            (define frame (first-frame env))
            (define b (find-binding-in-frame var frame))
            (if b
              (set-value! b val)
              (env-loop (enclosing-environment env)))]))
  (env-loop env))
 
(define (define-variable! var val env)
  (define frame (first-frame env))
  (define b (find-binding-in-frame var frame))
  (if b
    (set-mcar! b val)
    (add-binding-to-frame! var val frame)))
 
(define (lookup-variable-value var env) ; this is the book version
  (define (env-loop env)
    (define (scan vars vals)
      (cond [(empty? vars)
             (env-loop (enclosing-environment env))]
            [(eq? var (mcar vars))
             (mcar vals)]
            [else (scan (mcdr vars) (mcdr vals))]))
    (cond [(eq? env the-empty-environment)
           (error "Unbound variable" var)]
          [else
            (define frame (first-frame env))
            (scan (frame-variables frame)
                  (frame-values frame))]))
  (env-loop env))
 
(define (enclosing-environment env) (mcdr env))
(define (first-frame env) (mcar env))
(define the-empty-environment empty)
 
;; TEST
 
(define f (make-frame (mlist 'a 'b 'c) (mlist 1 2 3)))
(define env (mlist f))
 
(lookup-variable-value 'c env)
;; 3
(set-variable-value! 'c 42 env)
(lookup-variable-value 'c env)
;; 42
(define-variable! 'd 5 env) ; mappend! in add-binding-to-frame! returns the frame
;; (mcons
 ;; 'frame
 ;; (mcons
  ;; (mcons 'a 1)
  ;; (mcons (mcons 'b 2) (mcons (mcons 'c 42) (mcons (mcons 'd 5) '())))))
(lookup-variable-value 'd env)
;; 5
env
;; (mcons
 ;; (mcons
  ;; 'frame
  ;; (mcons
   ;; (mcons 'a 1)
   ;; (mcons (mcons 'b 2) (mcons (mcons 'c 42) (mcons (mcons 'd 5) '())))))
 ;; '())
 
;;;;;;;;;;
;; 4.12 ;;
;;;;;;;;;;
 
;; We can abstract these procedures in terms of find-binding-in-frame and a new
;; procedure find-binding-in-env.  We'll keep the frame representation from exercise
;; 4.11.
 
(define (find-binding-in-env var env)
  ; Return the closest binding for var if present else false.
  (cond [(eq? env the-empty-environment) false]
        [else
          (define b (find-binding-in-frame var (first-frame env)))
          (or b (find-binding-in-env var (enclosing-environment env)))]))
 
(define (lookup-variable-value2 var env)
  (define b (find-binding-in-env var env))
  (if b
    (binding-value b)
    (error "Unbound variable" var)))
 
(define (set-variable-value2! var val env)
  (define b (find-binding-in-env var env))
  (if b
    (set-value! b val)
    (error "Unbound variable -- SET!" var)))
 
(define (define-variable2! var val env)
  (define frame (first-frame env))
  (define b (find-binding-in-frame var frame))
  (if b
    (set-value! b val)
    (add-binding-to-frame! var val frame)))
 
;; TEST
 
(define f2 (make-frame (mlist 'x 'y 'z) (mlist 10 11 12)))
(define env2 (mlist f2))
 
(lookup-variable-value2 'y env2)
;; 11
(set-variable-value2! 'y 42 env2)
(lookup-variable-value2 'y env2)
;; 42
(define-variable2! 'w 33 env2) ; mappend! in add-binding-to-frame! returns the frame
;; (mcons
 ;; 'frame
 ;; (mcons
  ;; (mcons 'x 10)
  ;; (mcons (mcons 'y 42) (mcons (mcons 'z 12) (mcons (mcons 'w 33) '())))))
(lookup-variable-value2 'w env2)
;; 33
env2
;; (mcons
 ;; (mcons
  ;; 'frame
  ;; (mcons
   ;; (mcons 'x 10)
   ;; (mcons (mcons 'y 42) (mcons (mcons 'z 12) (mcons (mcons 'w 33) '())))))
 ;; '())
;; (lookup-variable-value2 'not-there env2)
;; ;; . . Unbound variable not-there
 
;;;;;;;;;;
;; 4.13 ;;
;;;;;;;;;;
 
;; We'll have make-unbound! remove only the binding in the first frame.  In the
;; interest of modularity, it seems unwise to have a procedure that searches and
;; modifies the entire environment, possibly removing bindings created by other parts
;; of the program.  But if we ever needed that functionality, we could always create
;; a make-global-unbound! function.
 
;; Should we remove frames from the environment that have had all the bindings
;; removed?  I think not because the frame is a node in a graph, a place, and not
;; just a collection of values.  A procedure may want to create new bindings in that
;; place without realizing it is empty and needs to be created.  So be aware that
;; this implementation of make-unbound! may leave empty frames in the environment.
 
;; Use the representaion and helper functions from exercises 4.11 and 4.12.
 
(define (remove-binding! b frame)
  ; Mutate frame to remove b.  Assume b is in frame.
  (define (loop! lst)
    (if (equal? b (mcar (mcdr lst)))
      (set-mcdr! lst (mcdr (mcdr lst)))
      (loop! (mcdr lst))))
  (loop! frame))
 
(define (make-unbound! var env)
  (define frame (first-frame env))
  (define b (find-binding-in-frame var frame))
  (when b (remove-binding! b frame)))
 
;; TEST
 
(define f3 (make-frame (mlist 'p 'q 'r) (mlist 1 2 3)))
(define env3 (mlist f3))
env3
;; (mcons
 ;; (mcons
  ;; 'frame
  ;; (mcons (mcons 'p 1) (mcons (mcons 'q 2) (mcons (mcons 'r 3) '()))))
 ;; '())
(make-unbound! 'p env3)
env3
;; (mcons (mcons 'frame (mcons (mcons 'q 2) (mcons (mcons 'r 3) '()))) '())
(make-unbound! 'r env3)
env3
;; (mcons (mcons 'frame (mcons (mcons 'q 2) '())) '())
(make-unbound! 'q env3)
env3
;; (mcons (mcons 'frame '()) '())
(eq? env3 the-empty-environment)
;; #f