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

forge/sf: minor improvements

Browse source
This commit is contained in:
Helmut Merz 2024-09-08 22:29:01 +02:00
parent a61dc2f1dc
commit 3e26a361c4
3 changed files with 19 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
forge/sf.lisp
View file

@ -7,8 +7,8 @@
(:local-nicknames (:iter :scopes/util/iter)) (:local-nicknames (:iter :scopes/util/iter))
(:export #:*input* #:*stack* (:export #:*input* #:*stack*
#:proc-list #:proc-input #:proc-list #:proc-input
#:add #:add #:mul #:dup
#:pushd #:popd)) #:pushd #:popd #:peekd))
(defpackage :sf-builtin) (defpackage :sf-builtin)
(defpackage :sf-user) (defpackage :sf-user)
@ -26,9 +26,9 @@
(defun proc-input () (defun proc-input ()
(let ((inp *input*)) (let ((inp *input*))
(do ((item (iter:next inp) (iter:next inp))) (do ((end (iter:next inp) (iter:next inp)))
((null item)) (end)
(proc-item item)))) (proc-item (iter:value inp)))))
(defun proc-item (item) (defun proc-item (item)
(typecase item (typecase item
@ -36,8 +36,8 @@
(t (pushd item)))) (t (pushd item))))
(defun reg2 (sym fn) (defun reg2 (sym fn)
(setf (fdefinition sym) #'(lambda () (setf (fdefinition sym)
(pushd (funcall fn (popd) (popd)))))) #'(lambda () (pushd (funcall fn (popd) (popd))))))
(defun pushd (v) (defun pushd (v)
(push v *stack*)) (push v *stack*))
@ -45,6 +45,12 @@
(defun popd () (defun popd ()
(pop *stack*)) (pop *stack*))
(defun peekd ()
(car *stack*))
;;;; builtins ;;;; builtins
(reg2 'add #'+) (reg2 'add #'+)
(reg2 'mul #'*)
(defun dup () (pushd (peekd)))

10
test/test-sf.lisp
View file

@ -20,16 +20,10 @@
(test-exec))) (test-exec)))
(deftest test-exec () (deftest test-exec ()
(util:lgi 42) ;(forge:proc-str "4 2 add")
(== (+ 2 1) 3)
(forge:pushd 4)
(forge:pushd 2)
(forge:add)
(== (forge:popd) 6)
(forge:proc-list '(4 2 forge:add)) (forge:proc-list '(4 2 forge:add))
(util:lgi forge:*stack*)
(== (forge:popd) 6) (== (forge:popd) 6)
;(forge:exec-str "4 2 +")
;(== (car (forge:dstack)) 6))
(t:show-result)) (t:show-result))

8
util/iter.lisp
View file

@ -5,7 +5,7 @@
(defpackage :scopes/util/iter (defpackage :scopes/util/iter
(:use :common-lisp) (:use :common-lisp)
(:export #:current #:next (:export #:next #:value
#:list-iterator)) #:list-iterator))
(in-package :scopes/util/iter) (in-package :scopes/util/iter)
@ -13,7 +13,7 @@
;;;; iterators ;;;; iterators
(defgeneric next (it)) (defgeneric next (it))
(defgeneric current (it)) (defgeneric value (it))
(defclass list-iterator () (defclass list-iterator ()
((data :reader data :initarg :data :initform nil) ((data :reader data :initarg :data :initform nil)
@ -24,7 +24,7 @@
(defmethod next ((it list-iterator)) (defmethod next ((it list-iterator))
(pop (cur it)) (pop (cur it))
(current it)) (null (cur it)))
(defmethod current ((it list-iterator)) (defmethod value ((it list-iterator))
(car (cur it))) (car (cur it)))