The structural printer reads only the case in hand

print, the REPL inspector and the break buffer's locals all walk a concrete
type through render.ml, and a union fell through its Named arm to <Shape>.
It now recovers the case from the tag by a chain of comparisons -- the same
shape the enum arm already had, and for the same reason: the name is erased
before any backend sees it -- and reads the fields of that case only. Reading
the others would be reading a payload that is not there.

It prints (Shape.Dot {.x 1.5 .y -2.5}), which is what the source would write.

The union table has to reach the walk, so Render.ctx grew a field and its
three construction sites in session.ml and one in check.ml pass it. That is
the whole of the session.ml change.

test/programs/unions.flan is the program: a case with no fields, a case wider
than another, a case holding a string, a union in a struct, a union through a
call in both directions, ZII, reassignment, and printing. Its layout was
checked against clang's for the same declaration -- 32 bytes aligned 8 with
the payload at offset 8, and 40/8 for the struct holding it.

lib/check.ml

@@ -1121,7 +1121,8 @@ and var ctx loc ~want name =
                (Tast.MakeCase (uname, c.Tast.vname, [])))
         | Some (uname, c) ->
           fail loc
-            "%s is a case of the union %s, and a union value names both —              write %s.%s" name uname uname c.Tast.vname
+            "%s is a case of the union %s, and a union value names both — \
+             write %s.%s" name uname uname c.Tast.vname
         | None ->
           if Hashtbl.mem ctx.env.fns name then
             unimplemented loc
@@ -1479,12 +1480,14 @@ and check_struct ctx ~want loc name kvs =
         misspelling. It can now, so it says what was meant. *)
      | Some (uname, c) ->
        fail loc
-         "%s is a case of the union %s, not a struct — a union value names           both, as (%s.%s {.field value ...})"
+         "%s is a case of the union %s, not a struct — a union value names \
+          both, as (%s.%s {.field value ...})"
          name uname uname c.Tast.vname
      | None ->
        if Hashtbl.mem ctx.env.unions name then
          fail loc
-           "%s is a union, and a union value names the case as well as the             type — write (%s.%s {.field value ...}) for one of %s"
+           "%s is a union, and a union value names the case as well as the \
+            type — write (%s.%s {.field value ...}) for one of %s"
            name name (first_case_name ctx.env name) (case_list ctx.env name)
        else fail loc "unknown struct %s" name)
   | Some s ->
@@ -3116,6 +3119,7 @@ and named_call ctx ~want loc name args =
     let rc =
       { Render.structs =
           Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.structs [];
+        unions = Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.unions [];
         enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) ctx.env.enums [];
         emit = emitter;
         alloc = (fun ty -> fresh_slot ctx ty) }
@@ -3219,7 +3223,8 @@ and named_call ctx ~want loc name args =
            reaches for a constructor, and neither is one. *)
         let uname, c = Hashtbl.find ctx.env.cases name in
         fail loc
-          "%s is a case of the union %s — write (%s.%s {.field value ...}),            or %s.%s on its own when it has no fields"
+          "%s is a case of the union %s — write (%s.%s {.field value ...}), \
+           or %s.%s on its own when it has no fields"
           name uname uname c.Tast.vname uname c.Tast.vname
       else if Hashtbl.mem ctx.env.structs name then
         fail loc

lib/render.ml

@@ -35,6 +35,10 @@ type emitter = {
 
 type ctx = {
   structs : Tast.structure list;
+  (* The declared unions. [Types.Named] covers a struct and a union alike, so
+     which list the name is in is what says which this is — the same
+     arrangement the checker and the emitter use. *)
+  unions  : Tast.union list;
   enums   : (string * (string * int64) list) list;
   emit    : emitter;
   (* A slot in the *caller's* frame. Only the slice arm needs one, and it needs
@@ -132,6 +136,59 @@ let rec render c depth (e : Tast.expr) : Tast.expr list =
           (Tast.If (is_some,
                     do_ ((lit "(some " :: render c (depth + 1) some) @ [ lit ")" ]),
                     lit "none")) ]
+    (* A union, printed as the source would write it: the case is recovered
+       from the tag by a chain of comparisons, exactly as an enum's member name
+       is, and only the case in hand has its fields read. Reading the others
+       would be reading a payload that is not there. *)
+    | Types.Named n
+      when List.exists (fun (u : Tast.union) -> String.equal u.Tast.uname n)
+             c.unions ->
+      let u =
+        List.find (fun (u : Tast.union) -> String.equal u.Tast.uname n) c.unions
+      in
+      let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I32; loc } in
+      let one i (v : Tast.variant) otherwise =
+        let is =
+          { Tast.e =
+              Tast.Prim (Tast.Eq,
+                         [ tag; { Tast.e = Tast.Int (Int64.of_int i, Types.I32);
+                                  ty = Types.Int Types.I32; loc } ]);
+            ty = Types.Bool; loc }
+        in
+        let full = n ^ "." ^ v.Tast.vname in
+        let body =
+          if v.Tast.vfields = [] then lit full
+          else
+            let shown = List.filteri (fun i _ -> i < max_span) v.Tast.vfields in
+            let parts =
+              List.concat
+                (List.mapi
+                   (fun i (f : Tast.field) ->
+                      let fv =
+                        { Tast.e = Tast.CaseField (e, v.Tast.vname, i);
+                          ty = f.Tast.fty; loc }
+                      in
+                      (if i = 0 then [] else [ lit " " ])
+                      @ [ lit ("." ^ f.Tast.fname ^ " ") ]
+                      @ render c (depth + 1) fv)
+                   shown)
+            in
+            do_ ((lit ("(" ^ full ^ " {") :: parts)
+                 @ (if List.length v.Tast.vfields > max_span then [ lit " ..." ]
+                    else [])
+                 @ [ lit "})" ])
+        in
+        unit_ (Tast.If (is, body, otherwise))
+      in
+      (* The fallback is a tag no case names, which only a scribbled-over union
+         could hold. Showing the number is more use than showing a case it is
+         not. *)
+      let base =
+        do_ [ lit ("<" ^ n ^ " tag ");
+              c.emit.ei64 (cast (Types.Int Types.I64) tag); lit ">" ]
+      in
+      [ List.fold_left (fun acc x -> x acc) base
+          (List.rev (List.mapi one u.Tast.cases)) ]
     | Types.Named n ->
       (match
          List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n)

lib/session.ml

@@ -463,6 +463,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
   let extra = ref [] and nslots = ref 0 in
   let c =
     { Render.structs = t.program.Tast.structs;
+      unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
       emit = dev_emitter;
       alloc = (fun ty ->
@@ -582,6 +583,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
   let extra = ref [] and nslots = ref 0 in
   let c =
     { Render.structs = t.program.Tast.structs;
+      unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
       emit = dev_emitter;
       alloc = (fun ty ->
@@ -651,6 +653,7 @@ let eval_expr ?(origin = "<eval>") t src : change =
   let extra = ref [] and nslots = ref (Array.length base) in
   let c =
     { Render.structs = t.program.Tast.structs;
+      unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
       emit = dev_emitter;
       alloc = (fun ty ->

test/programs/unions.flan

@@ -0,0 +1,78 @@
+;;;; Union values: declaring one, making one, matching one, printing one.
+;;;;
+;;;; The layout claim is the load-bearing one, so it is asserted rather than
+;;;; described: a union is a tag and room for the largest case, aligned to the
+;;;; widest member of any case, which is C's struct { int tag; union {...}; }.
+;;;; That is what the macro expander will need to agree with byte for byte, so
+;;;; `Shape` here is deliberately the shape a Form has: a case with no fields,
+;;;; a case whose members are wider than another's, and a case holding a
+;;;; string -- the three things a payload blob has to hold without disturbing
+;;;; the alignment of any of them.
+
+(defunion Shape
+  [Empty
+   (Dot   [x f64  y f64])
+   (Rect  [w i32  h i32])
+   (Tag   [name string  n u8])])
+
+;; A union crosses a call boundary in both directions, as a parameter and as a
+;; return type -- a value that cannot do that is not a value.
+(defn area [s Shape] f64
+  (match s
+    (Rect w h) (* (f64 w) (f64 h))
+    (Dot _x _y) 0.0
+    _ -1.0))
+
+(defn widen [n i32] Shape (Shape.Rect {.w n .h (* n 2)}))
+
+;; A union as a struct field, which is the path that makes its size and
+;; alignment visible to something other than a slot.
+(defstruct Cell [id i32  s Shape])
+
+(defn describe [s Shape] string
+  (match s
+    Empty "empty"
+    (Dot x y) (if (= x y) "dot on the diagonal" "dot")
+    (Rect w h) (if (= w h) "square" "rect")
+    (Tag name n) name))
+
+(defn main [] i32
+  ;; A case with no fields is a whole value and is written as a name.
+  (println (describe Shape.Empty))
+  (println (describe (Shape.Dot {.x 2.0 .y 2.0})))
+  (println (describe (Shape.Dot {.x 1.0 .y 2.0})))
+  (println (describe (Shape.Rect {.w 3 .h 3})))
+  (println (describe (Shape.Tag {.name "tagged" .n 7})))
+
+  ;; ZII: omitted fields are zeroed, exactly as in a struct literal.
+  (println (describe (Shape.Rect {.w 0})))
+
+  ;; Returned from a call, then matched.
+  (print (i64 (area (widen 4)))) (println "")
+  (print (i64 (area (Shape.Dot {.x 9.0 .y 9.0})))) (println "")
+  (print (i64 (area Shape.Empty))) (println "")
+
+  ;; Through a struct field, and copied: assigning a Cell copies the union's
+  ;; bytes, so the copy's payload must be the original's.
+  (let [c (Cell {.id 1 .s (Shape.Tag {.name "in a cell" .n 3})})
+        d c]
+    (println (describe (.s d)))
+    ;; A zeroed union is the first declared case -- Empty -- which is what
+    ;; makes case order part of the contract.
+    (let [z (Cell {.id 2})]
+      (println (describe (.s z)))))
+
+  ;; A local assigned a second case: the tag moves and the payload is rewritten.
+  (let [v Shape.Empty]
+    (set v (Shape.Rect {.w 5 .h 6}))
+    (print (i64 (area v))) (println "")
+    (set v (Shape.Tag {.name "reassigned" .n 1}))
+    (println (describe v)))
+
+  ;; The structural printer, which reads only the case in hand: the other
+  ;; cases' fields are not there to read.
+  (print Shape.Empty) (println "")
+  (print (Shape.Dot {.x 1.5 .y -2.5})) (println "")
+  (print (Shape.Tag {.name "printed" .n 9})) (println "")
+  (print (Cell {.id 7 .s (Shape.Rect {.w 1 .h 2})})) (println "")
+  0)