1 files changed, 72 insertions, 0 deletions

diff --git a/environment.scm b/environment.scm
new file mode 100644
index 0000000..2444059
--- /dev/null
+++ b/environment.scm
@@ -0,0 +1,72 @@
+(include "prelude/primitives.scm")
+
+;;; env
+(define (enclosing-env environ) (cdr environ))
+(define (first-frame environ) (car environ))
+(define the-empty-env '())
+(define (empty-env? environ) (eq? environ the-empty-env))
+
+;; frames
+(define (make-frame variables values)
+  (cons variables values))
+(define frame-variables car)
+(define frame-values cdr)
+(define (add-binding-to-frame! var val frame)
+  (begin
+    (set-car! frame (cons var (frame-variables frame)))
+    (set-cdr! frame (cons val (frame-values frame)))))
+(define (extend-env vars vals base-env)
+  (if (= (length vars) (length vals))
+      (cons (make-frame vars vals) base-env)
+      (error "Too few or too many arguments supplied" vars vals)))
+
+;;; variable lookup
+(define (lookup-variable-value var env)
+  (cond
+    [(empty-env? env) (error "Unbound variable" var)]
+    [else
+      (let ([f (first-frame env)])
+        (let scan ([variables (frame-variables f)]
+                   [values (frame-values f)])
+          (cond
+            [(null? variables)
+             (lookup-variable-value var
+                                    (enclosing-env env))]
+            [(eq? var (car variables)) (car values)]
+            [else (scan (cdr variables) (cdr values))])))]))
+
+;;; environment modification
+(define (set-variable-value! var val env)
+  (cond
+    [(empty-env? env) (error "Unbound variable" var)]
+    [else
+      (let ([f (first-frame env)])
+        (let scan ([variables (frame-variables f)]
+                   [values (frame-values f)])
+          (cond
+            [(null? variables) (set-variable-value! 
+                                 var
+                                 val
+                                 (enclosing-env env))]
+            [(eq? var (car variables)) (set-car! values val)]
+            [else (scan (cdr variables) (cdr values))])))]))
+
+(define (define-variable! var val env)
+  (let ([f (first-frame env)])
+    (define (scan vars vals)
+      (cond
+        [(null? vars) (add-binding-to-frame! var val f)]
+        [(eq? var (car vars)) (set-car! vals val)]
+        [else (scan (cdr vars) (cdr vals))]))
+    (scan (frame-variables f)
+          (frame-values f))))
+
+(define (setup-environment)
+  (let ([initial-env (extend-env
+                       (primitive-names)
+                       (primitive-objs)
+                       the-empty-env)])
+    (define-variable! 'true #t initial-env)
+    (define-variable! 'false #f initial-env)
+    initial-env))
+