.

src/interp.lisp

@@ -1,7 +1,10 @@
 (in-package :evl)
+
 (defvar *ctx* nil)
 
 ; TODO: argument count guards
+; TODO: optional symbol pass through
+; TODO: &optional defaults does not work. see flat-arg-list
 
 
 (defun new-env (&optional (kv +std-env+))
@@ -33,44 +36,44 @@
   (remove-if (lambda (s) (match-pref (mkstr s) "&"))
              (flatten args)))
 
-(defmacro evl/ctx ((expr) &body body)
+(defmacro evl/ctx (expr &body body)
   (with-gensyms (e)
-     `(handler-case
-        (progn ,@body)
-        (error (,e) (error "expr:~%~a~%msg:~%~a~&" ,expr ,e)))))
+     `(handler-case (progn ,@body)
+                    (error (,e) (error "██  at expr:~%~a~%██  msg:~%~a~&" ,expr ,e)))))
+
 (defun evl/eval-dsb (args in expr evl* env*)
   (declare (list args) (function evl* env*))
    "get dsb argument values of (evl* in) as a list (l) of quoted values. then do:
 (evl* '((lambda (,@args*) expr) ,@lst))
 requires that evl* implements (quote ...) and ((lambda ...) ...)."
-   (evl/ctx (`(destructuring-bind ,args ,@expr))
-   (funcall evl* `((lambda ,#1=(flat-arg-list args) ,@expr)
-                  ; quote the elements in the list. so they will not be  evaluated by evl*
-                  ,@(mapcar (lambda (x) `(quote ,x))
-                      ; use CL dsb to get variables as a list
-                      (eval `(destructuring-bind ,args ',(funcall evl* in env*)
-                               (list ,@#1#)))))
-           env*)))
+   (evl/ctx `(destructuring-bind ,args ,@expr)
+     (funcall evl* `((lambda ,#1=(flat-arg-list args) ,@expr)
+                    ; quote the elements in the list. so they will not be  evaluated by evl*
+                    ,@(mapcar (lambda (x) `(quote ,x))
+                        ; use CL dsb to get variables as a list
+                        (eval `(destructuring-bind ,args ',(funcall evl* in env*)
+                                 (list ,@#1#)))))
+             env*)))
 
 (defun evl/eval-mvb (args in expr evl* env*)
   (declare (list args) (function evl* env*))
    "get dsb argument values of (evl* in) as a list (l) of quoted values. then do:
 (evl* '((lambda (,@args*) expr) ,@lst))
 requires that evl* implements (quote ...) and ((lambda ...) ...)."
-  (evl/ctx (`(mvb ,args ,in ,@expr))
-  (funcall evl* `((lambda ,(flat-arg-list args) ,@expr)
-                  ,@(mapcar (lambda (x) `(quote ,x))
-                            (multiple-value-list (funcall evl* in env*))))
-           env*)))
+  (evl/ctx `(mvb ,args ,in ,@expr)
+    (funcall evl* `((lambda ,(flat-arg-list args) ,@expr)
+                    ,@(mapcar (lambda (x) `(quote ,x))
+                              (multiple-value-list (funcall evl* in env*))))
+             env*)))
 
 (defun evl/eval-lambda (args body evl* env*)
   (declare (function evl* env*))
   "use CL eval to build a function with these args and body.
 requires that evl* implements (progn ...)"
-  (evl/ctx (`(lambda (,@args) (progn ,@body)))
-  (eval `(lambda (,@args)
-           (funcall ,evl* '(progn ,@body)
-             (evl/extenv ,env* ',#1=(flat-arg-list args) (list ,@#1#)))))))
+  (evl/ctx `(lambda (,@args) (progn ,@body))
+    (eval `(lambda (,@args)
+             (funcall ,evl* '(progn ,@body)
+               (evl/extenv ,env* ',#1=(flat-arg-list args) (list ,@#1#)))))))
 
 (defun evl/do-labels (pairs body evl* env*)
   (declare (list body) (function evl* env*))
@@ -102,8 +105,6 @@ requires that evl* implements (progn ...)"
   (multiple-value-call (funcall evl* fx env*)
     (evl/eval-coerce-values expr evl* env*)))
 
-; TODO: optional symbol pass through
-; TODO: &optional defaults does not work. see flat-arg-list
 (defun evl (expr env)
   (declare (function env))
   "evaluate an EVL expression in env.
@@ -130,7 +131,7 @@ deviations from regular CL syntax:
   - &aux is not supported
   "
   (let ((*ctx* expr))
-    (cond ((null expr) expr)                                       ; eval atoms to themselves
+  (cond ((null expr) expr)                                       ; eval atoms to themselves
         ((stringp expr) expr)
         ((numberp expr) expr)
         ((functionp expr) expr)
@@ -141,10 +142,10 @@ deviations from regular CL syntax:
 
         ((evl/car-is expr 'quote) (cadr expr))                   ; quote; don't evaluate
 
-        ((evl/car-is-in expr '(cl-user::~ evl:~ veq:~))          ; coerce value packs
+        ((evl/car-is-in expr '(cl-user::~ evl:~ veq:~))          ; ~; coerce value packs
          (evl/eval-coerce-values (cdr expr) #'evl env))
 
-        ((evl/car-is-in expr '(cl-user::~~ evl:~~))              ; coerce apply fx to values
+        ((evl/car-is-in expr '(cl-user::~~ evl:~~))              ; ~~; coerce apply fx to values
          (destructuring-bind (fx &rest rest) (cdr expr)
            (evl/eval-coerce-apply-values fx rest #'evl env)))
 
@@ -176,9 +177,11 @@ deviations from regular CL syntax:
         ((evl/car-is-in expr '(destructuring-bind dsb))          ; dsb
          (destructuring-bind (vars in &rest rest) (cdr expr)
            (evl/eval-dsb vars in rest #'evl env)))
+
         ((evl/car-is-in expr '(multiple-value-bind mvb veq:mvb)) ; mvb
          (destructuring-bind (vars in &rest rest) (cdr expr)
            (evl/eval-mvb vars in rest #'evl env)))
+
         ((evl/car-is-in expr '(multiple-value-list mvl))         ; mvl
          (multiple-value-list (evl (cadr expr) env)))
 
@@ -187,16 +190,15 @@ deviations from regular CL syntax:
            (evl/do-labels pairs body #'evl env)))
 
         ((consp expr)                                            ; (apply (fx/lambda) ...)
-         (evl/ctx (`(,@expr))
-         (apply (evl (car expr) env)
-                (mapcar (lambda (x) (evl x env))
-                        (cdr expr)))))
+         (evl/ctx `(,@expr)
+           (apply (evl (car expr) env)
+                  (mapcar (lambda (x) (evl x env))
+                          (cdr expr)))))
         (t (error "~&-->>~%[EVL]: invalid expression:~%  ~a <<--~&"
                   expr)))))
 
 (defun evl* (expr &optional (env (new-env)))
-  (handler-case
-   (evl expr env)
-   (error (e) (warn "[EVL WRN] failed to evaluate:~%---~%~a~%---~%~a" expr e))
-   ))
+  (handler-case (evl expr env)
+                (error (e) (warn "~%██  EVL* failed to evaluate:~%---~%~a~%---~%~a"
+                                 expr e))))