From 180bcca22e7ade7f948818d96e8ea363c6d4329e Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Tue, 10 Sep 2024 11:11:06 +0200
Subject: [PATCH] forge/sf, work in progress: define / compile forge words

---
 forge/sf.lisp     | 15 ++++++++++++---
 test/test-sf.lisp |  5 +++--
 util/iter.lisp    | 10 +++++++---
 3 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/forge/sf.lisp b/forge/sf.lisp
index fcd43f9..e87e909 100644
--- a/forge/sf.lisp
+++ b/forge/sf.lisp
@@ -6,7 +6,7 @@
   (:use :common-lisp)
   (:local-nicknames (:iter :scopes/util/iter))
   (:export #:*input* #:*stack*
-           #:exec-list #:exec-input
+           #:exec-list #:exec-input #:comp-input #:call
            #:lit #:reg #:reg2
            #:pushd #:popd #:peekd))
 
@@ -47,7 +47,7 @@
 
 (defclass comp-word (word) ())
 
-(defmethod comp-item ((w word))
+(defmethod comp-item ((w comp-word))
   (funcall (func w)))
 
 ;;;; functions
@@ -92,7 +92,8 @@
   (:use :common-lisp)
   (:local-nicknames (:f :scopes/forge/sf)
                     (:iter :scopes/util/iter))
-  (:export #:add #:mul #:dup #:in #:? #:lit))
+  (:export #:add #:mul #:dup #:in #:? #:lit
+           #:<comp #:reg))
 
 (in-package :sf-builtin)
 
@@ -104,3 +105,11 @@
 (f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*))))
 
 (f:reg 'lit #'f:lit)
+
+(f:reg '<comp #'f:comp-input)
+
+(f:reg 'reg 
+  #'(lambda () 
+    (let ((name (popd))
+          (code (popd)))
+      (f:reg name #'(lambda () (f:call code))))))
diff --git a/test/test-sf.lisp b/test/test-sf.lisp
index ad1bd8c..82c88f5 100644
--- a/test/test-sf.lisp
+++ b/test/test-sf.lisp
@@ -25,8 +25,9 @@
   (forge:exec-list '(4 2 add))
   (util:lgi forge:*stack*)
   (== (forge:popd) 6)
-  (forge:exec-list '(in name))
-  (util:lgi (forge:popd))
+  (forge:exec-list '(<comp dup mul))
+  (forge:exec-list '(in square))
+  (util:lgi forge:*stack*)
   (t:show-result))
 
 
diff --git a/util/iter.lisp b/util/iter.lisp
index 785f130..65900d8 100644
--- a/util/iter.lisp
+++ b/util/iter.lisp
@@ -13,7 +13,7 @@
 ;;;; iterators
 
 (defclass iterator () 
-  ((stop :accessor stop :initform nil)))
+  ((stopped :accessor stopped :initform nil)))
 
 (defgeneric next (it))
 (defgeneric value (it))
@@ -23,12 +23,16 @@
     (next it)
     (value it)))
 
+(defgeneric stop (it)
+  (:method ((it iterator))
+    (setf (stopped it) t)))
+
 (defgeneric process (it fn)
   (:method ((it iterator) fn)
     (do ((eoi (next it) (next it)))
-        ((or eoi (stop it)))
+        ((or eoi (stopped it)))
       (funcall fn (value it)))
-    (setf (stop it) nil)))
+    (setf (stopped it) nil)))
 
 ;;;; list iterator implementation