;;;; 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.

(defdata 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))

;; A union that names itself through a pointer. check_finite refuses one that
;; contains itself by value -- the emitter would recurse forever laying it out
;; -- and this is the shape that works instead.
(defdata Tree [Leaf (Node [l (Ptr Tree)  n i32])])

(defn depth [t (Ptr Tree)] i32
  (match (deref t)
    Leaf 0
    (Node l n) (+ n (depth l))))

(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)))

  ;; Recursive through a pointer, which is the shape a Form has: a union that
  ;; contains itself by value has no size and is refused, and (Ptr T) is what
  ;; breaks the cycle. 5 + 10 + 0.
  (let [leaf Tree.Leaf
        mid  (Tree.Node {.l (addr leaf) .n 10})
        top  (Tree.Node {.l (addr mid)  .n 5})]
    (print (depth (addr top))) (println ""))

  ;; 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 "")

  ;; A union names an element type the same way a struct does. It reads as
  ;; trivia and it was not: the type-name test (vec-new) and (map-new) use to
  ;; read a leading bare symbol listed structs, enums, aliases and primitives
  ;; and not unions, so (vec-new Shape) was refused for not saying what it
  ;; held -- by a program that had said.
  (let [vs (vec-new Shape)
        ms (map-new string Shape)]
    (push vs (Shape.Rect {.w 2 .h 3}))
    (push vs Shape.Empty)
    (put ms "only" (Shape.Tag {.name "in a map" .n 1}))
    (print (i64 (area (at vs 0)))) (println "")
    (println (describe (at vs 1)))
    (println (match (get ms "only") (Some s) (describe s) None "missing")))
  0)