diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-12-14 22:35:06 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-12-14 22:35:06 -0800 |
| commit | f56d0211640a4cae6181bb7e7aac8aacfa2f6ab5 (patch) | |
| tree | bb828f122285551e89702845f560ef0087a0d2be | |
| parent | 8b5cba427098511aaec8ba061d056d960bccfad9 (diff) | |
| download | txr-f56d0211640a4cae6181bb7e7aac8aacfa2f6ab5.tar.gz txr-f56d0211640a4cae6181bb7e7aac8aacfa2f6ab5.tar.bz2 txr-f56d0211640a4cae6181bb7e7aac8aacfa2f6ab5.zip | |
compiler: fix broken (compile '(lambda ...)).
* stdlib/compiler.tl (compile): The symbol-function function
returns true for lambda and that's where we are handling
lambda expressions. However, the (set (symbol-function ...) ...)
then fails: that requires a function name that designates
a mutable function location. Let's restructure the code with
match-case, and handle the lambda pattern separately via
compile-toplevel.
| -rw-r--r-- | stdlib/compiler.tl | 32 |
1 files changed, 17 insertions, 15 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 12e51947..2f2c7755 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -2425,18 +2425,20 @@ form) (defun usr:compile (obj) - (typecase obj - (fun (tree-bind (indicator args . body) (func-get-form obj) - (let* ((form (sys:env-to-let (func-get-env obj) - ^(lambda ,args ,*body))) - (vm-desc (compile-toplevel form t))) - (vm-execute-toplevel vm-desc)))) - (t (condlet - (((fun (symbol-function obj))) - (tree-bind (indicator args . body) (func-get-form fun) - (let* ((form (sys:env-to-let (func-get-env fun) - ^(lambda ,args ,*body))) - (vm-desc (compile-toplevel form t)) - (comp-fun (vm-execute-toplevel vm-desc))) - (set (symbol-function obj) comp-fun)))) - (t (error "~s: cannot compile ~s" 'compile obj)))))) + (match-case obj + (@(functionp) + (tree-bind (indicator args . body) (func-get-form obj) + (let* ((form (sys:env-to-let (func-get-env obj) + ^(lambda ,args ,*body))) + (vm-desc (compile-toplevel form t))) + (vm-execute-toplevel vm-desc)))) + ((lambda . @nil) + [(compile-toplevel obj nil)]) + (@(@fun (symbol-function)) + (tree-bind (indicator args . body) (func-get-form fun) + (let* ((form (sys:env-to-let (func-get-env fun) + ^(lambda ,args ,*body))) + (vm-desc (compile-toplevel form t)) + (comp-fun (vm-execute-toplevel vm-desc))) + (set (symbol-function obj) comp-fun)))) + (@else (error "~s: cannot compile ~s" 'compile obj)))) |