summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2022-09-15 07:22:50 -0700
committerKaz Kylheku <kaz@kylheku.com>2022-09-15 07:22:50 -0700
commit5c73a495f9563bcccba5a5989f2ae9b50d7280bb (patch)
tree72a56716c0e037f25fc0c72b610de5e50ae53ff7
parent8ca41d8efe17a932e0fe13782021f7430f188568 (diff)
downloadtxr-5c73a495f9563bcccba5a5989f2ae9b50d7280bb.tar.gz
txr-5c73a495f9563bcccba5a5989f2ae9b50d7280bb.tar.bz2
txr-5c73a495f9563bcccba5a5989f2ae9b50d7280bb.zip
compiler: bug: scoping of lambda optionals.
The scoping is not behind handled correctly for optional variables. The init-forms are being evaluated in a scope in which all the variables are already visible, instead of sequentially. Thus, for instance, variable rebinding doesn't work, as in (lambda (: (x x)) ...). When the argument is missing, x ends up with the value : because the expression refers to the new x, rather than the outer x. * stdlib/compiler.tl (compiler comp-lambda-impl): Perform the compilation of the init-forms earlier. Use the same new trick that is used for let*: the target for the code fragment is a locaton obtained from get-loc, which is then attached to a variable afterward. The spec-sub helper is extended with a loc parameter to help with this case. * tests/012/lambda.tl: New test case that fails without this fix.
-rw-r--r--stdlib/compiler.tl32
-rw-r--r--tests/012/lambda.tl5
2 files changed, 20 insertions, 17 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index e31fa6a2..78ee5f12 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -1058,42 +1058,40 @@
(when (> pars.nfix %max-lambda-fixed-args%)
(compile-warning form "~s arguments in a lambda (max is ~s)"
pars.nfix %max-lambda-fixed-args%))
- (flet ((spec-sub (sym)
+ (flet ((spec-sub (sym : (loc :))
(cond
((special-var-p sym)
(let ((sub (gensym)))
(push (cons sym sub) specials)
(set need-dframe t)
- nenv.(extend-var sub)
+ nenv.(extend-var sub loc)
sub))
(t
(push sym lexsyms)
- nenv.(extend-var sym)
+ nenv.(extend-var sym loc)
sym))))
(let* ((req-pars (collect-each ((rp pars.req))
(spec-sub rp)))
+ (allsyms req-pars)
(opt-pars (collect-each ((op pars.opt))
(tree-bind (var-sym : init-form have-sym) op
- (list (spec-sub var-sym)
- init-form
- (if have-sym (spec-sub have-sym))))))
- (rest-par (when pars.rest (spec-sub pars.rest)))
- (allsyms req-pars))
+ (let* ((loc nenv.(get-loc))
+ (ifrag me.(compile loc nenv init-form)))
+ (set fvars (uni fvars
+ (diff ifrag.fvars allsyms)))
+ (push var-sym allsyms)
+ (push have-sym allsyms)
+ (list (spec-sub var-sym loc)
+ ifrag
+ (if have-sym (spec-sub have-sym)))))))
+ (rest-par (when pars.rest (spec-sub pars.rest))))
(upd specials nreverse)
(with-closure-spy me (and (not specials)
(>= *opt-level* 2))
cspy (new closure-spy env nenv)
(let* ((col-reg (if opt-pars me.(get-dreg :)))
(tee-reg (if opt-pars me.(get-dreg t)))
- (ifrags (collect-each ((op opt-pars))
- (tree-bind (var-sym init-form have-sym) op
- (let* ((vbind nenv.(lookup-var var-sym))
- (ifrag me.(compile vbind.loc nenv init-form)))
- (set fvars (uni fvars
- (diff ifrag.fvars allsyms)))
- (push var-sym allsyms)
- (push have-sym allsyms)
- ifrag))))
+ (ifrags [mapcar cadr opt-pars])
(opt-code (append-each ((op opt-pars)
(ifrg ifrags))
(tree-bind (var-sym init-form have-sym) op
diff --git a/tests/012/lambda.tl b/tests/012/lambda.tl
index 96f8ba14..d298f59a 100644
--- a/tests/012/lambda.tl
+++ b/tests/012/lambda.tl
@@ -128,6 +128,11 @@
(test (functionp (lambda (: (n n)))) t)
+(defvarl n)
+
+(ltest
+ [(lambda (: (n n)) n)] nil)
+
(cond
(*compile-test* (exit t))
(t (set *compile-test* t)