compile code in def

forge/forge.lisp

@@ -28,9 +28,10 @@
 
 (defun exec (fe code)
   (dolist (x code)
-	(if (symbolp x)
-      (funcall (find-word (vocabulary fe) x) fe)
-	  (pushd fe x))))
+	(typecase x
+	  (symbol (funcall (find-word (vocabulary fe) x) fe))
+	  (compiled-function (funcall x fe))
+	  (t (pushd fe x)))))
 
 (defun register (voc key fn)
   (let ((k (if (symbolp key) (symbol-name key) key)))
@@ -46,6 +47,18 @@
   (do ((input (read-line) (read-line))) ((string= input "q") nil)
     (exec-str fe input)))
 
+(defun comp (fe inp)
+  (let ((code nil))
+    (dolist (item inp)
+	  (setf code (cons (comp1 fe item) code)))
+	(reverse code)))
+
+(defun comp1 (fe item)
+  (format t "~%item: ~a" item)
+  (typecase item
+	(symbol (find-word (vocabulary fe) item))
+	(t item)))
+
 ; built-in primitives
 
 (defun reg-b (key fn) (register *builtins* key fn))
@@ -59,8 +72,8 @@
 (reg-b "??" #'(lambda (fe) (format t "~a~%" (data-stack fe))))
 
 (reg-b "def" #'(lambda (fe) 
-  (let ((name (popd fe)) 
-		(code (popd fe)))
+  (let* ((name (popd fe)) 
+		 (code (comp fe (popd fe))))
     (register (voc fe) name #'(lambda (fe) (exec fe code))))))
 
 (reg-b "const" #'(lambda (fe)

scratch.lisp

@@ -20,13 +20,13 @@
 				(package-name (symbol-package y)))))))
 
 (defun x-make-var (value)
-  #'(lambda (&optional (nv nil))
-	  (if (eq nv nil)
+  #'(lambda (nv)
+	  (if (null nv)
 		value
 		(setf value nv))))
 
 (defun x-get-var (vf)
-  (funcall vf))
+  (funcall vf nil))
 
 (defun x-put-var (vf value)
   (funcall vf value))