aboutsummaryrefslogtreecommitdiffhomepage
path: root/tactics/hipattern.ml
diff options
context:
space:
mode:
authorGravatar Maxime Dénès <mail@maximedenes.fr>2018-01-22 09:45:12 +0100
committerGravatar Maxime Dénès <mail@maximedenes.fr>2018-01-22 09:45:12 +0100
commit35a275e22b72abba344b837e7276af8057d5da2c (patch)
treed04e278cfc4a018be1a22b902aeeb8992027c760 /tactics/hipattern.ml
parente0805eac59ee4c6c2eafae1d6b7f91530104f18f (diff)
parentd8652efca406c852ebc27cb27c903d9a6a4b2532 (diff)
Merge PR #6461: Let dtauto recognize '@sigT A (fun _ => B)' as a conjunction.
Diffstat (limited to 'tactics/hipattern.ml')
-rw-r--r--tactics/hipattern.ml11
1 files changed, 9 insertions, 2 deletions
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml
index 11ac16680..2bb9be66b 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml
@@ -88,6 +88,12 @@ let is_lax_conjunction = function
let prod_assum sigma t = fst (decompose_prod_assum sigma t)
+(* whd_beta normalize the types of arguments in a product *)
+let rec whd_beta_prod sigma c = match EConstr.kind sigma c with
+ | Prod (n,t,c) -> mkProd (n,Reductionops.whd_beta sigma t,whd_beta_prod sigma c)
+ | LetIn (n,d,t,c) -> mkLetIn (n,d,t,whd_beta_prod sigma c)
+ | _ -> c
+
let match_with_one_constructor sigma style onlybinary allow_rec t =
let (hdapp,args) = decompose_app sigma t in
let res = match EConstr.kind sigma hdapp with
@@ -111,8 +117,9 @@ let match_with_one_constructor sigma style onlybinary allow_rec t =
Some (hdapp,args)
else None
else
- let ctyp = Termops.prod_applist_assum sigma (Context.Rel.length mib.mind_params_ctxt)
- (EConstr.of_constr mip.mind_nf_lc.(0)) args in
+ let ctyp = whd_beta_prod sigma
+ (Termops.prod_applist_assum sigma (Context.Rel.length mib.mind_params_ctxt)
+ (EConstr.of_constr mip.mind_nf_lc.(0)) args) in
let cargs = List.map RelDecl.get_type (prod_assum sigma ctyp) in
if not (is_lax_conjunction style) || has_nodep_prod sigma ctyp then
(* Record or non strict conjunction *)