diff --git a/forge/forge.lisp b/forge/forge.lisp index 009d0bc..a224f8e 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -85,6 +85,13 @@ `(register ',sym #'(lambda () ,@body))) (defun lit () (pushd (isq-next (fip)))) +(defun defer () (comp-item (isq-next (fip)))) +(defun do-pop () (comp-item #'lit) (comp-item (popd))) + +(defun do-reg () + (let* ((name (popd)) + (code (popd))) + (register name #'(lambda () (call code))))) (defun setup-builtins () @@ -95,21 +102,24 @@ (reg swap (let ((a (popd)) (b (popd))) (pushd a) (pushd b))) (register 'lit #'lit) + (register 'defer #'defer) + (register 'pop #'do-pop) + (register 'reg #'do-reg) - (register 'reg + (register 'regc #'(lambda () (let* ((name (popd)) (code (popd))) - (register name #'(lambda () (call code)))))) + (register-comp-word name #'(lambda () (call code)))))) (register-comp-word 'quote - #'(lambda () - (let ((w (read-next))) - (comp-item #'lit) (comp-item w)))) + #'(lambda () (comp-item #'lit) (comp-item (read-next)))) (register-comp-word 'comp - #'(lambda () - (comp-item (read-next)))) + #'(lambda () (let* ((sym (read-next)) + (w (get-word sym))) + (format t "~%rcw: ~a ~a ~a" sym w (gethash w (comp-words))) + (comp-item (gethash w (comp-words)))))) (register-comp-word 'def #'(lambda () @@ -133,6 +143,7 @@ (call (comp code))) (defun call (code) + (print code) (let ((old-ip (fip)) (ip (make-iseq code))) (setf (slot-value *forge-env* 'ip) ip) @@ -142,6 +153,7 @@ (setf (slot-value *forge-env* 'ip) old-ip))) (defun comp (slist) + (print slist) (let ((cp (make-iseq)) (inp (make-iseq slist))) (setf (slot-value *forge-env* 'cp) cp) @@ -161,6 +173,7 @@ (defun comp-symbol (sym) (let* ((w (get-word sym)) (comp-fn (gethash w (comp-words)))) + (format t "~%csym: ~a ~a ~a" sym w comp-fn) (if comp-fn (funcall comp-fn) (comp-item (gethash w (words)))))) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index fb7b1c7..1d38957 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -19,6 +19,7 @@ (test-exec) ;(format t "~%data-stack ~a" (dstack)) (test-def) + (test-const) (t:show-result))) (deftest test-iseq () @@ -37,3 +38,9 @@ (forge:exec-str "(dup *) quote square reg") (forge:exec-str "7 square") (== (car (forge:dstack)) 49)) + +(deftest test-const () + (forge:exec-str "(comp quote defer reg) quote const regc") + (forge:exec-str "(11) const eleven") + (forge:exec-str "eleven square") + (== (car (forge:dstack)) 121))