work in progress: define 'def'

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)))
+        (symbol (comp-symbol item))
-        (cons (comp1 lit) (comp1 (comp item)))
+        (cons (comp-item lit) (comp-item (comp item)))
-        (t (comp1 lit) (comp1 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))

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