diff options
| author |  Jasper Hugunin <jasperh@cs.washington.edu> | 2017-12-18 21:51:25 +0900 |
|---|---|---|
| committer | Jasper Hugunin <jasperh@cs.washington.edu> | 2018-01-17 14:59:11 +0900 |
| commit | 2d8dcd741d229c4de57ccce9f3ab09b808ccfc94 (patch) | |
| tree | 1f1b510add53ed24ffd403a6f1e03f1095dfad5f | |
| parent | 8ea2a8307a8d96f8275ebbd9bd4cbd1f6b0a00c6 (diff) | |
Let dtauto recognize '@sigT A (fun _ => B)' as a conjunction
| -rw-r--r-- | tactics/hipattern.ml | 9 | ||||
| -rw-r--r-- | test-suite/bugs/opened/6393.v | 11 |
2 files changed, 19 insertions, 1 deletions
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml index a3a3e0a9e..28424c38e 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,7 +117,8 @@ let match_with_one_constructor sigma style onlybinary allow_rec t = Some (hdapp,args) else None else - let ctyp = Termops.prod_applist sigma (EConstr.of_constr mip.mind_nf_lc.(0)) args in + let ctyp = whd_beta_prod sigma + (Termops.prod_applist sigma (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 *) diff --git a/test-suite/bugs/opened/6393.v b/test-suite/bugs/opened/6393.v new file mode 100644 index 000000000..8d5d09233 --- /dev/null +++ b/test-suite/bugs/opened/6393.v @@ -0,0 +1,11 @@ +(* These always worked. *) +Goal prod True True. firstorder. Qed. +Goal True -> @sigT True (fun _ => True). firstorder. Qed. +Goal prod True True. dtauto. Qed. +Goal prod True True. tauto. Qed. + +(* These should work. *) +Goal @sigT True (fun _ => True). dtauto. Qed. +(* These should work, but don't *) +(* Goal @sigT True (fun _ => True). firstorder. Qed. *) +(* Goal @sigT True (fun _ => True). tauto. Qed. *) |