forge/sf: minor improvements

forge/sf.lisp

@@ -7,8 +7,8 @@
   (:local-nicknames (:iter :scopes/util/iter))
   (:export #:*input* #:*stack*
            #:proc-list #:proc-input
-           #:add
-           #:pushd #:popd))
+           #:add #:mul #:dup
+           #:pushd #:popd #:peekd))
 
 (defpackage :sf-builtin)
 (defpackage :sf-user)
@@ -26,9 +26,9 @@
 
 (defun proc-input ()
   (let ((inp *input*))
-    (do ((item (iter:next inp) (iter:next inp)))
-        ((null item))
-      (proc-item item))))
+    (do ((end (iter:next inp) (iter:next inp)))
+        (end)
+      (proc-item (iter:value inp)))))
 
 (defun proc-item (item)
   (typecase item
@@ -36,8 +36,8 @@
     (t (pushd item))))
 
 (defun reg2 (sym fn)
-  (setf (fdefinition sym) #'(lambda ()
-    (pushd (funcall fn (popd) (popd))))))
+  (setf (fdefinition sym) 
+        #'(lambda () (pushd (funcall fn (popd) (popd))))))
 
 (defun pushd (v)
   (push v *stack*))
@@ -45,6 +45,12 @@
 (defun popd ()
   (pop *stack*))
 
+(defun peekd ()
+  (car *stack*))
+
 ;;;; builtins
 
 (reg2 'add #'+)
+(reg2 'mul #'*)
+
+(defun dup () (pushd (peekd)))

test/test-sf.lisp

@@ -20,16 +20,10 @@
     (test-exec)))
  
 (deftest test-exec ()
-  (util:lgi 42)
-  (== (+ 2 1) 3)
-  (forge:pushd 4)
-  (forge:pushd 2)
-  (forge:add)
-  (== (forge:popd) 6)
+  ;(forge:proc-str "4 2 add")
   (forge:proc-list '(4 2 forge:add))
+  (util:lgi forge:*stack*)
   (== (forge:popd) 6)
-  ;(forge:exec-str "4 2 +")
-  ;(== (car (forge:dstack)) 6))
   (t:show-result))
 
 

util/iter.lisp

@@ -5,7 +5,7 @@
 
 (defpackage :scopes/util/iter
   (:use :common-lisp)
-  (:export #:current #:next 
+  (:export #:next #:value
            #:list-iterator))
 
 (in-package :scopes/util/iter)
@@ -13,7 +13,7 @@
 ;;;; iterators
 
 (defgeneric next (it))
-(defgeneric current (it))
+(defgeneric value (it))
 
 (defclass list-iterator ()
   ((data :reader data :initarg :data :initform nil)
@@ -24,7 +24,7 @@
 
 (defmethod next ((it list-iterator))
   (pop (cur it))
-  (current it))
+  (null (cur it)))
 
-(defmethod current ((it list-iterator))
+(defmethod value ((it list-iterator))
   (car (cur it)))