work in progress: const as forge-word defined with reg and regc

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))))))

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))