matching: avoid useless bindings in do_for_multiple_match

lambda/matching.ml

@@ -3738,8 +3738,10 @@ let do_for_multiple_match ~scopes loc paraml pat_act_list partial =
   try
     let next, nexts = split_and_precompile ~arg 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
+    and idl = List.map (function
+      | Lvar id -> false, id
+      | _ -> true, 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
@@ -3748,7 +3750,11 @@ let do_for_multiple_match ~scopes loc paraml pat_act_list partial =
       comp_match_handlers (compile_flattened ~scopes repr) partial
         (Context.start size) flat_next flat_nexts
     in
-    List.fold_right2 (bind Strict) idl paraml
+    List.fold_right2
+      (fun (fresh, v) lam body ->
+         if not fresh then body
+         else bind Strict v lam body)
+      idl paraml
       ( match partial with
       | Partial ->
           check_total total lam raise_num (partial_function ~scopes loc)

testsuite/tests/basic/patmatch_for_multiple.ml

@@ -9,17 +9,11 @@ match (3, 2, 1) with
 | _ -> false
 ;;
 [%%expect{|
-(let
-  (*match*/88 = 3
-   *match*/89 = 2
-   *match*/90 = 1
-   *match*/91 = *match*/88
-   *match*/92 = *match*/89
-   *match*/93 = *match*/90)
+(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1)
   (catch
     (catch
-      (catch (if (!= *match*/92 3) (exit 3) (exit 1)) with (3)
-        (if (!= *match*/91 1) (exit 2) (exit 1)))
+      (catch (if (!= *match*/89 3) (exit 3) (exit 1)) with (3)
+        (if (!= *match*/88 1) (exit 2) (exit 1)))
      with (2) 0)
    with (1) 1))
 - : bool = false
@@ -33,25 +27,19 @@ match (3, 2, 1) with
 | _ -> false
 ;;
 [%%expect{|
-(let
-  (*match*/96 = 3
-   *match*/97 = 2
-   *match*/98 = 1
-   *match*/103 = *match*/96
-   *match*/104 = *match*/97
-   *match*/105 = *match*/98)
+(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1)
   (catch
     (catch
       (catch
-        (if (!= *match*/104 3) (exit 6)
-          (let (x/102 =a (makeblock 0 *match*/96 *match*/97 *match*/98))
-            (exit 4 x/102)))
+        (if (!= *match*/94 3) (exit 6)
+          (let (x/99 =a (makeblock 0 *match*/93 *match*/94 *match*/95))
+            (exit 4 x/99)))
        with (6)
-        (if (!= *match*/103 1) (exit 5)
-          (let (x/100 =a (makeblock 0 *match*/96 *match*/97 *match*/98))
-            (exit 4 x/100))))
+        (if (!= *match*/93 1) (exit 5)
+          (let (x/97 =a (makeblock 0 *match*/93 *match*/94 *match*/95))
+            (exit 4 x/97))))
      with (5) 0)
-   with (4 x/94) (seq (ignore x/94) 1)))
+   with (4 x/91) (seq (ignore x/91) 1)))
 - : bool = false
 |}];;
 
@@ -61,7 +49,7 @@ let _ = fun a b ->
   | ((true, _) as _g)
   | ((false, _) as _g) -> ()
 [%%expect{|
-(function a/106 b/107 (let (*match*/110 = a/106 *match*/111 = b/107) 0))
+(function a/100 b/101 0)
 - : bool -> 'a -> unit = <fun>
 |}];;
 
@@ -80,12 +68,7 @@ let _ = fun a b -> match a, b with
 | (false, _) as p -> p
 (* outside, trivial *)
 [%%expect {|
-(function a/112 b/113
-  (let
-    (*match*/116 = a/112
-     *match*/117 = b/113
-     p/114 =a (makeblock 0 a/112 b/113))
-    p/114))
+(function a/104 b/105 (let (p/106 =a (makeblock 0 a/104 b/105)) p/106))
 - : bool -> 'a -> bool * 'a = <fun>
 |}]
 
@@ -94,12 +77,7 @@ let _ = fun a b -> match a, b with
 | ((false, _) as p) -> p
 (* inside, trivial *)
 [%%expect{|
-(function a/118 b/119
-  (let
-    (*match*/126 = a/118
-     *match*/127 = b/119
-     p/120 =a (makeblock 0 a/118 b/119))
-    p/120))
+(function a/108 b/109 (let (p/110 =a (makeblock 0 a/108 b/109)) p/110))
 - : bool -> 'a -> bool * 'a = <fun>
 |}];;
 
@@ -108,13 +86,9 @@ let _ = fun a b -> match a, b with
 | (false as x, _) as p -> x, p
 (* outside, simple *)
 [%%expect {|
-(function a/128 b/129
-  (let
-    (*match*/134 = a/128
-     *match*/135 = b/129
-     x/130 =a *match*/134
-     p/131 =a (makeblock 0 a/128 b/129))
-    (makeblock 0 x/130 p/131)))
+(function a/116 b/117
+  (let (x/118 =a a/116 p/119 =a (makeblock 0 a/116 b/117))
+    (makeblock 0 x/118 p/119)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -123,13 +97,9 @@ let _ = fun a b -> match a, b with
 | ((false as x, _) as p) -> x, p
 (* inside, simple *)
 [%%expect {|
-(function a/136 b/137
-  (let
-    (*match*/148 = a/136
-     *match*/149 = b/137
-     x/138 =a *match*/148
-     p/139 =a (makeblock 0 a/136 b/137))
-    (makeblock 0 x/138 p/139)))
+(function a/122 b/123
+  (let (x/124 =a a/122 p/125 =a (makeblock 0 a/122 b/123))
+    (makeblock 0 x/124 p/125)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -138,13 +108,12 @@ let _ = fun a b -> match a, b with
 | (false, x) as p -> x, p
 (* outside, complex *)
 [%%expect{|
-(function a/150 b/151
-  (let (*match*/156 = a/150 *match*/157 = b/151)
-    (if *match*/156
-      (let (x/152 =a *match*/156 p/153 =a (makeblock 0 a/150 b/151))
-        (makeblock 0 x/152 p/153))
-      (let (x/154 =a *match*/157 p/155 =a (makeblock 0 a/150 b/151))
-        (makeblock 0 x/154 p/155)))))
+(function a/134 b/135
+  (if a/134
+    (let (x/136 =a a/134 p/137 =a (makeblock 0 a/134 b/135))
+      (makeblock 0 x/136 p/137))
+    (let (x/138 =a b/135 p/139 =a (makeblock 0 a/134 b/135))
+      (makeblock 0 x/138 p/139))))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -154,15 +123,14 @@ let _ = fun a b -> match a, b with
   -> x, p
 (* inside, complex *)
 [%%expect{|
-(function a/158 b/159
-  (let (*match*/170 = a/158 *match*/171 = b/159)
-    (catch
-      (if *match*/170
-        (let (x/167 =a *match*/170 p/169 =a (makeblock 0 a/158 b/159))
-          (exit 10 x/167 p/169))
-        (let (x/164 =a *match*/171 p/166 =a (makeblock 0 a/158 b/159))
-          (exit 10 x/164 p/166)))
-     with (10 x/160 p/161) (makeblock 0 x/160 p/161))))
+(function a/140 b/141
+  (catch
+    (if a/140
+      (let (x/149 =a a/140 p/151 =a (makeblock 0 a/140 b/141))
+        (exit 10 x/149 p/151))
+      (let (x/146 =a b/141 p/148 =a (makeblock 0 a/140 b/141))
+        (exit 10 x/146 p/148)))
+   with (10 x/142 p/143) (makeblock 0 x/142 p/143)))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -174,13 +142,12 @@ let _ = fun a b -> match a, b with
 | (false as x, _) as p -> x, p
 (* outside, onecase *)
 [%%expect {|
-(function a/172 b/173
-  (let (*match*/178 = a/172 *match*/179 = b/173)
-    (if *match*/178
-      (let (x/174 =a *match*/178 _p/175 =a (makeblock 0 a/172 b/173))
-        (makeblock 0 x/174 [0: 1 1]))
-      (let (x/176 =a *match*/178 p/177 =a (makeblock 0 a/172 b/173))
-        (makeblock 0 x/176 p/177)))))
+(function a/152 b/153
+  (if a/152
+    (let (x/154 =a a/152 _p/155 =a (makeblock 0 a/152 b/153))
+      (makeblock 0 x/154 [0: 1 1]))
+    (let (x/156 =a a/152 p/157 =a (makeblock 0 a/152 b/153))
+      (makeblock 0 x/156 p/157))))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -189,13 +156,9 @@ let _ = fun a b -> match a, b with
 | ((false as x, _) as p) -> x, p
 (* inside, onecase *)
 [%%expect{|
-(function a/180 b/181
-  (let
-    (*match*/192 = a/180
-     *match*/193 = b/181
-     x/182 =a *match*/192
-     p/183 =a (makeblock 0 a/180 b/181))
-    (makeblock 0 x/182 p/183)))
+(function a/158 b/159
+  (let (x/160 =a a/158 p/161 =a (makeblock 0 a/158 b/159))
+    (makeblock 0 x/160 p/161)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -211,14 +174,11 @@ let _ =fun a b -> match a, b with
 | (_, _) as p -> p
 (* outside, tuplist *)
 [%%expect {|
-(function a/197 b/198
-  (let (*match*/201 = a/197 *match*/202 = b/198)
-    (catch
-      (if *match*/201
-        (if *match*/202 (let (p/199 =a (field 0 *match*/202)) p/199)
-          (exit 12))
-        (exit 12))
-     with (12) (let (p/200 =a (makeblock 0 a/197 b/198)) p/200))))
+(function a/173 b/174
+  (catch
+    (if a/173 (if b/174 (let (p/175 =a (field 0 b/174)) p/175) (exit 12))
+      (exit 12))
+   with (12) (let (p/176 =a (makeblock 0 a/173 b/174)) p/176)))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
 |}]
 
@@ -227,15 +187,13 @@ let _ = fun a b -> match a, b with
 | ((_, _) as p) -> p
 (* inside, tuplist *)
 [%%expect{|
-(function a/203 b/204
-  (let (*match*/210 = a/203 *match*/211 = b/204)
+(function a/177 b/178
+  (catch
     (catch
-      (catch
-        (if *match*/210
-          (if *match*/211
-            (let (p/209 =a (field 0 *match*/211)) (exit 13 p/209)) (exit 14))
-          (exit 14))
-       with (14) (let (p/208 =a (makeblock 0 a/203 b/204)) (exit 13 p/208)))
-     with (13 p/205) p/205)))
+      (if a/177
+        (if b/178 (let (p/183 =a (field 0 b/178)) (exit 13 p/183)) (exit 14))
+        (exit 14))
+     with (14) (let (p/182 =a (makeblock 0 a/177 b/178)) (exit 13 p/182)))
+   with (13 p/179) p/179))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
 |}]