diff --git a/forge/sf.lisp b/forge/sf.lisp
index 44cdccb..137024f 100644
--- a/forge/sf.lisp
+++ b/forge/sf.lisp
@@ -6,22 +6,30 @@
(:use :common-lisp)
(:local-nicknames (:iter :scopes/util/iter)
(:util :scopes/util))
- (:export #:*input* #:*stack*
+ (:export #:forge-env #:vocabulary #:stack
+ #:*forge-env* #:*stack* #:*input* #:*code*
#:word #:comp-word
#:exec-list #:exec-input #:comp-input #:call
+ #:comp-item
#:lit #:reg #:reg2 #:reg-code
#:pushd #:popd #:peekd))
(in-package :scopes/forge/sf)
+(defclass forge-env ()
+ ((vocabulary :reader vocabulary :initform (make-hash-table))
+ (func-index :reader func-index :initform (make-hash-table))
+ (stack :reader stack :initform nil)))
+
+(defvar *forge-env* (make-instance 'forge-env))
+
(defvar *stack* nil)
(defvar *input* nil)
(defvar *buffer* nil)
(defvar *code* nil)
-(defvar *func-index* (make-hash-table))
(defmethod print-object :around ((fn function) s)
- (let ((sym (gethash fn *func-index*)))
+ (let ((sym (gethash fn (func-index *forge-env*))))
(if sym
(print-unreadable-object (fn s) (format s "~s" sym))
(call-next-method))))
@@ -43,7 +51,7 @@
(:method ((it symbol))
(let ((v (symbol-value it)))
(when v
- (util:lgi it v)
+ ;(util:lgi it v)
(comp-item v)))))
;;;; class word*
@@ -80,12 +88,12 @@
(defun call (code)
(let ((*code* (make-instance 'iter:list-iterator :data code)))
- (util:lgi code)
+ ;(util:lgi code)
(iter:process *code* #'funcall)))
(defun reg (sym fn &optional (cls 'word))
(setf (symbol-value sym) (make-instance cls :func fn))
- (setf (gethash fn *func-index*) sym))
+ (setf (gethash fn (func-index *forge-env*)) sym))
(defun reg2 (sym fn)
(reg sym #'(lambda () (pushd (funcall fn (popd) (popd))))))
@@ -113,7 +121,8 @@
(:use :common-lisp)
(:local-nicknames (:f :scopes/forge/sf)
(:iter :scopes/util/iter))
- (:export #:add #:mul #:dup #:swp #:in #:? #:lit #:defer
+ (:export #:add #:mul #:dup #:swp #:in #:? #:lit
+ #:comp-pop #:comp-in #:comp
#:))
(in-package :sf-builtin)
@@ -125,9 +134,11 @@
(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 'defer #'(lambda () (push (iter:next-value f::*code*) f::*buffer*)))
+
+(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 '