Optional arguments in boa construction.

* share/txr/stdlib/struct.tl (defstruct): Split boa
arguments on colon and generate the lambda
accordingly. The generated function detects which
optional arguments are actually present and only
performs the slot updates for those.

* tests/012/struct.tl: Corrected boa test case.

* txr.1: Documented.

3 files changed, 56 insertions, 10 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index f943c06f..bd049f75 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -134,11 +134,26 @@
                       ^((finalize ,arg-sym (lambda (,(car instance-fini-form))
                                              ,*(cdr instance-fini-form))
                                   t)))))
-           ,(if args
-              (let ((gens (mapcar (ret (gensym)) args)))
-                ^(lambda (,arg-sym ,*gens)
-                   ,*(mapcar (ret ^(slotset ,arg-sym ',@1 ,@2))
-                             args gens)))))))))
+           ,(when args
+              (when (> (countql : args) 1)
+                (throwf 'eval-error "~s: multiple colons in boa syntax"
+                        'defstruct))
+              (let ((col-pos (posq : args)))
+                (let ((req-args [args 0..col-pos])
+                      (opt-args (if col-pos [args (succ col-pos)..:])))
+                  (let ((r-gens (mapcar (ret (gensym)) req-args))
+                        (o-gens (mapcar (ret (gensym)) opt-args))
+                        (p-gens (mapcar (ret (gensym)) opt-args)))
+                    ^(lambda (,arg-sym ,*r-gens
+                              ,*(if opt-args '(:))
+                              ,*(if opt-args
+                                  (mapcar (ret ^(,@1 nil ,@2))
+                                          o-gens p-gens)))
+                       ,*(mapcar (ret ^(slotset ,arg-sym ',@1 ,@2))
+                                 req-args r-gens)
+                       ,*(mapcar (ret ^(if ,@3
+                                         (slotset ,arg-sym ',@1 ,@2)))
+                                 opt-args o-gens p-gens)))))))))))
 
 (defmacro sys:struct-lit (name . plist)
   ^(make-struct ',name ',plist))
diff --git a/tests/012/struct.tl b/tests/012/struct.tl
index 209bae71..d9ecc325 100644
--- a/tests/012/struct.tl
+++ b/tests/012/struct.tl
@@ -94,8 +94,8 @@
 (test (new (boa 1 2))
       #S(boa x 1 y 2))
 (test (new (boa 1 2) x 10 y (+ 10 10))
-      #S(boa x 10 y 20))
-(test (new boa x 10 y 20)
+      #S(boa x 1 y 2))
+(test (new boa x 10 y (+ 10 10))
       #S(boa x 10 y 20))
 
 (defstruct baz nil
diff --git a/txr.1 b/txr.1
index 1dc7ea9c..309b5d8b 100644
--- a/txr.1
+++ b/txr.1
@@ -17972,9 +17972,33 @@ arguments in the
 .code new
 macro or the
 .code make-struct
-function. A slot initialized in this style still has a
+function.
+
+Slots are first initialized according to their
+.metn init-form -s,
+regardless of whether they are involved in boa construction
+
+A slot initialized in this style still has a
 .meta init-form
-which is evaluated unconditionally.
+which is processed independently of the existence of, and prior to,
+boa construction.
+
+The boa constructor syntax can specify optional arguments, delimited
+by a colon, similarly to the
+.code lambda
+syntax. However, the optional arguments may only be symbols which name
+slots. The
+.cblk
+.meti >> ( name < init-form <> [ present-p ])
+.cble
+optional argument syntax isn't supported.
+
+When boa construction is invoked with optional arguments missing,
+the default values for those arguments come from the
+.metn init-form -s
+in the remaining
+.code defstruct
+syntax.
 
 .TP* Examples:
 .cblk
@@ -18004,7 +18028,7 @@ which is evaluated unconditionally.
   *counter* -> 5
 
   ;; boa initialization
-  (defstruct (point x y) nil (x 0) (y 0))
+  (defstruct (point x : y) nil (x 0) (y 0))
 
   (new point) -> #S(point x 0 y 0)
   (new (point 1 1)) -> #S(point x 1 y 1)
@@ -18015,6 +18039,13 @@ which is evaluated unconditionally.
 
   ;; boa applies last:
   (new (point 1 1) x 4 y 5) -> #S(point x 1 y 1)
+
+  ;; boa with optional argument omitted:
+  (new (point 1)) -> #S(point x 1 y 0)
+
+  ;; boa with optional argument omitted and
+  ;; with property list style initialization:
+  (new (point 1) x 5 y 5) -> #S(point x 1 y 5)
 .cble
 
 .coNP Macro @ new