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

forge/sf: stack and vocabulary in class forge-env

Browse source
This commit is contained in:
Helmut Merz 2024-09-13 10:12:52 +02:00
parent 5df8a852b1
commit 78cce53f29
2 changed files with 13 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
forge/sf.lisp
View file

@ -7,7 +7,7 @@
(: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
#:*forge-env* #:*stack* #:*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
#:comp-item #:comp-item
@ -19,11 +19,10 @@
(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 :reader stack :initform nil))) (stack :accessor stack :initform nil)))
(defvar *forge-env* (make-instance 'forge-env)) (defvar *forge-env* (make-instance 'forge-env))
(defvar *stack* nil)
(defvar *input* nil) (defvar *input* nil)
(defvar *buffer* nil) (defvar *buffer* nil)
(defvar *code* nil) (defvar *code* nil)
@ -40,7 +39,7 @@
(:method ((it t)) (:method ((it t))
(pushd it)) (pushd it))
(:method ((it symbol)) (:method ((it symbol))
(let ((v (symbol-value it))) (let ((v (find-word it)))
(when v (when v
(exec-item v))))) (exec-item v)))))
@ -49,11 +48,14 @@
(push #'lit *buffer*) (push #'lit *buffer*)
(push it *buffer*)) (push it *buffer*))
(:method ((it symbol)) (:method ((it symbol))
(let ((v (symbol-value it))) (let ((v (find-word it)))
(when v (when v
;(util:lgi it v) ;(util:lgi it v)
(comp-item v))))) (comp-item v)))))
(defun find-word (sym)
(gethash sym (vocabulary *forge-env*)))
;;;; class word* ;;;; class word*
(defclass word () (defclass word ()
@ -88,11 +90,11 @@
(defun call (code) (defun call (code)
(let ((*code* (make-instance 'iter:list-iterator :data code))) (let ((*code* (make-instance 'iter:list-iterator :data code)))
;(util:lgi code) (util:lgi code)
(iter:process *code* #'funcall))) (iter:process *code* #'funcall)))
(defun reg (sym fn &optional (cls 'word)) (defun reg (sym fn &optional (cls 'word))
(setf (symbol-value sym) (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 reg2 (sym fn) (defun reg2 (sym fn)
@ -104,13 +106,13 @@
(reg name #'(lambda () (call code)) cls))) (reg name #'(lambda () (call code)) cls)))
(defun pushd (v) (defun pushd (v)
(push v *stack*)) (push v (stack *forge-env*)))
(defun popd () (defun popd ()
(pop *stack*)) (pop (stack *forge-env*)))
(defun peekd () (defun peekd ()
(car *stack*)) (car (stack *forge-env*)))
(defun lit () (defun lit ()
(pushd (iter:next-value *code*))) (pushd (iter:next-value *code*)))

2
test/test-sf.lisp
View file

@ -20,7 +20,7 @@
;(forge:setup-builtins) ;(forge:setup-builtins)
(test-exec) (test-exec)
(test-def))) (test-def)))
(util:lgi forge:*stack*) (util:lgi (forge:stack forge:*forge-env*))
(t:show-result))) (t:show-result)))
(deftest test-exec () (deftest test-exec ()