AST-76: implement shorthand variants with unit payload

src/arrange_ir.ml

@@ -14,7 +14,7 @@ let rec exp e = match e.it with
   | UnE (t, uo, e)      -> "UnE"     $$ [typ t; Arrange.unop uo; exp e]
   | BinE (t, e1, bo, e2)-> "BinE"    $$ [typ t; exp e1; Arrange.binop bo; exp e2]
   | RelE (t, e1, ro, e2)-> "RelE"    $$ [typ t; exp e1; Arrange.relop ro; exp e2]
-  | ShowE (t, e)        -> "ShowE"     $$ [typ t; exp e]
+  | ShowE (t, e)        -> "ShowE"   $$ [typ t; exp e]
   | TupE es             -> "TupE"    $$ List.map exp es
   | ProjE (e, i)        -> "ProjE"   $$ [exp e; Atom (string_of_int i)]
   | DotE (e, n)         -> "DotE"    $$ [exp e; Atom (name n)]

src/parser.mly

@@ -268,8 +268,8 @@ typ_field :
       {id = x; typ = t; mut = Const @@ no_region} @@ at $sloc }
 
 typ_tag :
-  | i=variant_tag COLON t=typ
-    { (i, t) }
+  | i=variant_tag t=return_typ_nullary?
+    { (i, Lib.Option.get t (TupT [] @! at $sloc)) }
 
 typ_bind :
   | x=id SUB t=typ
@@ -351,6 +351,8 @@ exp_nullary :
     { VarE(x) @? at $sloc }
   | l=lit
     { LitE(ref l) @? at $sloc }
+  | i=variant_tag
+    { VariantE (i, TupE([]) @? at $sloc) @? at $sloc }
   | LPAR es=seplist(exp, COMMA) RPAR
     { match es with [e] -> e | _ -> TupE(es) @? at $sloc }
   | PRIM s=TEXT
@@ -500,6 +502,8 @@ pat_nullary :
     { VarP(x) @! at $sloc }
   | l=lit
     { LitP(ref l) @! at $sloc }
+  | i=variant_tag
+    { VariantP(i, TupP [] @! at $sloc) @! at $sloc }
   | LPAR ps=seplist(pat_bin, COMMA) RPAR
     { (match ps with [p] -> ParP(p) | _ -> TupP(ps)) @! at $sloc }
 

src/prelude.ml

@@ -151,7 +151,9 @@ func @text_of_option<T>(f : T -> Text, x : ?T) : Text {
 };
 
 func @text_of_variant<T>(l : Text, f : T -> Text, x : T) : Text {
-  "(#" # l # " " # f x # ")"
+  let fx = f x;
+  if (fx == "()") "#" # l
+  else "(#" # l # " " # fx # ")"
 };
 
 func @text_of_array<T>(f : T -> Text, xs : [T]) : Text {

src/show.ml

@@ -414,6 +414,7 @@ let rec show_val t v =
     Printf.sprintf "{%s}" (String.concat "; " (List.map (show_field fs) fts))
   | T.Variant cts, Value.Variant (l, v) ->
     begin match List.find_opt (fun (l',t) -> l = l') cts with
+    | Some (_, T.Tup []) -> Printf.sprintf "#%s" l
     | Some (_, t') -> Printf.sprintf "(#%s %s)" l (show_val t' v)
     | _ -> assert false
     end

src/type.ml

@@ -756,8 +756,9 @@ and string_of_typ' vs t =
 and string_of_field vs {lab; typ} =
   sprintf "%s : %s" lab (string_of_typ' vs typ)
 
-and string_of_summand vs (tag, typ) =
-  sprintf "#%s : %s" tag (string_of_typ' vs typ)
+and string_of_summand vs = function
+  | (tag, Tup []) -> sprintf "#%s" tag
+  | (tag, typ) -> sprintf "#%s : %s" tag (string_of_typ' vs typ)
 
 and vars_of_binds vs bs =
   List.map (fun b -> name_of_var vs (b.var, 0)) bs

src/value.ml

@@ -387,6 +387,7 @@ let rec string_of_val_nullary d = function
     sprintf "[%s]" (String.concat ", "
       (List.map (string_of_val' d) (Array.to_list a)))
   | Func (_, _) -> "func"
+  | Variant (l, Tup []) -> sprintf "#%s" l
   | v -> "(" ^ string_of_val' d v ^ ")"
 
 and string_of_val' d = function
@@ -395,7 +396,7 @@ and string_of_val' d = function
   | Async {result; waiters} ->
     sprintf "async[%d] %s"
       (List.length waiters) (string_of_def_nullary d result)
-  | Variant (l, v) ->
+  | Variant (l, v) when v <> unit ->
     sprintf "#%s %s" l (string_of_val_nullary d v)
   | Mut r -> sprintf "%s" (string_of_val' d !r)
   | v -> string_of_val_nullary d v

test/run/ok/show.run-ir.ok

@@ -8,6 +8,6 @@ false
 [var 1, 2, 3]
 {bar = true; foo = 42}
 {bar = true; foo = 42}
-(#foo ())
+#foo
 (#bar 42)
 (#foo 42)

test/run/ok/show.run-low.ok

@@ -8,6 +8,6 @@ false
 [var 1, 2, 3]
 {bar = true; foo = 42}
 {bar = true; foo = 42}
-(#foo ())
+#foo
 (#bar 42)
 (#foo 42)

test/run/ok/show.run.ok

@@ -8,6 +8,6 @@ false
 [var 1, 2, 3]
 {bar = true; foo = 42}
 {bar = true; foo = 42}
-(#foo ())
+#foo
 (#bar 42)
 (#foo 42)

test/run/variants.as

@@ -32,3 +32,21 @@ type C = { #foo : Int; };
 type D = { #foo : Int; #bar : Char };
 type E = { #foo : Int; #bar : Char; };
 type F = { #foo : Int; #bar : Char; #daz : Bool };
+
+// lightweight (enumeration-like) variants
+
+type Weekday = { #Monday; #Tuesday; #Wednesday; #Thursday; #Friday; #Saturday; #Sunday };
+
+func sayIcelandic (day : Weekday) : Text = switch day {
+  case #Monday "Mánudagur";
+  case #Tuesday "Þriðjudagur";
+  case #Wednesday "Miðvikudagur";
+  case #Thursday "Fimmtudagur";
+  case #Friday "Föstudagur";
+  case #Saturday "Laugardagur";
+  case #Sunday "Sunnudagur"
+};
+
+assert (sayIcelandic #Wednesday == "Miðvikudagur");
+
+assert (debug_show (#foo #bar) == "(#foo #bar)")