From e9e151e1a478c6e28e4a906890f926bc44e6f7d2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:33:22 +0700 Subject: [PATCH] A match over an enum names its members as keywords and is refused when it misses one --- TODO.org | 10 +++-- lib/ast.ml | 1 + lib/check.ml | 83 ++++++++++++++++++++++++++++------- lib/load.ml | 2 +- lib/parse.ml | 14 ++---- test/programs/match-enum.flan | 36 +++++++++++++++ test/test_acceptance.ml | 12 +++++ test/test_flan.ml | 43 ++++++++++++------ 8 files changed, 156 insertions(+), 45 deletions(-) create mode 100644 test/programs/match-enum.flan diff --git a/TODO.org b/TODO.org index 7d72ce13..24edcfed 100644 --- a/TODO.org +++ b/TODO.org @@ -291,9 +291,13 @@ keyword resolves against the expected type and against nothing else, so two enum could always share a member spelling. What the prefix buys is the call site read on its own. -** TODO match over enums -Fully desugarable and wanted, blocked only on =Ast.pattern= needing a keyword -case. +** DONE match over enums +CLOSED: [2026-09-25] +=Ast.Pkw= is the keyword pattern; =Check.check_match= resolves it against the +scrutinee's enum and lowers the match to one temporary and a chain of =if (= t +:member)=, the last arm untested. Exhaustiveness is the data type's rule: refused, +not defaulted. Rules out a new IR node for it, and a keyword arm over an Option or +a data type. ** DONE defdata is the tagged sum, defunion is C's untagged one CLOSED: [2026-09-17] diff --git a/lib/ast.ml b/lib/ast.ml index 41708a09..459bd53d 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -204,6 +204,7 @@ and arm = { pat : pattern; body : expr list; aloc : Loc.t } and pattern = | Pctor of string * string list (* (Some e) (Rect w h) None *) + | Pkw of string (* :north — an enum member *) | Pwild (* _ :else *) (* ── Declarations ──────────────────────────────────────────────────── *) diff --git a/lib/check.ml b/lib/check.ml index 64e43869..892caf11 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -5639,17 +5639,11 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | Types.Option t -> `Option t | Types.Named n when Hashtbl.mem ctx.env.datas n -> `Data (Hashtbl.find ctx.env.datas n) - (* An enum is the one scrutinee that is not a milestone away: it is an i32 - at run time and its members are all known, so the arms would be a chain - of [=] with an exhaustiveness check over [env.enums] — a desugaring, not - a new IR node. What blocks it is upstream of here: a keyword has no case - in [Ast.pattern], and [lib/load.ml] matches that type exhaustively, so - the variant cannot be added. Said as itself rather than folded into the - milestone answer below, because the milestone is not the reason. *) - | Types.Enum n -> - fail loc - "match over the enum %s is not implemented — use cond with \ - (= k :member)" n + (* An enum is an i32 at run time and its members are all known, so the + arms are a chain of [=] over a temporary, built at the foot of this + function — a desugaring, not a new IR node. The exhaustiveness check is + the one a data type gets. *) + | Types.Enum n -> `Enum (n, Hashtbl.find ctx.env.enums n) (* An untagged union has nothing for the arms to be alternatives over. This is not a milestone and not a missing lowering: [match] reads a tag and decides, and the absence of a tag is the whole definition of this @@ -5661,7 +5655,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = so there is nothing to match on. Read the member you mean with \ (.member u), or use a defdata" n | other -> - fail loc "match works on an Option or a data type, not on %s" + fail loc "match works on an Option, a data type or an enum, not on %s" (Types.to_string other) in (* Which case each arm names, and the type of each name it binds. This is the @@ -5678,6 +5672,33 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | `Option _, Ast.Pctor (c, _) -> fail a.Ast.aloc "%s is not a case of Option — the cases are Some and None" c + | `Enum (n, members), Ast.Pkw k -> + if not (List.mem_assoc k members) then begin + let all = + String.concat " " (List.map (fun (m, _) -> ":" ^ m) members) + in + match member_near_miss members k with + | Some (m, _) -> + fail a.Ast.aloc "%s has no member :%s — did you mean :%s? It has %s" + n k m all + | None -> fail a.Ast.aloc "%s has no member :%s — it has %s" n k all + end; + Some k, [] + | `Enum (n, members), Ast.Pctor (c, _) -> + fail a.Ast.aloc + "this match is over the enum %s, and %s is not one of its members. An \ + arm names a member as a keyword: %s" n c + (String.concat " " (List.map (fun (m, _) -> ":" ^ m) members)) + | `Option _, Ast.Pkw k -> + fail a.Ast.aloc + ":%s is an enum member, and this match is over an Option, whose arms \ + are (Some x) and None" k + | `Data u, Ast.Pkw k -> + fail a.Ast.aloc + ":%s is an enum member, and this match is over the data type %s, \ + whose arms name its cases: %s" k u.Tast.dname + (String.concat ", " + (List.map (fun (v : Tast.variant) -> v.Tast.vname) u.Tast.cases)) | `Data u, Ast.Pctor (c, names) -> (* A pattern names the case bare: the scrutinee's type already says which data type, so [(Node l r)] is unambiguous even where two data types @@ -5727,7 +5748,8 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | None -> saw_wild := true | Some c -> if Hashtbl.mem seen c then - fail a.Ast.aloc "this match has two %s arms" c; + fail a.Ast.aloc "this match has two %s arms" + (match subject with `Enum _ -> ":" ^ c | _ -> c); Hashtbl.add seen c ()); branch ctx (fun () -> (* What each name in this arm is, in words, for the one refusal @@ -5780,21 +5802,50 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = if Hashtbl.mem seen c.Tast.vname then None else Some (u.Tast.dname ^ "." ^ c.Tast.vname)) u.Tast.cases + | `Enum (_, members) -> + List.filter_map + (fun (m, _) -> if Hashtbl.mem seen m then None else Some (":" ^ m)) + members in if not !saw_wild && missing <> [] then (* The data type's declaration, because that is where the case list this match failed to cover actually lives, and because adding a case there is what makes a match non-exhaustive in the first place. *) Loc.failk "check/non-exhaustive-match" loc - ~notes:(match subject with `Data u -> declared_note ctx.env u.Tast.dname - | _ -> []) + ~notes:(match subject with + | `Data u -> declared_note ctx.env u.Tast.dname + | `Enum (n, _) -> declared_note ctx.env n + | `Option _ -> []) "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \ the rest" (String.concat ", " missing) (if List.length missing = 1 then "has" else "have") (if List.length missing = 1 then "it" else "them"); let ty = match !want with Some t -> t | None -> Types.Never in - mk loc ty (Tast.Match (s, arms)) + match subject with + | `Option _ | `Data _ -> mk loc ty (Tast.Match (s, arms)) + | `Enum (_, members) -> + (* The scrutinee once, into a temporary, and then an [if] per arm in the + order written. A [_] arm ends the chain, and so does the last arm of a + match with none: it is exhaustive by the check above, so the last + member's test is the only one left and cannot fail on a value the enum + declares. *) + let slot = fresh_slot ctx s.Tast.ty in + let local = mk loc s.Tast.ty (Tast.Local slot) in + let body (a : Tast.arm) = + match a.Tast.abody with [ b ] -> b | bs -> mk loc ty (Tast.Do bs) + in + let rec chain = function + | [] -> unit_at loc + | ({ Tast.acase = None; _ } as a) :: _ -> body a + | [ a ] -> body a + | ({ Tast.acase = Some m; _ } as a) :: rest -> + let v = mk loc s.Tast.ty (Tast.Int (List.assoc m members, Types.I32)) in + mk loc ty + (Tast.If (mk loc Types.Bool (Tast.Prim (Tast.Eq, [ local; v ])), + body a, chain rest)) + in + mk loc ty (Tast.Let ([ (slot, s) ], [ chain arms ])) (* ── Places ────────────────────────────────────────────────────────── *) diff --git a/lib/load.ml b/lib/load.ml index a3f28a9b..17d9b0c8 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -263,7 +263,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = let bound = match a.Ast.pat with | Ast.Pctor (_, ns) -> ns @ bound - | Ast.Pwild -> bound + | Ast.Pkw _ | Ast.Pwild -> bound in { a with Ast.body = List.map (rename_expr owned alias bound) a.Ast.body }) arms) diff --git a/lib/parse.ml b/lib/parse.ml index 3402fa32..3458841b 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1187,17 +1187,9 @@ and pattern (f : Form.t) : Ast.pattern = | Sym "_" -> Ast.Pwild | Kw "else" -> Ast.Pwild | Sym ctor -> Ast.Pctor (ctor, []) - (* An enum member, which is the one other thing [match] could plausibly be - over: an enum is an i32 at run time, so the arms would be a chain of [=] - and the members are all known, which is exhaustiveness [cond] cannot give. - What stops it is not the lowering, it is that a keyword pattern needs a - case in [Ast.pattern] — and [lib/load.ml] matches that type exhaustively, - so the variant cannot be added from here. Refused by name rather than - spelled as a constructor it is not. *) - | Kw member -> - fail f - ":%s is not implemented as a pattern — use cond with (= k :%s)" - member member + (* An enum member. Which enum is the scrutinee's type, so [Check] resolves + it, as it resolves a keyword anywhere an enum is expected. *) + | Kw member -> Ast.Pkw member | List ({ v = Sym ctor; _ } :: binds) -> List.iter no_pattern binds; Ast.Pctor (ctor, List.map sym binds) diff --git a/test/programs/match-enum.flan b/test/programs/match-enum.flan new file mode 100644 index 00000000..01123a06 --- /dev/null +++ b/test/programs/match-enum.flan @@ -0,0 +1,36 @@ +;;;; match over an enum: the arms name members as keywords, a _ arm is the +;;;; rest, and a match that names neither every member nor _ is refused. + +(defenum Dir [north east south west]) + +(defn turn [d Dir] Dir + (match d + :north :east + :east :south + :south :west + :west :north)) + +(defn name [d Dir] string + (match d + :north "north" + :south "south" + _ "sideways")) + +(defn calls [] i32 + (print "(called) ") + 0) + +;; The scrutinee is evaluated once, however many arms test it. +(defn once [] Dir + (calls) + :west) + +(defn main [] i32 + (println (name :north)) + (println (name (turn :north))) + (println (name (turn (turn :north)))) + (println (name (once))) + (match (turn :west) + :north (println "back to north") + _ (println "somewhere else")) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 005fad8d..66c2d732 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -420,6 +420,18 @@ let () = chain_out; outputs ~x86:true "chained comparisons, --x86" "programs/chain.flan" chain_out; + (* match over an enum lowers to a chain of [=] over one temporary, so + "(called) " printed once is the scrutinee evaluated once. *) + let match_enum_out = + "north\nsideways\nsouth\n(called) sideways\nback to north\n" + in + outputs "match over an enum" "programs/match-enum.flan" match_enum_out; + outputs ~opt:"-O0" "match over an enum, -O0" "programs/match-enum.flan" + match_enum_out; + outputs ~x86:true "match over an enum, --x86" "programs/match-enum.flan" + match_enum_out; + outputs ~dev:true "match over an enum, dev" "programs/match-enum.flan" + match_enum_out; (* The count is [length] so that [len] is left to programs, and this is the claim that it really is one: a local holding a count, a parameter, and a defn the program calls by its bare name, all of diff --git a/test/test_flan.ml b/test/test_flan.ml index 4772008a..1121dbc2 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -4091,22 +4091,37 @@ let () = (* ── match over an enum ────────────────────────────────────────── *) - (* Not shipped, and refused twice over because there are two ways to write it - and they fail in different files. Both now say the same thing, which is the - point: the lowering is not what is missing — a keyword has no case in - [Ast.pattern], and [lib/load.ml] matches that type exhaustively. *) - rejects_check "match over an enum, members written as keywords" - "(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k :lo 1 :hi 2))" - ~needle:"is not implemented as a pattern"; + (* The arms name members as keywords, and the lowering is a chain of [=] + over one temporary, so the exhaustiveness rule is the data type's: + refused, not defaulted. *) + let k = "(defenum K [lo 0 hi 1 mid 2])\n" in + accepts "match over an enum, every member named" + (k ^ "(defn f [k K] i32 (match k :lo 1 :hi 2 :mid 3))"); + accepts "match over an enum, with _ for the rest" + (k ^ "(defn f [k K] i32 (match k :lo 1 _ 2))"); + accepts "match over an enum, :else for the rest" + (k ^ "(defn f [k K] i32 (match k :lo 1 :else 2))"); + rejects_check "match over an enum that misses a member" + (k ^ "(defn f [k K] i32 (match k :lo 1 :hi 2))") + ~needle:"this match is not exhaustive — :mid has no arm"; + rejects_check "a member the enum does not have" + (k ^ "(defn f [k K] i32 (match k :low 1 _ 2))") + ~needle:"K has no member :low — did you mean :lo?"; + rejects_check "a member named twice" + (k ^ "(defn f [k K] i32 (match k :lo 1 :lo 2 _ 3))") + ~needle:"this match has two :lo arms"; rejects_check "match over an enum, members written as names" - "(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k lo 1 hi 2))" - ~needle:"match over the enum K is not implemented"; - (* The old message blamed milestone 2, which was never the reason, and the - milestone has since arrived: match now works over a declared data type as - well, so the message names both subjects and no milestone. *) - rejects_check "match over something that is neither" + (k ^ "(defn f [k K] i32 (match k lo 1 _ 2))") + ~needle:"lo is not one of its members. An arm names a member as a keyword: :lo :hi :mid"; + rejects_check "a keyword arm over an Option" + "(defn f [o (Option i32)] i32 (match o :lo 1 _ 2))" + ~needle:"whose arms are (Some x) and None"; + rejects_check "arms of different types" + (k ^ "(defn f [k K] i32 (match k :lo 1 _ \"x\"))") + ~needle:"expected i32, found string"; + rejects_check "match over something that is none of them" "(defn f [n i32] i32 (match n _ 2))" - ~needle:"match works on an Option or a data type, not on i32"; + ~needle:"match works on an Option, a data type or an enum, not on i32"; (* A destructuring pattern in an arm's binds is a name position like any other. *) rejects_check "a pattern inside a match arm's binds"