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