fisl

commit 8f0650f25245b34f87c91135f6a11b3b6ab18480 (patch)
parent 7b56eb4c6951f157448ab5029203828b27126d92
Author: Alex Karle <alex@alexkarle.com>
Date:   Tue,  1 Nov 2022 21:30:34 -0400

statements: Add support for print statements

This implements ch8.1, setting up the pattern of having multiple
statements to be interpreted (instead of one expression).

Diffstat:
M
fisl.scm
 | 
6
+++---
M
interpreter.scm
 | 
14
++++++++++++--
M
parser.scm
 | 
41
+++++++++++++++++++++++++++++++++++++++--

3 files changed, 54 insertions(+), 7 deletions(-)
diff --git a/fisl.scm b/fisl.scm
@@ -16,9 +16,9 @@
 (define (run code fname)
   (let ((tokens (scan code fname)))
     (if tokens
-	(let ((expr (parse tokens fname)))
-	  (if expr
-	      (print (interpret expr)))))))
+	(let ((stmts (parse tokens fname)))
+	  (if stmts
+	      (print (interpret stmts)))))))
 
 (define (run-prompt)
   (display "> ")
diff --git a/interpreter.scm b/interpreter.scm
@@ -82,8 +82,18 @@
            (else (runtime-err! (format "Unknown bin op ~A" op))))))
       (else (runtime-err! (format "Unknown expr type ~A" expr)))))
 
-  (define (interpret expr)
+  (define (execute stmt)
+    (cond
+     ((print-stmt? stmt)
+      (print (evaluate (print-stmt-value stmt)))
+      '())
+     (else (runtime-err! (format "Unknown stmt ~A" stmt)))))
+
+  (define (interpret stmts)
     (call/cc (lambda (cc)
 	       (set! abort cc)
-	       (evaluate expr))))
+	       (let loop ((sts stmts))
+		 (if (not (null? sts))
+		     (begin (execute (car sts))
+			    (loop (cdr sts))))))))
 )
diff --git a/parser.scm b/parser.scm
@@ -1,7 +1,11 @@
 (module parser (parse
                 ; TODO: figure out a better way to export these :(
                 ; maybe ditch records?
-                binary?
+		print-stmt?
+		print-stmt-value
+		expr-stmt?
+		expr-stmt-value
+		binary?
                 binary-left
                 binary-right
                 binary-operator
@@ -42,6 +46,16 @@
                              (token-lexeme (unary-operator x))
                              (unary-right x))))
 
+  (define-record print-stmt value)
+  (set-record-printer! print-stmt
+		       (lambda (x out)
+			 (fprintf out "(print ~A)" (print-stmt-value x))))
+
+  (define-record expr-stmt value)
+  (set-record-printer! expr-stmt
+		       (lambda (x out)
+			 (fprintf out "(expr ~A)" (expr-stmt-value x))))
+
   (define (top-type? tokens types)
     (memq (token-type (car tokens)) types))
 
@@ -59,6 +73,25 @@
       ; TODO: synchronize instead of abort
       (abort #f))
 
+    (define (statement tokens)
+      (if (top-type? tokens '(PRINT))
+	  (print-statement (cdr tokens))
+	  (expression-statement tokens)))
+
+    (define (print-statement tokens)
+      (let ((ret (expression '() tokens)))
+	(let ((expr (car ret)) (toks (cdr ret)))
+	  (if (top-type? toks '(SEMICOLON))
+	      (cons (make-print-stmt expr) (cdr toks))
+	      (panic (car toks) "expected ;")))))
+
+    (define (expression-statement tokens)
+      (let ((ret (expression '() tokens)))
+	(let ((expr (car ret)) (toks (cdr ret)))
+	  (if (top-type? toks '(SEMICOLON))
+	      (cons (make-expr-stmt expr) (cdr toks))
+	      (panic (car toks) "expected ;")))))
+
     (define (expression expr toks)
       (equality expr toks))
 
@@ -124,5 +157,9 @@
     ;; Actual body of parse!
     (call/cc (lambda (cc)
 	       (set! abort cc)
-	       (car (expression '() tokens)))))
+	       (let loop ((toks tokens))
+		 (if (not (top-type? toks '(EOF)))
+		     (let ((ret (statement toks)))
+		       (cons (car ret) (loop (cdr ret))))
+		     '())))))
 )