forge/sf: stack and vocabulary in class forge-env

forge/sf.lisp

@@ -7,7 +7,7 @@
   (:local-nicknames (:iter :scopes/util/iter)
                     (:util :scopes/util))
   (:export #:forge-env #:vocabulary #:stack
-           #:*forge-env* #:*stack* #:*input* #:*code*
+           #:*forge-env* #:*input* #:*code*
            #:word #:comp-word
            #:exec-list #:exec-input #:comp-input #:call
            #:comp-item
@@ -19,11 +19,10 @@
 (defclass forge-env ()
   ((vocabulary :reader vocabulary :initform (make-hash-table))
    (func-index :reader func-index :initform (make-hash-table))
-   (stack :reader stack :initform nil)))
+   (stack :accessor stack :initform nil)))
 
 (defvar *forge-env* (make-instance 'forge-env))
 
-(defvar *stack* nil)
 (defvar *input* nil)
 (defvar *buffer* nil)
 (defvar *code* nil)
@@ -40,7 +39,7 @@
   (:method ((it t))
     (pushd it))
   (:method ((it symbol))
-    (let ((v (symbol-value it)))
+    (let ((v (find-word it)))
       (when v
         (exec-item v)))))
 
@@ -49,11 +48,14 @@
     (push #'lit *buffer*)
     (push it *buffer*))
   (:method ((it symbol))
-    (let ((v (symbol-value it)))
+    (let ((v (find-word it)))
       (when v
         ;(util:lgi it v)
         (comp-item v)))))
 
+(defun find-word (sym)
+  (gethash sym (vocabulary *forge-env*)))
+
 ;;;; class word*
 
 (defclass word () 
@@ -88,11 +90,11 @@
 
 (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 sym (vocabulary *forge-env*)) (make-instance cls :func fn))
   (setf (gethash fn (func-index *forge-env*)) sym))
 
 (defun reg2 (sym fn)
@@ -104,13 +106,13 @@
     (reg name #'(lambda () (call code)) cls)))
 
 (defun pushd (v)
-  (push v *stack*))
+  (push v (stack *forge-env*)))
 
 (defun popd ()
-  (pop *stack*))
+  (pop (stack *forge-env*)))
 
 (defun peekd ()
-  (car *stack*))
+  (car (stack *forge-env*)))
 
 (defun lit () 
   (pushd (iter:next-value *code*)))

test/test-sf.lisp

@@ -20,7 +20,7 @@
         ;(forge:setup-builtins)
         (test-exec)
         (test-def)))
-    (util:lgi forge:*stack*)
+    (util:lgi (forge:stack forge:*forge-env*))
     (t:show-result)))
  
 (deftest test-exec ()