diff --git a/forge/sf.lisp b/forge/sf.lisp index 9663d27..986b65d 100644 --- a/forge/sf.lisp +++ b/forge/sf.lisp @@ -11,7 +11,7 @@ #:word #:comp-word #:exec-list #:exec-input #:comp-input #:call #:comp-item - #:next #:reg #:reg2 #:reg-code + #:next #:reg #:reg1 #:reg2 #:reg-code #:pushd #:popd #:peekd)) (in-package :scopes/forge/sf) @@ -102,6 +102,9 @@ (setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn)) (setf (gethash fn (func-index *forge-env*)) sym)) +(defun reg1 (sym fn) + (reg sym #'(lambda () (pushd (funcall fn (popd)))))) + (defun reg2 (sym fn) (reg sym #'(lambda () (pushd (funcall fn (popd) (popd)))))) @@ -158,8 +161,8 @@ (f:reg 'dup #'(lambda () (f:pushd (f:peekd)))) (f:reg 'swp #'(lambda () (let ((a (f:popd)) (b (f:popd))) (f:pushd a) (f:pushd b)))) -(f:reg 'ptr #'(lambda () (f:pushd (util:ptr (f:popd))))) -(f:reg 'get #'(lambda () (f:pushd (aref (f:popd))))) +(f:reg1 'ptr #'util:ptr) +(f:reg1 'get #'aref) (f:reg 'put #'(lambda () (setf (aref (f:popd)) (f:popd)))) (f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*)))) diff --git a/test/test-core.lisp b/test/test-core.lisp index 8477920..b6ea8df 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -87,8 +87,15 @@ ) (deftest test-util-iter () - (let ((it (iter:list-iterator '(1 2 3)))) - (== (iter:value it) nil)) + (let ((it (iter:list-iterator '(a b c)))) + (== (iter:value it) nil) + (== (iter:next it) nil) + (== (iter:value it) 'a)) + (let ((it (iter:string-iterator "a b c"))) + (== (iter:value it) nil) + (== (iter:next it) nil) + (== (iter:value it) (intern "A"))) + ;(== (iter:value it) (read-from-string "a"))) ) (deftest test-shape() diff --git a/util/iter.lisp b/util/iter.lisp index cd64351..4cf2ce1 100644 --- a/util/iter.lisp +++ b/util/iter.lisp @@ -6,7 +6,7 @@ (defpackage :scopes/util/iter (:use :common-lisp) (:export #:stop #:next #:value #:next-value #:process - #:list-iterator)) + #:list-iterator #:string-iterator)) (in-package :scopes/util/iter) @@ -52,3 +52,23 @@ (defmethod value ((it list-iterator)) (car (cur it))) + +;;;; string iterator implementation + +(defclass string-iterator (iterator) + ((data :reader data :initarg :data :initform "") + (curpos :accessor curpos :initform 0) + (value :accessor value :initform nil))) + +(defun string-iterator (s) + (make-instance 'string-iterator :data s)) + +(defmethod next ((it string-iterator)) + (let ((pos (curpos it))) + (if (< pos (length (data it))) + (multiple-value-bind (val newpos) + (read-from-string (data it) nil nil :start pos) + (setf (curpos it) newpos + (value it) val) + nil) + t)))