diff --git a/forge/forge.lisp b/forge/forge.lisp index ffaeb37..cd70db7 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -44,6 +44,8 @@ (defclass forge-env () ((data-stack :initform nil :accessor data-stack) + (comp-words :initform (make-hash-table)) + (rp :initform (make-iseq)) (cp :initform (make-iseq)) (ip :initform (make-iseq)))) @@ -56,12 +58,26 @@ (defun dstack() (data-stack *forge-env*)) +(defun define-comp-word (sym fn) + (setf (gethash sym (slot-value *forge-env* 'comp-words)) fn)) + ;;; builtins (defvar add #'(lambda () (pushd (+ (popd) (popd))))) +(defvar dup #'(lambda () (pushd (car (dstack))))) + (defvar lit #'(lambda () (pushd (isq-next (fip))))) +(define-comp-word 'def + #'(lambda () + (let* ((name (isq-next (frp))) + (code (isq-next (frp)))) + (print name) + (print code) + ;(eval `(defvar ,name (comp code))) + ))) + ;;; compiler, interpreter (defun exec-str (s) @@ -82,29 +98,42 @@ ((null item)) (funcall item)))) -(defun get-word (sym) - (symbol-value (find-symbol (string sym) :scopes/forge))) - (defun comp (slist) (setf (slot-value *forge-env* 'cp) (make-iseq)) (let ((inp (make-iseq slist))) + (setf (slot-value *forge-env* 'rp) inp) (do ((item (isq-next inp) (isq-next inp))) ((null item)) (typecase item - (symbol (comp1 (get-word item))) - (cons (comp1 lit) (comp1 (comp item))) - (t (comp1 lit) (comp1 item))))) + (symbol (comp-symbol item)) + (cons (comp-item lit) (comp-item (comp item))) + (t (comp-item lit) (comp-item item))))) (isq-all (fcp))) -(defun comp1 (item) +(defun comp-symbol (sym) + (let* ((word (get-word sym)) + (comp-word (get-comp-word word))) + (if comp-word + (funcall comp-word) + (comp-item (symbol-value word))))) + +(defun comp-item (item) (isq-add (fcp) item)) +(defun get-word (sym) + (intern (string sym) :scopes/forge)) + +(defun get-comp-word (sym) + (gethash sym (slot-value *forge-env* 'comp-words))) + ;;; internal definitions (defun popd () (pop (data-stack *forge-env*))) (defun pushd (v) (push v (data-stack *forge-env*))) +(defun frp () (slot-value *forge-env* 'rp)) + (defun fcp () (slot-value *forge-env* 'cp)) (defun fip () (slot-value *forge-env* 'ip)) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index b04f0e0..86d37de 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -16,6 +16,7 @@ (test-iseq) (test-exec) ;(format t "~%data-stack ~a" (dstack)) + (test-def) (t:show-result))) (deftest test-iseq () @@ -28,3 +29,8 @@ (deftest test-exec () (forge:exec-str "4 2 add") (== (car (forge:dstack)) 6)) + +(deftest test-def () + (forge:exec-str "def square (dup *)")) + ;(forge:exec-str "7 square") + ;(== (car (forge:dstack)) 49))