diff --git a/forge/forge.lisp b/forge/forge.lisp index f4b0e74..51fe652 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -6,10 +6,17 @@ (:use :common-lisp) (:export #:*forge-env* #:forge-env #:dstack #:exec #:exec-str #:repl - #:make-iseq #:isq-all #:isq-cur #:isq-next #:isq-end #:isq-add)) + #:make-iseq #:isq-all #:isq-cur #:isq-next #:isq-end #:isq-add + #:add)) (in-package :scopes/forge) +;;; builtins + +(defvar add #'(lambda () (pushd (cl:+ (popd) (popd))))) + +(defvar lit #'(lambda () (pushd (isq-next (ip *forge-env*))))) + ;;; iseq: iterable sequence (defclass iseq () @@ -62,40 +69,35 @@ (exec (read-from-string (concatenate 'string "(" s ")")))) -(defun exec (code) - (dolist (x code) - (typecase x - (symbol (funcall (comp1 x))) - (compiled-function (funcall x)) - (t (pushd x))))) - -(defun call (code) - (dolist (x code) - (funcall x))) - (defun repl () (do ((input (read-line) (read-line))) ((string= input "q") nil) (exec-str input))) -(defun find-word (key)) +(defun exec (code) + (call (comp code))) -(defun comp (inp) - (let ((code nil)) - (dolist (item inp) - (setf code (cons (comp1 item) code))) - (reverse code))) +(defun call (code) + (let ((ip (make-iseq code))) + (setf (ip *forge-env*) ip) + (do ((item (isq-next ip) (isq-next ip))) + ((null item)) + (funcall item)))) + +(defun comp (slist) + (setf (cp *forge-env*) (make-iseq)) + (let ((inp (make-iseq slist))) + (do ((item (isq-next inp) (isq-next inp))) + ((null item)) + (typecase item + (symbol (comp1 (symbol-value item))) + (cons (comp1 lit) (comp1 (comp item))) + (t (comp1 lit) (comp1 item))))) + (isq-all (cp *forge-env*))) (defun comp1 (item) - (typecase item - (symbol (find-word item)) - (cons (comp item)) - (t item))) + (isq-add (cp *forge-env*) item)) -(defun register (voc key fn) - (let ((k (if (symbolp key) (symbol-name key) key))) - (setf (gethash (string-downcase k) voc) fn))) - -; internal definitions +;;; internal definitions (defun popd () (pop (data-stack *forge-env*))) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index 985288c..a73e7a5 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -14,7 +14,7 @@ (defun run () (let ((t:*test-suite* (t:test-suite "forge"))) (test-iseq) - ;(test-exec) + (test-exec) ;(format t "~%data-stack ~a" (dstack)) (t:show-result))) @@ -26,5 +26,5 @@ (== (forge:isq-end seq) 2))) (deftest test-exec () - (forge:exec '(4 2 +)) + (forge:exec '(4 2 forge:add)) (== (car (forge:dstack)) 6))