diff --git a/forge/sf.lisp b/forge/sf.lisp index 9f56d1c..b1a7cc6 100644 --- a/forge/sf.lisp +++ b/forge/sf.lisp @@ -5,7 +5,8 @@ (defpackage :scopes/forge/sf (:use :common-lisp) (:local-nicknames (:iter :scopes/util/iter)) - (:export #:*stack* + (:export #:*input* #:*stack* + #:proc-list #:proc-input #:add #:pushd #:popd)) @@ -15,19 +16,35 @@ (in-package :scopes/forge/sf) (defvar *stack* nil) +(defvar *input* nil) -;;;; builtins +;;;; core definitions + +(defun proc-list (lst) + (setf *input* (make-instance 'iter:list-iterator :data lst)) + (proc-input)) + +(defun proc-input () + (let ((inp *input*)) + (do ((item (iter:next inp) (iter:next inp))) + ((null item)) + (proc-item item)))) + +(defun proc-item (item) + (typecase item + (symbol (funcall item)) + (t (pushd item)))) (defun reg2 (sym fn) (setf (fdefinition sym) #'(lambda () (pushd (funcall fn (popd) (popd)))))) -(reg2 'add #'+) - -;;;; core definitions - (defun pushd (v) (push v *stack*)) (defun popd () (pop *stack*)) + +;;;; builtins + +(reg2 'add #'+) diff --git a/test/test-sf.lisp b/test/test-sf.lisp index 79709f3..23d68fb 100644 --- a/test/test-sf.lisp +++ b/test/test-sf.lisp @@ -26,6 +26,8 @@ (forge:pushd 2) (forge:add) (== (forge:popd) 6) + (forge:proc-list '(4 2 forge:add)) + (== (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 a940626..f40cbb1 100644 --- a/util/iter.lisp +++ b/util/iter.lisp @@ -5,9 +5,26 @@ (defpackage :scopes/util/iter (:use :common-lisp) - (:export #:list-iterator)) + (:export #:current #:next + #:list-iterator)) (in-package :scopes/util/iter) +;;;; iterators + +(defgeneric next (it)) +(defgeneric current (it)) + (defclass list-iterator () - ((data :reader data :initarg :data :initform nil))) + ((data :reader data :initarg :data :initform nil) + (cur :accessor cur))) + +(defmethod initialize-instance :after ((it list-iterator) &key &allow-other-keys) + (setf (cur it) (cons nil (data it)))) + +(defmethod next ((it list-iterator)) + (pop (cur it)) + (current it)) + +(defmethod current ((it list-iterator)) + (car (cur it)))