matching: try => match with exceptionflatten-pattern

This makes it clearer where the exception comes from.

1 files changed, 30 insertions, 27 deletions

diff --git a/lambda/matching.ml b/lambda/matching.ml
index e2a2891908..b409df4247 100644
--- a/lambda/matching.ml
+++ b/lambda/matching.ml
@@ -3601,35 +3601,38 @@ let do_for_multiple_match loc paraml pat_act_list partial =
       } )
   in
   try
-    try
-      (* Once for checking that compilation is possible *)
-      let next, nexts = split_and_precompile ~arg_id:None pm1 in
-      let size = List.length paraml
-      and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
-      let args = List.map (fun id -> (Lvar id, Alias)) idl in
-      let flat_next = flatten_precompiled size args next
-      and flat_nexts =
-        List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
-      in
-      let lam, total =
-        comp_match_handlers (compile_flattened repr) partial
-          (Context.start size) flat_next flat_nexts
-      in
-      List.fold_right2 (bind Strict) idl paraml
-        ( match partial with
-        | Partial -> check_total total lam raise_num (partial_function loc)
+    match split_and_precompile ~arg_id:None pm1 with
+    | exception Cannot_flatten -> (
+        (* One pattern binds the whole tuple, flattening is not possible.
+           We need to allocate the scrutinee. *)
+        let lambda, total = compile_match None partial (Context.start 1) pm1 in
+        match partial with
+        | Partial -> check_total total lambda raise_num (partial_function loc)
         | Total ->
             assert (Jumps.is_empty total);
-            lam
-        )
-    with Cannot_flatten -> (
-      let lambda, total = compile_match None partial (Context.start 1) pm1 in
-      match partial with
-      | Partial -> check_total total lambda raise_num (partial_function loc)
-      | Total ->
-          assert (Jumps.is_empty total);
-          lambda
-    )
+            lambda
+      )
+    | next, nexts -> (
+        let size = List.length paraml
+        and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
+        let args = List.map (fun id -> (Lvar id, Alias)) idl in
+        (* This will not raise, since the PM is well typed. *)
+        let flat_next = flatten_precompiled size args next
+        and flat_nexts =
+          List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
+        in
+        let lam, total =
+          comp_match_handlers (compile_flattened repr) partial
+            (Context.start size) flat_next flat_nexts
+        in
+        List.fold_right2 (bind Strict) idl paraml
+          ( match partial with
+            | Partial -> check_total total lam raise_num (partial_function loc)
+            | Total ->
+                assert (Jumps.is_empty total);
+                lam
+          )
+      )
   with Unused -> assert false
 
 (* ; partial_function loc () *)