From 18581a452c8cbdf5945aa45de839530b0550afad Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 21:35:31 +0700 Subject: [PATCH 1/3] = and != compare bools, a match over a bool takes true and false arms, a match over a dyn takes keyword arms, and where predicates joined with and are refused with the comma or vector form as the fix --- TODO.org | 6 +- lib/check.ml | 227 ++++++++++++++++++++-------------- lib/emit.ml | 4 + lib/parse.ml | 21 ++++ lib/types.ml | 5 +- spec-syntax.md | 8 +- test/programs/match-bool.flan | 58 +++++++++ test/test_acceptance.ml | 14 +++ test/test_flan.ml | 58 ++++++++- test/test_syntax.ml | 15 +++ web/index.html | 6 +- 11 files changed, 315 insertions(+), 107 deletions(-) create mode 100644 test/programs/match-bool.flan diff --git a/TODO.org b/TODO.org index dc07b62f..77aed9ff 100644 --- a/TODO.org +++ b/TODO.org @@ -296,10 +296,6 @@ 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. -** NEXT Keyword arms over a dyn, and = on bool -Decided 2026-09-25: a match over a dyn takes keyword arms, meaning (= d :k); = and != -compare bools, and a match over a bool takes true/false arms, exhaustive without _. - ** WAIT ML-style patterns Held 2026-09-25 as a future direction, like the JS backend: nested destructuring, guards, or-patterns, literals at any depth, exhaustiveness over the nesting. @@ -307,7 +303,7 @@ guards, or-patterns, literals at any depth, exhaustiveness over the nesting. ** DONE match over numbers and strings CLOSED: [2026-09-25] Rules out a literal the scrutinee's type cannot hold (refused, not widened as =(=)= -would), keyword arms over a dyn, and a bare-name catch-all: a bare name is a nullary case. +would) and a bare-name catch-all: a bare name is a nullary case. ** DONE match over enums CLOSED: [2026-09-25] diff --git a/lib/check.ml b/lib/check.ml index 01f3e36c..c673442f 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8373,12 +8373,16 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = (* A number, a string or a dyn: the arms are literals, and each is the test (= t lit) over one temporary — the enum's chain, with [=]'s own two lowerings for the test, so a match over a dyn means what [=] over - it means. [is_equatable]'s set minus the enums, which are above. *) + it means. [is_equatable]'s set minus the enums, which are above, and + minus bool, below. *) | (Types.Int _ | Types.Float _ | Types.String | Types.Dyn) as t -> `Lit t + (* A bool is a two-member enum spelled true and false: the same chain, + and exhaustive without a [_] once both are named. *) + | Types.Bool -> `Bool | other -> fail loc - "match works on an Option, a data type, an enum, a number, a string \ - or a dyn, not on %s" + "match works on an Option, a data type, an enum, a bool, a number, a \ + string or a dyn, not on %s" (Types.to_string other) in (* A literal arm, spelled as it was written, for the refusals that name one. *) @@ -8398,6 +8402,8 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = | Ast.Byte b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b) | Ast.Byte b -> string_of_int b | Ast.Str t -> Printf.sprintf "%S" t + | Ast.Kw k -> ":" ^ k + | Ast.Var b -> b | _ -> "this literal" in let what_ty t = match t with Types.Dyn -> "a dyn" | t -> Types.to_string t in @@ -8411,11 +8417,106 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = (match t with | Types.String -> "\"yes\" 1 _ 0" | Types.Float _ -> "0.5 1 _ 0" + | Types.Dyn -> "5 1 :go 2 _ 0" | _ -> "5 1 _ 0") in + let bool_fix () = + let name = match scrutinee.Ast.e with Ast.Var n -> n | _ -> "b" in + Printf.sprintf "(match %s true 1 false 0)" name + in (* The checked literal of each literal arm, by the key [resolve_pat] gave it. *) let lits : (string, Tast.expr) Hashtbl.t = Hashtbl.create 8 in let lit_values = ref [] in + (* A literal arm over [t]: its checked value under a fresh key in [lits], + refused if [t] cannot hold it or an earlier arm already equals it. *) + let lit_arm (a : Ast.arm) t (e : Ast.expr) = + let v = + (* [=]'s dyn pair checks its literal at dyn, which boxes it. *) + match trial ctx (fun () -> check ctx ~want:t e) with + | Ok v -> v + | Error _ -> + (* A literal that does not fit is refused, where [=] would widen + the pair and let the arm quietly never match. The literal's + own refusal is not repeated: its fixes are casts, and a cast + is not a pattern. *) + (match t with + | Types.Dyn -> + fail a.Ast.aloc + "this match is over a dyn, which holds a number as an i64 or \ + an f64, and %s fits in neither. Change the arm to a value an \ + i64 holds, or remove it" (spell e) + | _ -> ()); + let tn = Types.to_string t in + let an = + match tn.[0] with + | 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn + | _ -> "a " ^ tn + in + let why = + match e.Ast.e, t with + | Ast.Str _, _ -> "is a string" + | _, Types.String -> "is a number" + | Ast.Float x, Types.Int _ when not (Float.is_integer x) -> + "is not a whole number" + | Ast.Float _, Types.Int _ -> "is a float" + | _ -> "does not fit in one" + in + fail a.Ast.aloc + "this match is over %s, so each arm has to be %s, and %s %s. \ + Change the arm to a value %s holds, or remove it" + tn an (spell e) why an + in + (* The arm's value at the scrutinee's type, and a second arm [=] could + not tell from an earlier one is refused, since it can never be + reached: 97 and \a are one u8, 0.1 and 0.10000000001 are one f32, + and over a dyn 1 and 1.0 are equal. Compared pairwise rather than + hashed, because dyn = between an integer and a float goes through + the float and is not transitive past 2^53. *) + let value = + let f32 x = Int32.float_of_bits (Int32.bits_of_float x) in + let num x = + match t with Types.Float Types.F32 -> `F (f32 x) | _ -> `F x + in + match e.Ast.e, t with + | Ast.Str s, _ -> `S s + | (Ast.Int n | Ast.UInt (n, _)), Types.Float _ -> num (Int64.to_float n) + | Ast.Byte b, Types.Float _ -> num (float_of_int b) + | (Ast.Int n | Ast.UInt (n, _)), _ -> `I n + | Ast.Byte b, _ -> `I (Int64.of_int b) + | Ast.Float x, _ -> num x + | Ast.Kw k, _ -> `K k + | Ast.Var b, _ -> `B b + | _ -> assert false + in + let same x y = + match x, y with + | `I a, `I b -> Int64.equal a b + | `F a, `F b -> a = b + | `I a, `F b | `F b, `I a -> Int64.to_float a = b + | `S a, `S b | `K a, `K b | `B a, `B b -> String.equal a b + | _ -> false + in + (match List.find_opt (fun (w, _) -> same value w) !lit_values with + | Some (_, earlier) when earlier = spell e -> + fail a.Ast.aloc "this match has two %s arms" earlier + | Some (_, earlier) -> + fail a.Ast.aloc + "this match has two %s arms — %s equals it as %s, so this arm is \ + never reached. Remove it" + earlier (spell e) + (match t with + | Types.Dyn -> "a dyn" + | t -> + let tn = Types.to_string t in + (match tn.[0] with + | 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn + | _ -> "a " ^ tn)) + | None -> ()); + lit_values := (value, spell e) :: !lit_values; + let key = string_of_int (Hashtbl.length lits) in + Hashtbl.replace lits key v; + Some key, [] + in (* Which case each arm names, and the type of each name it binds. This is the whole of what differs between the two subjects; everything below it is shared. *) @@ -8447,91 +8548,27 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = "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)) - | `Lit t, Ast.Plit e -> - let v = - (* [=]'s dyn pair checks its literal at dyn, which boxes it. *) - match trial ctx (fun () -> check ctx ~want:t e) with - | Ok v -> v - | Error _ -> - (* A literal that does not fit is refused, where [=] would widen - the pair and let the arm quietly never match. The literal's - own refusal is not repeated: its fixes are casts, and a cast - is not a pattern. *) - (match t with - | Types.Dyn -> - fail a.Ast.aloc - "this match is over a dyn, which holds a number as an i64 or \ - an f64, and %s fits in neither. Change the arm to a value an \ - i64 holds, or remove it" (spell e) - | _ -> ()); - let tn = Types.to_string t in - let an = - match tn.[0] with - | 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn - | _ -> "a " ^ tn - in - let why = - match e.Ast.e, t with - | Ast.Str _, _ -> "is a string" - | _, Types.String -> "is a number" - | Ast.Float x, Types.Int _ when not (Float.is_integer x) -> - "is not a whole number" - | Ast.Float _, Types.Int _ -> "is a float" - | _ -> "does not fit in one" - in - fail a.Ast.aloc - "this match is over %s, so each arm has to be %s, and %s %s. \ - Change the arm to a value %s holds, or remove it" - tn an (spell e) why an - in - (* The arm's value at the scrutinee's type, and a second arm [=] could - not tell from an earlier one is refused, since it can never be - reached: 97 and \a are one u8, 0.1 and 0.10000000001 are one f32, - and over a dyn 1 and 1.0 are equal. Compared pairwise rather than - hashed, because dyn = between an integer and a float goes through - the float and is not transitive past 2^53. *) - let value = - let f32 x = Int32.float_of_bits (Int32.bits_of_float x) in - let num x = - match t with Types.Float Types.F32 -> `F (f32 x) | _ -> `F x - in - match e.Ast.e, t with - | Ast.Str s, _ -> `S s - | (Ast.Int n | Ast.UInt (n, _)), Types.Float _ -> num (Int64.to_float n) - | Ast.Byte b, Types.Float _ -> num (float_of_int b) - | (Ast.Int n | Ast.UInt (n, _)), _ -> `I n - | Ast.Byte b, _ -> `I (Int64.of_int b) - | Ast.Float x, _ -> num x - | _ -> assert false - in - let same x y = - match x, y with - | `I a, `I b -> Int64.equal a b - | `F a, `F b -> a = b - | `I a, `F b | `F b, `I a -> Int64.to_float a = b - | `S a, `S b -> String.equal a b - | _ -> false - in - (match List.find_opt (fun (w, _) -> same value w) !lit_values with - | Some (_, earlier) when earlier = spell e -> - fail a.Ast.aloc "this match has two %s arms" earlier - | Some (_, earlier) -> - fail a.Ast.aloc - "this match has two %s arms — %s equals it as %s, so this arm is \ - never reached. Remove it" - earlier (spell e) - (match t with - | Types.Dyn -> "a dyn" - | t -> - let tn = Types.to_string t in - (match tn.[0] with - | 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn - | _ -> "a " ^ tn)) - | None -> ()); - lit_values := (value, spell e) :: !lit_values; - let key = string_of_int (Hashtbl.length lits) in - Hashtbl.replace lits key v; - Some key, [] + | `Lit t, Ast.Plit e -> lit_arm a t e + (* Over a dyn a keyword is a value like any other, so :north is the arm + (= d :north), and true and false are the arms (= d true) and + (= d false). *) + | `Lit Types.Dyn, Ast.Pkw k -> + lit_arm a Types.Dyn { Ast.e = Ast.Kw k; loc = a.Ast.aloc } + | `Lit Types.Dyn, Ast.Pctor (("true" | "false") as b, []) -> + lit_arm a Types.Dyn { Ast.e = Ast.Var b; loc = a.Ast.aloc } + | `Bool, Ast.Pctor (("true" | "false") as b, []) -> Some b, [] + | `Bool, Ast.Pctor (c, _) -> + fail a.Ast.aloc + "%s names a case, and this match is over a bool, whose arms are true \ + and false, as in %s" c (bool_fix ()) + | `Bool, Ast.Pkw k -> + fail a.Ast.aloc + ":%s is a keyword, and this match is over a bool, whose arms are true \ + and false, as in %s" k (bool_fix ()) + | `Bool, Ast.Plit e -> + fail a.Ast.aloc + "%s is a literal, and this match is over a bool, whose arms are true \ + and false, as in %s" (spell e) (bool_fix ()) | `Lit t, Ast.Pkw k -> fail a.Ast.aloc ":%s is an enum member, and this match is over %s, whose arms are \ @@ -8720,6 +8757,8 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = List.filter_map (fun (m, _) -> if Hashtbl.mem seen m then None else Some (":" ^ m)) members + | `Bool -> + List.filter (fun c -> not (Hashtbl.mem seen c)) [ "true"; "false" ] | `Lit _ -> [] in (* No list of literals covers a number, a string or a dyn, so a literal @@ -8741,7 +8780,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = ~notes:(match subject with | `Data u -> declared_note ctx.env u.Tast.dname | `Enum (n, _) -> declared_note ctx.env n - | `Option _ | `Lit _ -> []) + | `Option _ | `Bool | `Lit _ -> []) "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \ the rest" (String.concat ", " missing) @@ -8750,7 +8789,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = let ty = match !want with Some t -> t | None -> Types.Never in match subject with | `Option _ | `Data _ -> mk loc ty (Tast.Match (s, arms)) - | `Enum _ | `Lit _ -> + | `Enum _ | `Bool | `Lit _ -> (* 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 @@ -8773,6 +8812,8 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = mk loc s.Tast.ty (Tast.Int (List.assoc m members, Types.I32)) in mk loc Types.Bool (Tast.Prim (Tast.Eq, [ local; v ])) + | `Bool when String.equal m "true" -> local + | `Bool -> mk loc Types.Bool (Tast.Prim (Tast.Not, [ local ])) | `Lit Types.Dyn -> dyn_eq loc local (Hashtbl.find lits m) | _ -> mk loc Types.Bool (Tast.Prim (Tast.Eq, [ local; Hashtbl.find lits m ])) @@ -10180,7 +10221,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = ordering attached — plan.org, Types calls out an ordering as a collation the language has not picked. Backend codegen (emit.ml, x86.ml) has a [Types.String] case in the [Eq]/[Ne] arm and nowhere - else. *) + else. A bool is the third: two values and no order between them. *) let ok = match name with | "=" | "!=" -> Types.is_equatable a.Tast.ty @@ -10193,8 +10234,8 @@ and named_call ?(qualified = false) ctx ~want loc name args = (match name with | "=" | "!=" -> fail loc - "%s compares machine numbers, enums and strings, and %s is none of \ - those" name (Types.to_string a.Tast.ty) + "%s compares numbers, enums, strings and bools, and %s is none \ + of those" name (Types.to_string a.Tast.ty) | _ -> fail loc "%s orders machine numbers and enums, and %s is neither" name diff --git a/lib/emit.ml b/lib/emit.ml index 01b82b72..fd4f6423 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3800,6 +3800,10 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = location. Signed, because a member may be declared negative. *) | Types.Enum _ -> ins f "%s = icmp %s %s %s, %s" t (icmp_op true p) (ll x.Tast.ty) a b + (* A bool is an i1 here, and only [=]/[!=] reach it: [<] on a bool is + refused in check.ml. *) + | Types.Bool -> + ins f "%s = icmp %s i1 %s, %s" t (icmp_op false p) a b (* A string is ptr+len at this boundary, not a machine word, so there is no [icmp] to reach for — the comparison itself is [flan_str_eq] (runtime/flan_rt.c), bytewise with a length and a same-pointer fast diff --git a/lib/parse.ml b/lib/parse.ml index b325e03a..bf36a4bc 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -373,6 +373,27 @@ let constraints (body : Form.t list) : Ast.pred list * Form.t list = ignore vloc; { Ast.pname = name; pvar = String.sub v 1 (String.length v - 1); ploc = p.Form.loc } + (* [and] is how a condition joins tests, so it is what gets written + for several predicates. The fix is spelled in the file's own syntax, + which only the location's file name tells apart here. *) + | Form.List ({ Form.v = Form.Sym "and"; _ } :: (_ :: _ as ps)) -> + let fln = Filename.check_suffix p.Form.loc.Loc.file ".fln" in + let fln_pred (q : Form.t) = + match q.Form.v with + | Form.List [ { Form.v = Form.Sym n; _ }; { Form.v = Form.Sym v; _ } ] + -> Printf.sprintf "%s(%s)" n v + | _ -> Form.to_string q + in + if fln then + Loc.fail p.Form.loc + "a where clause separates its predicates with commas, not and — \ + write where %s" + (String.concat ", " (List.map fln_pred ps)) + else + Loc.fail p.Form.loc + "a where clause puts several predicates in a vector, not in an \ + and — write {:where [%s]}" + (String.concat " " (List.map Form.to_string ps)) | _ -> Loc.fail p.Form.loc "a where predicate is (name? $t), one predicate about one type \ diff --git a/lib/types.ml b/lib/types.ml index a6f25857..37162cd5 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -305,8 +305,9 @@ let is_comparable = function Enum _ -> true | t -> is_numeric t (* Equality admits one type ordering does not: a string, grown in by the M2 queue's item 5 — bytewise, by content and not by address, so two - separately built strings with the same bytes are equal. *) -let is_equatable = function String -> true | t -> is_comparable t + separately built strings with the same bytes are equal. A bool is the + other: true and false are two values with no order between them. *) +let is_equatable = function String | Bool -> true | t -> is_comparable t (* [Never] is the type of an expression that does not produce a value: return, an early-returning `some`, exit. It fits anywhere, and that is the only diff --git a/spec-syntax.md b/spec-syntax.md index 1da02171..72a60321 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -209,10 +209,16 @@ Each item: the proposal, then the reason in one line. "ok" -> "fine" \a -> "a" _ -> "other" + + match ready + true -> go() + false -> wait() ``` An arm's body can be an indented block, which reads as `(do …)`. **Built** (a one-line block reads as that line). A number, char or string pattern is the - literal as written, compared as `(= t lit)`. + literal as written, compared as `(= t lit)`; over a dyn a keyword or + `true`/`false` is too. A bool's arms are `true` and `false`, and naming both + needs no `_`. - **Conditions**, clauses at the header's column: ``` diff --git a/test/programs/match-bool.flan b/test/programs/match-bool.flan new file mode 100644 index 00000000..76e9ec11 --- /dev/null +++ b/test/programs/match-bool.flan @@ -0,0 +1,58 @@ +;;;; = and != on bools, a match over a bool, and keyword arms over a dyn. + +(defstruct Flag [on bool]) + +(defn truth [n i32] bool (> n 0)) + +(defn same? [a bool b bool] bool (= a b)) + +;; Exhaustive without a _ arm: true and false are every bool. +(defn word [b bool] string + (match b + true "yes" + false "no")) + +(defn flipped [b bool] i32 + (match b + false 0 + true 1)) + +(defn only-true [b bool] i32 + (match b + true 1 + _ 0)) + +;; Over a dyn :north is the arm (= d :north), beside numbers, strings and +;; bools, which are dyn values too. +(defn heading [d dyn] string + (match d + :north "up" + :south "down" + 1 "one" + "west" "left" + true "true" + _ "other")) + +(defn main [] i32 + (let [f (Flag {.on true}) + g (Flag {.on false}) + flags [true false true]] + (print (same? true true)) (print " ") + (print (same? true false)) (print " ") + (print (!= true false)) (print " ") + (print (= (.on f) (truth 3))) (print " ") + (print (= (.on g) (truth 3))) (print " ") + (print (!= (.on g) (at flags 1))) (print " ") + (print (= true (at flags 0) (at flags 2))) (println "") + (println (word true)) + (println (word (truth -1))) + (print (flipped true)) (print (flipped false)) + (print (only-true true)) (print (only-true false)) (println "") + (println (heading :north)) + (println (heading :south)) + (println (heading :east)) + (println (heading 1.0)) + (println (heading "west")) + (println (heading true)) + (println (heading false)) + 0)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 0691f63c..1c25dae4 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -445,6 +445,20 @@ let () = match_lit_out; outputs ~dev:true "match over literals, dev" "programs/match-literal.flan" match_lit_out; + (* heading 1.0 is "one": a keyword arm sits in the same dyn = chain as + the literal arms. *) + let match_bool_out = + "true false true true false false true\nyes\nno\n1010\nup\ndown\n\ + other\none\nleft\ntrue\nother\n" + in + outputs "match over a bool and keywords" "programs/match-bool.flan" + match_bool_out; + outputs ~opt:"-O0" "match over a bool and keywords, -O0" + "programs/match-bool.flan" match_bool_out; + outputs ~x86:true "match over a bool and keywords, --x86" + "programs/match-bool.flan" match_bool_out; + outputs ~dev:true "match over a bool and keywords, dev" + "programs/match-bool.flan" match_bool_out; (* update, ++ and -- evaluate their place's subexpressions once: the counts are the number of calls an index or a key function got. *) let update_out = "3\n11 20 90\n1 1 3\n16\n2\n7 1\n32\n2 50\n" in diff --git a/test/test_flan.ml b/test/test_flan.ml index 5b63acd7..90ce6d94 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1888,6 +1888,11 @@ let () = rejects_check ":where is reserved at a defn body's head, even alone" "(defn f [] dyn {:where 1})\n(defn main [] i32 0)" ~needle:"a where predicate is"; + rejects_check "several where predicates joined with and" + "(defn f [x $t y $u] i32 {:where (and (ordered? $t) (equal? $u))} 0)\n\ + (defn main [] i32 (f 1 2))" + ~needle:"a where clause puts several predicates in a vector, not in an \ + and — write {:where [(ordered? $t) (equal? $u)]}"; (* Keywords: dyn where nothing else is asked, still an enum member where an enum is, and refused where a concrete non-dyn type is wanted. *) @@ -2693,7 +2698,7 @@ let () = accepts "a wildcard arm is exhaustive" "(defn g [] (Option i32) None) (defn f [] i32 (match (g) (Some v) v _ 0))"; rejects_check "match on a non-Option" - "(defn f [x bool] i32 (match x _ 0))" ~needle:"match works on an Option"; + "(defn f [x [u8]] i32 (match x _ 0))" ~needle:"match works on an Option"; (* ── Names, order-independence, entry point ────────────────────── *) accepts "mutually recursive, no forward declaration" @@ -4683,9 +4688,9 @@ let () = (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 bool] i32 (match n _ 2))" - ~needle:"match works on an Option, a data type, an enum, a number, a \ - string or a dyn, not on bool"; + "(defn f [n [u8]] i32 (match n _ 2))" + ~needle:"match works on an Option, a data type, an enum, a bool, a \ + number, a string or a dyn, not on [u8]"; (* ── match over literals ───────────────────────────────────────── *) @@ -4762,6 +4767,51 @@ let () = rejects_check "a literal match over a byte slice, which = does not compare" "(defn f [b [u8]] i32 (match b \"a\" 1 _ 0))" ~needle:"not on [u8]"; + + (* ── match over a bool, keyword arms over a dyn ────────────────── *) + + accepts "a match over a bool naming both is exhaustive" + "(defn f [b bool] i32 (match b true 1 false 0))"; + accepts "a match over a bool, one arm and _" + "(defn f [b bool] i32 (match b false 1 _ 0))"; + rejects_check "a match over a bool naming one of them" + "(defn f [b bool] i32 (match b true 1))" + ~needle:"this match is not exhaustive — false has no arm. Add it, or a _ \ + arm for the rest"; + rejects_check "true named twice" + "(defn f [b bool] i32 (match b true 1 true 2 _ 0))" + ~needle:"this match has two true arms"; + rejects_check "a number arm over a bool" + "(defn f [b bool] i32 (match b 1 1 _ 0))" + ~needle:"1 is a literal, and this match is over a bool, whose arms are \ + true and false, as in (match b true 1 false 0)"; + rejects_check "a keyword arm over a bool" + "(defn f [b bool] i32 (match b :yes 1 _ 0))" + ~needle:":yes is a keyword, and this match is over a bool"; + accepts "keyword arms over a dyn, beside numbers, strings and bools" + "(defn f [d dyn] i32 (match d :north 1 :south 2 5 3 \"w\" 4 true 5 _ 0))"; + rejects_check "keyword arms over a dyn need a _ arm" + "(defn f [d dyn] i32 (match d :north 1 :south 2))" + ~needle:"covers every dyn value. Add a _ arm for the rest, as in (match d \ + 5 1 :go 2 _ 0)"; + rejects_check "a keyword named twice over a dyn" + "(defn f [d dyn] i32 (match d :north 1 :north 2 _ 0))" + ~needle:"this match has two :north arms"; + rejects_check "true named twice over a dyn" + "(defn f [d dyn] i32 (match d true 1 true 2 _ 0))" + ~needle:"this match has two true arms"; + accepts "a keyword arm over an enum still names a member" + (k ^ "(defn f [k K] i32 (match k :lo 1 _ 0))"); + (* = and != compare bools; ordering them stays refused. *) + accepts "= on bools" "(defn f [a bool b bool] bool (= a b))"; + accepts "!= on bools, chained" "(defn f [a bool b bool] bool (!= a b true))"; + rejects_check "< on bools" + "(defn f [a bool b bool] bool (< a b))" + ~needle:"< orders machine numbers and enums, and bool is neither"; + rejects_check "= on a struct names what it compares" + "(defstruct P [x i32])\n(defn f [a P b P] bool (= a b))" + ~needle:"= compares numbers, enums, strings and bools, and P is none of \ + those"; (* 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" diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 6b83e947..9470557e 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -364,6 +364,10 @@ let () = "(match s (Circle r) r _ (do (a) (b)))"; reads "match over literals" "match n\n 5 -> a\n -2.5 -> b\n \"go\" -> c\n \\a -> d\n _ -> e" "(match n 5 a -2.5 b \"go\" c \\a d _ e)"; + reads "match over a bool" "match b\n true -> a\n false -> b" + "(match b true a false b)"; + reads "keyword arms over a dyn" "match d\n :north -> a\n 1 -> b\n _ -> c" + "(match d :north a 1 b _ c)"; reads "handler-bind moves the clauses" "handler-bind\n f()\non E(c)\n g(c)" "(handler-bind [(E [c] (g c))] (f))"; reads "quote block" @@ -530,6 +534,17 @@ let () = if not (Test_support.contains d.Loc.dmsg "Did you mean x - 1?") then fail "x-1: %s" d.Loc.dmsg | exception e -> fail "x-1: %s" (Printexc.to_string e)); + (* Several where predicates joined with and: the fix is .fln's commas. *) + let f = Filename.concat scratch "syntax-where-and.fln" in + write f "fn f(x: $t, y: $u) -> i32 where ordered?($t) and equal?($u)\n 0\n"; + (match Front.checked f with + | _ -> fail "where joined with and checked" + | exception Loc.Error d -> + if not (Test_support.contains d.Loc.dmsg + "separates its predicates with commas, not and — write where \ + ordered?($t), equal?($u)") then + fail "where joined with and: %s" d.Loc.dmsg + | exception e -> fail "where joined with and: %s" (Printexc.to_string e)); (* One package, one file in two syntaxes: refused naming both. *) let dir = Filename.concat scratch "syntax-twin" in let pkg = Filename.concat dir "geo" in diff --git a/web/index.html b/web/index.html index a8a8a6e8..db773a3d 100644 --- a/web/index.html +++ b/web/index.html @@ -1097,8 +1097,10 @@ as first-even does above.

(Option T) is how absence is spelled: a lookup miss, an empty collection, the end of a stream. match works on an Option, a -defdata and an enum, whose arms name cases; and on a number, a string or a -dyn, whose arms are literals — (match n 0 "zero" -1 "none" _ "some") +defdata and an enum, whose arms name cases; on a bool, whose arms +are true and false; and on a number, a string or a +dyn, whose arms are literals — (match n 0 "zero" -1 "none" _ "some"), +or over a dyn also keywords such as :north — each compared with =, with a _ arm required for the rest. some unwraps Some and early-returns None from the enclosing function.

From c3a05d7447ad00d1306b7fb66db1335a9562e065 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 21:37:44 +0700 Subject: [PATCH 2/3] The site says a match over a bool needs no _ arm --- web/index.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/web/index.html b/web/index.html index db773a3d..cd8e96ef 100644 --- a/web/index.html +++ b/web/index.html @@ -1098,7 +1098,7 @@ as first-even does above.

(Option T) is how absence is spelled: a lookup miss, an empty collection, the end of a stream. match works on an Option, a defdata and an enum, whose arms name cases; on a bool, whose arms -are true and false; and on a number, a string or a +are true and false and need no _; and on a number, a string or a dyn, whose arms are literals — (match n 0 "zero" -1 "none" _ "some"), or over a dyn also keywords such as :north — each compared with =, with a _ arm required for the rest. From e81191d7706ff04fd7469b9b3ef9b9889111b643 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 21:50:56 +0700 Subject: [PATCH 3/3] A bool returned from C reads as its low bit on --x86 as on LLVM, and the where-and fix and the x-1 hint follow the code's own syntax rather than its file name --- lib/check.ml | 2 +- lib/indent_reader.ml | 16 ++++++++++++++++ lib/parse.ml | 25 ++++++------------------- lib/source.ml | 15 +++++++++++++-- lib/x86.ml | 5 +++++ test/programs/ffi-bool.flan | 24 ++++++++++++++++++++++++ test/test_acceptance.ml | 6 ++++++ test/test_syntax.ml | 16 +++++----------- 8 files changed, 76 insertions(+), 33 deletions(-) create mode 100644 test/programs/ffi-bool.flan diff --git a/lib/check.ml b/lib/check.ml index c673442f..a3065a85 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8868,7 +8868,7 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a = and [x/2] are one name each. When the parts either side of an operator character are a value in scope and a number or another value, that is almost certainly the arithmetic, and the sentence says how to spell it. *) - (if Filename.check_suffix loc.Loc.file ".fln" then begin + (if Source.indented_at loc then begin let known s = s <> "" && (String.for_all (fun c -> (c >= '0' && c <= '9') || c = '.') s diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 2f8ad73f..fd719c39 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1209,6 +1209,22 @@ and header (s : st) w : Form.t = let wt = advance p in let rec preds acc = let e, _ = expr p in + (* [and] is how a condition joins tests, so it is what gets written + for several predicates; the clause separates them with commas. *) + (match e.Form.v with + | Form.List ({ Form.v = Form.Sym "and"; _ } :: (_ :: _ as ps)) -> + let spell (q : Form.t) = + match q.Form.v with + | Form.List [ { Form.v = Form.Sym n; _ }; + { Form.v = Form.Sym v; _ } ] -> + Printf.sprintf "%s(%s)" n v + | _ -> Form.to_string q + in + failk "where-and" e.Form.loc + "a where clause separates its predicates with commas, not and \ + — write where %s" + (String.concat ", " (List.map spell ps)) + | _ -> ()); match (peek p).tok with | COMMA -> ignore (advance p); preds (e :: acc) | _ -> List.rev (e :: acc) diff --git a/lib/parse.ml b/lib/parse.ml index bf36a4bc..5a76c9ab 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -374,26 +374,13 @@ let constraints (body : Form.t list) : Ast.pred list * Form.t list = { Ast.pname = name; pvar = String.sub v 1 (String.length v - 1); ploc = p.Form.loc } (* [and] is how a condition joins tests, so it is what gets written - for several predicates. The fix is spelled in the file's own syntax, - which only the location's file name tells apart here. *) + for several predicates. The .fln reader refuses its own spelling of + this with its own fix; what reaches here is paren code. *) | Form.List ({ Form.v = Form.Sym "and"; _ } :: (_ :: _ as ps)) -> - let fln = Filename.check_suffix p.Form.loc.Loc.file ".fln" in - let fln_pred (q : Form.t) = - match q.Form.v with - | Form.List [ { Form.v = Form.Sym n; _ }; { Form.v = Form.Sym v; _ } ] - -> Printf.sprintf "%s(%s)" n v - | _ -> Form.to_string q - in - if fln then - Loc.fail p.Form.loc - "a where clause separates its predicates with commas, not and — \ - write where %s" - (String.concat ", " (List.map fln_pred ps)) - else - Loc.fail p.Form.loc - "a where clause puts several predicates in a vector, not in an \ - and — write {:where [%s]}" - (String.concat " " (List.map Form.to_string ps)) + Loc.fail p.Form.loc + "a where clause puts several predicates in a vector, not in an and \ + — write {:where [%s]}" + (String.concat " " (List.map Form.to_string ps)) | _ -> Loc.fail p.Form.loc "a where predicate is (name? $t), one predicate about one type \ diff --git a/lib/source.ml b/lib/source.ml index d6429e19..48966744 100644 --- a/lib/source.ml +++ b/lib/source.ml @@ -41,13 +41,24 @@ let syntax_of_field = function | Some ("indented" | "fln") -> Indented | _ -> Paren +let in_request = ref false + let with_code ?indent ~syntax ~at f = - let s = !code_syntax and a = !code_at and i = !code_indent in + let s = !code_syntax and a = !code_at and i = !code_indent + and r = !in_request in code_syntax := syntax; code_at := at; code_indent := indent; + in_request := true; Fun.protect - ~finally:(fun () -> code_syntax := s; code_at := a; code_indent := i) f + ~finally:(fun () -> + code_syntax := s; code_at := a; code_indent := i; in_request := r) f + +(* Was the code at [loc] written in the indented syntax? Inside an editor + request the request says; outside one a file's name does, as + [read_file] decides. *) +let indented_at (loc : Loc.t) = + if !in_request then !code_syntax = Indented else is_indented loc.Loc.file (* The paren reader started at a line and column: [Reader.read_all] always starts at 1:1. *) diff --git a/lib/x86.ml b/lib/x86.ml index 6b409272..7e557646 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -3244,6 +3244,11 @@ and call_native ?at f ~sym ?(chan = false) ~(args : Tast.expr list) ~rty dst = unsupported "%s returns %s by value, which needs SysV return classification this \ backend does not have" sym (Types.to_string rty); + (* A C bool is 0 or 1 only by the callee's good faith: [(declare f [..] + bool "abs")] hands back whatever byte abs left. LLVM declares the + return [i1] and reads its low bit, so this does too, and every bool + past this point is 0 or 1 — which [=], [not] and [match] assume. *) + if Types.equal rty Types.Bool then and_imm f.b ~dst:rax 1; store_loc f ~reg:(if is_float rty then xmm0 else rax) dst rty end diff --git a/test/programs/ffi-bool.flan b/test/programs/ffi-bool.flan new file mode 100644 index 00000000..f0112205 --- /dev/null +++ b/test/programs/ffi-bool.flan @@ -0,0 +1,24 @@ +;;;; A bool from C that is not 0 or 1 reads as its low bit on both backends: +;;;; abs(3) is 3, which is true, and equal to abs(1). + +(declare two [n i32] bool "abs") + +(defstruct Flag [on bool]) + +(defn main [] i32 + (let [a (two 3) + b (two 1) + c (two 0) + f (Flag {.on a}) + v [a b]] + (print (= a b)) (print " ") + (print (!= a b)) (print " ") + (print (= a true)) (print " ") + (print (= (.on f) b)) (print " ") + (print (= (at v 0) (at v 1))) (print " ") + (print (match a true "T" false "F")) (print " ") + (print (if a "t" "f")) (print " ") + (print (not a)) (print " ") + (print (= c false)) + (println "") + 0)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 1c25dae4..dd1821ca 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -459,6 +459,12 @@ let () = "programs/match-bool.flan" match_bool_out; outputs ~dev:true "match over a bool and keywords, dev" "programs/match-bool.flan" match_bool_out; + let ffi_bool_out = "true false true true true T t false true\n" in + outputs "a bool from C" "programs/ffi-bool.flan" ffi_bool_out; + outputs ~opt:"-O0" "a bool from C, -O0" "programs/ffi-bool.flan" + ffi_bool_out; + outputs ~x86:true "a bool from C, --x86" "programs/ffi-bool.flan" + ffi_bool_out; (* update, ++ and -- evaluate their place's subexpressions once: the counts are the number of calls an index or a key function got. *) let update_out = "3\n11 20 90\n1 1 3\n16\n2\n7 1\n32\n2 50\n" in diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 9470557e..553c684f 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -287,6 +287,11 @@ let () = "(defn g [h (Fn [i32 i32] bool)] () (h 1 2))"; reads "untyped parameter is dyn" "fn id(x) -> dyn = x" "(defn id [x dyn] dyn x)"; refuses "no return type" "fn f(x)\n x" "indent/return-type" "-> i32"; + (* The fix is .fln's commas whatever the file is called: [read] names it + . *) + refuses "where predicates joined with and" + "fn f(x: $t, y: $u) -> i32 where ordered?($t) and equal?($u)\n 0" + "indent/where-and" "commas, not and — write where ordered?($t), equal?($u)"; (* Characters, lexed before brackets and separators. *) reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])"; reads "character arguments" "f(\\,, \\))" "(f \\, \\))"; @@ -534,17 +539,6 @@ let () = if not (Test_support.contains d.Loc.dmsg "Did you mean x - 1?") then fail "x-1: %s" d.Loc.dmsg | exception e -> fail "x-1: %s" (Printexc.to_string e)); - (* Several where predicates joined with and: the fix is .fln's commas. *) - let f = Filename.concat scratch "syntax-where-and.fln" in - write f "fn f(x: $t, y: $u) -> i32 where ordered?($t) and equal?($u)\n 0\n"; - (match Front.checked f with - | _ -> fail "where joined with and checked" - | exception Loc.Error d -> - if not (Test_support.contains d.Loc.dmsg - "separates its predicates with commas, not and — write where \ - ordered?($t), equal?($u)") then - fail "where joined with and: %s" d.Loc.dmsg - | exception e -> fail "where joined with and: %s" (Printexc.to_string e)); (* One package, one file in two syntaxes: refused naming both. *) let dir = Filename.concat scratch "syntax-twin" in let pkg = Filename.concat dir "geo" in