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

forge/sf: exec-string, using iter:string-iterator

Browse source
This commit is contained in:
Helmut Merz 2024-09-16 10:50:12 +02:00
parent 66bc23c97a
commit 6eff29f62d
3 changed files with 12 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
forge/sf.lisp
View file

@ -9,7 +9,7 @@
(:export #:forge-env #:vocabulary #:stack #:current-package (:export #:forge-env #:vocabulary #:stack #:current-package
#:*forge-env* #:*input* #:*code* #:*forge-env* #:*input* #:*code*
#:word #:comp-word #:word #:comp-word
#:exec-list #:exec-input #:comp-input #:call #:exec-list #:exec-string #:exec-input #:comp-input #:call
#:comp-item #:comp-item
#:next #:reg #:reg1 #:reg2 #:reg-code #:next #:reg #:reg1 #:reg2 #:reg-code
#:pushd #:popd #:peekd)) #:pushd #:popd #:peekd))
@ -55,7 +55,7 @@
(comp-item v))))) (comp-item v)))))
(defun find-word (sym) (defun find-word (sym)
(let ((sym (find-symbol (symbol-name sym) (current-package *forge-env*)))) (let ((sym (intern (symbol-name sym) (current-package *forge-env*))))
(multiple-value-bind (val found) (gethash sym (vocabulary *forge-env*)) (multiple-value-bind (val found) (gethash sym (vocabulary *forge-env*))
(when (not found) (when (not found)
(util:lgw "not found" sym)) (util:lgw "not found" sym))
@ -85,6 +85,10 @@
(let ((*input* (iter:list-iterator lst))) (let ((*input* (iter:list-iterator lst)))
(exec-input))) (exec-input)))
(defun exec-string (s)
(let ((*input* (iter:string-iterator s)))
(exec-input)))
(defun exec-input () (defun exec-input ()
(iter:process *input* #'exec-item)) (iter:process *input* #'exec-item))

3
test/test-core.lisp
View file

@ -94,8 +94,7 @@
(let ((it (iter:string-iterator "a b c"))) (let ((it (iter:string-iterator "a b c")))
(== (iter:value it) nil) (== (iter:value it) nil)
(== (iter:next it) nil) (== (iter:next it) nil)
(== (iter:value it) (intern "A"))) (== (string (iter:value it)) "A"))
;(== (iter:value it) (read-from-string "a")))
) )
(deftest test-shape() (deftest test-shape()

9
test/test-sf.lisp
View file

@ -3,8 +3,7 @@
;;;; testing facility for scopes/forge ;;;; testing facility for scopes/forge
(defpackage :scopes/test-sf (defpackage :scopes/test-sf
(:use :common-lisp (:use :common-lisp)
:sf-builtin)
(:local-nicknames (:forge :scopes/forge/sf) (:local-nicknames (:forge :scopes/forge/sf)
(:util :scopes/util) (:util :scopes/util)
(:t :scopes/testing)) (:t :scopes/testing))
@ -29,10 +28,12 @@
(== (forge:popd) 6) (== (forge:popd) 6)
(forge:exec-list '(<comp dup mul /> in square reg)) (forge:exec-list '(<comp dup mul /> in square reg))
(forge:exec-list '(7 square)) (forge:exec-list '(7 square))
(== (forge:popd) 49)) (== (forge:popd) 49)
(forge:exec-string "8 square")
(== (forge:popd) 64))
(deftest test-def () (deftest test-def ()
(forge:exec-list '(<comp in <comp swp reg /> in <def reg)) (forge:exec-list '(<comp in <comp swp reg /> in <def reg))
(forge:exec-list '(<def cube dup dup mul mul />)) (forge:exec-string "<def cube dup dup mul mul />")
(forge:exec-list '(3 cube)) (forge:exec-list '(3 cube))
(== (forge:popd) 27)) (== (forge:popd) 27))