From 0a1e7693df57971fd3eaf1e97c9f1b1e25634c72 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 7 Apr 2018 10:16:46 -0700 Subject: new function: compile. * lisplib.c (compiler_set_entries): Add compile to autoloads. * share/txr/stdlib/compiler.tl (usr:compile): New function. --- lisplib.c | 2 +- share/txr/stdlib/compiler.tl | 15 +++++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) 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)))))) -- cgit v1.2.3