From 58d209fe36e37b6c0ee4acd702dac333388b1b88 Mon Sep 17 00:00:00 2001
From: Jasper Hugunin
Date: Sat, 6 Jan 2018 16:37:06 +0900
Subject: 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).
---
 engine/termops.ml  | 12 ++++++++++++
 engine/termops.mli |  7 +++++++
 2 files changed, 19 insertions(+)

(limited to 'engine')

diff --git a/engine/termops.ml b/engine/termops.ml
index a71bdff31e..40b3d0d8b6 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 c1600abe80..1f4c85054d 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
-- 
cgit v1.2.3


From 92bc1c642c2bf9001b86c71bb26f3e73011d02a7 Mon Sep 17 00:00:00 2001
From: Jasper Hugunin
Date: Wed, 10 Jan 2018 17:13:44 +0900
Subject: Add a test that `prod_applist_assum` reduces the right number of
 let-ins

---
 engine/termops.mli | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

(limited to 'engine')

diff --git a/engine/termops.mli b/engine/termops.mli
index 1f4c85054d..a3559a693b 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -165,7 +165,10 @@ 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. *)
+    the local definitions of [Γ] expanded.
+    Note that [n] counts both let-ins and prods, while the length of [args]
+    only counts prods. In other words, varying [n] changes how many
+    trailing let-ins are expanded. *)
 val prod_applist_assum : Evd.evar_map -> int -> constr -> constr list -> constr
 
 (** Remove recursively the casts around a term i.e.
-- 
cgit v1.2.3