fisl

commit 517e4a7c97715986f72c5902c8162b95b9c21c5b (patch)
parent 19417d286621943eb6406d6b938c8ee63b0f08ac
Author: Alex Karle <alex@alexkarle.com>
Date:   Mon,  7 Nov 2022 23:24:35 -0500

Add support for assignment

ch8.4

> var x = 2;
> print x = 1;
1

Diffstat:
M
interpreter.scm
 | 
8
++++++++
M
parser.scm
 | 
22
++++++++++++++++++++--

2 files changed, 28 insertions(+), 2 deletions(-)
diff --git a/interpreter.scm b/interpreter.scm
@@ -41,6 +41,14 @@
         (hash-table-ref global-env (token-lexeme tok))
         (runtime-err! (format "~Unbound variable ~A at line ~A"
                               (token-lexeme tok) (token-line tok))))))
+   ((assignment? expr)
+    (let ((tok (assignment-name expr)))
+      (if (hash-table-exists? global-env (token-lexeme tok))
+        (begin
+          (hash-table-set! global-env (token-lexeme tok) (assignment-value expr))
+          (assignment-value expr))
+        (runtime-err! (format "Unbound variable ~A at line ~A"
+                              (token-lexeme tok) (token-line tok))))))
    ((unary? expr)
     (let ((right (evaluate (unary-right expr)))
           (op (token-type (unary-operator expr))))
diff --git a/parser.scm b/parser.scm
@@ -26,7 +26,12 @@
 
 (define-record variable name)
 (set-record-printer! variable
-		     (lambda (x out) (fprintf out "~A" (token-lexeme x))))
+		     (lambda (x out) (fprintf out "~A" (token-lexeme (variable-name x)))))
+
+(define-record assignment name value)
+(set-record-printer! assignment
+		     (lambda (x out) (fprintf out "(set! ~A ~A)" (token-lexeme (assignment-name x)) (assignment-value x))))
+
 
 
 (define-record print-stmt value)
@@ -101,7 +106,20 @@
 	    (panic (car toks) "expected ;")))))
 
   (define (expression expr toks)
-    (equality expr toks))
+    (assignment expr toks))
+
+  (define (assignment expr toks)
+    (let* ((ret (equality expr toks))
+           (e2 (car ret))
+           (t2 (cdr ret)))
+      (if (top-type? t2 '(EQUAL))
+        (let* ((ret2 (assignment e2 (cdr t2)))
+               (e3 (car ret2))
+               (t3 (cdr ret2)))
+          (if (variable? e2)
+            (cons (make-assignment (variable-name e2) e3) t3)
+            (begin (err! "Invalid assignment target") (cons e2 t3))))
+        (cons e2 t2))))
 
   (define (equality expr toks)
     ;; (print (format "equality ~S ~S" expr toks))