diff --git a/forge/sf.lisp b/forge/sf.lisp
index e87e909..52c801a 100644
--- a/forge/sf.lisp
+++ b/forge/sf.lisp
@@ -6,8 +6,9 @@
(:use :common-lisp)
(:local-nicknames (:iter :scopes/util/iter))
(:export #:*input* #:*stack*
+ #:word #:comp-word
#:exec-list #:exec-input #:comp-input #:call
- #:lit #:reg #:reg2
+ #:lit #:reg #:reg2 #:reg-code
#:pushd #:popd #:peekd))
(in-package :scopes/forge/sf)
@@ -16,6 +17,13 @@
(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*)))
+ (if sym
+ (print-unreadable-object (fn s) (format s "~s" sym))
+ (call-next-method))))
;;;; core definitions
@@ -32,7 +40,7 @@
(:method ((it symbol))
(comp-item (symbol-value it))))
-;;;; class word
+;;;; class word*
(defclass word ()
((func :reader func :initarg :func)))
@@ -68,12 +76,18 @@
(let ((*code* (make-instance 'iter:list-iterator :data code)))
(iter:process *code* #'funcall)))
-(defun reg (sym fn)
- (setf (symbol-value sym) (make-instance 'word :func fn)))
+(defun reg (sym fn &optional (cls 'word))
+ (setf (symbol-value sym) (make-instance cls :func fn))
+ (setf (gethash fn *func-index*) sym))
(defun reg2 (sym fn)
(reg sym #'(lambda () (pushd (funcall fn (popd) (popd))))))
+(defun reg-code (&optional (cls 'word))
+ (let ((name (popd))
+ (code (popd)))
+ (reg name #'(lambda () (call code)) cls)))
+
(defun pushd (v)
(push v *stack*))
@@ -93,7 +107,7 @@
(:local-nicknames (:f :scopes/forge/sf)
(:iter :scopes/util/iter))
(:export #:add #:mul #:dup #:in #:? #:lit
- #:))
(in-package :sf-builtin)
@@ -108,8 +122,7 @@
(f:reg ' #'(lambda () (iter:stop f:*input*)) 'f:comp-word)
diff --git a/test/test-sf.lisp b/test/test-sf.lisp
index 82c88f5..d8b05e2 100644
--- a/test/test-sf.lisp
+++ b/test/test-sf.lisp
@@ -23,11 +23,12 @@
(deftest test-exec ()
;(forge:exec-str "4 2 add")
(forge:exec-list '(4 2 add))
- (util:lgi forge:*stack*)
(== (forge:popd) 6)
(forge:exec-list '(