commit 19417d286621943eb6406d6b938c8ee63b0f08ac (patch)
parent 11be32bbaf9d22ba7ff60767326ef152810f9c7b
Author: Alex Karle <alex@alexkarle.com>
Date: Mon, 7 Nov 2022 22:37:47 -0500
Implement global variable declaration and access
ch8.2 and ch8.3
Diffstat:
2 files changed, 64 insertions(+), 12 deletions(-)
diff --git a/interpreter.scm b/interpreter.scm
@@ -1,8 +1,12 @@
;; interpreter.scm -- evaluates parsed statements
-(import (chicken format))
+(import
+ srfi-69 ; hash-tables
+ (chicken format))
(define interpreter-abort #f)
+(define global-env (make-hash-table))
+
(define (runtime-err! msg)
(err! msg)
(interpreter-abort #f))
@@ -31,6 +35,12 @@
((literal? expr) (literal-value expr))
((grouping? expr)
(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))))))
((unary? expr)
(let ((right (evaluate (unary-right expr)))
(op (token-type (unary-operator expr))))
@@ -79,7 +89,19 @@
(define (execute stmt)
(cond
((print-stmt? stmt)
- (print (evaluate (print-stmt-value stmt)))
+ (let ((res (evaluate (print-stmt-value stmt))))
+ (print (cond
+ ((null? res) "nil")
+ ((eq? res #f) "false")
+ ((eq? res #t) "true")
+ (else res)))
+ '()))
+ ((var-stmt? stmt)
+ (let ((value
+ (if (null? (var-stmt-init stmt))
+ '()
+ (evaluate (var-stmt-init stmt)))))
+ (hash-table-set! global-env (token-lexeme (var-stmt-name stmt)) value))
'())
(else (runtime-err! (format "Unknown stmt ~A" stmt)))))
diff --git a/parser.scm b/parser.scm
@@ -24,6 +24,11 @@
(token-lexeme (unary-operator x))
(unary-right x))))
+(define-record variable name)
+(set-record-printer! variable
+ (lambda (x out) (fprintf out "~A" (token-lexeme x))))
+
+
(define-record print-stmt value)
(set-record-printer! print-stmt
(lambda (x out)
@@ -34,11 +39,16 @@
(lambda (x out)
(fprintf out "(expr ~A)" (expr-stmt-value x))))
+(define-record var-stmt name init)
+(set-record-printer! var-stmt
+ (lambda (x out)
+ (fprintf out "(var ~A ~A)" (var-stmt-name x) (var-stmt-init x))))
+
+
(define (top-type? tokens types)
(memq (token-type (car tokens)) types))
(define (parse tokens fname)
-
(define (panic tok msg)
(if (eq? (token-type tok) 'EOF)
(err! (format "~A:~A:~A ~A" fname (token-line tok) "Error at end." msg))
@@ -48,9 +58,29 @@
"Error at"
(token-lexeme tok)
msg)))
- ; TODO: synchronize instead of abort
+ ;; TODO: synchronize instead of abort
(parser-abort #f))
+ (define (declaration tokens)
+ (if (top-type? tokens '(VAR))
+ ;; TODO: sync on failure
+ (var-decl (cdr tokens))
+ (statement tokens)))
+
+ (define (var-decl tokens)
+ (if (top-type? tokens '(IDENTIFIER))
+ (let* ((ret
+ (if (top-type? (cdr tokens) '(EQUAL))
+ (expression '() (cddr tokens))
+ (cons '() (cdr tokens))))
+ (init (car ret))
+ (toks (cdr ret)))
+ (if (top-type? toks '(SEMICOLON))
+ (cons (make-var-stmt (car tokens) init)
+ (cdr toks))
+ (panic (car toks) "Expected ';' after variable declaration")))
+ (panic (car tokens) "expected variable name")))
+
(define (statement tokens)
(if (top-type? tokens '(PRINT))
(print-statement (cdr tokens))
@@ -74,7 +104,7 @@
(equality expr toks))
(define (equality expr toks)
- ; (print (format "equality ~S ~S" expr toks))
+ ;; (print (format "equality ~S ~S" expr toks))
(let ((ret (comparison expr toks)))
(let loop ((e (car ret)) (ts (cdr ret)))
(if (top-type? ts '(BANG_EQUAL EQUAL_EQUAL))
@@ -83,7 +113,7 @@
(cons e ts)))))
(define (comparison expr toks)
- ; (print (format "comparison ~S ~S" expr toks))
+ ;; (print (format "comparison ~S ~S" expr toks))
(let ((ret (term expr toks)))
(let loop ((e (car ret)) (ts (cdr ret)))
(if (top-type? ts '(GREATER GREATER_EQUAL LESS LESS_EQUAL))
@@ -92,7 +122,7 @@
(cons e ts)))))
(define (term expr toks)
- ; (print (format "term ~S ~S" expr toks))
+ ;; (print (format "term ~S ~S" expr toks))
(let ((ret (factor expr toks)))
(let loop ((e (car ret)) (ts (cdr ret)))
(if (top-type? ts '(MINUS PLUS))
@@ -101,7 +131,7 @@
(cons e ts)))))
(define (factor expr toks)
- ; (print (format "factor ~S ~S" expr toks))
+ ;; (print (format "factor ~S ~S" expr toks))
(let ((ret (unary expr toks)))
(let loop ((e (car ret)) (ts (cdr ret)))
(if (top-type? ts '(SLASH STAR))
@@ -110,21 +140,21 @@
(cons e ts)))))
(define (unary expr toks)
- ; (print (format "unary ~S ~S" expr toks))
+ ;; (print (format "unary ~S ~S" expr toks))
(if (top-type? toks '(BANG MINUS))
(let ((ret (unary expr (cdr toks))))
(cons (make-unary (car toks) (car ret)) (cdr ret)))
(primary expr toks)))
(define (primary expr toks)
- ; (print (format "primary ~S ~S" expr toks))
+ ;; (print (format "primary ~S ~S" expr toks))
(cond
((top-type? toks '(FALSE)) (cons (make-literal #f) (cdr toks)))
((top-type? toks '(TRUE)) (cons (make-literal #t) (cdr toks)))
- ; XXX: nil vs false?
((top-type? toks '(NIL)) (cons (make-literal '()) (cdr toks)))
((top-type? toks '(NUMBER STRING))
(cons (make-literal (token-literal (car toks))) (cdr toks)))
+ ((top-type? toks '(IDENTIFIER)) (cons (make-variable (car toks)) (cdr toks)))
((top-type? toks '(LEFT_PAREN))
(let ((ret (expression expr (cdr toks))))
(if (eq? (token-type (cadr ret)) 'RIGHT_PAREN)
@@ -137,6 +167,6 @@
(set! parser-abort cc)
(let loop ((toks tokens))
(if (not (top-type? toks '(EOF)))
- (let ((ret (statement toks)))
+ (let ((ret (declaration toks)))
(cons (car ret) (loop (cdr ret))))
'())))))
