forge: reg basically working

forge/forge.lisp

@@ -95,6 +95,18 @@
 
   (register 'lit #'lit)
 
+  (register 'reg
+    #'(lambda ()
+        (let* ((name (popd))
+               (code (popd)))
+          (format t "~%~a ~a" name code)
+          (register name #'(lambda () (call code))))))
+
+  (register-comp-word 'quote
+    #'(lambda () 
+        (let ((w (read-next)))
+          (comp-item #'lit) (comp-item w))))
+
   (register-comp-word 'def
     #'(lambda () 
         (let* ((name (read-next))
@@ -119,25 +131,33 @@
 (defun call (code)
   (let ((ip (make-iseq code)))
     (setf (slot-value *forge-env* 'ip) ip)
+    (print (isq-all ip))
     (do ((item (isq-next ip) (isq-next ip)))
         ((null item))
       (funcall item))))
 
 (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 (comp-symbol item))
-        (cons (comp-item #'lit) (comp-item (comp item)))
-        (t (comp-item #'lit) (comp-item item)))))
+  (let ((cp (make-iseq)))
+    (setf (slot-value *forge-env* 'cp) cp)
+    (let ((inp (make-iseq slist)))
+      (setf (slot-value *forge-env* 'rp) inp)
+      (do ((item (isq-next inp) (isq-next inp)))
+          ((null item))
+        (print item)
+        (typecase item
+          (symbol (comp-symbol item))
+          (cons (comp-item #'lit) 
+                (let ((sub (comp item)))
+                  (setf (slot-value *forge-env* 'cp) cp)
+                  (setf (slot-value *forge-env* 'rp) inp)
+                  (comp-item sub)))
+          (t (comp-item #'lit) (comp-item item))))))
   (isq-all (fcp)))
 
 (defun comp-symbol (sym)
   (let* ((w (get-word sym))
          (comp-fn (gethash w (comp-words))))
+    (format t "~%~a ~a ~a" sym w comp-fn)
     (if comp-fn
       (funcall comp-fn)
       (comp-item (gethash w (words))))))

scopes-forge.asd

@@ -16,4 +16,4 @@
 (defsystem :scopes-forge/test
   :depends-on (:scopes-forge)
   :components ((:file "test/test-forge"))
-  :perform (test-op (o c) (funcall #'scopes/test-forge:run)))
+  :perform (test-op (o c) (symbol-call :scopes/test-forge :run)))

scopes.asd

@@ -24,5 +24,5 @@
   :components ((:file "test/test-storage")
                (:file "test/test-forge"))
   :perform (test-op (o c) 
-    (funcall #'scopes/test-storage:run-all)
-    (funcall #'scopes/test-forge:run)))
+    (symbol-call :scopes/test-storage :run-all)
+    (symbol-call :scopes/test-forge :run)))

steps/steps.lisp

@@ -5,3 +5,4 @@
 
 (in-package :scopes/steps)
 
+(defclass process ())

test/test-forge.lisp

@@ -33,6 +33,7 @@
   (== (car (forge:dstack)) 6))
 
 (deftest test-def ()
-  (forge:exec-str "def square (dup *)")
+  ;(forge:exec-str "def square (dup *)")
+  (forge:exec-str "(dup *) quote square reg")
   (forge:exec-str "7 square")
   (== (car (forge:dstack)) 49))