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

forge: run (embed forge code in lisp), comp (compile list on stack)

Browse source
This commit is contained in:
Helmut Merz 2026-02-14 22:15:16 +01:00
parent b6ed8805e4
commit 1ef29cd06c
2 changed files with 31 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
forge/forge.lisp
View file

@ -9,8 +9,8 @@
(:export #:forge-env #:vocabulary #:stack #:current-package (:export #:forge-env #:vocabulary #:stack #:current-package
#:*forge-env* #:*input* #:*code* #:*forge-env* #:*input* #:*code*
#:word #:comp-word #:word #:comp-word
#:repl #:exec-list #:exec-string #:exec-stream #:repl #:exec-list #:exec-string #:exec-stream #:run
#:exec-input #:comp-input #:call #:exec-input #:comp-input #:comp-list #:call
#:comp-item #:comp-item
#:next #:reg #:reg1 #:reg2 #:reg-code #:next #:reg #:reg1 #:reg2 #:reg-code
#:pushd #:popd #:peekd)) #:pushd #:popd #:peekd))
@ -97,6 +97,9 @@
(input-line :prompt ".. "))))) (input-line :prompt ".. ")))))
(exec-string input)))) (exec-string input))))
(defmacro run (&body code)
`(exec-list (quote ,code)))
(defun exec-list (lst) (defun exec-list (lst)
(let ((*input* (iter:list-iterator lst))) (let ((*input* (iter:list-iterator lst)))
(exec-input))) (exec-input)))
@ -117,6 +120,11 @@
(iter:process *input* #'comp-item) (iter:process *input* #'comp-item)
(pushd (reverse *buffer*)))) (pushd (reverse *buffer*))))
(defun comp-list (lst)
(let ((*buffer* nil))
(iter:process (iter:list-iterator lst) #'comp-item)
(pushd (reverse *buffer*))))
(defun call (code) (defun call (code)
;(util:lgi code) ;(util:lgi code)
(let ((*code* code)) (let ((*code* code))
@ -163,7 +171,7 @@
#:? #:?? #:? #:??
#:ptr #:get #:put #:ptr #:get #:put
#:in #:next #:in #:next
#:call #:call-if #:call-while #:lit #:val #:call #:call-if #:call-while #:comp #:lit #:val
#:<comp #:reg #:regc #:/>)) #:<comp #:reg #:regc #:/>))
(in-package :sf-builtin) (in-package :sf-builtin)
@ -203,6 +211,7 @@
(f:reg 'call #'(lambda () (f:call (f:popd)))) (f:reg 'call #'(lambda () (f:call (f:popd))))
(f:reg 'call-if #'call-if) (f:reg 'call-if #'call-if)
(f:reg 'call-while #'call-while) (f:reg 'call-while #'call-while)
(f:reg 'comp (lambda () (f:comp-list (f:popd))))
(f:reg 'lit #'(lambda () (cons (f:popd) f::*buffer*))) (f:reg 'lit #'(lambda () (cons (f:popd) f::*buffer*)))
(f:reg 'val #'(lambda () (f:pushd (list #'f:next (f:popd))))) (f:reg 'val #'(lambda () (f:pushd (list #'f:next (f:popd)))))

33
test/test-forge.lisp
View file

@ -27,8 +27,8 @@
(deftest test-exec () (deftest test-exec ()
(forge:exec-list '(4 2 add)) (forge:exec-list '(4 2 add))
(== (forge:popd) 6) (== (forge:popd) 6)
(forge:exec-list '(<comp dup mul /> in square reg)) (forge:run <comp dup mul /> in square reg)
(forge:exec-list '(7 square)) (forge:run 7 square)
(== (forge:popd) 49) (== (forge:popd) 49)
(forge:exec-string "8 square") (forge:exec-string "8 square")
(== (forge:popd) 64) (== (forge:popd) 64)
@ -36,25 +36,30 @@
(== (forge:popd) 144)) (== (forge:popd) 144))
(deftest test-def () (deftest test-def ()
(forge:exec-list '(<comp in <comp swp reg /> in <def reg)) (forge:run <comp in <comp swp reg /> in <def reg)
(forge:exec-string "<def cube dup dup mul mul />") (forge:exec-string "<def cube dup dup mul mul />")
(forge:exec-list '(3 cube)) (forge:run 3 cube)
(== (forge:popd) 27)) (== (forge:popd) 27))
(deftest test-val () (deftest test-val ()
(forge:exec-list '(<def const val in reg />)) (forge:run <def const val in reg />)
(forge:exec-list '(7 const seven)) (forge:run 7 const seven)
(forge:exec-list '(seven square)) (forge:run seven square)
(== (forge:popd) 49) (== (forge:popd) 49)
(forge:exec-list '(<def var ptr const />)) (forge:run <def var ptr const />)
(forge:exec-list '(3 var myvar)) (forge:run 3 var myvar)
(forge:exec-list '(myvar get)) (forge:run myvar get)
(== (forge:popd) 3) (== (forge:popd) 3)
(forge:exec-list '(42 myvar put)) (forge:run 42 myvar put)
(forge:exec-list '(myvar get)) (forge:run myvar get)
(== (forge:popd) 42) (== (forge:popd) 42)
) )
(deftest test-comp ()
(forge:run (2 3 mul) comp call)
(== (forge:popd) 6)
)
(deftest test-if () (deftest test-if ()
(forge:exec-list '(<comp in <comp swp reg /> in <defc regc)) (forge:run <comp in <comp swp reg /> in <defc regc)
(forge:exec-list '(<defc <if <comp next next lit lit next call-if lit />))) (forge:run <defc <if <comp next next lit lit next call-if lit />))