From 7840f507a485c78607605493e575ff1546245b87 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 7 Aug 2019 21:13:15 -0700
Subject: 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.
---
 share/txr/stdlib/compiler.tl | 29 ++++++++++++++++++++---------
 1 file 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))))
-- 
cgit v1.2.3