From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Sun, 13 Nov 2011 15:56:07 +0000 (+0530)
Subject: changes to evaluator taking the exercise solutions into account
X-Git-Url: https://git.rkrishnan.org/pf/content/en/seg/priv/frontends/(%5B%5E?a=commitdiff_plain;h=bcae2fe9a2c2a782a8757deb8f3d83db32590dbb;p=sicp.git

changes to evaluator taking the exercise solutions into account
---

diff --git a/src/sicp/metacircular.rkt b/src/sicp/metacircular.rkt
index 24ef7e0..bae6128 100644
--- a/src/sicp/metacircular.rkt
+++ b/src/sicp/metacircular.rkt
@@ -184,4 +184,86 @@
                        clauses))
             (make-if (cond-predicate first)
                      (sequence->exp (cond-actions first))
-                     (expand-clauses rest))))))
\ No newline at end of file
+                     (expand-clauses rest))))))
+
+;; true and false
+(define (true? x)
+  (not (eq? x false)))
+
+(define (false? x)
+  (eq? x false))
+
+;; procedures
+(define (make-procedure parameters body env)
+  (list 'procedure parameters body env))
+
+(define (compound-procedure? p)
+  (tagged-list? p 'procedure))
+
+(define (procedure-parameters p) (cadr p))
+(define (procedure-body p) (caddr p))
+(define (procedure-env p) (cadddr p))
+
+;; operations on environment
+(define (enclosing-environment env) (cdr env))
+(define (first-frame env) (car env))
+(define the-empty-environment '())
+
+;; frame operations
+(define (make-frame variables values)
+  (cons variables values))
+
+(define (frame-variables frame) (car frame))
+(define (frame-values frame) (cdr frame))
+(define (add-bindings-to-frame! var val frame)
+  (set-car! frame (cons var (frame-variables frame)))
+  (set-cdr! frame (cons val (frame-values frame))))
+
+(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 args supplied" vars vals)
+          (error "Too many args 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" 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-bindings-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))))
+