forge/sf: store words in sf-builtin:... variables; work in progress: use generic functions/methods

forge/sf.lisp

@@ -6,13 +6,10 @@
   (:use :common-lisp)
   (:local-nicknames (:iter :scopes/util/iter))
   (:export #:*input* #:*stack*
-           #:proc-list #:proc-input
-           #:add #:mul #:dup
+           #:exec-list #:exec-input
+           #:reg #:reg2
            #:pushd #:popd #:peekd))
 
-(defpackage :sf-builtin)
-(defpackage :sf-user)
-
 (in-package :scopes/forge/sf)
 
 (defvar *stack* nil)
@@ -20,24 +17,28 @@
 
 ;;;; core definitions
 
-(defun proc-list (lst)
+(defclass word () ())
+
+(defclass comp-word (word) ())
+
+(defun exec-list (lst)
   (setf *input* (make-instance 'iter:list-iterator :data lst))
-  (proc-input))
+  (exec-input))
 
-(defun proc-input ()
-  (let ((inp *input*))
-    (do ((end (iter:next inp) (iter:next inp)))
-        (end)
-      (proc-item (iter:value inp)))))
+(defun exec-input ()
+  (iter:process *input* #'exec-item))
 
-(defun proc-item (item)
+(defun exec-item (item)
   (typecase item
-    (symbol (funcall item))
+    (function (funcall item))
+    (symbol (funcall (symbol-value item)))
     (t (pushd item))))
 
+(defun reg (sym fn)
+  (setf (symbol-value sym) fn))
+
 (defun reg2 (sym fn)
-  (setf (fdefinition sym) 
-        #'(lambda () (pushd (funcall fn (popd) (popd))))))
+  (reg sym #'(lambda () (pushd (funcall fn (popd) (popd))))))
 
 (defun pushd (v)
   (push v *stack*))
@@ -50,7 +51,14 @@
 
 ;;;; builtins
 
-(reg2 'add #'+)
-(reg2 'mul #'*)
+(defpackage :sf-builtin
+  (:use :common-lisp)
+  (:local-nicknames (:f :scopes/forge/sf))
+  (:export #:add #:mul #:dup))
 
-(defun dup () (pushd (peekd)))
+(in-package :sf-builtin)
+
+(f:reg2 'add #'+)
+(f:reg2 'mul #'*)
+
+(f:reg 'dup #'(lambda () (pushd (peekd))))

scopes-core.asd

@@ -33,5 +33,5 @@
   :perform (test-op (o c) 
     (symbol-call :scopes/test-config :run)
     (symbol-call :scopes/test-core :run)
-    (symbol-call :scopes/test-forge :run)
+    ;(symbol-call :scopes/test-forge :run)
     (symbol-call :scopes/test-sf :run)))

test/test-core.lisp

@@ -87,6 +87,8 @@
   )
 
 (deftest test-util-iter ()
+  (let ((it (make-instance 'iter:list-iterator :data '(1 2 3))))
+    (== (iter:value it) nil))
   )
 
 (deftest test-shape()

test/test-sf.lisp

@@ -3,7 +3,8 @@
 ;;;; testing facility for scopes/forge
 
 (defpackage :scopes/test-sf
-  (:use :common-lisp)
+  (:use :common-lisp
+        :sf-builtin)
   (:local-nicknames (:forge :scopes/forge/sf) 
                     (:util :scopes/util)
                     (:t :scopes/testing))
@@ -20,8 +21,8 @@
     (test-exec)))
  
 (deftest test-exec ()
-  ;(forge:proc-str "4 2 add")
-  (forge:proc-list '(4 2 forge:add))
+  ;(forge:exec-str "4 2 add")
+  (forge:exec-list '(4 2 add))
   (util:lgi forge:*stack*)
   (== (forge:popd) 6)
   (t:show-result))

util/iter.lisp

@@ -5,17 +5,32 @@
 
 (defpackage :scopes/util/iter
   (:use :common-lisp)
-  (:export #:next #:value
+  (:export #:next #:value #:process
            #:list-iterator))
 
 (in-package :scopes/util/iter)
 
 ;;;; iterators
 
+(defclass abstract-iterator () ())
+
 (defgeneric next (it))
 (defgeneric value (it))
 
-(defclass list-iterator ()
+(defgeneric next-value (it)
+  (:method ((it abstract-iterator))
+    (next it)
+    (value it)))
+
+(defgeneric process (it fn &optional stop)
+  (:method ((it abstract-iterator) fn &optional (stop (constantly nil)))
+    (do ((eoi (next it) (next it)))
+        ((or eoi (funcall stop)))
+      (funcall fn (value it)))))
+
+;;;; list iterator implementation
+
+(defclass list-iterator (abstract-iterator)
   ((data :reader data :initarg :data :initform nil)
    (cur :accessor cur)))