[COMMITTED] pkl: settle semantics for constructing union values

[Jose E. Marchesi]

Unlike structs, union constructors with more than one field
initializer really don't make much sense, like in:

  (poke) type Foo = union { byte b : b > 0; int i; }
  (poke) Foo {b = 2, i = 12}

What kind of Foo are we asking for?  It is not clear.  Until this
patch, the same rules used for constructed structs applied, so the
result would be:

  Foo {
    b=2UB
  }

Now, if we do:

  (poke) var f = Foo {b = 2}
  (poke) f.b = 0

What would we expect?  For the value in `f' to change nature and
become a Foo of kind `i'?  Or for this to be considered as a
constraint error?

In the first case (the nature of the union value changes) we could
expect to get something like:

  (poke) f
  Foo {
  i = 12
  }

But should that really be 12, i.e. the value previously specified in
the initializer, or 0?  Wouldn't we expect this value to impacted by
the coupling in bits of the two fields, if we consider both "start" at
the beginning of the union?

This gets very complicated and obscure, and almost impossible to
implement properly and to understand.  However, this is because we are
thinking about unions like if they were regular structs: they are
not.  This is the wrong way of thinking.

A better approach, which is what this patch implements, is the
following: an union constructor admits either one or zero field
initializers.  Specifying more than one field initializer is a
compile-time error:

  (poke) Foo {b = 2, i = 12}
  <stdin>:1:1: error: union constructors require exactly one field initializer
  Foo {b = 2, i = 12};
  ^~~~~~~~~~~~~~~~~~~

When we specify a field initializer, we are also declaring the kind of
Foo we want to construct, i.e. its "nature":

  (poke) Foo {b = 2}
  (poke) Foo {b = 2}
  Foo {
    b=2UB
  }

Therefore, if we provide an invalid initial value for `b', then we get
a constraint-violation exception:

  (poke) Foo {b = 0}
  unhandled constraint violation exception

The alternative `i' is not considered in this case: we asked for a Foo
of kind `b', and we provided the wrong values for it: we want the
exception.

Once constructed, union values do not change "nature" due to
assignments:

  (poke) var f = Foo {b = 2}
  (poke) f.b = 0
  unhandled constraint violation exception

Note that mapped unions are different in this sense.  When we map an
union on some IO space:

  (poke) var m = Foo @ 0#B

we are not specifying what nature of Foo we want: it all depends on
the contents of the IO space.  Therefore, we could get either a `b' or
an `i', and if the underlying data in the IO space changes, the nature
of the value in `m' may change as well.

Something similar happens when we don't specify a field initializer in
an union constructor:

  (poke) Foo {}
  Foo {
    i=0
  }

Since no initializer was provided, we didn't indicate what kind of Foo
we wanted, and therefore each alternative is tried assuming all fields
have default values, which in the case of integral types is a zero.

Hope all this makes sense XD

2020-11-15  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-typify.c (pkl_typify1_ps_scons): Union constructors
        require exactly one field initializer.
        * libpoke/pkl-gen.pks (struct_constructor): Implement new
        semantics for union construction.
        * testsuite/poke.pkl/scons-56.pk: Adjust test.
        * testsuite/poke.pkl/scons-union-1.pk: Likewise.
        * testsuite/poke.pkl/scons-union-2.pk: Likewise.
        * testsuite/poke.pkl/scons-union-3.pk: LIkewise.
        * testsuite/poke.pkl/scons-union-5.pk: Likewise.
        * testsuite/poke.pkl/scons-union-6.pk: Likewise.
        * testsuite/poke.pkl/scons-union-7.pk: Likewise.
        * testsuite/poke.pkl/scons-union-8.pk: Likewise
        * testsuite/poke.pkl/scons-union-2.pk: Likewise.
        * testsuite/poke.pkl/scons-union-10.pk: New test.
        * testsuite/poke.pkl/scons-union-diag-1.pk: New test.
        * testsuite/poke.pkl/scons-union-diag-2.pk: Likewise.
        * testsuite/poke.pkl/scons-union-9.pk: Likewise.
        * testsuite/poke.pkl/ass-union-int-1.pk: Likewise.
        * testsuite/poke.pkl/ass-union-int-2.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Update tests.
---
 ChangeLog                                | 23 +++++++++
 doc/poke.texi                            | 63 ++++++++++++++++++++++++
 libpoke/pkl-gen.pks                      | 26 +++++++++-
 libpoke/pkl-typify.c                     | 10 ++++
 testsuite/Makefile.am                    |  5 ++
 testsuite/poke.pkl/ass-union-int-1.pk    |  7 +++
 testsuite/poke.pkl/ass-union-int-2.pk    | 12 +++++
 testsuite/poke.pkl/scons-56.pk           |  2 +-
 testsuite/poke.pkl/scons-union-1.pk      |  2 +-
 testsuite/poke.pkl/scons-union-10.pk     | 12 +++++
 testsuite/poke.pkl/scons-union-2.pk      |  4 +-
 testsuite/poke.pkl/scons-union-3.pk      |  2 +-
 testsuite/poke.pkl/scons-union-5.pk      |  2 +-
 testsuite/poke.pkl/scons-union-6.pk      |  2 +-
 testsuite/poke.pkl/scons-union-7.pk      |  2 +-
 testsuite/poke.pkl/scons-union-8.pk      |  2 +-
 testsuite/poke.pkl/scons-union-9.pk      | 14 ++++++
 testsuite/poke.pkl/scons-union-diag-1.pk |  4 ++
 18 files changed, 184 insertions(+), 10 deletions(-)
 create mode 100644 testsuite/poke.pkl/ass-union-int-1.pk
 create mode 100644 testsuite/poke.pkl/ass-union-int-2.pk
 create mode 100644 testsuite/poke.pkl/scons-union-10.pk
 create mode 100644 testsuite/poke.pkl/scons-union-9.pk
 create mode 100644 testsuite/poke.pkl/scons-union-diag-1.pk

diff --git a/ChangeLog b/ChangeLog
index d0e9b8cc..dfc38c81 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,26 @@
+2020-11-15  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-typify.c (pkl_typify1_ps_scons): Union constructors
+       require exactly one field initializer.
+       * libpoke/pkl-gen.pks (struct_constructor): Implement new
+       semantics for union construction.
+       * testsuite/poke.pkl/scons-56.pk: Adjust test.
+       * testsuite/poke.pkl/scons-union-1.pk: Likewise.
+       * testsuite/poke.pkl/scons-union-2.pk: Likewise.
+       * testsuite/poke.pkl/scons-union-3.pk: LIkewise.
+       * testsuite/poke.pkl/scons-union-5.pk: Likewise.
+       * testsuite/poke.pkl/scons-union-6.pk: Likewise.
+       * testsuite/poke.pkl/scons-union-7.pk: Likewise.
+       * testsuite/poke.pkl/scons-union-8.pk: Likewise
+       * testsuite/poke.pkl/scons-union-2.pk: Likewise.
+       * testsuite/poke.pkl/scons-union-10.pk: New test.
+       * testsuite/poke.pkl/scons-union-diag-1.pk: New test.
+       * testsuite/poke.pkl/scons-union-9.pk: Likewise.
+       * testsuite/poke.pkl/ass-union-int-1.pk: Likewise.
+       * testsuite/poke.pkl/ass-union-int-2.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Update tests.
+       * doc/poke.texi (Union Constructors): New section.
+
 2020-11-15  Jose E. Marchesi  <jemarch@gnu.org>
 
        * libpoke/pvm-val.c (pvm_make_struct): Initialize the bit-offset
diff --git a/doc/poke.texi b/doc/poke.texi
index 336b43cc..c3a7f9db 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -6659,6 +6659,7 @@ They contain heterogeneous collections of values.
 * Pinned Structs::             Fix the offset of fields.
 * Integral Structs::           Composite data stored in integers.
 * Unions::                     Dealing with conditional data.
+* Union Constructors::          Constructing union values.
 * Optional Fields::            Fields that may or may not exist.
 * Casting Structs::            Converting structs from one type to another.
 * Declarations in Structs::    Declaring stuff within a struct.
@@ -7249,6 +7250,68 @@ XXX
 For performance purposes, it is good to always place the most common
 alternatives first in unions.
 
+@node Union Constructors
+@subsection Union Constructors
+
+Constructing union values is very similar to constructing struct
+values:
+
+@example
+@var{type_name} @{ [@var{field_initializer}] @}
+@end example
+
+The main difference is that union constructors require either exactly
+one field initializer, or none.  Specifying initialization values for
+more than one field doesn't make sense in the case of unions.
+
+Suppose we have the following union type:
+
+@example
+type Packet =
+  union
+  @{
+    byte b : b > 0;
+    int k;
+  @};
+@end example
+
+If we try to construct a @code{Packet} with an invalid @code{b}, we
+get a constraint error:
+
+@example
+(poke) Packet @{b = 0@}
+unhandled constraint violation exception
+@end example
+
+@noindent
+The reason why @code{k} is not chosen is because we specified @code{b}
+in the union constructor: we explicitly as for a @code{Packet} of that
+kind, but the data we provide doesn't accommodate to that.  If we
+wanted another kind of value, we could of course specify an initial
+value for @code{k} instead:
+
+@example
+(poke) Packet @{k = 10@}
+Packet @{
+  k=10
+@}
+@end example
+
+If no field initializer is specified in an union constructor then each
+alternative is tried assuming all fields have default values, which in
+the case of integral types is a zero:
+
+@example
+(poke) Packet @{@}
+Packet @{
+  k=0
+@}
+@end example
+
+@noindent
+Therefore the alternative @code{b} is considered invalid (it has to be
+bigger than 0) and @code{k} is chosen instead.
+
 @node Optional Fields
 @subsection Optional Fields
 @cindex struct fields
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index 5bec18e0..1eaeac5c 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -1100,6 +1100,29 @@
         ;; obtained by subpassing in the value's type, or the field's
         ;; initializer.
         bnn .got_value         ; ... SCT ENAME null
+        ;; If the struct is an union, and the given struct contains one element
+        ;; (the compiler guarantees that it will be just one element)
+        ;; then we have to skip every field until we reach the only field that
+        ;; exists in $sct.
+ .c  if (PKL_AST_TYPE_S_UNION_P (@type_struct))
+ .c  {
+        .label .skip_field
+        .label .process_field
+        drop                    ; SCT ENAME
+        over                    ; SCT ENAME SCT
+        sel                     ; SCT ENAME SCT SEL
+        nip                     ; SCT ENAME SEL
+        bnzlu .skip_field
+        ba .process_field
+.skip_field:
+        ;; This is to keep the right lexical environment.
+        push null
+        regvar $foo
+        ba .alternative_failed
+.process_field:
+        drop                    ; SCT ENAME
+        push null               ; SCT ENAME null
+ .c  }
  .c if (@field_initializer)
  .c {
         drop
@@ -1115,7 +1138,6 @@
         .label .alternative_ok
         bnzi .alternative_ok
         drop
-        drop
         ba .alternative_failed
 .alternative_ok:
  .c   }
@@ -1183,6 +1205,7 @@
    .c   if (PKL_AST_TYPE_S_UNION_P (@type_struct))
    .c   {
         ;; Alternative failed: try next alternative.
+        push null
         ba .alternative_failed
    .c   }
         push PVM_E_CONSTRAINT
@@ -1240,6 +1263,7 @@
         ;; And we are done :)
         ba .union_fields_done
 .alternative_failed:
+        drop
         drop                    ; ... ENAME
         drop                    ; ... EVAL
    .c }
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 1f664687..40850f2a 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -1914,6 +1914,16 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_scons)
   pkl_ast_node struct_fields = PKL_AST_STRUCT_FIELDS (astruct);
   pkl_ast_node elem = NULL;
 
+  /* Unions require either zero or exactly one initializer in their 
constructors.  */
+  if (PKL_AST_TYPE_S_UNION_P (scons_type)
+      && PKL_AST_STRUCT_NELEM (astruct) > 1)
+    {
+      PKL_ERROR (PKL_AST_LOC (astruct),
+                 "union constructors require exactly one field initializer");
+      PKL_TYPIFY_PAYLOAD->errors++;
+      PKL_PASS_ERROR;
+    }
+
   /* This check is currently redundant, because the restriction is
      implicitly satisfied by the parser.  */
   if (PKL_AST_TYPE_CODE (scons_type) != PKL_TYPE_STRUCT)
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index c4189081..569b8074 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -546,6 +546,8 @@ EXTRA_DIST = \
   poke.pkl/ass-offset-1.pk \
   poke.pkl/ass-struct-int-1.pk \
   poke.pkl/ass-struct-int-2.pk \
+  poke.pkl/ass-union-int-1.pk \
+  poke.pkl/ass-union-int-2.pk \
   poke.pkl/attr-diag-1.pk \
   poke.pkl/attr-ios-1.pk \
   poke.pkl/attr-ios-2.pk \
@@ -1337,6 +1339,9 @@ EXTRA_DIST = \
   poke.pkl/scons-union-6.pk \
   poke.pkl/scons-union-7.pk \
   poke.pkl/scons-union-8.pk \
+  poke.pkl/scons-union-9.pk \
+  poke.pkl/scons-union-10.pk \
+  poke.pkl/scons-union-diag-1.pk \
   poke.pkl/scons-union-method-1.pk \
   poke.pkl/scons-union-method-2.pk \
   poke.pkl/scons-union-method-3.pk \
diff --git a/testsuite/poke.pkl/ass-union-int-1.pk 
b/testsuite/poke.pkl/ass-union-int-1.pk
new file mode 100644
index 00000000..395f2f59
--- /dev/null
+++ b/testsuite/poke.pkl/ass-union-int-1.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = union { int a : a < 10; int b : b < 20; };
+var f = Foo { };
+
+/* { dg-command {try f.a = 30; catch if E_constraint { print "caught\n"; } } } 
*/
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/ass-union-int-2.pk 
b/testsuite/poke.pkl/ass-union-int-2.pk
new file mode 100644
index 00000000..b8fff4fd
--- /dev/null
+++ b/testsuite/poke.pkl/ass-union-int-2.pk
@@ -0,0 +1,12 @@
+/* { dg-do run } */
+
+type Foo = union { int a : a < 10; int b : b < 20; };
+var f = Foo { a = 3 };
+
+/* { dg-command {f.a = 5} } */
+/* { dg-command {f} } */
+/* { dg-output "Foo {a=5}" } */
+/* { dg-command {try f.a = 11; catch if E_constraint { print "caught\n"; } } } 
*/
+/* { dg-output "\ncaught" } */
+/* { dg-command {f} } */
+/* { dg-output "\nFoo {a=5}" } */
diff --git a/testsuite/poke.pkl/scons-56.pk b/testsuite/poke.pkl/scons-56.pk
index caf7ce26..38547df7 100644
--- a/testsuite/poke.pkl/scons-56.pk
+++ b/testsuite/poke.pkl/scons-56.pk
@@ -14,5 +14,5 @@ type Foo =
     };
 
 /* { dg-command { .set obase 16 } } */
-/* { dg-command { Foo {} } } */
+/* { dg-command { Foo { l32 = 0#B } } } */
 /* { dg-output {Foo {l32=0x0U#B}} } */
diff --git a/testsuite/poke.pkl/scons-union-1.pk 
b/testsuite/poke.pkl/scons-union-1.pk
index 3b973b28..857a8125 100644
--- a/testsuite/poke.pkl/scons-union-1.pk
+++ b/testsuite/poke.pkl/scons-union-1.pk
@@ -2,5 +2,5 @@
 
 type Foo = union { int i : i != 0; long l : l != 0; };
 
-/* { dg-command { try Foo {}; catch if E_constraint { printf "caught\n"; } } } 
*/
+/* { dg-command { try Foo { i = 0 }; catch if E_constraint { printf 
"caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/scons-union-10.pk 
b/testsuite/poke.pkl/scons-union-10.pk
new file mode 100644
index 00000000..591794d9
--- /dev/null
+++ b/testsuite/poke.pkl/scons-union-10.pk
@@ -0,0 +1,12 @@
+/* { dg-do run } */
+
+type Foo = union { byte b : b > 0; int i; };
+
+/* { dg-command {try Foo {b = 0}; catch if E_constraint { printf "caught\n"; 
}} } */
+/* { dg-output "caught" } */
+/* { dg-command {Foo {b = 2}} } */
+/* { dg-output "\nFoo {b=2UB}" } */
+/* { dg-command {Foo {i = 3}} } */
+/* { dg-output "\nFoo {i=3}" } */
+/* { dg-command {Foo {}} } */
+/* { dg-output "\nFoo {i=0}" } */
diff --git a/testsuite/poke.pkl/scons-union-2.pk 
b/testsuite/poke.pkl/scons-union-2.pk
index 4021963a..e5866866 100644
--- a/testsuite/poke.pkl/scons-union-2.pk
+++ b/testsuite/poke.pkl/scons-union-2.pk
@@ -2,5 +2,5 @@
 
 type Bar = union { int i : i != 0; long l : l == 0; };
 
-/* { dg-command { Bar { } } } */
-/* { dg-output "Bar \{l=0L\}" } */
+/* { dg-command { try Bar { i = 0 }; catch if E_constraint { printf 
"caught\n"; } } } */
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/scons-union-3.pk 
b/testsuite/poke.pkl/scons-union-3.pk
index 9f32f6b7..5cea446b 100644
--- a/testsuite/poke.pkl/scons-union-3.pk
+++ b/testsuite/poke.pkl/scons-union-3.pk
@@ -8,5 +8,5 @@ type Bar =
     int c : c == 2;
   };
 
-/* { dg-command { Bar { } } } */
+/* { dg-command { Bar { a = 0 } } } */
 /* { dg-output "Bar \{a=0\}" } */
diff --git a/testsuite/poke.pkl/scons-union-5.pk 
b/testsuite/poke.pkl/scons-union-5.pk
index 5c42d73c..ca6feef1 100644
--- a/testsuite/poke.pkl/scons-union-5.pk
+++ b/testsuite/poke.pkl/scons-union-5.pk
@@ -8,5 +8,5 @@ type Bar =
     int c : c == 2;
   };
 
-/* { dg-command { Bar { a = 2, b = 1 } } } */
+/* { dg-command { Bar { b = 1 } } } */
 /* { dg-output "Bar \{b=1\}" } */
diff --git a/testsuite/poke.pkl/scons-union-6.pk 
b/testsuite/poke.pkl/scons-union-6.pk
index 2b15bde7..f4106073 100644
--- a/testsuite/poke.pkl/scons-union-6.pk
+++ b/testsuite/poke.pkl/scons-union-6.pk
@@ -8,5 +8,5 @@ type Bar =
     int c : c == 2;
   };
 
-/* { dg-command { Bar { c = 2, a = 20 } } } */
+/* { dg-command { Bar { c = 2 } } } */
 /* { dg-output "Bar \{c=2\}" } */
diff --git a/testsuite/poke.pkl/scons-union-7.pk 
b/testsuite/poke.pkl/scons-union-7.pk
index 904ab129..b722f53f 100644
--- a/testsuite/poke.pkl/scons-union-7.pk
+++ b/testsuite/poke.pkl/scons-union-7.pk
@@ -8,5 +8,5 @@ type Bar =
     int c : c == 2;
   };
 
-/* { dg-command { try Bar { a = 100, c = 20 }; catch if E_constraint { printf 
"caught\n"; } } } */
+/* { dg-command { try Bar { c = 20 }; catch if E_constraint { printf 
"caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/scons-union-8.pk 
b/testsuite/poke.pkl/scons-union-8.pk
index f9e319c9..8734e06e 100644
--- a/testsuite/poke.pkl/scons-union-8.pk
+++ b/testsuite/poke.pkl/scons-union-8.pk
@@ -10,5 +10,5 @@ type Bar =
     int c : N == 2;
   };
 
-/* { dg-command { Bar { } } } */
+/* { dg-command { Bar { b = 0 } } } */
 /* { dg-output "Bar \{b=0\}" } */
diff --git a/testsuite/poke.pkl/scons-union-9.pk 
b/testsuite/poke.pkl/scons-union-9.pk
new file mode 100644
index 00000000..c59b117f
--- /dev/null
+++ b/testsuite/poke.pkl/scons-union-9.pk
@@ -0,0 +1,14 @@
+/* { dg-do run } */
+
+var N = 1;
+
+type Bar =
+  union
+  {
+    int a : N == 0;
+    int b : N == 1;
+    int c : N == 2;
+  };
+
+/* { dg-command { try Bar { c = 0 }; catch if E_constraint { printf 
"caught\n"; } } } */
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/scons-union-diag-1.pk 
b/testsuite/poke.pkl/scons-union-diag-1.pk
new file mode 100644
index 00000000..aaa52e71
--- /dev/null
+++ b/testsuite/poke.pkl/scons-union-diag-1.pk
@@ -0,0 +1,4 @@
+/* { dg-do compile } */
+
+type Foo = union { byte b : b > 0; int i; };
+Foo { b = 0, i = 0 }; /* { dg-error "exactly one" } */
-- 
2.25.0.2.g232378479e