From d1aeae93d94a18dcf3184da1bf30e9d21b993d0a Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 29 Jun 2017 06:45:28 -0700
Subject: ffi: make-union can initialize.

* ffi.c (make_union): Two arguments added. These
are optional.
(ffi_init): Update registration of make-union as
three-parameter function, with one required arg.

* ffi.h (make_union): Declaration updated.

* txr.1: Documented.
---
 ffi.c | 15 ++++++++++++---
 ffi.h |  2 +-
 txr.1 | 21 ++++++++++++++++++++-
 3 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/ffi.c b/ffi.c
index a766ead6..98d126ce 100644
--- a/ffi.c
+++ b/ffi.c
@@ -5270,11 +5270,20 @@ mem_t *union_get_ptr(val uni)
   return us->data;
 }
 
-val make_union(val type)
+val make_union(val type, val init, val memb)
 {
+  val self = lit("make-union");
   struct txr_ffi_type *tft = ffi_type_struct_checked(type);
   mem_t *data = chk_calloc(1, tft->size);
-  return make_union_common(data, tft);
+  val uni = make_union_common(data, tft);
+  if (!missingp(init)) {
+    if (tft->nelem == 0)
+      uw_throwf(error_s, lit("~a: ~s cannot be initialized: no members"),
+                self, type, nao);
+    memb = default_arg(memb, tft->memb[0].mname);
+    union_put(uni, memb, init);
+  }
+  return uni;
 }
 
 val union_members(val uni)
@@ -5455,7 +5464,7 @@ void ffi_init(void)
   reg_fun(intern(lit("num-carray"), user_package), func_n1(num_carray));
   reg_fun(intern(lit("put-carray"), user_package), func_n3o(put_carray, 1));
   reg_fun(intern(lit("fill-carray"), user_package), func_n3o(fill_carray, 1));
-  reg_fun(intern(lit("make-union"), user_package), func_n1(make_union));
+  reg_fun(intern(lit("make-union"), user_package), func_n3o(make_union, 1));
   reg_fun(intern(lit("union-members"), user_package), func_n1(union_members));
   reg_fun(intern(lit("union-get"), user_package), func_n2(union_get));
   reg_fun(intern(lit("union-put"), user_package), func_n3(union_put));
diff --git a/ffi.h b/ffi.h
index 351dedb5..232337a1 100644
--- a/ffi.h
+++ b/ffi.h
@@ -122,7 +122,7 @@ val num_carray(val carray);
 val put_carray(val carray, val offs, val stream);
 val fill_carray(val carray, val offs, val stream);
 mem_t *union_get_ptr(val uni);
-val make_union(val type);
+val make_union(val type, val init, val memb);
 val union_members(val uni);
 val union_get(val uni, val memb);
 val union_put(val uni, val memb, val newval);
diff --git a/txr.1 b/txr.1
index d9653cb0..65da6830 100644
--- a/txr.1
+++ b/txr.1
@@ -56749,7 +56749,7 @@ following equivalence holds:
 
 .coNP Function @ make-union
 .synb
-.mets (make-union << type )
+.mets (make-union < type >> [ initval <> [ member ]])
 .syne
 .desc
 The
@@ -56766,6 +56766,25 @@ The object provides storage for the foreign representation of
 .codn type ,
 and that storage is initialized to all zero bytes.
 
+Additionally, if
+.meta initval
+is specified, but
+.meta member
+is not, then
+.meta initval
+is stored into the union's via the first member, as if by
+.codn union-put .
+If the union type has no members, an error exception is thrown.
+
+If both
+.meta initval
+and
+.meta member
+are specified, then
+.meta initval
+is stored into the union using the specified member, as if by
+.codn union-put .
+
 .coNP Function @ union-members
 .synb
 .mets (union-members << union )
-- 
cgit v1.2.3