diff --git a/forge/sf.lisp b/forge/sf.lisp
index 54c3cb9..f151f60 100644
--- a/forge/sf.lisp
+++ b/forge/sf.lisp
@@ -11,11 +11,13 @@
#:word #:comp-word
#:exec-list #:exec-input #:comp-input #:call
#:comp-item
- #:lit #:reg #:reg2 #:reg-code
+ #:next #:reg #:reg2 #:reg-code
#:pushd #:popd #:peekd))
(in-package :scopes/forge/sf)
+;;;; common definitions
+
(defclass forge-env ()
((vocabulary :reader vocabulary :initform (make-hash-table))
(func-index :reader func-index :initform (make-hash-table))
@@ -33,8 +35,6 @@
(print-unreadable-object (fn s) (format s "~s" sym))
(call-next-method))))
-;;;; core definitions
-
(defgeneric exec-item (it)
(:method ((it t))
(pushd it))
@@ -45,7 +45,7 @@
(defgeneric comp-item (it)
(:method ((it t))
- (push #'lit *buffer*)
+ (push #'next *buffer*)
(push it *buffer*))
(:method ((it symbol))
(let ((v (find-word it)))
@@ -54,9 +54,12 @@
(comp-item v)))))
(defun find-word (sym)
- (gethash sym (vocabulary *forge-env*)))
+ (multiple-value-bind (val found) (gethash sym (vocabulary *forge-env*))
+ (when (not found)
+ (util:lgw "not found" sym))
+ val))
-;;;; class word*
+;;;; class word
(defclass word ()
((func :reader func :initarg :func)))
@@ -74,10 +77,10 @@
(defmethod comp-item ((w comp-word))
(funcall (func w)))
-;;;; functions
+;;;; code compilation and execution
(defun exec-list (lst)
- (let ((*input* (make-instance 'iter:list-iterator :data lst)))
+ (let ((*input* (iter:list-iterator lst)))
(exec-input)))
(defun exec-input ()
@@ -89,9 +92,11 @@
(pushd (reverse *buffer*))))
(defun call (code)
- (let ((*code* (make-instance 'iter:list-iterator :data code)))
- (util:lgi code)
- (iter:process *code* #'funcall)))
+ (util:lgi code)
+ (let ((*code* code))
+ (do ((fn (pop *code*) (pop *code*)))
+ ((null fn))
+ (funcall fn))))
(defun reg (sym fn &optional (cls 'word))
(setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn))
@@ -114,7 +119,7 @@
(defun peekd ()
(car (stack *forge-env*)))
-(defun lit ()
+(defun next ()
(pushd (iter:next-value *code*)))
;;;; builtins
@@ -123,12 +128,28 @@
(:use :common-lisp)
(:local-nicknames (:f :scopes/forge/sf)
(:iter :scopes/util/iter))
- (:export #:add #:mul #:dup #:swp #:in #:? #:lit
- #:comp-pop #:comp-in #:comp
+ (:export #:add #:mul #:dup #:swp
+ #:in #:next
+ #:call #:comp
#:))
(in-package :sf-builtin)
+;;;; implementation functions
+
+(defun call-if ()
+ (let ((code (f:popd)))
+ (if (f:popd)
+ (f:call code))))
+
+(defun call-while ()
+ (let ((code (f:popd)))
+ (do ((cond (f:popd) (f:popd)))
+ ((not cond))
+ (f:call code))))
+
+;;;; lisp-code word definitions
+
(f:reg2 'add #'+)
(f:reg2 'mul #'*)
@@ -136,11 +157,10 @@
(f:reg 'swp #'(lambda () (let ((a (f:popd)) (b (f:popd))) (f:pushd a) (f:pushd b))))
(f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*))))
-(f:reg 'lit #'f:lit)
+(f:reg 'next #'f:next)
-(f:reg 'comp-pop #'(lambda () (f:comp-item (popd))))
-(f:reg 'comp-in #'(lambda () (f:comp-item (iter:next-value f:*input*))))
-(f:reg 'comp #'(lambda () (f:comp-item (iter:next-value f:*code*))))
+(f:reg 'call #'(lambda () (f:call (popd))))
+(f:reg 'comp #'(lambda () (f:comp-item (popd))))
(f:reg ' #'(lambda () (iter:stop f:*input*)) 'f:comp-word)
+
+;;;; forge-code word definitions
diff --git a/test/test-core.lisp b/test/test-core.lisp
index 6617040..8477920 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -87,7 +87,7 @@
)
(deftest test-util-iter ()
- (let ((it (make-instance 'iter:list-iterator :data '(1 2 3))))
+ (let ((it (iter:list-iterator '(1 2 3))))
(== (iter:value it) nil))
)
diff --git a/util/iter.lisp b/util/iter.lisp
index 7506d1d..cd64351 100644
--- a/util/iter.lisp
+++ b/util/iter.lisp
@@ -40,6 +40,9 @@
((data :reader data :initarg :data :initform nil)
(cur :accessor cur)))
+(defun list-iterator (data)
+ (make-instance 'list-iterator :data data))
+
(defmethod initialize-instance :after ((it list-iterator) &key)
(setf (cur it) (cons nil (data it))))