diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2019-08-07 21:13:15 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2019-08-07 21:13:15 -0700 |
commit | 7840f507a485c78607605493e575ff1546245b87 (patch) | |
tree | ca04df4dd937ae388e50317cf32d9bdddd1c5ea3 | |
parent | 7abdb7132afa0f5d8351c1a04d8fc819de3f1ea1 (diff) | |
download | txr-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.tl | 29 |
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)))) |