diff options
| -rw-r--r-- | bytecomp/matching.ml | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index b1eec7327..360568502 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -527,11 +527,15 @@ let for_multiple_match loc paraml pat_act_list = args = [Lprim(Pmakeblock(0, Immutable), paraml), Strict] } in let pm2 = simplify_matching pm1 in - let pm3 = - try + try + let idl = List.map (fun _ -> Ident.create "match") paraml in + let pm3 = { cases = flatten_cases (List.length paraml) pm2.cases; - args = List.map (fun lam -> (lam, Strict)) paraml } - with Cannot_flatten -> - pm2 in - let (lambda, total) = compile_match None pm3 in - if total then lambda else Lcatch(lambda, partial_function loc ()) + args = List.map (fun id -> (Lvar id, Alias)) idl } in + let (lambda, total) = compile_match None pm3 in + let lambda2 = + if total then lambda else Lcatch(lambda, partial_function loc ()) in + List.fold_right2 (bind Strict) idl paraml lambda2 + with Cannot_flatten -> + let (lambda, total) = compile_match None pm2 in + if total then lambda else Lcatch(lambda, partial_function loc ()) |