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

forge: define def in forge code

Browse source
This commit is contained in:
Helmut Merz 2024-05-29 10:21:17 +02:00
parent 70bdac68a2
commit ef7ee0b9f4
2 changed files with 3 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
forge/forge.lisp
View file

@ -111,10 +111,8 @@
(comp-item (gethash w (comp-words))))) (comp-item (gethash w (comp-words)))))
(defun setup-builtins () (defun setup-builtins ()
(reg + (pushd (+ (popd) (popd)))) (reg + (pushd (+ (popd) (popd))))
(reg * (pushd (* (popd) (popd)))) (reg * (pushd (* (popd) (popd))))
(reg dup (pushd (car (dstack)))) (reg dup (pushd (car (dstack))))
(reg swap (let ((a (popd)) (b (popd))) (pushd a) (pushd b))) (reg swap (let ((a (popd)) (b (popd))) (pushd a) (pushd b)))
@ -127,12 +125,6 @@
(register-comp-word 'quote #'do-quote) (register-comp-word 'quote #'do-quote)
(register-comp-word 'comp #'do-comp) (register-comp-word 'comp #'do-comp)
(register-comp-word 'def
#'(lambda ()
(let* ((name (read-next))
(code (comp (read-next))))
(register name #'(lambda () (call code))))))
(activate-package :sf-user)) (activate-package :sf-user))
;;; compiler, interpreter ;;; compiler, interpreter

5
test/test-forge.lisp
View file

@ -34,8 +34,9 @@
(== (car (forge:dstack)) 6)) (== (car (forge:dstack)) 6))
(deftest test-def () (deftest test-def ()
;(forge:exec-str "def square (dup *)") (forge:exec-str "(comp quote defer reg) quote def regc")
(forge:exec-str "(dup *) quote square reg") ;(forge:exec-str "(dup *) quote square reg")
(forge:exec-str "(dup *) def square")
(forge:exec-str "7 square") (forge:exec-str "7 square")
(== (car (forge:dstack)) 49)) (== (car (forge:dstack)) 49))