src/sicp/ex4_11.rkt

   1 #lang r5rs
   2
   3 (define (error x)
   4   (display x)
   5   (newline))
   6
   7 (define (make-frame variables values)
   8   (if (not (= (length variables)
   9               (length values)))
  10       (error "Number of variables and values should be the same -- MAKE-FRAME")
  11       (map cons variables values)))
  12
  13 (define (frame-variables frame)
  14   (map car frame))
  15
  16 (define (frame-values frame)
  17   (map cdr frame))
  18
  19 (define (add-binding-to-frame! var val frame)
  20   (define (add-to-end-of-frame! b f)
  21     (if (null? (cdr f))
  22         (set-cdr! f b)
  23         (add-to-end-of-frame! b (cdr f))))
  24   (add-to-end-of-frame! (cons var val) frame))
  25
  26 (define (lookup-variable-value var env)
  27   (define (env-loop env)
  28     (define (scan frame)
  29       (if (null? frame)
  30           (env-loop (enclosing-environment env))
  31           (let ((p (car frame)))
  32             (if (eq? var (car p))
  33                 (cdr p)
  34                 (scan (cdr frame))))))
  35     (if (eq? env the-empty-environment)
  36         (error "variable not defined")
  37         (let ((f (first-frame env)))
  38           (scan f))))
  39   (env-loop env))
  40
  41 (define (set-variable-value! var val env)
  42   (define (env-loop env)
  43     (define (scan frame)
  44       (if (null? frame)
  45           (env-loop (enclosing-environment env))
  46           (let ((p (car frame)))
  47             (if (eq? var (car p))
  48                 (set-cdr! p val)
  49                 (scan (cdr frame))))))
  50     (if (eq? env the-empty-environment)
  51         (error "variable not defined")
  52         (let ((f (first-frame env)))
  53           (scan f))))
  54   (env-loop env))
  55
  56 (define (define-variable! var val env)
  57   (let ((frame (first-frame env)))
  58     (define (scan frame)
  59       (if (null? frame)
  60           (add-binding-to-frame var val frame)
  61           (let ((p (car frame)))
  62             (if (eq? (car p) var)
  63                 (set-cdr! p val)
  64                 (scan (cdr frame))))))
  65     (scan frame)))