cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

forge/sf: define current-package in forge-env, use for registering and finding words

Browse source
This commit is contained in:
Helmut Merz 2024-09-15 18:39:03 +02:00
parent ee2acbe1b9
commit 66bc23c97a
1 changed files with 11 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
forge/sf.lisp
View file

@ -6,7 +6,7 @@
(:use :common-lisp)
(:local-nicknames (:iter :scopes/util/iter)
(:util :scopes/util))
(:export #:forge-env #:vocabulary #:stack
(:export #:forge-env #:vocabulary #:stack #:current-package
#:*forge-env* #:*input* #:*code*
#:word #:comp-word
#:exec-list #:exec-input #:comp-input #:call
@ -21,7 +21,8 @@
(defclass forge-env ()
((vocabulary :reader vocabulary :initform (make-hash-table))
(func-index :reader func-index :initform (make-hash-table))
(stack :accessor stack :initform nil)))
(stack :accessor stack :initform nil)
(current-package :accessor current-package :initform :sf-builtin)))
(defvar *forge-env* (make-instance 'forge-env))
@ -54,10 +55,11 @@
(comp-item v)))))
(defun find-word (sym)
(let ((sym (find-symbol (symbol-name sym) (current-package *forge-env*))))
(multiple-value-bind (val found) (gethash sym (vocabulary *forge-env*))
(when (not found)
(util:lgw "not found" sym))
val))
val)))
;;;; class word
@ -99,8 +101,9 @@
(funcall fn))))
(defun reg (sym fn &optional (cls 'word))
(let ((sym (intern (symbol-name sym) (current-package *forge-env*))))
(setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn))
(setf (gethash fn (func-index *forge-env*)) sym))
(setf (gethash fn (func-index *forge-env*)) sym)))
(defun reg1 (sym fn)
(reg sym #'(lambda () (pushd (funcall fn (popd))))))