summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-12-14 22:35:06 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-12-14 22:35:06 -0800
commitf56d0211640a4cae6181bb7e7aac8aacfa2f6ab5 (patch)
treebb828f122285551e89702845f560ef0087a0d2be
parent8b5cba427098511aaec8ba061d056d960bccfad9 (diff)
downloadtxr-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.tl32
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))))