diff --git a/forge/sf.lisp b/forge/sf.lisp index 54c3cb9..f151f60 100644 --- a/forge/sf.lisp +++ b/forge/sf.lisp @@ -11,11 +11,13 @@ #:word #:comp-word #:exec-list #:exec-input #:comp-input #:call #:comp-item - #:lit #:reg #:reg2 #:reg-code + #:next #:reg #:reg2 #:reg-code #:pushd #:popd #:peekd)) (in-package :scopes/forge/sf) +;;;; common definitions + (defclass forge-env () ((vocabulary :reader vocabulary :initform (make-hash-table)) (func-index :reader func-index :initform (make-hash-table)) @@ -33,8 +35,6 @@ (print-unreadable-object (fn s) (format s "~s" sym)) (call-next-method)))) -;;;; core definitions - (defgeneric exec-item (it) (:method ((it t)) (pushd it)) @@ -45,7 +45,7 @@ (defgeneric comp-item (it) (:method ((it t)) - (push #'lit *buffer*) + (push #'next *buffer*) (push it *buffer*)) (:method ((it symbol)) (let ((v (find-word it))) @@ -54,9 +54,12 @@ (comp-item v))))) (defun find-word (sym) - (gethash sym (vocabulary *forge-env*))) + (multiple-value-bind (val found) (gethash sym (vocabulary *forge-env*)) + (when (not found) + (util:lgw "not found" sym)) + val)) -;;;; class word* +;;;; class word (defclass word () ((func :reader func :initarg :func))) @@ -74,10 +77,10 @@ (defmethod comp-item ((w comp-word)) (funcall (func w))) -;;;; functions +;;;; code compilation and execution (defun exec-list (lst) - (let ((*input* (make-instance 'iter:list-iterator :data lst))) + (let ((*input* (iter:list-iterator lst))) (exec-input))) (defun exec-input () @@ -89,9 +92,11 @@ (pushd (reverse *buffer*)))) (defun call (code) - (let ((*code* (make-instance 'iter:list-iterator :data code))) - (util:lgi code) - (iter:process *code* #'funcall))) + (util:lgi code) + (let ((*code* code)) + (do ((fn (pop *code*) (pop *code*))) + ((null fn)) + (funcall fn)))) (defun reg (sym fn &optional (cls 'word)) (setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn)) @@ -114,7 +119,7 @@ (defun peekd () (car (stack *forge-env*))) -(defun lit () +(defun next () (pushd (iter:next-value *code*))) ;;;; builtins @@ -123,12 +128,28 @@ (:use :common-lisp) (:local-nicknames (:f :scopes/forge/sf) (:iter :scopes/util/iter)) - (:export #:add #:mul #:dup #:swp #:in #:? #:lit - #:comp-pop #:comp-in #:comp + (:export #:add #:mul #:dup #:swp + #:in #:next + #:call #:comp #:)) (in-package :sf-builtin) +;;;; implementation functions + +(defun call-if () + (let ((code (f:popd))) + (if (f:popd) + (f:call code)))) + +(defun call-while () + (let ((code (f:popd))) + (do ((cond (f:popd) (f:popd))) + ((not cond)) + (f:call code)))) + +;;;; lisp-code word definitions + (f:reg2 'add #'+) (f:reg2 'mul #'*) @@ -136,11 +157,10 @@ (f:reg 'swp #'(lambda () (let ((a (f:popd)) (b (f:popd))) (f:pushd a) (f:pushd b)))) (f:reg 'in #'(lambda () (f:pushd (iter:next-value f:*input*)))) -(f:reg 'lit #'f:lit) +(f:reg 'next #'f:next) -(f:reg 'comp-pop #'(lambda () (f:comp-item (popd)))) -(f:reg 'comp-in #'(lambda () (f:comp-item (iter:next-value f:*input*)))) -(f:reg 'comp #'(lambda () (f:comp-item (iter:next-value f:*code*)))) +(f:reg 'call #'(lambda () (f:call (popd)))) +(f:reg 'comp #'(lambda () (f:comp-item (popd)))) (f:reg ' #'(lambda () (iter:stop f:*input*)) 'f:comp-word) + +;;;; forge-code word definitions diff --git a/test/test-core.lisp b/test/test-core.lisp index 6617040..8477920 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -87,7 +87,7 @@ ) (deftest test-util-iter () - (let ((it (make-instance 'iter:list-iterator :data '(1 2 3)))) + (let ((it (iter:list-iterator '(1 2 3)))) (== (iter:value it) nil)) ) diff --git a/util/iter.lisp b/util/iter.lisp index 7506d1d..cd64351 100644 --- a/util/iter.lisp +++ b/util/iter.lisp @@ -40,6 +40,9 @@ ((data :reader data :initarg :data :initform nil) (cur :accessor cur))) +(defun list-iterator (data) + (make-instance 'list-iterator :data data)) + (defmethod initialize-instance :after ((it list-iterator) &key) (setf (cur it) (cons nil (data it))))