new function: compile.

* lisplib.c (compiler_set_entries): Add compile to autoloads.

* share/txr/stdlib/compiler.tl (usr:compile): New function.

2 files changed, 16 insertions, 1 deletions

diff --git a/lisplib.c b/lisplib.c
index 1b93b19a..0a31f1db 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -678,7 +678,7 @@ static val compiler_set_entries(val dlt, val fun)
     nil
   };
   val name[] = {
-    lit("compile-toplevel"), lit("compile-file"),
+    lit("compile-toplevel"), lit("compile-file"), lit("compile"),
     nil
   };
 
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 47d77d7f..0a46e0ae 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1387,3 +1387,18 @@
           (when (> (sys:parser-errors parser) 0)
             (error "~s: compilation of ~s failed" 'compile-file
                    (stream-get-prop in-stream :name))))))))
+
+(defun usr:compile (obj)
+  (typecase obj
+    (fun (tree-bind (indicator args . body) (func-get-form obj)
+           (let* ((form ^(lambda ,args ,*body))
+                  (vm-desc (compile-toplevel form)))
+             (vm-execute-toplevel vm-desc))))
+    (t (condlet
+         (((fun (symbol-function obj)))
+          (tree-bind (indicator args . body) (func-get-form fun)
+            (let* ((form ^(lambda ,args ,*body))
+                   (vm-desc (compile-toplevel form))
+                   (comp-fun (vm-execute-toplevel vm-desc)))
+              (set (symbol-function obj) comp-fun))))
+         (t (error "~s: cannot compile ~s" 'compile obj))))))