Fix compiler crash on unreachable guarded or-patterns

changes/unreachable-guarded-or-pattern.fix.md

@@ -0,0 +1 @@
+- Fix a compiler crash ("Fatal error: Matching.comp_exit") on a guarded or-pattern that an earlier case makes unreachable.

compiler/ml/matching.ml

@@ -2484,13 +2484,31 @@ let as_exit_call lam =
   in
   go Ident.empty lam
 
+(* Adds the static exits [lam] jumps to to [raised]. Exits cannot leave a
+   function, so function bodies are skipped. *)
+let rec add_raised_exits raised lam =
+  match lam with
+  | Lfunction _ -> ()
+  | Lstaticraise (i, _) ->
+    Hashtbl.replace raised i ();
+    Lambda_traverse.iter (add_raised_exits raised) lam
+  | _ -> Lambda_traverse.iter (add_raised_exits raised) lam
+
 let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
+  (* The exits of the match and of the handlers compiled so far *)
+  let raised = Hashtbl.create 16 in
+  add_raised_exits raised lambda1;
   let rec do_rec r total_r = function
     | [] -> (r, total_r)
+    | (_, i, _, _) :: rem when not (Hashtbl.mem raised i) ->
+      (* The or-pattern is unreachable, e.g. after a wildcard. Its handler is
+         not compiled: with a guard and no default, its failure has no exit. *)
+      do_rec r total_r rem
     | (mat, i, vars, pm) :: rem -> (
       try
         let ctx = select_columns mat ctx in
         let handler_i, total_i = compile_fun ctx pm in
+        add_raised_exits raised handler_i;
         match as_exit_call r with
         | Some (j, args) ->
           if i = j then

tests/build_tests/super_errors/expected/warning_11_unreachable_guarded_or_pattern.res.expected

@@ -0,0 +1,47 @@
+
+  Warning number 11
+  /.../fixtures/warning_11_unreachable_guarded_or_pattern.res:9:5-9
+
+   7 ┆ switch x {
+   8 ┆ | _ => 2
+   9 ┆ | 1 | 2 if g() => 3
+  10 ┆ }
+  11 ┆ 
+
+  this match case is unused.
+
+
+  Warning number 11
+  /.../fixtures/warning_11_unreachable_guarded_or_pattern.res:15:5-13
+
+  13 ┆ switch c {
+  14 ┆ | _ => "any"
+  15 ┆ | 'a' | 'b' if g() => "ab"
+  16 ┆ }
+  17 ┆ 
+
+  this match case is unused.
+
+
+  Warning number 11
+  /.../fixtures/warning_11_unreachable_guarded_or_pattern.res:21:5-13
+
+  19 ┆ switch s {
+  20 ┆ | _ => "any"
+  21 ┆ | "a" | "b" if g() => "ab"
+  22 ┆ }
+  23 ┆ 
+
+  this match case is unused.
+
+
+  Warning number 11
+  /.../fixtures/warning_11_unreachable_guarded_or_pattern.res:28:5-19
+
+  26 ┆ | (0, _) => "zero"
+  27 ┆ | (_, _) => "other"
+  28 ┆ | (1, 1) | (2, 2) if g() => "same"
+  29 ┆ }
+  30 ┆ 
+
+  this match case is unused.

tests/build_tests/super_errors/fixtures/warning_11_unreachable_guarded_or_pattern.res

@@ -0,0 +1,29 @@
+// Each guarded or-pattern is unreachable after a case that matches
+// everything. Compiling them used to fail with
+// "Fatal error: Matching.comp_exit" instead of reporting them as unused.
+let g = () => true
+
+let int = x =>
+  switch x {
+  | _ => 2
+  | 1 | 2 if g() => 3
+  }
+
+let char = c =>
+  switch c {
+  | _ => "any"
+  | 'a' | 'b' if g() => "ab"
+  }
+
+let string = s =>
+  switch s {
+  | _ => "any"
+  | "a" | "b" if g() => "ab"
+  }
+
+let pair = p =>
+  switch p {
+  | (0, _) => "zero"
+  | (_, _) => "other"
+  | (1, 1) | (2, 2) if g() => "same"
+  }