~akarle/fisl

cf77b879d8cbf5bd345a8c40d197dd9f8708c9fb — Alex Karle 1 year, 5 months ago 5ff7353
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
4 files changed, 33 insertions(+), 0 deletions(-)

M examples/scope.lox
A examples/while.lox
M interpreter.scm
M parser.scm
M examples/scope.lox => examples/scope.lox +6 -0
@@ 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;

A examples/while.lox => examples/while.lox +5 -0
@@ 0,0 1,5 @@
var x = 10;
while (x > 0) {
    print x;
    x = x - 1;
}

M interpreter.scm => interpreter.scm +7 -0
@@ 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

M parser.scm => parser.scm +15 -0
@@ 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))