From cf77b879d8cbf5bd345a8c40d197dd9f8708c9fb Mon Sep 17 00:00:00 2001
From: Alex Karle <alex@alexkarle.com>
Date: Fri, 18 Nov 2022 12:11:31 -0500
Subject: [PATCH] ch9.4: Implement 'while' loops

Another fun one to see come together!

~/src/fisl $ cat examples/while.lox
var x = 10;
while (x > 0) {
    print x;
    x = x - 1;
}
~/src/fisl $ ./fisl.scm examples/while.lox
10
9
8
7
6
5
4
3
2
1
---
 examples/scope.lox |  6 ++++++
 examples/while.lox |  5 +++++
 interpreter.scm    |  7 +++++++
 parser.scm         | 15 +++++++++++++++
 4 files changed, 33 insertions(+)
 create mode 100644 examples/while.lox

diff --git a/examples/scope.lox b/examples/scope.lox
index d563807..c510229 100644
--- a/examples/scope.lox
+++ b/examples/scope.lox
@@ -1,19 +1,25 @@
 var a = "global a";
 var b = "global b";
 var c = "global c";
+var d = "global d";
 {
   var a = "outer a";
   var b = "outer b";
+  d = "outer d";
   {
     var a = "inner a";
+    d = "inner d";
     print a;
     print b;
     print c;
+    print d;
   }
   print a;
   print b;
   print c;
+  print d;
 }
 print a;
 print b;
 print c;
+print d;
diff --git a/examples/while.lox b/examples/while.lox
new file mode 100644
index 0000000..3e254ed
--- /dev/null
+++ b/examples/while.lox
@@ -0,0 +1,5 @@
+var x = 10;
+while (x > 0) {
+    print x;
+    x = x - 1;
+}
diff --git a/interpreter.scm b/interpreter.scm
index 865658d..45dc5a8 100644
--- a/interpreter.scm
+++ b/interpreter.scm
@@ -176,6 +176,13 @@
 	(if (not (null? (if-stmt-else-stmt stmt)))
 	    (execute (if-stmt-else-stmt stmt) env)
 	    '())))
+   ((while-stmt? stmt)
+    (let loop ()
+      (if (truthy? (evaluate (while-stmt-cond-expr stmt) env))
+	  (begin
+	    (execute (while-stmt-body-stmt stmt) env)
+	    (loop))
+	  '())))
    (else (runtime-err! (format "Unknown stmt ~A" stmt)))))
 
 ;; Save the global-env outside interpret so that it persists in the REPL
diff --git a/parser.scm b/parser.scm
index 2947787..b33a4be 100644
--- a/parser.scm
+++ b/parser.scm
@@ -49,6 +49,7 @@
 (define-record var-stmt name init)
 (define-record block stmts)
 (define-record if-stmt cond-expr then-stmt else-stmt)
+(define-record while-stmt cond-expr body-stmt)
 
 (set-record-printer! print-stmt
   (lambda (x out)
@@ -73,6 +74,9 @@
       (if-stmt-then-stmt x)
       (if-stmt-else-stmt x))))
 
+(set-record-printer! while-stmt
+  (lambda (x out)
+    (fprintf out "(while ~A ~A)" (while-stmt-cond-expr x) (while-stmt-body-stmt x))))
 
 ;; helper to check if first is of types
 (define (top-type? tokens types)
@@ -100,6 +104,8 @@
 	 (parse-print-statement (cdr tokens)))
 	((top-type? tokens '(IF))
 	 (parse-if-statement (cdr tokens)))
+	((top-type? tokens '(WHILE))
+	 (parse-while-statement (cdr tokens)))
 	((top-type? tokens '(LEFT_BRACE))
 	 (let-values (((stmts toks) (parse-block (cdr tokens))))
 	   ;; TODO: return the block record instead of stmts? Not the
@@ -122,6 +128,15 @@
 (define (parse-expression-statement tokens)
   (parse-generic-stmt tokens make-expr-stmt))
 
+(define (parse-while-statement tokens)
+  (if (not (top-type? tokens '(LEFT_PAREN)))
+      (parse-err! tokens "Expected '(' after 'while'")
+      (let-values (((cond-expr toks) (parse-expression '() (cdr tokens))))
+	(if (not (top-type? toks '(RIGHT_PAREN)))
+	    (parse-err! toks "Expected ')' after while condition")
+	    (let-values (((body-stmt toks2) (parse-statement (cdr toks))))
+	      (values (make-while-stmt cond-expr body-stmt) toks2))))))
+
 (define (parse-block tokens)
   (let loop ((stmts '()) (toks tokens))
     (if (top-type? toks '(RIGHT_BRACE))
--
libgit2 1.1.1