~akarle/fisl

a11d38c70322ff1e99e783a4e7a776bb80b8b56f — Alex Karle 1 year, 5 months ago 5e57cfe
Add full block environments! (ch8.5)

This implements the parser for blocks as well as the necessary
interpreter bits!

Check it out!

$ cat examples/scope.lox
var a = "global a";
var b = "global b";
var c = "global c";
{
  var a = "outer a";
  var b = "outer b";
  {
    var a = "inner a";
    print a;
    print b;
    print c;
  }
  print a;
  print b;
  print c;
}
print a;
print b;
print c;

$ ./fisl.scm examples/scope.lox
inner a
outer b
global c
outer a
outer b
global c
global a
global b
global c
3 files changed, 78 insertions(+), 29 deletions(-)

A examples/scope.lox
M interpreter.scm
M parser.scm
A examples/scope.lox => examples/scope.lox +19 -0
@@ 0,0 1,19 @@
var a = "global a";
var b = "global b";
var c = "global c";
{
  var a = "outer a";
  var b = "outer b";
  {
    var a = "inner a";
    print a;
    print b;
    print c;
  }
  print a;
  print b;
  print c;
}
print a;
print b;
print c;

M interpreter.scm => interpreter.scm +27 -20
@@ 5,8 5,6 @@

(define interpreter-abort #f)

(define global-env (make-env #f))

(define (make-env parent)
  (let ((ht (make-hash-table)))
    (lambda (action)


@@ 56,24 54,24 @@
  (or (and (number? x) (number? y))
      (runtime-err! (format "Operands must be numbers ~A ~A ~A" x op y))))

(define (evaluate expr)
(define (evaluate expr env)
  (cond
   ((literal? expr) (literal-value expr))
   ((grouping? expr)
    (evaluate (grouping-expression expr)))
    (evaluate (grouping-expression expr) env))
   ((variable? expr)
    (let ((tok (variable-name expr)))
      (env-get global-env (token-lexeme tok))))
      (env-get env (token-lexeme tok))))
   ((assignment? expr)
    (let ((tok (assignment-name expr)))
      (if (env-exists? global-env (token-lexeme tok))
        (let ((res (evaluate (assignment-value expr))))
          (env-set! global-env (token-lexeme tok) res)
      (if (env-exists? env (token-lexeme tok))
        (let ((res (evaluate (assignment-value expr) env)))
          (env-set! env (token-lexeme tok) res)
          res)
        (runtime-err! (format "Unbound variable ~A at line ~A"
                              (token-lexeme tok) (token-line tok))))))
   ((unary? expr)
    (let ((right (evaluate (unary-right expr)))
    (let ((right (evaluate (unary-right expr) env))
          (op (token-type (unary-operator expr))))
      (case op
        ((BANG) (not (truthy? right)))


@@ 82,8 80,8 @@
         (- right))
        (else (runtime-err! (format "Unknown unary op ~A" op))))))
   ((binary? expr)
    (let ((left (evaluate (binary-left expr)))
          (right (evaluate (binary-right expr)))
    (let ((left (evaluate (binary-left expr) env))
          (right (evaluate (binary-right expr) env))
          (op (token-type (binary-operator expr))))
      (case op
        ((GREATER)


@@ 124,29 122,38 @@
           ((eq? val #t) "true")
           (else val))))

(define (execute stmt)
(define (execute stmt env)
  (cond
   ((print-stmt? stmt)
    (let ((res (evaluate (print-stmt-value stmt))))
    (let ((res (evaluate (print-stmt-value stmt) env)))
      (lox-print res)
      '()))
   ((var-stmt? stmt)
    (let ((value
            (if (null? (var-stmt-init stmt))
              '()
              (evaluate (var-stmt-init stmt)))))
      (env-set! global-env (token-lexeme (var-stmt-name stmt)) value))
              (evaluate (var-stmt-init stmt) env))))
      (env-set! env (token-lexeme (var-stmt-name stmt)) value))
    '())
   ((expr-stmt? stmt)
    (let ((res (evaluate (expr-stmt-value stmt))))
    (let ((res (evaluate (expr-stmt-value stmt) env)))
      (if in-repl (lox-print res))
      '()))
   ((block? stmt)
    (let ((new-env (make-env env)))
      (let loop ((stmts (block-stmts stmt)))
	(if (null? stmts)
	    '()  ; TODO: Why are we still returning null from all these?
	    (begin
	      (execute (car stmts) new-env)
	      (loop (cdr stmts)))))))
   (else (runtime-err! (format "Unknown stmt ~A" stmt)))))

(define (interpret stmts)
  (call/cc (lambda (cc)
	     (set! interpreter-abort cc)
	     (let loop ((sts stmts))
	       (if (not (null? sts))
		   (begin (execute (car sts))
			  (loop (cdr sts))))))))
	     (let ((global-env (make-env #f)))
	       (let loop ((sts stmts))
		 (if (not (null? sts))
		     (begin (execute (car sts) global-env)
			    (loop (cdr sts)))))))))

M parser.scm => parser.scm +32 -9
@@ 41,18 41,24 @@
(define-record print-stmt value)
(define-record expr-stmt value)
(define-record var-stmt name init)
(define-record block stmts)

(set-record-printer! print-stmt
		     (lambda (x out)
		       (fprintf out "(print ~A)" (print-stmt-value x))))
  (lambda (x out)
    (fprintf out "(print ~A)" (print-stmt-value x))))

(set-record-printer! expr-stmt
		     (lambda (x out)
		       (fprintf out "(expr ~A)" (expr-stmt-value x))))
  (lambda (x out)
    (fprintf out "(expr ~A)" (expr-stmt-value x))))

(set-record-printer! var-stmt
		     (lambda (x out)
		       (fprintf out "(var ~A ~A)" (var-stmt-name x) (var-stmt-init x))))
  (lambda (x out)
    (fprintf out "(var ~A ~A)" (var-stmt-name x) (var-stmt-init x))))

(set-record-printer! block
  (lambda (x out)
    (fprintf out "(block ~A)" (block-stmts x))))



;; helper to check if first is of types


@@ 77,9 83,14 @@
      (parse-err! tokens "expected variable name")))

(define (parse-statement tokens)
  (if (top-type? tokens '(PRINT))
      (parse-print-statement (cdr tokens))
      (parse-expression-statement tokens)))
  (cond ((top-type? tokens '(PRINT))
	 (parse-print-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
	   ;; way the book does it but seems cleaner :thinking:
	   (values (make-block stmts) toks)))
	(else (parse-expression-statement tokens))))

;; Used for print and expr statements, which have the same formula
(define (parse-generic-stmt tokens maker)


@@ 96,6 107,18 @@
(define (parse-expression-statement tokens)
  (parse-generic-stmt tokens make-expr-stmt))

(define (parse-block tokens)
  (let loop ((stmts '()) (toks tokens))
    (if (top-type? toks '(RIGHT_BRACE))
	(values stmts (cdr toks))
	(if (top-type? toks '(EOF))
	    (parse-err! toks "expected '}' after block")
	    (let-values (((decl rest) (parse-declaration toks)))
	      ;; TODO: can we do this with cons instead of append?
	      ;; I don't think so, given that we'd need to (cons decl (loop ...))
	      ;; but (loop) returns multiple values (sigh)
	      (loop (append stmts (list decl)) rest))))))

(define (parse-assignment expr toks)
  (let-values (((e2 t2) (parse-equality expr toks)))
    (if (top-type? t2 '(EQUAL))