fisl

commit 1c2f9da130f0002ae2f240d3c0ee23f2e724a089 (patch)
parent 8033151ca2d0834aa4fd41541dd13a59257ced00
Author: Alex Karle <alex@alexkarle.com>
Date:   Sun, 30 Oct 2022 23:45:12 -0400

errors: Update error handling to not exit process

Woo! I finally learned enough about call/cc to use it effectively to
abort the interpreter and parser loops *without* actually exiting the
process.

This is a large win for usability. No one wants their repl to die
because they had an error!

Diffstat:
M
fisl.scm
 | 
6
+++++-
M
interpreter.scm
 | 
22
+++++++++++++++-------
M
parser.scm
 | 
10
+++++++---

3 files changed, 27 insertions(+), 11 deletions(-)
diff --git a/fisl.scm b/fisl.scm
@@ -14,7 +14,11 @@
         util)
 
 (define (run code fname)
-  (print (interpret (parse (scan code fname) fname))))
+  (let ((tokens (scan code fname)))
+    (if tokens
+	(let ((expr (parse tokens fname)))
+	  (if expr
+	      (print (interpret expr)))))))
 
 (define (run-prompt)
   (display "> ")
diff --git a/interpreter.scm b/interpreter.scm
@@ -7,6 +7,12 @@
           (chicken base)
           (chicken format))
 
+  (define abort #f)
+
+  (define (runtime-err! msg)
+    (err! msg)
+    (abort #f))
+
   (define (truthy? x)
     (not (or (null? x) (eq? x #f))))
 
@@ -18,12 +24,12 @@
 
   (define (assert-num op x)
     ; TODO: use call/cc to not abort the process
-    (or (number? x) (die (format "Operand must be a number ~A ~A" op x))))
+    (or (number? x) (runtime-err! (format "Operand must be a number ~A ~A" op x))))
 
   (define (assert-nums op x y)
     ; TODO: use call/cc to not abort the process
     (or (and (number? x) (number? y))
-        (die (format "Operands must be numbers ~A ~A ~A" x op y))))
+        (runtime-err! (format "Operands must be numbers ~A ~A ~A" x op y))))
 
   (define (evaluate expr)
     ; TODO: put these on the types themselves? like methods
@@ -39,7 +45,7 @@
            ((MINUS)
             (assert-num op right)
             (- right))
-           (else die (format "Unknown unary op ~A" op)))))
+           (else (runtime-err! (format "Unknown unary op ~A" op))))))
       ((binary? expr)
        (let ((left (evaluate (binary-left expr)))
              (right (evaluate (binary-right expr)))
@@ -66,16 +72,18 @@
             (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)))))
+              (else (runtime-err! (format "Bad types for plus ~A" expr)))))
            ((SLASH)
             (assert-nums op left right)
             (/ left right))
            ((STAR)
             (assert-nums op left right)
             (* left right))
-           (else (die (format "Unknown bin op ~A" op))))))
-      (else (die (format "Unknown expr type ~A" expr)))))
+           (else (runtime-err! (format "Unknown bin op ~A" op))))))
+      (else (runtime-err! (format "Unknown expr type ~A" expr)))))
 
   (define (interpret expr)
-    (evaluate expr))
+    (call/cc (lambda (cc)
+	       (set! abort cc)
+	       (evaluate expr))))
 )
diff --git a/parser.scm b/parser.scm
@@ -19,6 +19,8 @@
           (chicken base)
           (chicken format))
 
+  (define abort #f)
+
   (define-record binary left operator right)
   (set-record-printer! binary
     (lambda (x out) (fprintf out "(~A ~S ~S)"
@@ -54,8 +56,8 @@
                       "Error at"
                       (token-lexeme tok)
                       msg)))
-      ; TODO: synchronize instead of exit
-      (exit 1))
+      ; TODO: synchronize instead of abort
+      (abort #f))
 
     (define (expression expr toks)
       (equality expr toks))
@@ -120,5 +122,7 @@
         (else (panic (car toks) "Unknown token"))))
 
     ;; Actual body of parse!
-    (car (expression '() tokens)))
+    (call/cc (lambda (cc)
+	       (set! abort cc)
+	       (car (expression '() tokens)))))
 )