new expression parser with explicit stack for error handling

1 files changed, 41 insertions, 23 deletions

diff --git a/prelude.scm b/prelude.scm
index cb22b18..61aefce 100644
--- a/prelude.scm
+++ b/prelude.scm
@@ -30,10 +30,10 @@
 ; __define: define in the environment
 ; __define-macro: Like __define but for macros
 ; set!
-; if
+; __exec: apply an argument to a lambda and return it to the continuation.
+; __continue-if: continuation version of if.
 ;
 ; Others:
-; __uniapply: Apply function to single argument
 ; <undefined>: A value that can only be passed to __unilambda. It cannot
 ;              be bound to a top-level, or "set!", or added to a list.
 ;              It can also be the parameter of a __unilambda, although
@@ -41,6 +41,15 @@
 ;
 ; Macros are functions that return an sexpr.
 
+(__define-macro if
+ (__unilambda l
+  (__continue-if (car l)
+                 (__unilambda <undefined> (car (cdr l)))
+                 (__unilambda <undefined> (car (cdr (cdr l))))
+  )
+ )
+)
+
 (__define-macro let
  (__unilambda l ; car = args, cdr = body
   (if (null? (car args))
@@ -48,9 +57,11 @@
       ; (car args) = ((A a) (B b) ...)
       ; (car (car args)) = (A a)
       ; (cdr (car (car args))) = (a)
-      `((__unilambda ,(car (car (car args)))
-                     (let ,(cdr (car args)) ,@body))
-        . ,(car (cdr (car (car args))))
+      `(__exec (__unilambda <undefined> ,(car (cdr (car (car args)))))
+               <undefined>
+               (__unilambda ,(car (car (car args)))
+                            (let ,(cdr (car args)) ,@body)
+               )
        )
   )
  )
@@ -58,16 +69,17 @@
 
 (__define-macro let* let)
 
-; if and __unilambda only execute one statement. This uses Flatrate's
-; evaluation order (arguments first) and tail-call optimization to simulate
-; multiple statements.
+; if and __unilambda only execute one statement.
 (__define-macro begin body
  (let ((first (car body))
        (rest (cdr body))
       )
   (if (null? rest)
       first
-      `((__unilambda <undefined> (begin ,@rest)) . ,first)
+      `(__exec (__unilambda <undefined> ,first)
+               <undefined>
+               (__unilambda <undefined> (begin ,@rest))
+       )
   )
  )
 )
@@ -85,14 +97,17 @@
              (begin ,@body)
          )
         )
-       (let* ((argval (cons args))
-              (rest (cdr args))
-              (arg (cons argval))
-              (val (cons (cdr argval)))
+       (if (symbol? args)
+           `(__unilambda ,args ,@body)
+            (let* ((argval (cons args))
+                   (rest (cdr args))
+                   (arg (cons argval))
+                   (val (cons (cdr argval)))
+                  )
+            `(__unilambda ,larg
+              (let ((,arg ,val)) __bindlambda ,larg ,rest ,@body)
              )
-       `(__unilambda ,larg
-         (let ((,arg ,val)) __bindlambda ,larg ,rest ,@body)
-        )
+            )
        )
    )
   )
@@ -118,13 +133,11 @@
 )
 
 (__define-macro define-macro
- (__unilambda l
-  (let* ((name-and-args (car l))
-         (name (car name-and-args))
-         (args (cdr name-and-args))
-         (body (cdr l))
-         (tmpname (gensym))
-        )
+ (lambda (name-and-args . body)
+  (let ((name (car name-and-args))
+        (args (cdr name-and-args))
+        (tmpname (gensym))
+       )
    `(__define-macro ,name
      (lambda ,args ,@body)
     )
@@ -189,6 +202,11 @@
 
 ;;;;;;;;;;;;;; Standard Library ;;;;;;;;;;;;;;;;;;;
 
+(define (call-with-current-continuation f)
+ (f (current-continuation))
+)
+(define call/cc call-with-current-continuation)
+
 ;; for a list of (v1 v2 ... vn)
 ;; runs (f vn (... (f v2 (f v1 start))))
 (define (foldl f start l)