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

work in progress: organizing words in hash-tables; simple exec working again

Browse source
This commit is contained in:
Helmut Merz 2024-05-24 15:39:30 +02:00
parent 272430f36c
commit 944b3402e5
1 changed files with 29 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
forge/forge.lisp
View file

@ -8,6 +8,9 @@
#:forge-env #:dstack #:exec #:exec-str #:repl #:forge-env #:dstack #:exec #:exec-str #:repl
#:make-iseq #:isq-all #:isq-cur #:isq-next #:isq-end #:isq-add)) #:make-iseq #:isq-all #:isq-cur #:isq-next #:isq-end #:isq-add))
(defpackage :sf-builtin)
(defpackage :sf-user)
(in-package :scopes/forge) (in-package :scopes/forge)
;;; iseq: iterable sequence ;;; iseq: iterable sequence
@ -44,7 +47,10 @@
(defclass forge-env () (defclass forge-env ()
((data-stack :initform nil :accessor data-stack) ((data-stack :initform nil :accessor data-stack)
(words :initform (make-hash-table))
(comp-words :initform (make-hash-table)) (comp-words :initform (make-hash-table))
(packages :initform '(:sf-user :sf-builtin))
(current-package :initform :sf-user)
(rp :initform (make-iseq)) (rp :initform (make-iseq))
(cp :initform (make-iseq)) (cp :initform (make-iseq))
(ip :initform (make-iseq)))) (ip :initform (make-iseq))))
@ -61,13 +67,21 @@
(defun define-comp-word (sym fn) (defun define-comp-word (sym fn)
(setf (gethash sym (slot-value *forge-env* 'comp-words)) fn)) (setf (gethash sym (slot-value *forge-env* 'comp-words)) fn))
(defun register (p sym fn)
(let ((w (intern (string sym) p)))
(setf (gethash w (slot-value *forge-env* 'words)) fn)))
;;; builtins ;;; builtins
(defvar add #'(lambda () (pushd (+ (popd) (popd))))) (defun reg-b (sym fn)
(register :sf-builtin sym fn))
(defvar dup #'(lambda () (pushd (car (dstack))))) (reg-b 'add #'(lambda () (pushd (+ (popd) (popd)))))
(reg-b 'dup #'(lambda () (pushd (car (dstack)))))
(defvar lit #'(lambda () (pushd (isq-next (fip))))) (defvar lit #'(lambda () (pushd (isq-next (fip)))))
(reg-b 'lit lit)
(define-comp-word 'def (define-comp-word 'def
#'(lambda () #'(lambda ()
@ -111,20 +125,25 @@
(isq-all (fcp))) (isq-all (fcp)))
(defun comp-symbol (sym) (defun comp-symbol (sym)
(let* ((word (get-word sym)) (let* ((w (get-word sym))
(comp-word (get-comp-word word))) (comp-fn (get-comp-word w)))
(if comp-word (if comp-fn
(funcall comp-word) (funcall comp-fn)
(comp-item (symbol-value word))))) (comp-item (gethash w (slot-value *forge-env* 'words))))))
(defun comp-item (item) (defun comp-item (item)
(isq-add (fcp) item)) (isq-add (fcp) item))
(defun get-word (sym) (defun get-word (sym)
(intern (string sym) :scopes/forge)) (let ((name (string sym)))
(dolist (p (slot-value *forge-env* 'packages))
(let ((w (find-symbol name p)))
(if w
(return-from get-word w))))
(intern name (slot-value *forge-env* 'current-package))))
(defun get-comp-word (sym) (defun get-comp-word (w)
(gethash sym (slot-value *forge-env* 'comp-words))) (gethash w (slot-value *forge-env* 'comp-words)))
;;; internal definitions ;;; internal definitions