fixed bug in gadt exhaustiveness check

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10729 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Le Normand 2010-10-20 04:24:09 +00:00
parent 71b84693af
commit 3f6f377cc0
2 changed files with 7 additions and 4 deletions

View File

@ -1047,12 +1047,12 @@ let rec pressure_variants tdefs = function
try_non_omega rem && ok
| [] -> true
in
if full_match false (tdefs=None) constrs then (* GAH : ask garrigue about this, should we ignore generalized constructors?*)
if full_match true (tdefs=None) constrs then (* GAH : ask garrigue about this, should we ignore generalized constructors?*)
try_non_omega constrs
else if tdefs = None then
pressure_variants None (filter_extra pss)
else
let full = full_match false true constrs in
let full = full_match true true constrs in
let ok =
if full then try_non_omega constrs
else try_non_omega (filter_all q0 (mark_partial pss))
@ -1786,6 +1786,9 @@ let generate_all (env:Env.t) : pattern -> pattern list =
match args with
| [] ->
Some (make_pat (Ppat_construct (lid,None,false)),ty_res)
| [x] ->
let arg = make_pat Ppat_any in
Some (make_pat (Ppat_construct (lid,Some arg,false)),ty_res)
| _ ->
let arg = make_pat (Ppat_tuple (List.map (fun _ -> make_pat Ppat_any) args)) in
(* GAH: what is the third argument of Ppat_construct? In parser.mly it is always false *)
@ -1912,7 +1915,6 @@ let generate_all (env:Env.t) : pattern -> pattern list =
in
loop typed_ps
in
let filter p =
match pred p with
| None -> None

View File

@ -659,7 +659,7 @@ let type_pat env sp expected_ty =
backtrack snap;
Some typed_p
with
_ ->
| _ ->
backtrack snap;
None end
in
@ -2351,6 +2351,7 @@ and type_cases ?in_function env ty_arg ty_res partial_loc caselist =
| Total ->
check_partial_gadt partial_loc env ty_arg (List.map fst caselist) (List.map fst cases)
in*)
let check_partial loc cases =
Parmatch.check_partial_gadt env (partial_pred env ty_arg) loc cases (List.map fst caselist)
in