summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-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)