forge/sf, work in progress: define / compile forge words

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))))))

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))
 
 

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