fisl

commit f91e1c8b88c9b413e0ac2a23984b7ea006f8b187 (patch)
parent 772bd98385430c73c77b6c7e199b37dc638afd1d
Author: Alex Karle <alex@alexkarle.com>
Date:   Sat, 29 Oct 2022 22:13:15 -0400

interpreter: Add first-pass evaluate procedure

This has a lot to clean up (no error handling, better eval dispatching
on types, etc... but it works!

	:$ ./fisl.scm
	> 1 + 1
	2
	> 1 < 1
	#f
	> 1 != 2
	#t
	> 1 != 1
	#f
	> (1 + 1) * 2
	4

Diffstat:
M
fisl.scm
 | 
4
+++-
A
interpreter.scm
 | 
57
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
parser.scm
 | 
15
++++++++++++++-

3 files changed, 74 insertions(+), 2 deletions(-)
diff --git a/fisl.scm b/fisl.scm
@@ -3,16 +3,18 @@
 (load "scanner.scm")
 (load "util.scm")
 (load "parser.scm")
+(load "interpreter.scm")
 
 (import (chicken io)
         (chicken base)
         (chicken format)
         scanner
         parser
+        interpreter
         util)
 
 (define (run code fname)
-  (print (parse (scan code fname) fname)))
+  (print (interpret (parse (scan code fname) fname))))
 
 (define (run-prompt)
   (display "> ")
diff --git a/interpreter.scm b/interpreter.scm
@@ -0,0 +1,57 @@
+(module interpreter (interpret)
+
+  (import scheme
+          util
+          scanner
+          parser
+          (chicken base)
+          (chicken format))
+
+  (define (truthy? x)
+    (not (or (null? x) (eq? x #f))))
+
+  (define (lox-equal? a b)
+    (cond
+      ((and (null? a) (null? b)) #t)
+      ((null? a) #f)
+      (else (equal? a b))))
+
+  (define (evaluate expr)
+    ; TODO: put these on the types themselves? like methods
+    (cond
+      ((literal? expr) (literal-value expr))
+      ((grouping? expr)
+       (evaluate (grouping-expression expr)))
+      ((unary? expr)
+       (let ((right (evaluate (unary-right expr)))
+             (op (token-type (unary-operator expr))))
+         (cond
+           ((eq? op 'BANG) (truthy? right))
+           ((eq? op 'MINUS) (- right))
+           ((die (format "Unknown unary op ~A" op))))))
+      ((binary? expr)
+       (let ((left (evaluate (binary-left expr)))
+             (right (evaluate (binary-right expr)))
+             (op (token-type (binary-operator expr))))
+         (cond
+           ((eq? op 'GREATER) (> left right))
+           ((eq? op 'GREATER_EQUAL) (>= left right))
+           ((eq? op 'LESS) (< left right))
+           ((eq? op 'LESS_EQUAL) (<= left right))
+           ((eq? op 'BANG_EQUAL) (not (lox-equal? left right)))
+           ((eq? op 'EQUAL_EQUAL) (lox-equal? left right))
+           ((eq? op 'MINUS) (- left right))
+           ((eq? op 'PLUS)
+            (cond
+              ((and (string? left) (string? right)) (string-append left right))
+              ((and (number? left) (number? right)) (+ left right))
+              (else (die (format "Bad types for plus ~A") expr))))
+           ((eq? op 'SLASH) (/ left right))
+           ((eq? op 'STAR) (* left right))
+           (else (die (format "Unknown bin op ~A" op))))))
+      (else (die (format "Unknown expr type ~A" expr)))))
+
+  (define (interpret expr)
+    ; TODO: handle errors!
+    (evaluate expr))
+)
diff --git a/parser.scm b/parser.scm
@@ -1,4 +1,17 @@
-(module parser (parse)
+(module parser (parse
+                ; TODO: figure out a better way to export these :(
+                ; maybe ditch records?
+                binary?
+                binary-left
+                binary-right
+                binary-operator
+                grouping?
+                grouping-expression
+                literal?
+                literal-value
+                unary?
+                unary-operator
+                unary-right)
 
   (import scheme
           scanner