summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisplib.c2
-rw-r--r--share/txr/stdlib/compiler.tl15
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))))))