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

forge/sf: new forge-env class, work in progress: put stack and vocabulary there

Browse source
This commit is contained in:
Helmut Merz 2024-09-13 09:39:07 +02:00
parent 65fbf0aac4
commit 5df8a852b1
1 changed files with 20 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
forge/sf.lisp
View file

@ -6,22 +6,30 @@
(:use :common-lisp)
(:local-nicknames (:iter :scopes/util/iter)
(:util :scopes/util))
(:export #:*input* #:*stack*
(:export #:forge-env #:vocabulary #:stack
#:*forge-env* #:*stack* #:*input* #:*code*
#:word #:comp-word
#:exec-list #:exec-input #:comp-input #:call
#:comp-item
#:lit #:reg #:reg2 #:reg-code
#:pushd #:popd #:peekd))
(in-package :scopes/forge/sf)
(defclass forge-env ()
((vocabulary :reader vocabulary :initform (make-hash-table))
(func-index :reader func-index :initform (make-hash-table))
(stack :reader stack :initform nil)))
(defvar *forge-env* (make-instance 'forge-env))
(defvar *stack* nil)
(defvar *input* nil)
(defvar *buffer* nil)
(defvar *code* nil)
(defvar *func-index* (make-hash-table))
(defmethod print-object :around ((fn function) s)
(let ((sym (gethash fn *func-index*)))
(let ((sym (gethash fn (func-index *forge-env*))))
(if sym
(print-unreadable-object (fn s) (format s "~s" sym))
(call-next-method))))
@ -43,7 +51,7 @@
(:method ((it symbol))
(let ((v (symbol-value it)))
(when v
(util:lgi it v)
;(util:lgi it v)
(comp-item v)))))
;;;; class word*
@ -80,12 +88,12 @@
(defun call (code)
(let ((*code* (make-instance 'iter:list-iterator :data code)))
(util:lgi code)
;(util:lgi code)
(iter:process *code* #'funcall)))
(defun reg (sym fn &optional (cls 'word))
(setf (symbol-value sym) (make-instance cls :func fn))
(setf (gethash fn *func-index*) sym))
(setf (gethash fn (func-index *forge-env*)) sym))
(defun reg2 (sym fn)
(reg sym #'(lambda () (pushd (funcall fn (popd) (popd))))))
@ -113,7 +121,8 @@
(:use :common-lisp)
(:local-nicknames (:f :scopes/forge/sf)
(:iter :scopes/util/iter))
(:export #:add #:mul #:dup #:swp #:in #:? #:lit #:defer
(:export #:add #:mul #:dup #:swp #:in #:? #:lit
#:comp-pop #:comp-in #:comp
#:<comp #:reg #:regc #:/>))
(in-package :sf-builtin)
@ -125,9 +134,11 @@
(f:reg 'swp #'(lambda () (let ((a (f:popd)) (b (f:popd))) (f:pushd a) (f:pushd b))))
(f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*))))
(f:reg 'lit #'f:lit)
(f:reg 'defer #'(lambda () (push (iter:next-value f::*code*) f::*buffer*)))
(f:reg 'comp-pop #'(lambda () (f:comp-item (popd))))
(f:reg 'comp-in #'(lambda () (f:comp-item (iter:next-value f:*input*))))
(f:reg 'comp #'(lambda () (f:comp-item (iter:next-value f:*code*))))
(f:reg '<comp #'f:comp-input)