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

first minimally working version of forge interpreter

Browse source
This commit is contained in:
Helmut Merz 2024-04-20 11:36:04 +02:00
parent 21843546fa
commit b573e49d2c
2 changed files with 12 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
forge/forge.lisp
View file

@ -4,36 +4,33 @@
(defpackage :scopes/forge (defpackage :scopes/forge
(:use :common-lisp) (:use :common-lisp)
(:export #:hello #:new-forge-env #:data-stack #:exec (:export #:new-forge-env #:data-stack #:exec
#:add)) #:add))
(in-package :scopes/forge) (in-package :scopes/forge)
(defun new-forge-env () (defun new-forge-env ()
nil) (vector nil))
(defun exec (fe &rest code) (defun exec (fe code)
code (dolist (x code)
fe) (if (numberp x)
(pushd fe x)
(funcall x fe))))
(defun data-stack (fe) (defun data-stack (fe)
fe) (elt fe 0))
; forge primitives ; forge primitives
(defun add (fe) (defun add (fe)
(pushd (+ (popd fe) (popd fe)) fe )) (pushd fe (+ (popd fe) (popd fe))))
; dummy exampled, to be removed
(defun hello ()
(format t "Hello Common Lisp - 2024-04-19"))
; internal definitions ; internal definitions
(defun popd (fe) (defun popd (fe)
(pop fe)) (pop (elt fe 0)))
(defun pushd (fe v) (defun pushd (fe v)
(push v fe)) (push v (elt fe 0)))

3
test/test-forge.lisp
View file

@ -11,11 +11,10 @@
(in-package :scopes/test-forge) (in-package :scopes/test-forge)
(defun run () (defun run ()
(scf:hello)
(let ((fe (scf:new-forge-env)) (let ((fe (scf:new-forge-env))
(tst (sct:test-suite))) (tst (sct:test-suite)))
(scf:exec fe '(4 2 scf:add)) (scf:exec fe '(4 2 scf:add))
(sct:assert-eql tst (car (scf:data-stack fe)) 6) (sct:assert-eql tst (car (scf:data-stack fe)) 6)
(format t "~%tst ~a" tst) ;;(format t "~%fe ~a" fe)
(sct:result tst) (sct:result tst)
)) ))