forge: compile / reg lisp expressions, setup-builtins

forge/forge.lisp

@@ -8,12 +8,13 @@
                     (:util :scopes/util))
   (:export #:forge-env #:vocabulary #:stack #:current-package
            #:*forge-env* #:*input* #:*code*
+           #:comp-item
            #:word #:comp-word
            #:repl #:exec-list #:exec-string #:exec-stream #:run
-           #:exec-input #:comp-input #:comp-list #:call
-           #:comp-item
+           #:exec-input #:comp-input #:comp-list #:compile-lisp #:call
            #:next #:reg #:reg1 #:reg2 #:reg-code
-           #:pushd #:popd #:peekd))
+           #:pushd #:popd #:peekd
+           #:setup-builtins))
 
 (in-package :scopes/forge)
 
@@ -85,9 +86,10 @@
 (defun input-line (&key prompt)
   (if (null prompt)
     (setf prompt (format nil "~a> " (length (stack *forge-env*)))))
-  (rl:readline :prompt prompt))
+  (rl:readline :prompt prompt :add-history t))
 
 (defun repl ()
+  ; TODO: load history, don't abort on errors, save history
   (do ((input (input-line) (input-line))) 
       ((string= input "q") (stack *forge-env*))
     (handler-bind
@@ -125,6 +127,9 @@
     (iter:process (iter:list-iterator lst) #'comp-item)
     (pushd (reverse *buffer*))))
 
+(defun compile-lisp (lst)
+  (compile nil (list 'lambda nil lst)))
+ 
 (defun call (code)
   ;(util:lgi code)
   (let ((*code* code))
@@ -132,6 +137,10 @@
         ((null fn))
       (funcall fn))))
 
+(defun x-call (code)
+  (let ((*code* (iter:list-iterator code)))
+    (iter:process *code* #'funcall)))
+
 (defun reg (sym fn &optional (cls 'word))
   (let ((sym (intern (symbol-name sym) (current-package *forge-env*))))
     (setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn))
@@ -172,7 +181,9 @@
            #:ptr #:get #:put
            #:in #:next 
            #:call #:call-if #:call-while #:comp #:lit #:val
-           #:<comp #:reg #:regc #:/>))
+           #:<comp #:reg #:regc #:reg-lisp #:/>
+           #:setup-builtins
+           ))
 
 (in-package :sf-builtin)
 
@@ -219,7 +230,14 @@
 
 (f:reg 'reg #'f:reg-code)
 (f:reg 'regc #'(lambda () (f:reg-code 'f:comp-word)))
+(f:reg 'reg-lisp (lambda () (f:reg (f:popd) (f:compile-lisp (f:popd)))))
 
 (f:reg '/> #'(lambda () (iter:stop f:*input*)) 'f:comp-word)
 
 ;;;; forge-code word definitions
+
+(defun setup-builtins ()
+  (f:run
+    (in in comp swp reg) comp in def reg
+    (in in swp reg-lisp) comp in def-lisp reg
+))

test/test-forge.lisp

@@ -18,8 +18,10 @@
       (progn
         ;(forge:setup-builtins)
         (test-exec)
+        (test-setup-builtins)
         (test-def)
         (test-val)
+        (test-comp)
         (test-if)))
     (util:lgi (forge:stack forge:*forge-env*))
     (t:show-result)))
@@ -35,6 +37,9 @@
   (forge:exec-stream (make-string-input-stream "12 square"))
   (== (forge:popd) 144))
 
+(deftest test-setup-builtins ()
+  (sf-builtin:setup-builtins))
+
 (deftest test-def ()
   (forge:run <comp in <comp swp reg /> in <def reg)
   (forge:exec-string "<def cube dup dup mul mul />")
@@ -58,6 +63,9 @@
 (deftest test-comp ()
   (forge:run (2 3 mul) comp call)
   (== (forge:popd) 6)
+  (forge:run def cubic (dup dup mul mul) 
+             4 cubic)
+  (== (forge:popd) 64)
   )
 
 (deftest test-if ()