PR#7031 Handle module variables in patterns.

master
Luc Maranget 2015-12-10 16:27:28 +01:00
parent 1fe21ec4c3
commit e2309b424a
3 changed files with 73 additions and 13 deletions

View File

@ -166,12 +166,27 @@ let not_ambiguous__constructor = function
;;
type tt = Z of int | Y of int * int | X of tt * tt
type amoi = Z of int | Y of int * int | X of amoi * amoi
;;
let ambiguous a = match a with
let ambiguous__amoi a = match a with
| X (Z x,Y (y,0))
| X (Z y,Y (x,_))
when x+y > 0 -> 0
| X _|Y _|Z _ -> 1
;;
module type S = sig val b : bool end
;;
let ambiguous__module_variable x b = match x with
| (module M:S),_,(1,_)
| _,(module M:S),(_,1) when M.b && b -> 1
| _ -> 2
;;
let not_ambiguous__module_variable x b = match x with
| (module M:S),_,(1,_)
| _,(module M:S),(_,1) when b -> 1
| _ -> 2
;;

View File

@ -93,10 +93,19 @@ val ambiguous__second_orpat :
# val not_ambiguous__lazy : ('a list * 'b list) * bool lazy_t -> unit = <fun>
# type t = A of int * int option * int option | B
# val not_ambiguous__constructor : t -> unit = <fun>
# type tt = Z of int | Y of int * int | X of tt * tt
# Characters 34-67:
# type amoi = Z of int | Y of int * int | X of amoi * amoi
# Characters 40-73:
..X (Z x,Y (y,0))
| X (Z y,Y (x,_))
Warning 57: Ambiguous guarded pattern, variables x,y may match different or-pattern arguments
val ambiguous : tt -> int = <fun>
val ambiguous__amoi : amoi -> int = <fun>
# module type S = sig val b : bool end
# Characters 56-101:
....(module M:S),_,(1,_)
| _,(module M:S),(_,1)...................
Warning 57: Ambiguous guarded pattern, variable M may match different or-pattern arguments
val ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
# val not_ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
#

View File

@ -2165,20 +2165,56 @@ let rec do_stable rs = match rs with
let stable p = do_stable [{unseen=[p]; seen=[];}]
(* all identifier paths that appear in an expression.
(* All identifier paths that appear in an expression that occurs
as a clause right hand side or guard.
This could be in a more general place, but for the ambiguous guards
seem to be the only user. At the same time, it cannot go in
typedtree.mli, as it depends on TypedtreeIter.
The function is rather complex due to the compilation of
unpack patterns by introducing code in rhs expressions
and **guards**.
For pattern (module M:S) -> e the code is
let module M_mod = unpack M .. in e
Hence M is "free" in e iff M_mod is free in e.
Not doing so will yield excessive warning in
(module (M:S) } ...) when true -> ....
as M is always present in
let module M_mod = unpack M .. in true
*)
let all_exp_idents exp =
let all_rhs_idents exp =
let ids = ref IdSet.empty in
let module Iterator = TypedtreeIter.MakeIterator(struct
include TypedtreeIter.DefaultIteratorArgument
let enter_expression exp = match exp.exp_desc with
| Texp_ident (Path.Pident id, _lid, _descr) ->
ids := IdSet.add id !ids
| Texp_ident (path, _lid, _descr) ->
List.iter
(fun id -> ids := IdSet.add id !ids)
(Path.heads path)
| _ -> ()
(* Very hackish, detect unpack pattern compilation
and perfom "indirect check for them" *)
let is_unpack exp =
List.exists
(fun (attr, _) -> attr.txt = "#modulepat") exp.exp_attributes
let leave_expression exp =
if is_unpack exp then begin match exp.exp_desc with
| Texp_letmodule
(id_mod,_,
{mod_desc=
Tmod_unpack ({exp_desc=Texp_ident (Path.Pident id_exp,_,_)},_)},
_) ->
assert (IdSet.mem id_exp !ids) ;
if not (IdSet.mem id_mod !ids) then begin
ids := IdSet.remove id_exp !ids
end
| _ -> assert false
end
end) in
Iterator.iter_expression exp;
!ids
@ -2193,7 +2229,7 @@ let check_ambiguous_bindings =
| { c_guard=None ; _} -> ()
| { c_lhs=p; c_guard=Some g; _} ->
let all =
IdSet.inter (pattern_vars p) (all_exp_idents g) in
IdSet.inter (pattern_vars p) (all_rhs_idents g) in
if not (IdSet.is_empty all) then begin
let st = stable p in
let ambiguous = IdSet.diff all st in