forge/sf: exec-item improvements, basic comp-item implementation

This commit is contained in:
Helmut Merz 2024-09-10 08:57:29 +02:00
parent 60cee40051
commit b86005e111

View file

@ -7,13 +7,15 @@
(:local-nicknames (:iter :scopes/util/iter)) (:local-nicknames (:iter :scopes/util/iter))
(:export #:*input* #:*stack* (:export #:*input* #:*stack*
#:exec-list #:exec-input #:exec-list #:exec-input
#:reg #:reg2 #:lit #:reg #:reg2
#:pushd #:popd #:peekd)) #:pushd #:popd #:peekd))
(in-package :scopes/forge/sf) (in-package :scopes/forge/sf)
(defvar *stack* nil) (defvar *stack* nil)
(defvar *input* nil) (defvar *input* nil)
(defvar *buffer* nil)
(defvar *code* nil)
;;;; core definitions ;;;; core definitions
@ -21,30 +23,53 @@
(:method ((it t)) (:method ((it t))
(pushd it)) (pushd it))
(:method ((it symbol)) (:method ((it symbol))
(call-item (symbol-value it)))) (exec-item (symbol-value it))))
(defgeneric comp-item (it)) (defgeneric comp-item (it)
(:method ((it t))
(push #'lit *buffer*)
(push it *buffer*))
(:method ((it symbol))
(comp-item (symbol-value it))))
(defgeneric call-item (it)) ;;;; class word
(defclass word () (defclass word ()
((func :reader func :initarg :func))) ((func :reader func :initarg :func)))
(defmethod call-item ((w word)) (defmethod exec-item ((w word))
(funcall (func w))) (funcall (func w)))
(defmethod comp-item ((w word))
(push (func w) *buffer*))
;;;; class comp-word
(defclass comp-word (word) ()) (defclass comp-word (word) ())
(defmethod comp-item ((w word))
(funcall (func w)))
;;;; functions
(defun exec-list (lst) (defun exec-list (lst)
(setf *input* (make-instance 'iter:list-iterator :data lst)) (let ((*input* (make-instance 'iter:list-iterator :data lst)))
(exec-input)) (exec-input)))
(defun exec-input () (defun exec-input ()
(iter:process *input* #'exec-item)) (iter:process *input* #'exec-item))
(defun comp-input ()
(let ((*buffer* nil))
(iter:process *input* #'comp-item)
(pushd (reverse *buffer*))))
(defun call (code)
(let ((*code* (make-instance 'iter:list-iterator :data code)))
(iter:process *code* #'funcall)))
(defun reg (sym fn) (defun reg (sym fn)
(setf (symbol-value sym) (make-instance 'word :func fn))) (setf (symbol-value sym) (make-instance 'word :func fn)))
;(setf (symbol-value sym) fn))
(defun reg2 (sym fn) (defun reg2 (sym fn)
(reg sym #'(lambda () (pushd (funcall fn (popd) (popd)))))) (reg sym #'(lambda () (pushd (funcall fn (popd) (popd))))))
@ -58,13 +83,16 @@
(defun peekd () (defun peekd ()
(car *stack*)) (car *stack*))
(defun lit ()
(pushd (iter:next-value *code*)))
;;;; builtins ;;;; builtins
(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))
(:export #:add #:mul #:dup #:in #:?)) (:export #:add #:mul #:dup #:in #:? #:lit))
(in-package :sf-builtin) (in-package :sf-builtin)
@ -74,3 +102,5 @@
(f:reg 'dup #'(lambda () (f:pushd (f:peekd)))) (f:reg 'dup #'(lambda () (f:pushd (f:peekd))))
(f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*)))) (f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*))))
(f:reg 'lit #'f:lit)