aboutsummaryrefslogtreecommitdiffhomepage
path: root/engine
diff options
context:
space:
mode:
authorGravatar Jasper Hugunin <jasperh@cs.washington.edu>2018-01-06 16:37:06 +0900
committerGravatar Jasper Hugunin <jasperh@cs.washington.edu>2018-01-17 14:54:14 +0900
commit58d209fe36e37b6c0ee4acd702dac333388b1b88 (patch)
tree856dcf2dc6b5e9ca2eb083c7640c07ae04308be8 /engine
parent8ea2a8307a8d96f8275ebbd9bd4cbd1f6b0a00c6 (diff)
Use let-in aware prod_applist_assum in dtauto and firstorder.
Fixes #6490. `prod_applist_assum` is copied from `kernel/term.ml` to `engine/termops.ml`, and adjusted to work with econstr. This change uncovered a bug in `Hipattern.match_with_nodep_ind`, where `has_nodep_prod_after` counts both products and let-ins, but was only being passed `mib.mind_nparams`, which does not count let-ins. Replaced with (Context.Rel.length mib.mind_params_ctxt).
Diffstat (limited to 'engine')
-rw-r--r--engine/termops.ml12
-rw-r--r--engine/termops.mli7
2 files changed, 19 insertions, 0 deletions
diff --git a/engine/termops.ml b/engine/termops.ml
index a71bdff31..40b3d0d8b 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1463,6 +1463,18 @@ let prod_applist sigma c l =
| _ -> anomaly (Pp.str "Not enough prod's.") in
app [] c l
+let prod_applist_assum sigma n c l =
+ let open EConstr in
+ let rec app n subst c l =
+ if Int.equal n 0 then
+ if l == [] then Vars.substl subst c
+ else anomaly (Pp.str "Not enough arguments.")
+ else match EConstr.kind sigma c, l with
+ | Prod(_,_,c), arg::l -> app (n-1) (arg::subst) c l
+ | LetIn(_,b,_,c), _ -> app (n-1) (Vars.substl subst b::subst) c l
+ | _ -> anomaly (Pp.str "Not enough prod/let's.") in
+ app n [] c l
+
(* Combinators on judgments *)
let on_judgment f j = { uj_val = f j.uj_val; uj_type = f j.uj_type }
diff --git a/engine/termops.mli b/engine/termops.mli
index c1600abe8..1f4c85054 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -159,8 +159,15 @@ val eta_reduce_head : Evd.evar_map -> constr -> constr
(** Flattens application lists *)
val collapse_appl : Evd.evar_map -> constr -> constr
+(** [prod_applist] [forall (x1:B1;...;xn:Bn), B] [a1...an] @return [B[a1...an]] *)
val prod_applist : Evd.evar_map -> constr -> constr list -> constr
+(** In [prod_applist_assum n c args], [c] is supposed to have the
+ form [∀Γ.c] with [Γ] of length [m] and possibly with let-ins; it
+ returns [c] with the assumptions of [Γ] instantiated by [args] and
+ the local definitions of [Γ] expanded. *)
+val prod_applist_assum : Evd.evar_map -> int -> constr -> constr list -> constr
+
(** Remove recursively the casts around a term i.e.
[strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *)
val strip_outer_cast : Evd.evar_map -> constr -> constr