summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2019-08-07 21:13:15 -0700
committerKaz Kylheku <kaz@kylheku.com>2019-08-07 21:13:15 -0700
commit7840f507a485c78607605493e575ff1546245b87 (patch)
treeca04df4dd937ae388e50317cf32d9bdddd1c5ea3
parent7abdb7132afa0f5d8351c1a04d8fc819de3f1ea1 (diff)
downloadtxr-7840f507a485c78607605493e575ff1546245b87.tar.gz
txr-7840f507a485c78607605493e575ff1546245b87.tar.bz2
txr-7840f507a485c78607605493e575ff1546245b87.zip
compiler: inline lambda: incomplete opt param support.
The compilation of lambdas that are immediately called or applied is missing the support for the Boolean parameters that indicate whether optional arguments are present. * share/txr/stdlib/compiler.tl (lambda-apply-transform): Check whether the opt parameter items from the fun-param-parser object have a third element, the indicator variable, and emit the binding for it. This has to be done in all three cases: optional parameter statically present, statically missing, and dynamically determined from run-time apply list of unknown length.
-rw-r--r--share/txr/stdlib/compiler.tl29
1 files changed, 20 insertions, 9 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 800c16dc..4bf56c31 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1506,7 +1506,10 @@
(while (and fix-arg-exprs pars.req)
(add ^(,(pop pars.req) ,(pop fix-arg-exprs))))
(while (and fix-arg-exprs pars.opt)
- (add ^(,(car (pop pars.opt)) ,(pop fix-arg-exprs))))
+ (tree-bind (var-sym : init-form have-sym) (pop pars.opt)
+ (add ^(,var-sym ,(pop fix-arg-exprs)))
+ (if have-sym
+ (add ^(,have-sym t)))))
(cond
((and (null pars.req)
(null pars.opt))
@@ -1526,20 +1529,28 @@
(while pars.req
(add ^(,(pop pars.req) (pop ,al-val))))
(while pars.opt
- (add ^(,(caar pars.opt)
- (if ,al-val
- (pop ,al-val)
- ,(cadar pars.opt))))
- (pop pars.opt))
+ (tree-bind (var-sym : init-form have-sym) (pop pars.opt)
+ (cond
+ (have-sym
+ (add ^(,var-sym (if ,al-val
+ (car ,al-val)
+ ,init-form)))
+ (add ^(,have-sym (when ,al-val
+ (pop ,al-val)
+ t))))
+ (t (add ^(,var-sym (if ,al-val
+ (pop ,al-val)
+ ,init-form)))))))
(when pars.rest
(add ^(,pars.rest ,al-val))))
(pars.req
(lambda-too-few-args lm-expr))
(pars.opt
(while pars.opt
- (add ^(,(caar pars.opt)
- ,(cadar pars.opt)))
- (pop pars.opt))
+ (tree-bind (var-sym : init-form have-sym) (pop pars.opt)
+ (add ^(,var-sym ,init-form))
+ (if have-sym
+ (add ^(,have-sym)))))
(when pars.rest
(add ^(,pars.rest))))))
,*lm-body))))