feat(#92): widths need not agree for ==, and match arms join on width

ASSUMPTIONS.md

@@ -33,6 +33,7 @@ Cross-references use `[[A-TG-N.M]]` syntax, resolved here.
 | A-TG-6.2 | DESIGN | Source semantics has no floating-point non-determinism (Tangle has only `Int` currently) | TG-6 | `Tangle.lean::Ty` lacks `.float` |
 | A-TG-7.1 | MATH | Word problem in the braid group `B_n` is solvable in polynomial time (Birman–Ko–Lee / Garside normal form) | TG-7 | Birman–Ko–Lee 1998; _A New Approach to the Word and Conjugacy Problems in the Braid Groups_ |
 | A-TG-7.2 | IMPL | `braidEquiv` (`proofs/Tangle.lean`) and `braid_equiv.ml` implement Dehornoy handle reduction **correctly**, and agree with each other. Since the 2026-07-29 ruling (#50) routed `==` through them, this is **load-bearing for the semantics of `==`**: the Step relation's metatheory is proven only *relative to* `braidEquiv`, never that it decides braid-group equality. Evidenced by testing (2220 + 8 assertions), not proof. Retired by the mechanised Garside/Dehornoy proof (#51, research-grade). The Lean port is additionally **fuel-bounded**, so termination is assumed rather than proven. | TG-7 | `compiler/lib/braid_equiv.ml`; `proofs/Tangle.lean` §BRAID-GROUP EQUIVALENCE; `compiler/test/tg7` |
+| A-TG-92.1 | MATH | Comparing braid words of different widths is decided in B_max(n,m) via the standard embedding Bn -> Bn+1 (adjoin a strand no generator touches). Used to justify widening `T-Eq-Word` (#92) and the match-arm width join. The embedding is standard mathematics but is **asserted in prose, not mechanised** — no Lean lemma states it. What IS machine-checked is that the metatheory (Progress/Preservation/Determinism/TypeSafety, infer_sound/complete) holds under the widened rule, and that OCaml `infer_expr` still agrees with Lean `infer` on the corpus (TG-3, 496 obligations). | TG-7 / #92 | `proofs/Tangle.lean` (`tEqWord`, `infer`); `compiler/lib/typecheck.ml` |
 | A-TG-8.1 | DESIGN | Each dialect's grammar is a strict superset of core's EBNF (`tangle.ebnf`) | TG-8 | `dialects/*/grammar.ebnf` |
 | A-TG-8.2 | DESIGN | Each dialect's typing rules are additive (new constructors + their typing rules only; no modification of existing rules) | TG-8 | Per-dialect spec |
 | A-TG-9.1 | DESIGN | `tangle-lsp` emits diagnostics in four documented categories (`PARSE_ERROR`, `MISSPELLING_HINT`, `STRUCTURAL_HINT`, `NAME_HINT`); only `PARSE_ERROR` corresponds to a grammar-level rejection. The other three are LSP-only by design (Option B from TG-9 audit; Option A — full refinement via FFI to `typecheck.ml` — remains queued at #28). Each emission site is tagged in the `Diagnostic.source` field as `tangle-lsp[CATEGORY]`. | TG-9 | `compiler/tangle-lsp/src/backend.rs`; `compiler/tangle-lsp/docs/lsp-diagnostic-categories.md` |

compiler/bin/main.ml

@@ -49,12 +49,23 @@ let parse_file_recovering (filename : string) : Tangle.Ast.program * parse_diagn
     Lexing.pos_lnum = 1;
   };
   let diagnostics = ref [] in
-  let stmts = ref [] in
+  (* Accumulate SEGMENTS (each a statement list from one parser run), newest
+     first, and flatten in order at the end.
+     The previous code did `stmts := prog @ !stmts` and then `List.rev !stmts`.
+     That reversal is correct for an accumulator built by prepending single
+     items — as `diagnostics` is — but here whole segments are prepended, so
+     reversing the FLATTENED list reversed the statements themselves. On the
+     normal path (one successful parse) every program came out backwards:
+     `def x; def y; def z` parsed to [z; y; x], so any program whose statements
+     depend on order failed at evaluation with "Unbound variable".
+     The test suites never caught it because they call Tangle.Parser.program
+     directly; only the CLI goes through this recovering path. *)
+  let segments = ref [] in
   let at_eof = ref false in
   while not !at_eof do
     (try
        let prog = Tangle.Parser.program Tangle.Lexer.token lexbuf in
-       stmts := prog @ !stmts;
+       segments := prog :: !segments;
        at_eof := true
      with
      | Tangle.Lexer.Lexer_error msg ->
@@ -76,7 +87,8 @@ let parse_file_recovering (filename : string) : Tangle.Ast.program * parse_diagn
        } :: !diagnostics;
        at_eof := synchronize_tangle_lexer lexbuf)
   done;
-  (List.rev !stmts, List.rev !diagnostics)
+  (* Flatten oldest-segment-first, preserving order WITHIN each segment. *)
+  (List.concat (List.rev !segments), List.rev !diagnostics)
 
 (** Parse a TANGLE source file into a program AST. *)
 let parse_file (filename : string) : Tangle.Ast.program =

compiler/lib/parser.mly

@@ -90,6 +90,18 @@ definition:
     { { def_name = name; def_params = ps; def_body = body; def_line = $startpos(name).Lexing.pos_lnum } }
   | DEF name = IDENT EQ body = expr
     { { def_name = name; def_params = []; def_body = body; def_line = $startpos(name).Lexing.pos_lnum } }
+  (* Weave as a DEFINITION BODY specifically, rather than as a general
+     primary_expr.  Admitting it into primary_expr made the grammar ambiguous:
+     inside a comma context such as `pair(weave ... yield strands a, b)` the
+     parser cannot tell whether the comma continues the strand list or
+     separates arguments, and menhir resolved that arbitrarily.  Definition
+     bodies are not comma-delimited, so this position is unambiguous — and it
+     is the only position the construct is actually used in
+     (conformance/valid/v02, v08, v09, v12). *)
+  | DEF name = IDENT EQ w = weave_block
+    { { def_name = name; def_params = []; def_body = Weave w; def_line = $startpos(name).Lexing.pos_lnum } }
+  | DEF name = IDENT LPAREN ps = param_list RPAREN EQ w = weave_block
+    { { def_name = name; def_params = ps; def_body = Weave w; def_line = $startpos(name).Lexing.pos_lnum } }
   ;
 
 param_list:
@@ -321,8 +333,6 @@ primary_expr:
     { e }
   | LBRACE e = expr RBRACE
     { e }
-  | w = weave_block
-    { Weave w }
   ;
 
 (* ---- Crossings: (a > b) or (a < b) ---- *)

compiler/lib/typecheck.ml

@@ -399,13 +399,38 @@ let rec infer_expr (gamma : env) (sigma : strand_ctx) (e : expr) : ty =
         env_bind_val g name ty) gamma bindings in
       infer_expr gamma' sigma arm.arm_body
     ) arms in
-    let result_ty = List.hd arm_types in
-    List.iteri (fun i ty ->
-      if ty <> result_ty then
-        type_error "Match arm %d has type %s but arm 0 has type %s"
-          i (pp_ty ty) (pp_ty result_ty)
-    ) arm_types;
-    result_ty
+    (* Arms must agree — but for WORDS, "agree" means agree up to width (#92),
+       consistent with `.` (compose) widening to max and with `==` no longer
+       requiring equal widths.  Arms at Word[0] and Word[2] describe the same
+       kind of thing at different strand counts; the join is the wider.
+       Everything else must still match exactly. *)
+    let join_ty a b =
+      match a, b with
+      | TWord n, TWord m -> Some (TWord (max n m))
+      | x, y when x = y  -> Some x
+      | _                -> None
+    in
+    let result_ty =
+      List.fold_left (fun acc ty ->
+        match acc with
+        | None -> None
+        | Some a -> join_ty a ty
+      ) (Some (List.hd arm_types)) arm_types
+    in
+    begin match result_ty with
+    | Some t -> t
+    | None ->
+      (* Report against arm 0, as before, so the message stays familiar. *)
+      let t0 = List.hd arm_types in
+      let i, bad =
+        let rec find i = function
+          | [] -> (0, t0)
+          | ty :: rest -> if join_ty t0 ty = None then (i, ty) else find (i+1) rest
+        in find 0 arm_types
+      in
+      type_error "Match arm %d has type %s but arm 0 has type %s"
+        i (pp_ty bad) (pp_ty t0)
+    end
 
   (* ---- Echo types (structured loss) ----
    * Mirror the HasType rules in proofs/Tangle.lean:
@@ -571,9 +596,13 @@ and infer_binop (op : binop) (t1 : ty) (t2 : ty) : ty =
    * PROOF-NEEDS.md. *)
   | Eq ->
     begin match t1, t2 with
-    | TWord n, TWord m when n = m -> TBool
-    | TWord n, TWord m ->
-      type_error "Cannot compare words of differing width: Word[%d] == Word[%d]" n m
+    (* Widths need not agree (#92).  Braid groups embed Bn -> Bn+1 by adding a
+       strand nothing touches, so a Word[n] IS a Word[max n m]; the comparison
+       is decided in the larger group.  That is already what
+       [Braid_equiv.equiv] computes — it takes two generator lists and has no
+       width parameter — and it is what `~` has always accepted.  Mirrors the
+       widened [tEqWord] in proofs/Tangle.lean. *)
+    | TWord _, TWord _ -> TBool
     | TNum, TNum        -> TBool
     | TStr, TStr        -> TBool
     | TBool, TBool      -> TBool

compiler/test/test_check.ml

@@ -43,11 +43,16 @@ let () =
     not (has_error (check_source "def b = true == false\n")));
 
   Printf.printf "\n=== Type errors are reported ===\n";
-  test "unequal-width word eq is rejected" (fun () ->
-    let ds = check_source "def bad = braid[s1] == braid[s1, s2]\n" in
-    has_error ds && mentions "width" ds);
+  (* #92: unequal-width `==` is now WELL-TYPED, so it is no longer a source of
+     type errors. Adding a word to a number still is. *)
+  test "unequal-width word eq is ACCEPTED (#92)" (fun () ->
+    not (has_error (check_source "def ok = braid[s1] == braid[s1, s2]\n")));
   test "add of word and num is rejected" (fun () ->
-    has_error (check_source "def bad = braid[s1] + 3\n"));
+    let ds = check_source "def bad = braid[s1] + 3\n" in
+    (* Also check the message is the specific one, not just that something
+       failed — `mentions` was left unused when #92 made width mismatches
+       legal, and an unused assertion helper is a smell. *)
+    has_error ds && mentions "add" ds);
 
   Printf.printf "\n=== Parse errors are reported ===\n";
   test "empty body is a parse error" (fun () ->
@@ -61,11 +66,11 @@ let () =
     List.exists (fun d -> d.level = Error && d.line >= 1) ds);
   test "type error is located at the def line, not the file top" (fun () ->
     (* `def bad` is on line 2; the diagnostic must point there, not line 1. *)
-    let src = "def a = braid[s1]\ndef bad = braid[s1] == braid[s1, s2]\n" in
+    let src = "def a = braid[s1]\ndef bad = braid[s1] + 3\n" in
     let ds = check_source src in
     List.exists (fun d -> d.level = Error && d.line = 2) ds);
   test "a single type error yields exactly one diagnostic (no duplicate)" (fun () ->
-    let ds = check_source "def bad = braid[s1] == braid[s1, s2]\n" in
+    let ds = check_source "def bad = braid[s1] + 3\n" in
     List.length (List.filter (fun d -> d.level = Error) ds) = 1);
   test "format_diag is tab-separated with 4 fields" (fun () ->
     let line = format_diag { level = Error; line = 3; col = 5; message = "boom" } in

compiler/test/test_typecheck.ml

@@ -1062,8 +1062,39 @@ let test_echo_types () =
     infer [] (BinOp (Eq, BraidLit [sigma 1], BraidLit [sigma 1])) = TBool);
   test "Eq: Bool == Bool ok (extra-core)" (fun () ->
     infer [] (BinOp (Eq, BoolLit true, BoolLit false)) = TBool);
-  test "Eq: unequal-width words rejected" (fun () ->
-    raises (fun () -> infer [] (BinOp (Eq, BraidLit [sigma 1], BraidLit [sigma 1; sigma 2]))))
+  (* #92: unequal widths are now WELL-TYPED. Bn embeds in Bn+1, the comparison
+     is decided in the larger group, and `Braid_equiv.equiv` has no width
+     parameter — it is only the typing rule that used to forbid this. *)
+  test "#92 Eq: unequal-width words are accepted" (fun () ->
+    infer [] (BinOp (Eq, BraidLit [sigma 1], BraidLit [sigma 1; sigma 2])) = TBool);
+
+  test "#92 Eq: identity == braid is accepted (the 'is it trivial?' shape)" (fun () ->
+    infer [] (BinOp (Eq, Identity, BraidLit [sigma 1])) = TBool);
+
+  test "#92 Eq: == and ~ now agree on what they accept" (fun () ->
+    (* They evaluate through the same Braid_equiv.equiv since TG-7; before #92
+       the typechecker accepted one and rejected the other. *)
+    let a = BraidLit [sigma 1] and b = BraidLit [sigma 2] in
+    infer [] (BinOp (Eq, a, b)) = infer [] (BinOp (Isotopy, a, b)));
+
+  test "#92 Eq: genuinely mismatched types are STILL rejected" (fun () ->
+    (* Widening must not become "anything compares to anything". *)
+    raises (fun () -> infer [] (BinOp (Eq, IntLit 1, BraidLit [sigma 1]))));
+
+  test "#92 match arms join on width instead of failing" (fun () ->
+    (* turing_complete.tangle's shape: arms at Word[0] and Word[2]. *)
+    let arms = [
+      { arm_pattern = PatIdentity;  arm_body = Identity };
+      { arm_pattern = PatWildcard;  arm_body = BraidLit [sigma 1] };
+    ] in
+    infer [] (Match (BraidLit [sigma 1], arms)) = TWord 2);
+
+  test "#92 match arms of genuinely different KINDS still fail" (fun () ->
+    let arms = [
+      { arm_pattern = PatIdentity;  arm_body = IntLit 1 };
+      { arm_pattern = PatWildcard;  arm_body = BraidLit [sigma 1] };
+    ] in
+    raises (fun () -> infer [] (Match (BraidLit [sigma 1], arms))))
 
 (* ================================================================== *)
 (*  Main: run all test groups                                          *)

compiler/test/tg3/tg3_emit.ml

@@ -357,11 +357,15 @@ let check () =
   pin "let shadowing inner"  (Let (x, IntLit 1, Let (x, BraidLit [s 2], BinOp (Compose, Var x, Var x))))
     (TWord 3);
   pin "nested pair fst.fst"  (Fst (Fst (Pair (Pair (IntLit 1, StringLit "a"), BoolLit true)))) TNum;
+  (* #92: widths need not agree, so this is now WELL-TYPED rather than
+     rejected. It is the `identity == braid` shape the Lean step relation has
+     always had rules for (eqIdBraid / eqBraidId). *)
+  pin "eq diff-width word"   (BinOp (Eq, BraidLit [s 1], Identity))            TBool;
 
   (* 3. Reject pins — these must raise Type_error. *)
   let rejects name e = ok name (infer_opt e = None) in
   rejects "add word+num"        (BinOp (Add, BraidLit [], IntLit 1));
-  rejects "eq diff-width word"  (BinOp (Eq, BraidLit [s 1], Identity));
+
   rejects "eq num vs str"       (BinOp (Eq, IntLit 1, StringLit "a"));
   rejects "lower non-echo"      (Lower (IntLit 1));
   rejects "fst non-prod"        (Fst (IntLit 1));

examples/trefoil.tangle

@@ -66,7 +66,15 @@ assert length(double_trefoil) == 6
 # --- Reverse ---
 
 def reversed = reverse(trefoil)
-assert reversed == braid[s1, s1, s1]
+
+# `reverse` reverses the word AND negates each exponent, so it yields the
+# INVERSE braid: reverse(s1 s1 s1) = s1^-1 s1^-1 s1^-1.
+#
+# This file previously asserted `reversed == braid[s1, s1, s1]`, which is false
+# — writhe(trefoil) = 3 but writhe(reversed) = -3, and writhe is invariant
+# under the braid relations, so they cannot be the same element. The assertion
+# had been wrong since it was written; nothing ran the examples until #89.
+assert reversed == braid[s1^-1, s1^-1, s1^-1]
 
 # --- Close to form a knot ---