ch4

ch4/ex4-11.scm

@@ -0,0 +1,88 @@
+#|#lang racket
+(require r5rs)|#
+
+;; Example 4.11
+
+;; environment
+
+;; environment is the list of frames
+(define (enclosing-environment env) (cdr env))
+(define (first-frame env) (car env))
+(define the-empty-environment '())
+
+;; frame is list of bindings (var:val)
+(define (make-frame variables values)
+  (cond ((or (null? variables) (null? values))
+         '())
+        ((= (length variables) (length values))
+         (cons (cons (car variables) (car values))
+               (make-frame (cdr variables) (cdr values))))
+        (else (error "Different size -- MAKE_FRAME" variables values))))
+
+(define (add-binding-to-frame! var val frame)
+  (let ((new-binding (list (cons var val))))
+    (if (null? (cdr frame))
+        (set-cdr! frame new-binding)
+        (add-binding-to-frame! var val (cdr frame)))))
+
+(define (lookup-variable-value var env)
+  (define (env-loop env)
+    (define (scan frame)
+      (cond ((null? frame)
+             (env-loop (enclosing-environment env)))
+            ((eq? var (caar frame))
+             (cdar frame))
+            (else (scan (cdr frame)))))
+    (if (eq? env the-empty-environment)
+        (error "Unbound variable" var)
+        (scan (first-frame env))))
+  (env-loop env))
+
+(define (set-variable-value! var val env)
+  (define (env-loop env)
+    (define (scan frame)
+      (cond ((null? frame)
+             (env-loop (enclosing-environment env)))
+            ((eq? var (caar frame))
+             (set-cdr! (car frame) val))
+            (else (scan (cdr frame)))))
+    (if (eq? env the-empty-environment)
+        (error "Unbound variable -- SET!" var)
+        (scan (first-frame env))))
+  (env-loop env))
+
+(define (define-variable! var val env)
+  (define (scan frame)
+    (cond ((null? frame)
+           (add-binding-to-frame! var val (first-frame env)))
+          ((eq? var (caar frame))
+           (set-cdr! (car frame) val))
+          (else (scan (cdr frame)))))
+  (scan (first-frame env)))
+
+(define variables '(x y z))
+(define vals '(42 24 -5))
+(define frame (make-frame variables vals))
+(define env (list frame))
+
+(display "Original frame :\n")
+frame
+
+(add-binding-to-frame! 'q 100 frame)
+(display "After adding (q:100) :\n")
+frame
+
+(display "Lookup added vars :\n")
+(lookup-variable-value 'x env)
+(lookup-variable-value 'y env)
+(lookup-variable-value 'z env)
+(lookup-variable-value 'q env)
+
+(display "Setting some vars to new vals :\n")
+(set-variable-value! 'x 2 env)
+(set-variable-value! 'q 1 env)
+frame
+
+(display "Definition (t:2) :\n")
+(define-variable! 't 2 env)
+frame

ch4/ex4-12.scm

@@ -0,0 +1,3 @@
+#lang racket
+
+;; Example 4.12

ch4/test_interpreter.scm

@@ -188,4 +188,75 @@
 
 (define (procedure-parameters p) (cadr p))
 (define (procedure-body p) (caddr p))
-(define (procedure-body p) (cadddr p))
+(define (procedure-environment p) (cadddr p))
+
+;; environment
+
+;; environment is the list of frames
+(define (enclosing-environment env) (cdr env))
+(define (first-frame env) (car env))
+(define the-empty-environment '())
+
+;; frame is the two lists: list of variables and list of values
+(define (make-frame variables values)
+  (cons variables values))
+(define (frame-variables frame) (car frame))
+(define (frame-values frame) (cdr frame))
+(define (add-binding-to-frame! var val frame)
+  (set-car! frame (cons var (car frame)))      ;; mutable append (frame = x + frame)
+  (set-cdr! frame (cons val (cdr frame))))
+
+;; create new frame(vars, vals) and ptr to base env
+(define (extend-environment vars vals base-env)
+  (if (= (length vars) (length vals))
+      (cons (make-frame vars vals) base-env)
+      (if (< (length vars) (length vals))
+          (error "Too many arguments supplied" vars vals)
+          (error "Too few arguments supplied" vars vals))))
+
+(define (lookup-variable-value var env)
+  (define (env-loop env)
+
+    (define (scan vars vals)
+      (cond ((null? vars)
+             (env-loop (enclosing-environment env)))
+            ((eq? var (car vars))
+             (car vals))
+            (else (scan (cdr vars) (cdr vals)))))
+
+    (if (eq? env the-empty-environment)
+        (error "Unbound variable" var)
+        (let ((frame (first-frame env)))
+          (scan (frame-variables frame)
+                (frame-values frame)))))
+
+  (env-loop env))
+
+(define (set-variable-value! var val env)
+  (define (env-loop env)
+
+    (define (scan vars vals)
+      (cond ((null? vars)
+             (env-loop (enclosing-environment env)))
+            ((eq? var (car vars))
+             (set-car! vals val))
+            (else (scan (cdr vars) (cdr vals)))))
+
+    (if (eq? env the-empty-environment)
+        (error "Unbound variable -- SET!" var)
+        (let ((frame (first-frame env)))
+          (scan (frame-variables frame)
+                (frame-values frame)))))
+
+  (env-loop env))
+
+(define (define-variable! var val env)
+  (let ((frame (first-frame env)))
+    (define (scan vars vals)
+      (cond ((null? vars)
+             (add-binding-to-frame! var val frame))
+            ((eq? var (car vars))
+             (set-car! vals val))
+            (else (scan (cdr vars) (cdr vals)))))
+    (scan (frame-variables frame)
+          (frame-values frame))))