From 67091e1d155be19333c5e5bd2cc306792ca630d3 Mon Sep 17 00:00:00 2001
From: Emilio Jesus Gallego Arias
Date: Sat, 3 Mar 2018 01:38:19 +0100
Subject: [compat] Remove "Refolding Reduction" option.

Following up on #6791, we remove support refolding in reduction.

We also update a test case that was not properly understood, see the
discussion in #6895.
---
 doc/refman/RefMan-tac.tex       | 11 -----------
 pretyping/reductionops.ml       | 17 ++---------------
 pretyping/reductionops.mli      |  5 -----
 test-suite/bugs/closed/3424.v   | 24 ------------------------
 test-suite/bugs/opened/3424.v   | 24 ++++++++++++++++++++++++
 test-suite/output/inference.out |  2 --
 test-suite/output/inference.v   |  6 ------
 7 files changed, 26 insertions(+), 63 deletions(-)
 delete mode 100644 test-suite/bugs/closed/3424.v
 create mode 100644 test-suite/bugs/opened/3424.v

diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex
index 40ba43b6cd..2597e3c37d 100644
--- a/doc/refman/RefMan-tac.tex
+++ b/doc/refman/RefMan-tac.tex
@@ -3504,17 +3504,6 @@ reduced to \texttt{S t}.
 
 \end{Variants}
 
-\begin{quote}
-\optindex{Refolding Reduction}
-{\tt Refolding Reduction}
-\end{quote}
-\emph{Deprecated since 8.7}
-
-This option (off by default) controls the use of the refolding strategy
-of {\tt cbn} while doing reductions in unification, type inference and
-tactic applications. It can result in expensive unifications, as
-refolding currently uses a potentially exponential heuristic.
-
 \begin{quote}
   \optindex{Debug RAKAM}
   {\tt Set Debug RAKAM}
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index e8b19f6bc4..44a69d1c1e 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -29,19 +29,6 @@ exception Elimconst
     their parameters in its stack.
 *)
 
-let refolding_in_reduction = ref false
-let _ = Goptions.declare_bool_option {
-  Goptions.optdepr = true; (* remove in 8.8 *)
-  Goptions.optname =
-    "Perform refolding of fixpoints/constants like cbn during reductions";
-  Goptions.optkey = ["Refolding";"Reduction"];
-  Goptions.optread = (fun () -> !refolding_in_reduction);
-  Goptions.optwrite = (fun a -> refolding_in_reduction:=a);
-}
-
-let get_refolding_in_reduction () = !refolding_in_reduction
-let set_refolding_in_reduction = (:=) refolding_in_reduction
-
 (** Support for reduction effects *)
 
 open Mod_subst
@@ -1135,7 +1122,7 @@ let local_whd_state_gen flags sigma =
   whrec
 
 let raw_whd_state_gen flags env =
-  let f sigma s = fst (whd_state_gen ~refold:(get_refolding_in_reduction ())
+  let f sigma s = fst (whd_state_gen ~refold:false
                          ~tactic_mode:false
                          flags env sigma s) in
   f
@@ -1561,7 +1548,7 @@ let is_sort env sigma t =
    of case/fix (heuristic used by evar_conv) *)
 
 let whd_betaiota_deltazeta_for_iota_state ts env sigma csts s =
-  let refold = get_refolding_in_reduction () in
+  let refold = false in
   let tactic_mode = false in
   let rec whrec csts s =
     let (t, stack as s),csts' = whd_state_gen ~csts ~refold ~tactic_mode CClosure.betaiota env sigma s in
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 3b56513f5e..29dc3ed0f2 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -31,11 +31,6 @@ module ReductionBehaviour : sig
   val print : Globnames.global_reference -> Pp.t
 end
 
-(** Option telling if reduction should use the refolding machinery of cbn
-   (off by default) *)
-val get_refolding_in_reduction : unit -> bool
-val set_refolding_in_reduction : bool -> unit
-
 (** {6 Support for reduction effects } *)
 
 type effect_name = string
diff --git a/test-suite/bugs/closed/3424.v b/test-suite/bugs/closed/3424.v
deleted file mode 100644
index ee8cabf171..0000000000
--- a/test-suite/bugs/closed/3424.v
+++ /dev/null
@@ -1,24 +0,0 @@
-Set Universe Polymorphism.
-Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope.
-Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }.
-Inductive trunc_index : Type := minus_two | trunc_S (x : trunc_index).
-Bind Scope trunc_scope with trunc_index.
-Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type :=
-  match n with
-    | minus_two => Contr_internal A
-    | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y)
-  end.
-Notation minus_one:=(trunc_S minus_two).
-Notation "0" := (trunc_S minus_one) : trunc_scope.
-Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A.
-Notation IsHProp := (IsTrunc minus_one).
-Notation IsHSet := (IsTrunc 0).
-Set Refolding Reduction.
-Goal forall (A : Type) (a b : A) (H' : IsHSet A), { x : Type & IsHProp x }.
-Proof.
-intros.
-eexists.
-(* exact (H' a b). *)
-(* Undo. *)
-apply (H' a b).
-Qed.
diff --git a/test-suite/bugs/opened/3424.v b/test-suite/bugs/opened/3424.v
new file mode 100644
index 0000000000..d1c5bb68f9
--- /dev/null
+++ b/test-suite/bugs/opened/3424.v
@@ -0,0 +1,24 @@
+Set Universe Polymorphism.
+Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope.
+Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }.
+Inductive trunc_index : Type := minus_two | trunc_S (x : trunc_index).
+Bind Scope trunc_scope with trunc_index.
+Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type :=
+  match n with
+    | minus_two => Contr_internal A
+    | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y)
+  end.
+Notation minus_one:=(trunc_S minus_two).
+Notation "0" := (trunc_S minus_one) : trunc_scope.
+Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A.
+Notation IsHProp := (IsTrunc minus_one).
+Notation IsHSet := (IsTrunc 0).
+Goal forall (A : Type) (a b : A) (H' : IsHSet A), { x : Type & IsHProp x }.
+Proof.
+intros.
+eexists.
+(* exact (H' a b). *)
+(* Undo. *)
+Fail apply (H' a b).
+exact (H' a b).
+Qed.
diff --git a/test-suite/output/inference.out b/test-suite/output/inference.out
index d28ee42761..2dbe215bfd 100644
--- a/test-suite/output/inference.out
+++ b/test-suite/output/inference.out
@@ -4,8 +4,6 @@ fun e : option L => match e with
                     | None => None
                     end
      : option L -> option L
-fun (m n p : nat) (H : S m <= S n + p) => le_S_n m (n + p) H
-     : forall m n p : nat, S m <= S n + p -> m <= n + p
 fun n : nat => let y : T n := A n in ?t ?x : T n
      : forall n : nat, T n
 where
diff --git a/test-suite/output/inference.v b/test-suite/output/inference.v
index 73169dae65..57a4739e9f 100644
--- a/test-suite/output/inference.v
+++ b/test-suite/output/inference.v
@@ -13,12 +13,6 @@ Definition P (e:option L) :=
 
 Print P.
 
-(* Check that plus is folded even if reduction is involved *)
-Set Warnings Append "-deprecated-option".
-Set Refolding Reduction.
-Check (fun m n p (H : S m <= (S n) + p) => le_S_n _ _ H).
-
-
 (* Check that the heuristic to solve constraints is not artificially
    dependent on the presence of a let-in, and in particular that the
    second [_] below is not inferred to be n, as if obtained by
-- 
cgit v1.2.3