.

inconvergent · Oct 27, 2024 · 2d34ba5 · 2d34ba5
1 parent 6ec53c5
commit 2d34ba5
Show file tree

Hide file tree

Showing 4 changed files with 40 additions and 137 deletions.
diff --git a/build-ast.lisp b/build-ast.lisp
diff --git a/compile.sh.txt b/compile.sh.txt
@@ -46,21 +46,21 @@ To load "evl":
 
 
 ; wrote /home/anders/.cache/common-lisp/sbcl-2.4.4-linux-x64/data/x/evl/src/docs-tmp5GEXGEG5.fasl
-; compilation finished in 0:00:00.014
+; compilation finished in 0:00:00.013
 ; compiling file "/data/x/evl/src/config.lisp" (written 27 OCT 2024 09:04:12 AM):
 
 ; wrote /home/anders/.cache/common-lisp/sbcl-2.4.4-linux-x64/data/x/evl/src/config-tmpAR3FSGEY.fasl
-; compilation finished in 0:00:00.008
-; compiling file "/data/x/evl/src/evl-gen.lisp" (written 27 OCT 2024 12:49:52 PM):
+; compilation finished in 0:00:00.009
+; compiling file "/data/x/evl/src/evl-gen.lisp" (written 27 OCT 2024 08:30:38 PM):
 .
 
 ; wrote /home/anders/.cache/common-lisp/sbcl-2.4.4-linux-x64/data/x/evl/src/evl-gen-tmpJAIDFZTC.fasl
-; compilation finished in 0:00:00.010
+; compilation finished in 0:00:00.013
 ; compiling file "/data/x/evl/src/interp.lisp" (written 27 OCT 2024 09:04:12 AM):
 ...
 
 ; wrote /home/anders/.cache/common-lisp/sbcl-2.4.4-linux-x64/data/x/evl/src/interp-tmp8V3J6PE9.fasl
-; compilation finished in 0:00:00.090
+; compilation finished in 0:00:00.091
 ; compiling file "/data/x/evl/src/code-factory.lisp" (written 27 OCT 2024 09:04:12 AM):
 
 ; file: /data/x/evl/src/code-factory.lisp
@@ -77,17 +77,17 @@ To load "evl":
 
 
 ; wrote /home/anders/.cache/common-lisp/sbcl-2.4.4-linux-x64/data/x/evl/src/code-factory-tmp9V47YWQF.fasl
-; compilation finished in 0:00:00.010
+; compilation finished in 0:00:00.011
 ; 
 ; compilation unit finished
 ;   printed 4 notes
 
 Evaluation took:
-  0.227 seconds of real time
-  0.227972 seconds of total run time (0.165010 user, 0.062962 system)
-  100.44% CPU
-  661 forms interpreted
-  1,069 lambdas converted
-  968,860,132 processor cycles
-  78,664,000 bytes consed
+  0.233 seconds of real time
+  0.234241 seconds of total run time (0.172178 user, 0.062063 system)
+  100.43% CPU
+  667 forms interpreted
+  1,097 lambdas converted
+  995,473,717 processor cycles
+  80,565,184 bytes consed
 
diff --git a/src/evl-gen.lisp b/src/evl-gen.lisp
@@ -1,35 +1,28 @@
 (in-package #:evl)
 
-; work in progress ...
-; TODO: inconsistent values orders several places
 ; TODO: rename col->lst?
 
-; refactor so an iterator returns the next generator function
-
 ; TODO: NOTE ; competition between similar guesser and different guesser
 
-; (gen (later value))
-; then inside gen:
-; test conditon, next value
-
-; (generator conditons
-;              -> check expression to get
-;                 new generator object
-;                 )
-; (later)
+; col/itr are not tail call optimizable on this format. the build the
+; result from the inside out so we get the
+; in (1 2 3);  out (1 2 3)
+;          not out (3 2 1)
+; deep recursion
+; incompatible with condition interruption?
 
 (defun g/make-labels (generator arg rule)
   (with-gensyms ()
     `((,(lqn:symb generator :*) (val-fx &optional (res-fx #'identity)) ; my-generator*
         (lambda (&optional act) ; GEN-FX
-          (mvb (nxt xxx) ((lambda (,arg) ,rule) (funcall (the function val-fx)))
-            (if nxt (if (functionp nxt)
-                        (values nxt #1=(funcall (or act res-fx) xxx))
-                        (values nil #1#))
-                    (values nil nil))))))))
+          (mvb (nxt val*) ((lambda (,arg) ,rule) (funcall (the function val-fx)))
+            (cond ((and nxt (functionp nxt))
+                   (values nxt #1=(funcall (or act res-fx) val*)))
+                  (nxt (values nil #1#))
+                  (t (values nil nil)))))))))
 
 (defun g/make-macrolets (generator arg rule)
-  (declare (ignorable arg rules))
+  (declare (ignorable arg rule))
   `((,generator (val-expr &optional res-fx) ; my-generator
       `(,',(lqn:symb generator :*)          ; my-generator*
            (lambda () ,val-expr)
@@ -52,13 +45,6 @@
   "run generator function until it is empty"
   (when gen-fx (g/itr/all (funcall (the function gen-fx) act) act)))
 
-; col/itr are not tail call optimizable on this format. the build the
-; result from the inside out so we get the
-; in (1 2 3);  out (1 2 3)
-;          not out (3 2 1)
-; deep recursion
-; incompatible with condition interruption?
-
 ; TODO: discriminator
 (defun g/col/itr/all (gen-fx &optional act)
   (declare (optimize speed))

diff --git a/test/evl-generator.lisp b/test/evl-generator.lisp
@@ -26,22 +26,20 @@ oh no 10.
 oh no 13.
 A1XXA2YYA3ZZA4WWA5QQ"))
 
-  ; (g/with ((gen-b l (and l (cond ((cdr l) (~ (car l) (later (cdr l))))
-  ;                                ((car l) (~ (car l) :last))))))
-  ;   (let ((itrl (gen-b (list :a1xx :a2yy :a3zz :a4ww :a5qq))))
-  ;    (is (mvb (g val) (g/col/itr/all itrl (lambda (s) (lqn:fmt "hi~a/" s)))
-  ;             (declare (ignore g))
-  ;             val)
-  ;        '("hiA1XX/" "hiA2YY/" "hiA3ZZ/" "hiA4WW/" "hiA5QQ/"))
-  ;    (is (mvb (g val) (g/col/itr/n 2 itrl)
-  ;             (declare (ignore g))
-  ;             val)
-  ;        '(:A1XX :A2YY))
-  ;    (is (mvb (g val) (g/col/itr/until itrl (lambda (s) (eq s :a4ww)))
-  ;             (declare (ignore g))
-  ;             val)
-  ;     '(:A1XX :A2YY :A3ZZ :A4WW))
-  ;    ))
-  )
+  (g/with ((gen-b l (and l (cond ((cdr l) (values (gen-b (cdr l)) (car l) ))
+                                 ((car l) (values t (car l)))))))
+    (let ((itrl (gen-b (list :a1xx :a2yy :a3zz :a4ww :a5qq))))
+     (is (mvb (g val) (g/col/itr/all itrl (lambda (s) (lqn:fmt "hi~a/" s)))
+              (declare (ignore g))
+              val)
+         '("hiA1XX/" "hiA2YY/" "hiA3ZZ/" "hiA4WW/" "hiA5QQ/"))
+     (is (mvb (g val) (g/col/itr/n 2 itrl)
+              (declare (ignore g))
+              val)
+         '(:A1XX :A2YY))
+     (is (mvb (g val) (g/col/itr/until itrl (lambda (s) (eq s :a4ww)))
+              (declare (ignore g))
+              val)
+      '(:A1XX :A2YY :A3ZZ :A4WW)))))
 
 (unless (finalize) (error "error in test generator"))