fisl

commit 5e57cfe6bf28e2038efa9dfc775bb435f3627e0f (patch)
parent 9b0ba684a64cf7ea6f516865ef923c4697c68b0c
Author: Alex Karle <alex@alexkarle.com>
Date:   Thu, 17 Nov 2022 15:02:41 -0500

interpreter: Add custom 'env' object for nested envs

This sets the stage for block scope, but keeps the existing
"everything is global" behavior.

I'm 85% sure the (make-env) returning a proc that returns procs is
something I've seen in SICP (as a means of creating objects with methods).

Diffstat:
M
interpreter.scm
 | 
42
++++++++++++++++++++++++++++++++++--------

1 file changed, 34 insertions(+), 8 deletions(-)
diff --git a/interpreter.scm b/interpreter.scm
@@ -5,7 +5,36 @@
 
 (define interpreter-abort #f)
 
-(define global-env (make-hash-table))
+(define global-env (make-env #f))
+
+(define (make-env parent)
+  (let ((ht (make-hash-table)))
+    (lambda (action)
+      (cond ((eq? action 'get)
+	     (lambda (el)
+	       (if (hash-table-exists? ht el)
+		   (hash-table-ref ht el)
+		   (if parent
+		       (env-get parent el)
+		       (runtime-err! (format "Unbound variable ~A" el))))))
+	    ((eq? action 'set)
+	     (lambda (el val)
+	       (hash-table-set! ht el val)))
+	    ((eq? action 'exists)
+	     (lambda (el)
+	       (if (hash-table-exists? ht el)
+		   #t
+		   (and parent (env-exists? parent el)))))
+	    (else (error (format "Unknown action for env -- ~A" action)))))))
+
+(define (env-get env key)
+  ((env 'get) key))
+
+(define (env-set! env key val)
+  ((env 'set) key val))
+
+(define (env-exists? env key)
+  ((env 'exists) key))
 
 (define (runtime-err! msg)
   (err! msg)
@@ -34,15 +63,12 @@
     (evaluate (grouping-expression expr)))
    ((variable? expr)
     (let ((tok (variable-name expr)))
-      (if (hash-table-exists? global-env (token-lexeme tok))
-        (hash-table-ref global-env (token-lexeme tok))
-        (runtime-err! (format "~Unbound variable ~A at line ~A"
-                              (token-lexeme tok) (token-line tok))))))
+      (env-get global-env (token-lexeme tok))))
    ((assignment? expr)
     (let ((tok (assignment-name expr)))
-      (if (hash-table-exists? global-env (token-lexeme tok))
+      (if (env-exists? global-env (token-lexeme tok))
         (let ((res (evaluate (assignment-value expr))))
-          (hash-table-set! global-env (token-lexeme tok) res)
+          (env-set! global-env (token-lexeme tok) res)
           res)
         (runtime-err! (format "Unbound variable ~A at line ~A"
                               (token-lexeme tok) (token-line tok))))))
@@ -109,7 +135,7 @@
             (if (null? (var-stmt-init stmt))
               '()
               (evaluate (var-stmt-init stmt)))))
-      (hash-table-set! global-env (token-lexeme (var-stmt-name stmt)) value))
+      (env-set! global-env (token-lexeme (var-stmt-name stmt)) value))
     '())
    ((expr-stmt? stmt)
     (let ((res (evaluate (expr-stmt-value stmt))))