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

store reverse word index and word metadata index in forge-env

Browse source
This commit is contained in:
Helmut Merz 2024-05-29 15:00:29 +02:00
parent fb88c0b934
commit b5dabdb73b
1 changed files with 22 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
forge/forge.lisp
View file

@ -51,13 +51,14 @@
(defclass forge-env ()
((data-stack :initform nil :accessor data-stack)
(words :initform (make-hash-table))
(words :initform (make-hash-table :test #'eq))
(comp-words :initform (make-hash-table))
(words-rev :initform (make-hash-table))
(words-meta :initform (make-hash-table))
(packages :initform '(:sf-user :sf-builtin))
(current-package :initform :sf-builtin)
(rp :initform (make-iseq))
(cp :initform (make-iseq))
(ip :initform (make-iseq))))
(ip :initform (make-iseq))
(rp) (cp)))
(defun forge-env ()
(make-instance 'forge-env))
@ -75,13 +76,16 @@
(defun comp-words () (slot-value *forge-env* 'comp-words))
(defun register-comp-word (sym fn)
(register sym fn 'comp-words))
(defun register-comp-word (sym fn &key code)
(register sym fn :slot 'comp-words :code code))
(defun register (sym fn &optional (slot 'words))
(defun register (sym fn &key (slot 'words) code)
(let* ((w (intern (string sym) (current-package)))
(words (slot-value *forge-env* slot)))
(setf (gethash w words) fn)))
(setf (gethash w words) fn)
(setf (gethash fn (slot-value *forge-env* 'words-rev)) w)
(if code
(setf (gethash w (slot-value *forge-env* 'words-meta)) code))))
;;; builtins
@ -95,12 +99,12 @@
(defun do-reg ()
(let* ((name (popd))
(code (popd)))
(register name #'(lambda () (call code)))))
(register name #'(lambda () (call code)) :code code)))
(defun do-regc ()
(let* ((name (popd))
(code (popd)))
(register-comp-word name #'(lambda () (call code)))))
(register-comp-word name #'(lambda () (call code)) :code code)))
(defun do-quote () (comp-item #'lit) (comp-item (read-next)))
@ -131,6 +135,13 @@
;;; compiler, interpreter
(defun do-trace (code)
(format t "~%~a"
(mapcar
#'(lambda (f)
(or (gethash f (slot-value *forge-env* 'words-rev)) f))
code)))
(defun exec-str (s)
(exec (read-from-string
(concatenate 'string "(" s ")"))))
@ -144,7 +155,7 @@
(call (comp code)))
(defun call (code)
#+forge-trace (print code)
#+forge-trace (do-trace code)
(let ((old-ip (fip))
(ip (make-iseq code)))
(setf (slot-value *forge-env* 'ip) ip)