Close Scope nat_scope.
End LISTTHEOREMS.
(** HintDB of hints for SCEV **)
Global Create HintDb Recurrence.
(** You can build the theory of SCEV over any ring, actually *)
Module Type RECURRENCE.
Parameter R: Type.
Parameter (zero one : R).
Parameter (plus mult minus : R -> R-> R).
Parameter (sym : R -> R).
Parameter rt : ring_theory zero one plus mult minus sym (@eq R).
Add Ring Rring : rt.
Notation "0" := zero.  Notation "1" := one.
Notation "x + y" := (plus x y).
Notation "x * y " := (mult x y).
(** A class for objects that vary over loop iterations *)
Class LoopVariant (A R : Type) :=
{
evalAtIx: A -> nat -> R
}.
Infix "#" := evalAtIx (at level 10).
Global Instance loopVariantFn (R: Type):
LoopVariant (nat -> R) (R : Type) :=
{
evalAtIx (f: nat -> R) (n: nat) := f n
}.
Definition scaleLoopVariantFn  (r: R) (f: nat -> R): nat -> R :=
fun n => r * (f n).
(* Const function *)
Definition const {A B: Type} (x: A) (y: B) := x.
Definition RBinop := R -> R -> R.
Section BR.
Inductive BR :=
| mkBR : R -> (R -> R -> R) -> (nat -> R) -> BR.
(** I need to define the notation outside again as wel **)
Notation "'{{' const ',' bop ',' fn  '}}'" :=
(mkBR const bop fn) (at level 30).
(** Semantics of evaluating a BR. It's too convenient to be able to `Opaque` and `Transparent` this to give it up *)
Definition evalBR (br: BR) (n: nat): R :=
match br with
| mkBR r0 binop f =>
let
vals : list R := map f (seq 1 n)
in
fold_left binop vals r0
end.
(** semantics of evaluating a BR *)
Global Instance loopVariantBR : LoopVariant BR R :=
{
evalAtIx (br: BR) (n: nat) := evalBR br n
}.
Class ToBR A : Type  :=
{
toBR : A -> BR
}.
Global Instance liftConstantToBR : ToBR R :=
{
toBR (c: R) := mkBR c plus (const zero)
}.
Global Instance liftBRToBR: ToBR BR :=
{
toBR br := br
}.

(* Specifications: *)
Lemma liftConstant_eval: forall (n: nat) (r: R),
evalAtIx (toBR r)  n = r.