diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2022-09-15 07:22:50 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2022-09-15 07:22:50 -0700 |
| commit | 5c73a495f9563bcccba5a5989f2ae9b50d7280bb (patch) | |
| tree | 72a56716c0e037f25fc0c72b610de5e50ae53ff7 | |
| parent | 8ca41d8efe17a932e0fe13782021f7430f188568 (diff) | |
| download | txr-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.tl | 32 | ||||
| -rw-r--r-- | tests/012/lambda.tl | 5 |
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) |