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

forge/sf: more basic builtin words

Browse source
This commit is contained in:
Helmut Merz 2024-09-14 16:09:33 +02:00
parent c85ab638a5
commit 33afa42f24
1 changed files with 10 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
forge/sf.lisp
View file

@ -127,10 +127,12 @@
(defpackage :sf-builtin (defpackage :sf-builtin
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:f :scopes/forge/sf) (:local-nicknames (:f :scopes/forge/sf)
(:iter :scopes/util/iter)) (:iter :scopes/util/iter)
(:util :scopes/util))
(:export #:add #:mul #:dup #:swp (:export #:add #:mul #:dup #:swp
#:ptr #:get #:put
#:in #:next #:in #:next
#:call #:comp #:call #:call-if #:call-while #:comp
#:<comp #:reg #:regc #:/>)) #:<comp #:reg #:regc #:/>))
(in-package :sf-builtin) (in-package :sf-builtin)
@ -156,10 +158,16 @@
(f:reg 'dup #'(lambda () (f:pushd (f:peekd)))) (f:reg 'dup #'(lambda () (f:pushd (f:peekd))))
(f:reg 'swp #'(lambda () (let ((a (f:popd)) (b (f:popd))) (f:pushd a) (f:pushd b)))) (f:reg 'swp #'(lambda () (let ((a (f:popd)) (b (f:popd))) (f:pushd a) (f:pushd b))))
(f:reg 'ptr #'(lambda () (f:pushd (util:ptr (f:popd)))))
(f:reg 'get #'(lambda () (f:pushd (aref (f:popd)))))
(f:reg 'put #'(lambda () (setf (aref (f:popd)) (f:popd))))
(f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*)))) (f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*))))
(f:reg 'next #'f:next) (f:reg 'next #'f:next)
(f:reg 'call #'(lambda () (f:call (popd)))) (f:reg 'call #'(lambda () (f:call (popd))))
(f:reg 'call-if #'call-if)
(f:reg 'call-while #'call-while)
(f:reg 'comp #'(lambda () (f:comp-item (popd)))) (f:reg 'comp #'(lambda () (f:comp-item (popd))))
(f:reg '<comp #'f:comp-input) (f:reg '<comp #'f:comp-input)