PR#7031 Handle module variables in patterns.
parent
1fe21ec4c3
commit
e2309b424a
|
@ -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
|
||||
;;
|
||||
|
|
|
@ -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>
|
||||
#
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue