util/iter: string-iterator

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:reg1 'ptr #'util:ptr)
-(f:reg 'get #'(lambda () (f:pushd (aref (f:popd)))))
+(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*))))

test/test-core.lisp

@@ -87,8 +87,15 @@
   )
 
 (deftest test-util-iter ()
-  (let ((it (iter:list-iterator '(1 2 3))))
+  (let ((it (iter:list-iterator '(a b c))))
-    (== (iter:value it) nil))
+    (== (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()

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)))