Fix struct lit problem exposed by circular syntax.

The semantics of how struct literals come to life is poorly
designed: namely, the slot-value pairs in the struct literal
are used as the plist argument in a call to make-struct.
This is wrong because the implied initializations are then
clobbered by the structure type's :init and :postinit
handlers, resulting in an object with slot values that don't
match what is in the literal. When you add circular syntax
to the mix, things get worse. Slots may be initialized with
(sys:circ-ref ...) expressions corresponding to #<n># syntax.
These expressions then get clobbered by the constructor
actions before the circ_backpatch processes the syntax.

* parser.y (struct): Use make_struct_lit rather than
make_struct to instantiate struct object.

* struct.tl (sys:struct-lit): Expand to a form which calls
sys:make-struct-lit, rather than make-struct.

* struct.c (struct_init): Register new make_struct_lit
function as sys:make-struct-lit intrinsic.
(make_struct_lit): New function.

* struct.h (make_struct_lit): Declared.

* tests/012/struct.tl: struct literal expansion test case
updated.

* txr.1: Updated documentation of struct literals.
Added compat notes.

6 files changed, 49 insertions, 12 deletions

diff --git a/parser.y b/parser.y
index c3bc60e5..953a942d 100644
--- a/parser.y
+++ b/parser.y
@@ -825,10 +825,8 @@ struct : HASH_S list            { if (unquotes_occur($2, 0))
                                     $$ = rl(cons(struct_lit_s, $2),
                                               num($1));
                                   else
-                                  { args_decl(args, 0);
-                                    val strct = make_struct(first($2),
-                                                            rest($2),
-                                                            args);
+                                  { val strct = make_struct_lit(first($2),
+                                                                rest($2));
                                     $$ = rl(strct, num($1)); } }
        ;
 
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index ecd1db5d..ca764b03 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -186,7 +186,7 @@
                          ,*(cdr instance-postinit-form)))))))))))
 
 (defmacro sys:struct-lit (name . plist)
-  ^(make-struct ',name ',plist))
+  ^(sys:make-struct-lit ',name ',plist))
 
 (defmacro qref (:whole form obj . refs)
   (when (null refs)
diff --git a/struct.c b/struct.c
index b109751c..71a2984c 100644
--- a/struct.c
+++ b/struct.c
@@ -130,6 +130,7 @@ void struct_init(void)
   reg_fun(intern(lit("make-struct"), user_package), func_n2v(make_struct));
   reg_fun(intern(lit("make-lazy-struct"), user_package),
           func_n2(make_lazy_struct));
+  reg_fun(intern(lit("make-struct-lit"), system_package), func_n2(make_struct_lit));
   reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct));
   reg_fun(intern(lit("replace-struct"), user_package), func_n2(replace_struct));
   reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1));
@@ -563,6 +564,22 @@ val make_lazy_struct(val type, val argfun)
   return sinst;
 }
 
+val make_struct_lit(val type, val plist)
+{
+  args_decl(args, 0);
+  val strct;
+
+  if (opt_compat && opt_compat <= 154) {
+    strct = make_struct(type, plist, args);
+  } else {
+    strct = make_struct(type, nil, args);
+    for (; plist; plist = cddr(plist))
+      slotset(strct, car(plist), cadr(plist));
+  }
+
+  return strct;
+}
+
 static struct struct_inst *struct_handle(val obj, val ctx)
 {
   if (cobjp(obj) && obj->co.ops == &struct_inst_ops)
diff --git a/struct.h b/struct.h
index 384c4755..cf1ef26a 100644
--- a/struct.h
+++ b/struct.h
@@ -34,6 +34,7 @@ val struct_type_p(val obj);
 val super(val type);
 val make_struct(val type, val plist, struct args *);
 val make_lazy_struct(val type, val argfun);
+val make_struct_lit(val type, val plist);
 val copy_struct(val strct);
 val clear_struct(val strct, val value);
 val replace_struct(val target, val source);
diff --git a/tests/012/struct.tl b/tests/012/struct.tl
index de5ab0f8..a55e8447 100644
--- a/tests/012/struct.tl
+++ b/tests/012/struct.tl
@@ -15,7 +15,7 @@
         bar b 4))
 
 (test (sys:expand ^#S(bar b ,(+ 2 2)))
-      (make-struct 'bar '(b 4)))
+      (sys:make-struct-lit 'bar '(b 4)))
 
 (defvar s (eval ^#S(bar b ,(+ 2 2))))
 
diff --git a/txr.1 b/txr.1
index 9585fdaf..3b9add31 100644
--- a/txr.1
+++ b/txr.1
@@ -10388,20 +10388,22 @@ followed by a nested list syntax denotes a struct literal.
 The first item in the syntax is a symbol denoting the struct type
 name. This must be the name of a struct type, otherwise the
 literal is erroneous.  Followed by the struct type are slot names
-interleaved with their values. Each slot name which is present in the
+interleaved with their values. The values are literal expressions,
+not subject to evaluation.
+Each slot name which is present in the
 literal must name a slot in the struct type, though not
 all slots in the struct type must be present in the literal.
+
 When a struct literal is read, the denoted struct type is
 constructed as if by a call to
 .code make-struct
-whose
+with an empty
 .meta plist
-argument is formed from the
+argument, followed by a sequence of assignments which store into each
 .meta slot
-and
+the corresponding
 .meta value
-elements of the literal, individually quoted to suppress their
-evaluation as forms.
+expression.
 
 .NP* Hash Literals
 
@@ -47305,6 +47307,25 @@ of these version values, the described behaviors are provided if
 is given an argument which is equal or lower. For instance
 .code "-C 103"
 selects the behaviors described below for version 105, but not those for 102.
+.IP 154
+After version 154, changes were introduced in the semantics of struct
+literals. Previously, the syntax
+.code "#S(abc x a y b)"
+denoted the construction of an instance of
+.code abc
+with
+.code "x a y b"
+as the constructor parameters, similarly to
+.codn "(new abc x 'a y 'b)" .
+The new behavior is that
+.code abc
+is constructed using no parameters, as if  by
+.code "(new abc)"
+and then the slot values are assigned. This means that the values
+specified in the literal override any manipulations of those slots by
+the type's user-defined
+.code :postinit
+handlers.
 .IP 151
 After version 151, changes were implemented to the way static slots work
 in \*(TL structs. Selecting compatibility with 151 restores most of the behaviors.