From c2b48289abdd3b1bfbfc663c76584576c4deb77f Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sat, 27 Apr 2024 08:25:53 +0200 Subject: [PATCH] add const definition --- forge/forge.lisp | 5 +++++ test/test-forge.lisp | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/forge/forge.lisp b/forge/forge.lisp index a05fd12..6ee87c1 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -64,6 +64,11 @@ (code (popd fe))) (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 (defun popd (fe) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index 89045f6..6b10abe 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -17,6 +17,7 @@ ;(format t "~%data-stack ~a" (data-stack fe)) (test-def tst fe) (test-exec-str tst fe) + (test-const tst fe) (sct:result tst))) (defun test-exec (tst fe) @@ -32,3 +33,7 @@ (scf:exec-str fe "16 square") (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))