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

add const definition

Browse source
This commit is contained in:
Helmut Merz 2024-04-27 08:25:53 +02:00
parent 848160c2de
commit c2b48289ab
2 changed files with 10 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
forge/forge.lisp
View file

@ -64,6 +64,11 @@
(code (popd fe))) (code (popd fe)))
(register voc name #'(lambda (fe) (exec fe code)))))) (register voc name #'(lambda (fe) (exec fe code))))))
(reg-b "const" #'(lambda (fe)
(let ((name (popd fe))
(value (popd fe)))
(register (car(vocabulary fe)) name #'(lambda (fe) (pushd fe value))))))
; internal definitions ; internal definitions
(defun popd (fe) (defun popd (fe)

5
test/test-forge.lisp
View file

@ -17,6 +17,7 @@
;(format t "~%data-stack ~a" (data-stack fe)) ;(format t "~%data-stack ~a" (data-stack fe))
(test-def tst fe) (test-def tst fe)
(test-exec-str tst fe) (test-exec-str tst fe)
(test-const tst fe)
(sct:result tst))) (sct:result tst)))
(defun test-exec (tst fe) (defun test-exec (tst fe)
@ -32,3 +33,7 @@
(scf:exec-str fe "16 square") (scf:exec-str fe "16 square")
(sct:assert-eq tst (car (scf:data-stack fe)) 256)) (sct:assert-eq tst (car (scf:data-stack fe)) 256))
(defun test-const (tst fe)
(scf:exec-str fe "17 \"c1\" const")
(scf:exec-str fe "c1 square")
(sct:assert-eq tst (car (scf:data-stack fe)) 289))