Permalink
Browse files

ch4

  • Loading branch information...
1 parent da1da74 commit 454fa416c907bbf4cb0f58bf6f732f7dbb146025 @flaming0 committed Aug 29, 2012
Showing with 163 additions and 1 deletion.
  1. +88 −0 ch4/ex4-11.scm
  2. +3 −0 ch4/ex4-12.scm
  3. +72 −1 ch4/test_interpreter.scm
View
@@ -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
View
@@ -0,0 +1,3 @@
+#lang racket
+
+;; Example 4.12
@@ -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))))

0 comments on commit 454fa41

Please sign in to comment.