diff --git a/forge/sf.lisp b/forge/sf.lisp index b1a7cc6..fd5abbd 100644 --- a/forge/sf.lisp +++ b/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))) diff --git a/test/test-sf.lisp b/test/test-sf.lisp index 23d68fb..bc7f02b 100644 --- a/test/test-sf.lisp +++ b/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)) diff --git a/util/iter.lisp b/util/iter.lisp index f40cbb1..7fc5e06 100644 --- a/util/iter.lisp +++ b/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)))