diff --git a/src/arrange_ir.ml b/src/arrange_ir.ml index 959ba29539c..b38b3469630 100644 --- a/src/arrange_ir.ml +++ b/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)] diff --git a/src/parser.mly b/src/parser.mly index 2fbaf92c7f4..03f1aabe016 100644 --- a/src/parser.mly +++ b/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 } diff --git a/src/prelude.ml b/src/prelude.ml index 698702f2e3f..8ed2b65a873 100644 --- a/src/prelude.ml +++ b/src/prelude.ml @@ -151,7 +151,9 @@ func @text_of_option(f : T -> Text, x : ?T) : Text { }; func @text_of_variant(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(f : T -> Text, xs : [T]) : Text { diff --git a/src/show.ml b/src/show.ml index d3900cf03ed..216bba835e2 100644 --- a/src/show.ml +++ b/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 diff --git a/src/type.ml b/src/type.ml index f2261cc5c3e..9604b955e46 100644 --- a/src/type.ml +++ b/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 diff --git a/src/value.ml b/src/value.ml index 4ac8f9a5556..8b6b5891730 100644 --- a/src/value.ml +++ b/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 diff --git a/test/run/ok/show.run-ir.ok b/test/run/ok/show.run-ir.ok index 9ebf68ef2fa..e8ff1dc78ab 100644 --- a/test/run/ok/show.run-ir.ok +++ b/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) diff --git a/test/run/ok/show.run-low.ok b/test/run/ok/show.run-low.ok index 9ebf68ef2fa..e8ff1dc78ab 100644 --- a/test/run/ok/show.run-low.ok +++ b/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) diff --git a/test/run/ok/show.run.ok b/test/run/ok/show.run.ok index 9ebf68ef2fa..e8ff1dc78ab 100644 --- a/test/run/ok/show.run.ok +++ b/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) diff --git a/test/run/variants.as b/test/run/variants.as index 4c67aaede2c..23bc76cb0b6 100644 --- a/test/run/variants.as +++ b/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)")