matching: more complete testsuite for do_for_multiple_match
Note: we now use -dlambda rather than -drawlambda, because otherwise the output is much more verbose and difficult to read. (-drawlambda is closed to the inner workings of the pattern-matching compiler, but the simplification in -dlambda make the output much more readable. They are also fairly predictable/non-surprising, so I think that we can still easily understand what the compiler did from that output.)master
parent
cc462e0f76
commit
31c2551c7c
|
@ -57,3 +57,196 @@ match (3, 2, 1) with
|
||||||
with (5 x/94) (seq (ignore x/94) 1)))
|
with (5 x/94) (seq (ignore x/94) 1)))
|
||||||
- : bool = false
|
- : bool = false
|
||||||
|}];;
|
|}];;
|
||||||
|
|
||||||
|
(* Regression test for #3780 *)
|
||||||
|
let _ = fun a b ->
|
||||||
|
match a, b with
|
||||||
|
| ((true, _) as _g)
|
||||||
|
| ((false, _) as _g) -> ()
|
||||||
|
[%%expect{|
|
||||||
|
(function a/105 b/106 (let (*match*/109 = a/105 *match*/110 = b/106) 0))
|
||||||
|
- : bool -> 'a -> unit = <fun>
|
||||||
|
|}];;
|
||||||
|
|
||||||
|
(* More complete tests.
|
||||||
|
|
||||||
|
The current strategy of the compiler is to determine whether
|
||||||
|
flattening of tuple patterns is possible during precompilation,
|
||||||
|
after the pattern has been half-simplified (toplevel alias
|
||||||
|
patterns are gone), during simplification (explosion of
|
||||||
|
or-patterns). Flattening fail if there is an alias pattern found
|
||||||
|
under an or-pattern during explosion.
|
||||||
|
|
||||||
|
The test cases below compare the compiler output on alias patterns
|
||||||
|
that are outside an or-pattern (handled during
|
||||||
|
half-simplification, then flattened) or inside an or-pattern
|
||||||
|
(handled during simplification, blocks flattening).
|
||||||
|
|
||||||
|
TL;DR:
|
||||||
|
- outside: flattening happens, good code generated
|
||||||
|
- inside: raises Cannot_flatten, worse code generated
|
||||||
|
*)
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| (true, _) as p -> p
|
||||||
|
| (false, _) as p -> p
|
||||||
|
(* outside, trivial *)
|
||||||
|
[%%expect {|
|
||||||
|
(function a/111 b/112
|
||||||
|
(let
|
||||||
|
(*match*/115 = a/111
|
||||||
|
*match*/116 = b/112
|
||||||
|
p/113 =a (makeblock 0 a/111 b/112))
|
||||||
|
p/113))
|
||||||
|
- : bool -> 'a -> bool * 'a = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| ((true, _) as p)
|
||||||
|
| ((false, _) as p) -> p
|
||||||
|
(* inside, trivial *)
|
||||||
|
[%%expect{|
|
||||||
|
(function a/117 b/118
|
||||||
|
(let (*match*/121 = (makeblock 0 a/117 b/118) p/119 =a *match*/121) p/119))
|
||||||
|
- : bool -> 'a -> bool * 'a = <fun>
|
||||||
|
|}];;
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| (true as x, _) as p -> x, p
|
||||||
|
| (false as x, _) as p -> x, p
|
||||||
|
(* outside, simple *)
|
||||||
|
[%%expect {|
|
||||||
|
(function a/125 b/126
|
||||||
|
(let
|
||||||
|
(*match*/131 = a/125
|
||||||
|
*match*/132 = b/126
|
||||||
|
x/127 =a *match*/131
|
||||||
|
p/128 =a (makeblock 0 a/125 b/126))
|
||||||
|
(makeblock 0 x/127 p/128)))
|
||||||
|
- : bool -> 'a -> bool * (bool * 'a) = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| ((true as x, _) as p)
|
||||||
|
| ((false as x, _) as p) -> x, p
|
||||||
|
(* inside, simple *)
|
||||||
|
[%%expect {|
|
||||||
|
(function a/133 b/134
|
||||||
|
(let
|
||||||
|
(*match*/140 = (makeblock 0 a/133 b/134)
|
||||||
|
x/135 =a (field 0 *match*/140)
|
||||||
|
p/136 =a *match*/140)
|
||||||
|
(makeblock 0 x/135 p/136)))
|
||||||
|
- : bool -> 'a -> bool * (bool * 'a) = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| (true as x, _) as p -> x, p
|
||||||
|
| (false, x) as p -> x, p
|
||||||
|
(* outside, complex *)
|
||||||
|
[%%expect{|
|
||||||
|
(function a/145 b/146
|
||||||
|
(let (*match*/151 = a/145 *match*/152 = b/146)
|
||||||
|
(if *match*/151
|
||||||
|
(let (x/147 =a *match*/151 p/148 =a (makeblock 0 a/145 b/146))
|
||||||
|
(makeblock 0 x/147 p/148))
|
||||||
|
(let (x/149 =a *match*/152 p/150 =a (makeblock 0 a/145 b/146))
|
||||||
|
(makeblock 0 x/149 p/150)))))
|
||||||
|
- : bool -> bool -> bool * (bool * bool) = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| ((true as x, _) as p)
|
||||||
|
| ((false, x) as p)
|
||||||
|
-> x, p
|
||||||
|
(* inside, complex *)
|
||||||
|
[%%expect{|
|
||||||
|
(function a/153 b/154
|
||||||
|
(let (*match*/160 = (makeblock 0 a/153 b/154))
|
||||||
|
(catch
|
||||||
|
(let (x/162 =a (field 0 *match*/160))
|
||||||
|
(if x/162
|
||||||
|
(let (*match*/163 =a (field 1 *match*/160))
|
||||||
|
(exit 14 x/162 *match*/160))
|
||||||
|
(let (x/161 =a (field 1 *match*/160)) (exit 14 x/161 *match*/160))))
|
||||||
|
with (14 x/155 p/156) (makeblock 0 x/155 p/156))))
|
||||||
|
- : bool -> bool -> bool * (bool * bool) = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* here flattening is an optimisation,
|
||||||
|
as we avoid allocating the tuple in the first case,
|
||||||
|
and only allocate in the second case *)
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| (true as x, _) as _p -> x, (true, true)
|
||||||
|
| (false as x, _) as p -> x, p
|
||||||
|
(* outside, onecase *)
|
||||||
|
[%%expect {|
|
||||||
|
(function a/164 b/165
|
||||||
|
(let (*match*/170 = a/164 *match*/171 = b/165)
|
||||||
|
(if *match*/170
|
||||||
|
(let (x/166 =a *match*/170 _p/167 =a (makeblock 0 a/164 b/165))
|
||||||
|
(makeblock 0 x/166 [0: 1 1]))
|
||||||
|
(let (x/168 =a *match*/170 p/169 =a (makeblock 0 a/164 b/165))
|
||||||
|
(makeblock 0 x/168 p/169)))))
|
||||||
|
- : bool -> bool -> bool * (bool * bool) = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| ((true as x, _) as p)
|
||||||
|
| ((false as x, _) as p) -> x, p
|
||||||
|
(* inside, onecase *)
|
||||||
|
[%%expect{|
|
||||||
|
(function a/172 b/173
|
||||||
|
(let
|
||||||
|
(*match*/179 = (makeblock 0 a/172 b/173)
|
||||||
|
x/174 =a (field 0 *match*/179)
|
||||||
|
p/175 =a *match*/179)
|
||||||
|
(makeblock 0 x/174 p/175)))
|
||||||
|
- : bool -> 'a -> bool * (bool * 'a) = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
type 'a tuplist = Nil | Cons of ('a * 'a tuplist)
|
||||||
|
[%%expect{|
|
||||||
|
0
|
||||||
|
type 'a tuplist = Nil | Cons of ('a * 'a tuplist)
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* another example where we avoid an allocation in the first case *)
|
||||||
|
let _ =fun a b -> match a, b with
|
||||||
|
| (true, Cons p) -> p
|
||||||
|
| (_, _) as p -> p
|
||||||
|
(* outside, tuplist *)
|
||||||
|
[%%expect {|
|
||||||
|
(function a/187 b/188
|
||||||
|
(let (*match*/191 = a/187 *match*/192 = b/188)
|
||||||
|
(catch
|
||||||
|
(if *match*/191
|
||||||
|
(if *match*/192 (let (p/189 =a (field 0 *match*/192)) p/189)
|
||||||
|
(exit 17))
|
||||||
|
(exit 17))
|
||||||
|
with (17) (let (p/190 =a (makeblock 0 a/187 b/188)) p/190))))
|
||||||
|
- : bool -> bool tuplist -> bool * bool tuplist = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* if we cannot flatten, we generate worse code *)
|
||||||
|
let _ = fun a b -> match a, b with
|
||||||
|
| (true, Cons p)
|
||||||
|
| ((_, _) as p) -> p
|
||||||
|
(* inside, tuplist *)
|
||||||
|
[%%expect{|
|
||||||
|
(function a/193 b/194
|
||||||
|
(let (*match*/197 = (makeblock 0 a/193 b/194))
|
||||||
|
(catch
|
||||||
|
(let (*match*/199 =a (field 0 *match*/197))
|
||||||
|
(catch
|
||||||
|
(if *match*/199
|
||||||
|
(let (*match*/200 =a (field 1 *match*/197))
|
||||||
|
(if *match*/200
|
||||||
|
(let (p/198 =a (field 0 *match*/200)) (exit 19 p/198))
|
||||||
|
(exit 20)))
|
||||||
|
(exit 20))
|
||||||
|
with (20)
|
||||||
|
(let (*match*/201 =a (field 1 *match*/197)) (exit 19 *match*/197))))
|
||||||
|
with (19 p/195) p/195)))
|
||||||
|
- : bool -> bool tuplist -> bool * bool tuplist = <fun>
|
||||||
|
|}]
|
||||||
|
|
Loading…
Reference in New Issue