Require Import String.
Require Import EquivDec.
Require Import RelationClasses.
Require Import List.
Require Import NPeano.
Require Import Lra Omega.
Require Reals.
Require Import Eqdep_dec.

Require Import Floatish.
Require Import Utils.
Require Import derivlemmas.
Require Import Coquelicot.Hierarchy.
Require Import Coquelicot.Derive.
Require Import Coquelicot.Rcomplements.
Require Import DefinedFunctions.
Require FunctionalExtensionality.

Set Bullet Behavior "Strict Subproofs".

Section DefinedFunctions.

  Context {floatish_impl:floatish}.
  Local Open Scope float.

Section real_pfs.

  Local Existing Instance floatish_R.
  Import Reals.
  Import List.

  (* following returns None if not-differentiable *)
    Fixpoint df_eval_deriv_exact {Ann} {T} (σ:df_env) (df:DefinedFunction Ann T) (v:var_type) : option (definition_function_types_interp T)
      := (match df with
         | Number _ _ => Some 0
         | Constant t _ x => Some
            match t return definition_function_types_interp t with
            | DTfloat => 0
            | DTVector n => ConstVector n 0
            | DTMatrix m n => ConstMatrix m n 0
            end
         | DVector n _ dfs => vectoro_to_ovector (fun i => df_eval_deriv_exact σ (dfs i) v)
         | DMatrix n m _ df => matrixo_to_omatrix (fun i j => df_eval_deriv_exact σ (df i j) v)
         | Var x _ => Some (let t:=snd x in
               match t return definition_function_types_interp t with
               | DTfloat => if x == v then 1 else 0
               | DTVector n => ConstVector n (if x == v then 1 else 0)
               | DTMatrix m n => ConstMatrix m n (if x == v then 1 else 0)
               end)
         | Plus _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some le, Some lr => Some (le + lr)
           | _, _ => None
           end
         | Minus _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some le, Some lr => Some (le - lr)
           | _, _ => None
           end
         | Times _ l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some le, Some ld, Some re, Some rd =>
             Some (le * rd +
                   (ld * re))
           | _, _, _, _ => None
           end
         | Divide _ l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some le, Some ld, Some re, Some rd =>
             if Feq re 0 then None else
               Some ((ld / re) - ((le * rd) / (re * re)))
           | _, _, _, _ => None
           end
         | Square _ e =>
           match df_eval σ e, df_eval_deriv_exact σ e v with
           | Some ee, Some ed => Some (2 * ee * ed)
           | _, _  => None
           end
         | Exp _ e =>
           match df_eval σ e, df_eval_deriv_exact σ e v with
           | Some ee, Some ed => Some (ed * Fexp ee)
           | _, _  => None
           end
         | Log _ e =>
           match df_eval σ e, df_eval_deriv_exact σ e v with
           | Some ee, Some ed =>
             if ee > 0 then Some (ed / ee) else None
           | _, _ => None
           end
         | Abs _ e =>
           match df_eval σ e, df_eval_deriv_exact σ e v with
           | Some ee, Some ed =>
             if Feq ee 0 then
               (if Feq ed 0 then Some 0 else None)
             else Some (ed * (sign ee))
           | _, _ => None
           end
         | Sign _ e =>
           match df_eval σ e, df_eval_deriv_exact σ e v with
           | Some ee, Some ed =>
             if Feq ee 0 then None else Some 0
           | _, _ => None
           end
         | PSign _ e =>
           match df_eval σ e, df_eval_deriv_exact σ e v with
           | Some ee, Some ed =>
             if Feq ee 0 then None else Some 0
           | _, _ => None
           end
         | Max _ l r =>
           match df_eval σ l, df_eval σ r, df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some le, Some re, Some ld, Some rd =>
             if Feq le re then
               (if Feq ld rd then Some ld else None)
             else
               (if le < re then Some rd else Some ld)
           | _, _, _, _=> None
           end
         | VectorElem n _ l i =>
           match (df_eval_deriv_exact σ l v)  with
           | Some l' => Some (l' i)
           | _ => None
           end
         | MatrixElem m n _ l i j =>
           match (df_eval_deriv_exact σ l v)  with
           | Some l' => Some (l' i j)
           | _ => None
           end
         | VectorDot n _ l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some le, Some ld, Some re, Some rd =>
               Some (vsum (fun j => (le j) * (rd j) + (ld j) * (re j)))
           | _, _, _, _ => None
           end
         | VectorSum n _ l =>
           match df_eval_deriv_exact σ l v with
           | Some ld =>
               Some (vsum ld)
           | _ => None
           end
         | MatrixSum n m _ l =>
           match df_eval_deriv_exact σ l v with
           | Some ld =>
               Some (msum ld)
           | _ => None
           end
         | VectorScalMult n _ x r =>
           match df_eval σ x, df_eval_deriv_exact σ x v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some xe, Some xd, Some re, Some rd => Some (fun j => xe * (rd j) + xd * (re j))
           | _, _, _, _ => None
           end
         | MatrixScalMult n m _ x r =>
           match df_eval σ x, df_eval_deriv_exact σ x v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some xe, Some xd, Some re, Some rd => Some (fun i j => xe * (rd i j) + xd * (re i j))
           | _, _, _, _ => None
           end
         | MatrixVectorMult n m _ l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some le, Some ld, Some re, Some rd =>
             Some (fun i => vsum (fun j => (le i j)*(rd j) + (ld i j)*(re j)))
           | _, _, _, _ => None
           end
         | MatrixVectorAdd n m _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some le, Some re =>
             Some (fun i j => (le i j) + (re i))
           | _, _ => None
           end
         | MatrixMult n m p _ l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v, df_eval σ r, df_eval_deriv_exact σ r v with
           | Some le, Some ld, Some re, Some rd =>
             Some (fun i k => vsum (fun j => (le i j)*(rd j k) + (ld i j)*(re j k)))
           | _, _, _, _ => None
           end
         | VectorPlus n _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some l', Some r' => Some (fun i => (l' i) + (r' i))
           | _, _ => None
           end
         | VectorMinus n _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some l', Some r' => Some (fun i => (l' i) - (r' i))
           | _, _ => None
           end
         | MatrixPlus n m _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some l', Some r' => Some (fun i j => (l' i j) + (r' i j))
           | _, _ => None
           end
         | MatrixMinus n m _ l r =>
           match df_eval_deriv_exact σ l v, df_eval_deriv_exact σ r v with
           | Some l', Some r' => Some (fun i j => (l' i j) - (r' i j))
           | _, _ => None
           end
         | VectorApply n _ x s r =>
           match df_eval σ r, df_eval_deriv_exact σ r v with
           | Some re, Some rd =>
             vectoro_to_ovector
               (fun i =>
                  let xv := (x, DTfloat):var_type in
                  match df_eval_deriv_exact (cons (mk_env_entry xv (re i)) nil) s xv with
                         | Some sd => Some ((rd i) * sd)
                         | _ => None
                         end)
           | _, _ => None
           end
         | MatrixApply n m _ x s r =>
           match df_eval σ r, df_eval_deriv_exact σ r v with
           | Some re, Some rd =>
             matrixo_to_omatrix
               (fun i j =>
                  let xv := (x, DTfloat):var_type in
                  match df_eval_deriv_exact (cons (mk_env_entry xv (re i j)) nil) s xv with
                         | Some sd => Some ((rd i j) * sd)
                         | _ => None
                         end)
           | _, _ => None
           end
         | VLossfun n _ v1 v2 s l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v with
           | Some le, Some ld =>
             match (vectoro_to_ovector
                      (fun i =>
                         let xv1 := (v1, DTfloat):var_type in
                         let xv2 := (v2, DTfloat):var_type in
                         match df_eval_deriv_exact (cons (mk_env_entry xv1 (le i))
                                                   (cons (mk_env_entry xv2 (r i)) nil)) s xv1 with
                         | Some sd => Some ((ld i) * sd)
                         | _ => None
                         end)) with
             | Some vv => Some (vsum vv)
             | _ => None
             end
           | _, _ => None
           end
         | MLossfun n m _ v1 v2 s l r =>
           match df_eval σ l, df_eval_deriv_exact σ l v with
           | Some le, Some ld =>
             match (matrixo_to_omatrix
                      (fun i j =>
                         let xv1 := (v1, DTfloat):var_type in
                         let xv2 := (v2, DTfloat):var_type in
                         match df_eval_deriv_exact (cons (mk_env_entry xv1 (le i j))
                                                   (cons (mk_env_entry xv2 (r i j)) nil)) s xv1 with
                         | Some sd => Some ((ld i j) * sd)
                         | _ => None
                         end)) with
             | Some vv =>
               if Nat.eq_dec m 0%nat then None else Some ((msum vv) / (FfromZ (Z.of_nat m)))
             | _ => None
             end
           | _, _ => None
           end
          end).

   Definition addBinding σ v x := (mk_env_entry (v,DTfloat) x)::σ.

   Definition df_eval_at_point {Ann T} σ (df:DefinedFunction Ann T) v x
     := df_eval (addBinding σ v x) df.

   Definition df_R {Ann} (σ:df_env) (df:DefinedFunction Ann DTfloat) v : R -> R
     := fun x => match df_eval_at_point σ df v x with
        | Some y => y
        | None => 0%R
        end.

    Definition ex_deriv_df {Ann} σ (df:DefinedFunction Ann DTfloat) v (x:R)
     :=  fully_closed_over df ((v,DTfloat)::map (@projT1 _ _) σ) /\
         ex_derive (df_R σ df v) x.

   Definition is_deriv_df {Ann} σ (df:DefinedFunction Ann DTfloat) v (x y:R)
     :=  fully_closed_over df ((v,DTfloat)::map (@projT1 _ _) σ) /\
         is_derive (df_R σ df v) x y.

   Lemma eval_at_point_fully_closed_total {T} (σ:df_env) (df:DefinedFunction UnitAnn T) v x :
      let vl := (v,DTfloat)::map (fun ve => projT1 ve) σ in
      fully_closed_over df vl ->
      {d:definition_function_types_interp T | df_eval_at_point σ df v x = Some d}.
   Proof.
     intros.
     unfold df_eval_at_point.
     destruct (eval_fully_closed_total (addBinding σ v x) df) as [dd pfd]
     ; simpl; eauto.
   Defined.

   Lemma eval_at_point_diferentiable_total {σ} {df:DefinedFunction UnitAnn DTfloat} {v x y} :
     is_deriv_df σ df v x y ->
     {xve | df_eval_at_point σ df v x = Some xve}.
   Proof.
     intros [closed _ ].
     destruct (eval_at_point_fully_closed_total σ df v x); eauto.
   Defined.

   Definition eval_differentiable_at_point {σ} {df:DefinedFunction UnitAnn DTfloat} {v x y}
              (pf_deriv:is_deriv_df σ df v x y) :=
     proj1_sig (eval_at_point_diferentiable_total pf_deriv).

   Lemma is_derive_df_exp
         (df:DefinedFunction UnitAnn DTfloat) (σ:df_env) v x y
         (pf_deriv:is_deriv_df σ df v x y) :
     forall a,
     is_deriv_df σ (Exp a df) v x (y * exp (eval_differentiable_at_point pf_deriv)).
   Proof.
     unfold eval_differentiable_at_point.
     destruct (eval_at_point_diferentiable_total pf_deriv) as [xve eqqx]; simpl.
     unfold is_deriv_df; simpl; destruct pf_deriv as [base_closed base_deriv].
     split; trivial.
     generalize (is_derive_comp exp (df_R σ df v) x (exp xve) y)
     ; intros isd.
     unfold df_R, df_eval_at_point in *.
     eapply is_derive_ext; [ | eapply isd]; trivial.
     - intros; simpl.
       match_option; simpl.
       eelim eval_fully_closed_not_none; [ | eapply eqq].
       simpl; trivial.
     - rewrite eqqx.
       apply is_derive_exp.
   Qed.

   Lemma is_derive_df_mult
         (df1 df2:DefinedFunction UnitAnn DTfloat) (σ:df_env) v x y1 y2
         (pf_deriv1:is_deriv_df σ df1 v x y1)
         (pf_deriv2:is_deriv_df σ df2 v x y2) :
     forall a,
     is_deriv_df σ (Times a df1 df2) v x ((y1 * eval_differentiable_at_point pf_deriv2 + eval_differentiable_at_point pf_deriv1 * y2)).
   Proof.
     unfold eval_differentiable_at_point.
     intros.
     destruct (eval_at_point_diferentiable_total pf_deriv1) as [xve1 eqqx1]; simpl.
     destruct (eval_at_point_diferentiable_total pf_deriv2) as [xve2 eqqx2]; simpl.
     unfold is_deriv_df; simpl
     ; destruct pf_deriv1 as [base_closed1 base_deriv1]
     ; destruct pf_deriv2 as [base_closed2 base_deriv2].
     split; [tauto | ].
     generalize (is_derive_mult (df_R σ df1 v) (df_R σ df2 v) x y1 y2 base_deriv1 base_deriv2)
     ; intros HH.
     unfold df_R in *.
     rewrite eqqx1, eqqx2 in HH.
     eapply is_derive_ext; [ | eapply HH]; trivial.
     - intros; simpl.
       unfold df_eval_at_point; simpl.
       repeat match_option; unfold mult; simpl; lra.
  Qed.

Tactic Notation "DefinedFunction_scalar_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "Number"%string
  | Case_aux c "Constant"%string
  | Case_aux c "Var"%string
  | Case_aux c "Plus"%string
  | Case_aux c "Minus"%string
  | Case_aux c "Times"%string
  | Case_aux c "Divide"%string
  | Case_aux c "Square"%string
  | Case_aux c "Exp"%string
  | Case_aux c "Log"%string
  | Case_aux c "Abs"%string
  | Case_aux c "Sign"%string
  | Case_aux c "PSign"%string
  | Case_aux c "Max"%string].

    Ltac refl_simpler :=
      repeat
        match goal with
        | [H: @eq var_type _ _ |- _ ] => try (inversion H; subst); rewrite (var_type_UIP_refl H)
        | [H: @equiv var_type _ _ _ _ |- _ ] => try (inversion H; subst); rewrite (var_type_UIP_refl H)
        | [H: @eq definition_function_types _ _ |- _ ] => try (inversion H; subst); rewrite (definition_function_types_UIP_refl H)
        | [H: @equiv definition_function_types _ _ _ _ |- _ ] => try (inversion H; subst); rewrite (definition_function_types_UIP_refl H)
        end.

    Lemma df_R_total_plus σ a (l r:DefinedFunction UnitAnn DTfloat) v x :
      fully_closed_over l ((v,DTfloat)::map (@projT1 _ _) σ) ->
      fully_closed_over r ((v,DTfloat)::map (@projT1 _ _) σ) ->
      df_R σ (Plus a l r) v x = df_R σ l v x + df_R σ r v x.
    Proof.
      simpl.
      intros.
      destruct (eval_fully_closed_total (addBinding σ v x) l); simpl; trivial.
      destruct (eval_fully_closed_total (addBinding σ v x) r); simpl; trivial.
      unfold df_R, df_eval_at_point; simpl.
      now rewrite e, e0.
    Qed.

    Lemma df_R_total_minus σ a (l r:DefinedFunction UnitAnn DTfloat) v x :
      fully_closed_over l ((v,DTfloat)::map (@projT1 _ _) σ) ->
      fully_closed_over r ((v,DTfloat)::map (@projT1 _ _) σ) ->
      df_R σ (Minus a l r) v x = df_R σ l v x - df_R σ r v x.
    Proof.
      simpl.
      intros.
      destruct (eval_fully_closed_total (addBinding σ v x) l); simpl; trivial.
      destruct (eval_fully_closed_total (addBinding σ v x) r); simpl; trivial.
      unfold df_R, df_eval_at_point; simpl.
      now rewrite e, e0.
    Qed.

    Lemma df_R_total_times σ a (l r:DefinedFunction UnitAnn DTfloat) v x :
      fully_closed_over l ((v,DTfloat)::map (@projT1 _ _) σ) ->
      fully_closed_over r ((v,DTfloat)::map (@projT1 _ _) σ) ->
      df_R σ (Times a l r) v x = df_R σ l v x * df_R σ r v x.
    Proof.
      simpl.
      intros.
      destruct (eval_fully_closed_total (addBinding σ v x) l); simpl; trivial.
      destruct (eval_fully_closed_total (addBinding σ v x) r); simpl; trivial.
      unfold df_R, df_eval_at_point; simpl.
      now rewrite e, e0.
    Qed.

    Lemma df_R_total_divide σ a (l r:DefinedFunction UnitAnn DTfloat) v x :
      fully_closed_over l ((v,DTfloat)::map (@projT1 _ _) σ) ->
      fully_closed_over r ((v,DTfloat)::map (@projT1 _ _) σ) ->
      df_R σ (Divide a l r) v x = df_R σ l v x / df_R σ r v x.
    Proof.
      simpl.
      intros.
      destruct (eval_fully_closed_total (addBinding σ v x) l); simpl; trivial.
      destruct (eval_fully_closed_total (addBinding σ v x) r); simpl; trivial.
      unfold df_R, df_eval_at_point; simpl.
      now rewrite e, e0.
    Qed.

(*
    Lemma ex_deriv_div (f g :R ->R) (x:R) :
      ex_derive (fun t => (f t)/(g t)) x -> (g x) <> 0.
      Admitted.

    Lemma ex_deriv_log (f : R -> R) (x:R) :
      ex_derive (fun t => ln (f t)) x -> (f x) > 0.
      Admitted.

    Lemma ex_deriv_abs (f : R -> R) (x:R) :
      ex_derive f x -> ex_derive (fun t => Rabs (f t)) x ->
      f x <> 0 \/ is_derive f x 0.
      Admitted.

    Lemma ex_deriv_sign (f : R -> R) (x:R) :
      ex_derive f x -> ex_derive (fun t => sign (f t)) x ->
      f x <> 0 \/ locally x (fun t => f t = 0).
      Admitted.

    Lemma ex_deriv_psign (f : R -> R) (x:R) :
      ex_derive f x -> ex_derive (fun t => psign (f t)) x ->
      f x <> 0 \/ locally x (fun t => f t >= 0).
      Admitted.

    Lemma ex_deriv_max (f g : R -> R) (x: R) :
      ex_derive f x -> ex_derive g x -> ex_derive (fun t => Rmax (f t) (g t)) x ->
      (f x) <> (g x) \/ is_derive (fun t => (f t) - (g t)) x 0.
    Admitted.
*)
    Lemma floatish_sign :
      forall (x:R), sign x = FloatishOps.sign x.
    Proof.
      intros.
      unfold sign, FloatishOps.sign; simpl.
      case_eq (Rlt_dec x 0); intros; trivial.
      - match_case; intros.
        destruct s; lra.
      - match_case; intros.
        + destruct s; case_eq (Rgt_dec x 0); simpl; intros; lra.
        + lra.
    Qed.

    Lemma pos_sign_psign:
      forall (x:R), psign x = pos_sign x.
    Proof.
      unfold psign, pos_sign.
      intros.
      simpl.
      now destruct (Rge_dec x 0).
    Qed.

    Lemma Rmax_Fmax :
      forall (x y:R), Rmax x y = Fmax x y.
      unfold Rmax, Fmax; simpl; intros.
      match_case; intros.
      - case_eq (Rlt_dec x y); intros; trivial.
        lra.
      - case_eq (Rlt_dec x y); intros; trivial.
        lra.
    Qed.

    Theorem df_eval_deriv_exact_correct σ (df:DefinedFunction UnitAnn DTfloat) v (x:R) y
     : is_scalar_function df ->
       fully_closed_over df ((v,DTfloat)::map (@projT1 _ _) σ) ->
       df_eval_deriv_exact (addBinding σ v x) df (v,DTfloat) = Some y ->
       is_derive (df_R σ df v) x y.
   Proof.
     simpl.
     intros is_scalar.
     generalize is_scalar.
     revert y.
     pattern df.
     revert df is_scalar.
     DefinedFunction_scalar_cases (apply is_scalar_function_ind) Case; simpl; intros.
     - Case "Number"%string.
       unfold df_R, df_eval_at_point; simpl.
       inversion H0; subst.
       now apply (@is_derive_const R_AbsRing).
     - Case "Constant"%string.
       unfold df_R, df_eval_at_point; simpl.
       inversion H0; subst.
       now apply (@is_derive_const R_AbsRing).
     - Case "Var"%string.
       unfold df_R, df_eval_at_point; simpl.
       inversion H0; subst.
       simpl.
       unfold equiv_dec, vart_eqdec.
       destruct (vart_dec (sv, DTfloat) (v, DTfloat)).
       + refl_simpler; simpl.
         now apply (@is_derive_id R_AbsRing).
       + now apply (@is_derive_const R_AbsRing).
     - Case "Plus"%string.
       destruct H1.
       do 2 match_option_in H2.
       invcs H2.
       destruct is_scalar as [isc1 isc2].
       specialize (H _ isc1 H1 eqq).
       specialize (H0 _ isc2 H3 eqq0).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_plus.
       + generalize (@is_derive_plus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "Minus"%string.
       destruct H1.
       do 2 match_option_in H2.
       invcs H2.
       destruct is_scalar as [isc1 isc2].
       specialize (H _ isc1 H1 eqq).
       specialize (H0 _ isc2 H3 eqq0).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_minus.
       + generalize (@is_derive_minus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "Times"%string.
       destruct H1.
       do 4 match_option_in H2.
       invcs H2.
       destruct is_scalar as [isc1 isc2].
       specialize (H _ isc1 H1 eqq0).
       specialize (H0 _ isc2 H3 eqq2).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_times.
       + generalize Derive.is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d * d2 + d0 * d1)%R with
                 (d0 * (df_R σ r v x) + (df_R σ l v x) * d2).
         * apply HH; trivial.
         * unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "Divide"%string.
       destruct H1.
       do 4 match_option_in H2.
       invcs H2.
       destruct is_scalar as [isc1 isc2].
       specialize (H _ isc1 H1 eqq0).
       specialize (H0 _ isc2 H3 eqq2).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_divide.
       + generalize is_derive_div; simpl; intros HH.
         replace (d0 / d1 - d * d2 / (d1 * d1)) with
             ((d0 * (df_R σ r v x) - (df_R σ l v x) * d2) / ((df_R σ r v x)*((df_R σ r v x)*1))).
         * destruct (Req_EM_T d1 0); [congruence |].
           inversion H5.
           specialize (HH (df_R σ l v) (df_R σ r v) x d0 d2).
           replace (d0 / d1 - d * d2 / (d1 * d1))%R with
             ((d0 * df_R σ r v x - df_R σ l v x * d2) / (df_R σ r v x * (df_R σ r v x * 1))).
           apply HH; trivial.
           unfold df_R, df_eval_at_point; simpl.
           now rewrite eqq1.
           unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           now field.
         * unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           destruct (Req_EM_T d1 0); [congruence |].
           now field; trivial.
     - Case "Square"%string.
       do 2 match_option_in H1.
       invcs H1.
       specialize (H _ is_scalar H0 eqq0).
       assert (forall t, (Rsqr (df_R σ e v t) = df_R σ (Square a e) v t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) e); simpl; trivial.
         rewrite e0; unfold Rsqr; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H1.
         * replace (2 * d * d0)%R with (d0 * (2 * d))%R by lra.
           apply (@is_derive_comp R_AbsRing); trivial.
           replace (d) with (df_R σ e v x).
           --  apply is_derive_sqr.
           --  unfold df_R, df_eval_at_point; simpl.
               now rewrite eqq.
     - Case "Exp"%string.
       do 2 match_option_in H1.
       invcs H1.
       specialize (H _ is_scalar H0 eqq0).
       assert (forall t, (exp (df_R σ e v t) = df_R σ (Exp a e) v t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) e); simpl; trivial.
         rewrite e0; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H1.
         * apply (@is_derive_comp R_AbsRing); trivial.
           replace (d) with (df_R σ e v x).
           --  apply is_derive_exp.
           --  unfold df_R, df_eval_at_point; simpl.
               now rewrite eqq.
     - Case "Log"%string.
       do 2 match_option_in H1.
       invcs H1.
       specialize (H _ is_scalar H0 eqq0).
       assert (forall t, (ln (df_R σ e v t) = df_R σ (Log a e) v t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) e); simpl; trivial.
         rewrite e0; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H1.
         * destruct (Rgt_dec d 0); [|congruence].
           inversion H3.
           apply (@is_derive_comp R_AbsRing); trivial.
           replace (d) with (df_R σ e v x).
           --  apply is_derive_ln.
               unfold df_R, df_eval_at_point; simpl.
               rewrite eqq.
               lra.
           --  unfold df_R, df_eval_at_point; simpl.
               now rewrite eqq.
     - Case "Abs"%string.
       do 2 match_option_in H1.
       invcs H1.
       specialize (H _ is_scalar H0 eqq0).
       assert (forall t, (Rabs (df_R σ e v t) = df_R σ (Abs a e) v t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) e); simpl; trivial.
         rewrite e0; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H1.
         * destruct ( Req_EM_T d 0 ).
           -- destruct (Req_EM_T d0 0).
              ++inversion H3.
                apply is_derive_Rabs_df0.
                rewrite e1 in H.
                apply H.
              ++ congruence.
           -- inversion H3.
              apply (@is_derive_comp R_AbsRing); trivial.
              replace (d) with (df_R σ e v x)
              ; unfold df_R, df_eval_at_point; simpl; rewrite eqq; trivial.
              apply is_derive_abs; lra.
     - Case "Sign"%string.
       match_option_in H1.
       match_option_in H1.
       destruct (Req_EM_T d 0); [congruence|].
       invcs H1.
       specialize (H _ is_scalar H0 eqq0).
       assert (forall t, (sign (df_R σ e v t) = df_R σ (Sign a e) v t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) e); simpl; trivial.
         rewrite e0; trivial.
         apply floatish_sign.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H1.
         * replace (0)%R with (d0 * 0)%R by lra.
           apply (@is_derive_comp R_AbsRing); trivial.
           apply is_derive_sign.
           unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; lra.
     - Case "PSign"%string.
       match_option_in H1.
       match_option_in H1.
       destruct (Req_EM_T d 0); [congruence|].
       invcs H1.
       specialize (H _ is_scalar H0 eqq0).
       assert (forall t, (psign (df_R σ e v t) = df_R σ (PSign a e) v t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) e); simpl; trivial.
         rewrite e0; trivial.
         apply pos_sign_psign.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H1.
         * replace (0)%R with (d0 * 0)%R by lra.
           apply (@is_derive_comp R_AbsRing); trivial.
           apply is_derive_psign.
           unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; lra.
     - Case "Max"%string.
       do 2 match_option_in H2.
       destruct H1.
       destruct is_scalar as [isc1  isc2].
       assert (forall t, (Rmax (df_R σ l v t) (df_R σ r v t)) = df_R σ (Max a l r) v t).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v t) l); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v t) r); simpl; trivial.
         rewrite e, e0; trivial.
         apply Rmax_Fmax.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H4.
         * match_option_in H2.
           match_option_in H2.
           destruct (Req_EM_T d d0).
           -- destruct (Req_EM_T d1 d2).
              ++ invcs H2.
                 apply is_derive_max_alt2.
                 apply H; trivial.
                 apply H0; trivial.
              ++ congruence.
           -- destruct (Rlt_dec d d0).
              ++ invcs H2.
                 specialize (H _ isc1 H1 eqq1).
                 specialize (H0 _ isc2 H3 eqq2).
                 replace (y) with ((d1 + y + (d1-y)*sign(df_R σ l v x - df_R σ r v x))/2).
                 ** apply is_derive_max; trivial.
                    unfold df_R, df_eval_at_point; simpl.
                    now rewrite eqq, eqq0.
                 ** unfold df_R, df_eval_at_point; simpl.
                    rewrite eqq, eqq0.
                    unfold sign; simpl.
                    destruct (total_order_T 0 (d - d0)); [destruct s; lra|lra].
              ++ invcs H2.
                 specialize (H _ isc1 H1 eqq1).
                 specialize (H0 _ isc2 H3 eqq2).
                 replace (y) with ((y + d2 + (y - d2)*sign(df_R σ l v x - df_R σ r v x))/2).
                 ** apply is_derive_max; trivial.
                    unfold df_R, df_eval_at_point; simpl.
                    now rewrite eqq, eqq0.
                 ** unfold df_R, df_eval_at_point; simpl.
                    rewrite eqq, eqq0.
                    unfold sign; simpl.
                    destruct (total_order_T 0 (d - d0)); [destruct s; lra | lra].
   Qed.

   Definition df_R_vec {Ann} {n} (σ:df_env) (df:DefinedFunction Ann (DTVector n)) v :
     R -> Vector R n
     := fun x => match df_eval_at_point σ df v x with
        | Some y => y
        | None => ConstVector n 0
        end.

   Definition df_R_mat {Ann} {n m} (σ:df_env) (df:DefinedFunction Ann (DTMatrix n m)) v :
     R -> Matrix R n m
     := fun x => match df_eval_at_point σ df v x with
        | Some y => y
        | None => ConstMatrix n m 0
        end.

   Definition df_R_gen Ann T σ :
     (DefinedFunction Ann T) -> SubVar -> R -> (definition_function_types_interp T) :=
     match T with
     | DTfloat => fun df v => df_R σ df v
     | DTVector n => fun df v => df_R_vec σ df v
     | DTMatrix n m => fun df v => df_R_mat σ df v
     end.

    Definition is_derive_vec {n} (f : R -> Vector R n) (x:R) (df : Vector R n) :=
      forall i, is_derive (fun x0 => f x0 i) x (df i).

    Definition is_derive_mat {n m} (f : R -> Matrix R n m) (x:R) (df : Matrix R n m) :=
      forall i j, is_derive (fun x0 => f x0 i j) x (df i j).

    Definition is_derive_gen {T} (f: R->definition_function_types_interp T) (x:R)
               (df : definition_function_types_interp T)
        :=
          (match T return (R -> definition_function_types_interp T) ->
                     definition_function_types_interp T -> Prop
           with
           | DTfloat => fun f df =>  is_derive f x df
           | DTVector n => fun f df => is_derive_vec f x df
           | DTMatrix n m => fun f df => is_derive_mat f x df
           end) f df.

    Definition vec_to_nat_fun {n:nat} (v:Vector R n) (i:nat) : R :=
        match lt_dec i n with
        | left pf => v (exist _ i pf)
        | right _ => 0
        end.

    Lemma vec_to_nat_fun_vcons_end {n} (v : Vector R n) b :
      vec_to_nat_fun (vcons b v) n = b.
    Proof.
      unfold vec_to_nat_fun; simpl.
      destruct (lt_dec n (S n)); [ | omega].
      destruct (Nat.eq_dec n n); [ | omega].
      trivial.
    Qed.

    Lemma vec_to_nat_fun_vcons_nend {n} (v : Vector R n) b m (pf:(m<n)%nat) :
      vec_to_nat_fun (vcons b v) m = vec_to_nat_fun v m.
    Proof.
      unfold vec_to_nat_fun; simpl.
      destruct (lt_dec m (S n)); [ | omega].
      destruct (Nat.eq_dec m n); [omega | ].
      destruct (lt_dec m n); [| omega].
      erewrite index_pf_irrel; eauto.
    Qed.

    Lemma sum_n_vsum {n:nat} (v:Vector R n) :
      sum_n (vec_to_nat_fun v) (n-1) = vsum v.
    Proof.
      unfold vsum, vector_fold_right1.
      apply (vector_fold_right1_dep_gen_ind (P:=fun n v r => sum_n (vec_to_nat_fun v) (n-1) = r)).
      - unfold vec_to_nat_fun, sum_n, sum_n_m, Iter.iter, Iter.iter_nat, plus, zero.
        simpl.
        lra.
      - unfold vec_to_nat_fun, sum_n, sum_n_m, Iter.iter, Iter.iter_nat, plus, zero, Datatypes.id.
        simpl; intros.
        lra.
      - intros.
        simpl.
        rewrite <- H.
        destruct n0.
        + unfold vec_to_nat_fun, sum_n, sum_n_m, Iter.iter, Iter.iter_nat, plus, zero, Datatypes.id.
          simpl.
          lra.
        + simpl.
          rewrite Nat.sub_0_r.
          rewrite sum_Sn.
          unfold plus; simpl.
          rewrite vec_to_nat_fun_vcons_end.
          rewrite Rplus_comm.
          f_equal; simpl.
          erewrite sum_n_ext_loc; [ reflexivity | ]; intros.
          apply vec_to_nat_fun_vcons_nend.
          omega.
    Qed.

    Lemma is_derive_vsum {n} (vf : R -> Vector R n) (x:R) (df : Vector R n) :
      is_derive_vec vf x df ->
      is_derive (fun x0 => vsum (vf x0)) x (vsum df).
    Proof.
      unfold is_derive_vec; intro.
      apply (is_derive_ext (fun x0 => sum_n (vec_to_nat_fun (vf x0)) (n-1)%nat))
      ; [intros; apply sum_n_vsum |].
      replace  (@vsum floatish_R n df) with (sum_n (vec_to_nat_fun df) (n-1)%nat)
      ; [|intros; apply sum_n_vsum ].
      apply (@is_derive_sum_n R_AbsRing); intros.
      unfold vec_to_nat_fun.
      destruct (lt_dec k n).
      - apply H.
      - apply (@is_derive_const R_AbsRing).
    Qed.

    Lemma is_derive_msum {n m} (mf : R -> Matrix R n m) (x:R) (df : Matrix R n m) :
      is_derive_mat mf x df ->
      is_derive (fun x0 => msum (mf x0)) x (msum df).
    Proof.
      simpl.
      unfold is_derive_mat; intro.
      unfold msum.
      apply is_derive_vsum.
      unfold is_derive_vec; simpl; intro.
      rewrite vmap_nth.
      apply (is_derive_ext (fun x0 => (@vsum floatish_R m) (mf x0 i))).
      - intro; now rewrite vmap_nth.
      - apply is_derive_vsum.
        now unfold is_derive_vec.
    Qed.

    Theorem df_eval_deriv_exact_gen_correct {T} σ (df:DefinedFunction UnitAnn T) v (x:R) y
     : fully_closed_over df ((v,DTfloat)::map (@projT1 _ _) σ) ->
       df_eval_deriv_exact (addBinding σ v x) df (v,DTfloat) = Some y ->
       is_derive_gen (df_R_gen UnitAnn T σ df v) x y.
    Proof.
      revert  σ v x.
      DefinedFunction_cases (induction T, df using DefinedFunction_ind_unit) Case
      ; simpl; intros σ v0 xx; intros.
     - Case "Number"%string.
       unfold df_R, df_eval_at_point; simpl.
       inversion H0; subst.
       now apply (@is_derive_const R_AbsRing).
     - Case "Constant"%string.
       unfold df_R_gen, is_derive_gen; simpl.
       destruct t.
       + unfold df_R; simpl; invcs H0.
         now apply (@is_derive_const R_AbsRing).
       + unfold df_R_vec; simpl; invcs H0.
         unfold is_derive_vec, ConstVector; intro.
         now apply (@is_derive_const R_AbsRing).
       + unfold df_R_mat; simpl; invcs H0.
         unfold is_derive_mat, ConstMatrix; intros.
         now apply (@is_derive_const R_AbsRing).
     - Case "DVector"%string.
       unfold is_derive_vec; intros.
       specialize (vectoro_to_ovector_forall_some_f H1); intros.
       specialize (H2 i); simpl in H2.
       rewrite vforall_forall in H0.
       assert (H0c := H0).
       specialize (H0 i).
       specialize (H i (y i) σ v0 xx H0 H2); simpl in *.
       apply (is_derive_ext (df_R σ (x i) v0) ); trivial; intros.
       unfold df_R_vec, df_R, df_eval_at_point; simpl.
       match_option.
       + match_option.
         * specialize (vectoro_to_ovector_forall_some_f eqq0); intros.
           specialize (H3 i); simpl in H3.
           now rewrite eqq in H3; invcs H3.
         * unfold ConstVector.
           apply vectoro_to_ovector_exists_None in eqq0; destruct eqq0.
           specialize (H0c x0).
           apply (eval_fully_closed_not_none (addBinding σ v0 t) (x x0)) in H0c; tauto.
       + match_option.
         specialize (vectoro_to_ovector_forall_some_f eqq0); intros.
         specialize (H3 i); simpl in H3; congruence.
     - Case "DMatrix"%string.
       unfold is_derive_mat; intros.
       unfold matrixo_to_omatrix in H1.
       specialize (vectoro_to_ovector_forall_some_f H1); intros.
       specialize (H2 i); simpl in H2.
       specialize (vectoro_to_ovector_forall_some_f H2); intros.
       specialize (H3 j); simpl in H3.
       rewrite vforall_forall in H0.
       assert (H0c := H0).
       specialize (H0 i).
       rewrite vforall_forall in H0.
       specialize (H0 j).
       specialize (H i j (y i j)  σ v0 xx H0 H3); simpl in H.
       apply (is_derive_ext (df_R σ (x i j) v0)); trivial; intros.
       unfold df_R_mat, df_R, df_eval_at_point; simpl.
       match_option.
       + match_option.
         * unfold matrixo_to_omatrix in eqq0.
           specialize (vectoro_to_ovector_forall_some_f eqq0); intros.
           specialize (H4 i); simpl in H4.
           specialize (vectoro_to_ovector_forall_some_f H4); intros.
           specialize (H5 j); simpl in H5.
           now rewrite eqq in H5; invcs H5.
         * unfold ConstMatrix.
           unfold matrixo_to_omatrix in eqq0.
           apply vectoro_to_ovector_exists_None in eqq0; destruct eqq0.
           apply vectoro_to_ovector_exists_None in e; destruct e.
           specialize (H0c x0).
           rewrite vforall_forall in H0c.
           specialize (H0c x1).
           apply (eval_fully_closed_not_none (addBinding σ v0 t) (x x0 x1)) in H0c; tauto.
       + match_option.
         unfold matrixo_to_omatrix in eqq0.
         specialize (vectoro_to_ovector_forall_some_f eqq0); intros.
         specialize (H4 i); simpl in H4.
         specialize (vectoro_to_ovector_forall_some_f H4); intros.
         specialize (H5 j); simpl in H5; congruence.
     - Case "Var"%string.
       unfold is_derive_gen.
       destruct v; unfold snd in *.
       destruct d.
       + unfold df_R_gen; simpl.
         invcs H0.
         destruct (vart_dec (s, DTfloat) (v0, DTfloat)).
         * unfold equiv_dec, vart_eqdec.
           inversion e.
           destruct (vart_dec (v0, DTfloat) (v0, DTfloat)); [|congruence].
           apply (is_derive_ext id); [|apply (@is_derive_id R_AbsRing)].
           intro.
           unfold id, df_R, df_eval_at_point.
           simpl.
           unfold equiv_dec, vart_eqdec.
           destruct (vart_dec (v0, DTfloat) (v0, DTfloat)); [|congruence].
           now refl_simpler.
         * unfold equiv_dec, vart_eqdec.
           destruct (vart_dec (s, DTfloat) (v0, DTfloat)); [congruence|].
           invcs H; [congruence | ].
           unfold df_R, df_eval_at_point.
           simpl.
           unfold equiv_dec, vart_eqdec.
           destruct (vart_dec (s, DTfloat) (v0, DTfloat)); [congruence|].
           apply (@is_derive_const R_AbsRing).
       + simpl.
         invcs H0.
         unfold is_derive_vec; simpl; intros.
         unfold ConstVector.
         unfold df_R_vec, df_eval_at_point; simpl.
         unfold equiv_dec, vart_eqdec.
         destruct (vart_dec (s, DTVector n) (v0, DTfloat)); [congruence |].
         apply (@is_derive_const R_AbsRing).
       + simpl.
         invcs H0.
         unfold is_derive_mat; simpl; intros.
         unfold ConstMatrix.
         unfold df_R_mat, df_eval_at_point; simpl.
         unfold equiv_dec, vart_eqdec.
         destruct (vart_dec (s, DTMatrix m n) (v0, DTfloat)); [congruence |].
         apply (@is_derive_const R_AbsRing).
     - Case "Plus"%string.
       destruct H.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _  σ v0 xx H eqq).
       specialize (IHdf2 _  σ v0 xx H1 eqq0).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_plus.
       + generalize (@is_derive_plus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "Minus"%string.
       destruct H.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _  σ v0 xx H eqq).
       specialize (IHdf2 _  σ v0 xx H1 eqq0).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_minus.
       + generalize (@is_derive_minus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "Times"%string.
       destruct H.
       do 4 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _  σ v0 xx H eqq0).
       specialize (IHdf2 _  σ v0 xx H1 eqq2).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_times.
       + generalize Derive.is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d * d2 + d0 * d1)%R with
                 (d0 * (df_R σ df2 v0 xx) + (df_R σ df1 v0 xx) * d2).
         * apply HH; trivial.
         * unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "Divide"%string.
       destruct H.
       do 4 match_option_in H0.
       destruct (Req_EM_T d1 0); [congruence |].
       invcs H0.
       specialize (IHdf1 _  σ v0 xx H eqq0).
       specialize (IHdf2 _  σ v0 xx H1 eqq2).
       eapply is_derive_ext.
       + intros.
         symmetry.
         now apply df_R_total_divide.
       + generalize is_derive_div; simpl; intros HH.
         replace (d0 / d1 - d * d2 / (d1 * d1))%R with
             ((d0 * (df_R σ df2 v0 xx) - (df_R σ df1 v0 xx) * d2) / ((df_R σ df2 v0 xx)*((df_R σ df2 v0 xx)*1))).
         * specialize (HH (df_R σ df1 v0) (df_R σ df2 v0) xx d0 d2).
           apply HH; trivial.
           unfold df_R, df_eval_at_point; simpl.
           now rewrite eqq1.
         * unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           destruct (Req_EM_T d1 0); [congruence |].
           now field; trivial.
     - Case "Square"%string.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf _  σ v0 xx H eqq0).
       assert (forall t, (Rsqr (df_R σ df v0 t) = df_R σ (Square ann df) v0 t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; unfold Rsqr; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H0.
         * replace (2 * d * d0)%R with (d0 * (2 * d))%R by lra.
           apply (@is_derive_comp R_AbsRing); trivial.
           replace (d) with (df_R σ df v0 xx).
           --  apply is_derive_sqr.
           --  unfold df_R, df_eval_at_point; simpl.
               now rewrite eqq.
     - Case "Exp"%string.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf _   σ v0 xx H eqq0).
       assert (forall t, (exp (df_R σ df v0 t) = df_R σ (Exp ann df) v0 t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H0.
         * apply (@is_derive_comp R_AbsRing); trivial.
           replace (d) with (df_R σ df v0 xx).
           --  apply is_derive_exp.
           --  unfold df_R, df_eval_at_point; simpl.
               now rewrite eqq.
     - Case "Log"%string.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf _   σ v0 xx H eqq0).
       assert (forall t, (ln (df_R σ df v0 t) = df_R σ (Log ann df) v0 t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H0.
         * destruct (Rgt_dec d 0); [|congruence].
           inversion H2.
           apply (@is_derive_comp R_AbsRing); trivial.
           replace (d) with (df_R σ df v0 xx).
           --  apply is_derive_ln.
               unfold df_R, df_eval_at_point; simpl.
               rewrite eqq.
               lra.
           --  unfold df_R, df_eval_at_point; simpl.
               now rewrite eqq.
     - Case "Abs"%string.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf _  σ v0 xx H eqq0).
       assert (forall t, (Rabs (df_R σ df v0 t) = df_R σ (Abs ann df) v0 t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; trivial.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H0.
         * destruct ( Req_EM_T d 0 ).
           -- destruct ( Req_EM_T d0 0 ).
              ++ invcs H2.
                 apply is_derive_Rabs_df0.
                 apply IHdf.
              ++ congruence.
           -- inversion H2.
              apply (@is_derive_comp R_AbsRing); trivial.
              replace (d) with (df_R σ df v0 xx).
              ++ replace (@FloatishOps.sign floatish_R (df_R σ df v0 xx)) with (sign (df_R σ df v0 xx)).
                 ** apply is_derive_abs.
                    unfold df_R, df_eval_at_point; simpl.
                    rewrite eqq.
                    lra.
                 ** apply floatish_sign.
              ++ unfold df_R, df_eval_at_point; simpl.
                 now rewrite eqq.
     - Case "Sign"%string.
       do 2 match_option_in H0.
       destruct (Req_EM_T d 0); [congruence|].
       invcs H0.
       specialize (IHdf _  σ v0 xx H eqq0).
       assert (forall t, (sign (df_R σ df v0 t) = df_R σ (Sign ann df) v0 t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; trivial.
         apply floatish_sign.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H0.
         * replace (0)%R with (d0 * 0)%R by lra.
           apply (@is_derive_comp R_AbsRing); trivial.
           apply is_derive_sign.
           unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; lra.
     - Case "PSign"%string.
       do 2 match_option_in H0.
       destruct (Req_EM_T d 0); [congruence|].
       invcs H0.
       specialize (IHdf _  σ v0 xx H eqq0).
       assert (forall t, (psign (df_R σ df v0 t) = df_R σ (PSign ann df) v0 t)).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; trivial.
         apply pos_sign_psign.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H0.
         * replace (0)%R with (d0 * 0)%R by lra.
           apply (@is_derive_comp R_AbsRing); trivial.
           apply is_derive_psign.
           unfold df_R, df_eval_at_point; simpl.
           rewrite eqq; lra.
     - Case "Max"%string.
       do 4 match_option_in H0.
       destruct H.
       assert (forall t, (Rmax (df_R σ df1 v0 t) (df_R σ df2 v0 t)) = df_R σ (Max ann df1 df2) v0 t).
       + intros; simpl.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         rewrite e, e0; trivial.
         apply Rmax_Fmax.
       + eapply is_derive_ext.
         * intros; simpl.
           now rewrite H2.
         * destruct (Req_EM_T d d0).
           -- destruct (Req_EM_T d1 d2).
              ++ invcs H0.
                 apply is_derive_max_alt2.
                 apply IHdf1; trivial.
                 apply IHdf2; trivial.
              ++ congruence.
           -- destruct (Rlt_dec d d0).
              ++ invcs H0.
                 specialize (IHdf1 _  σ v0 xx H eqq1).
                 specialize (IHdf2 _  σ v0 xx H1 eqq2).
                 replace (y) with ((d1 + y + (d1-y)*sign(df_R σ df1 v0 xx - df_R σ df2 v0 xx))/2).
                 ** apply is_derive_max; trivial.
                    unfold df_R, df_eval_at_point; simpl.
                    now rewrite eqq, eqq0.
                 ** unfold df_R, df_eval_at_point; simpl.
                    rewrite eqq, eqq0.
                    unfold sign; simpl.
                    destruct (total_order_T 0 (d - d0)); [destruct s; lra | lra].
              ++ invcs H0.
                 specialize (IHdf1 _  σ v0 xx H eqq1).
                 specialize (IHdf2 _  σ v0 xx H1 eqq2).
                 replace (y) with ((y + d2 + (y - d2)*sign(df_R σ df1 v0 xx - df_R σ df2 v0 xx))/2).
                 ** apply is_derive_max; trivial.
                    unfold df_R, df_eval_at_point; simpl.
                    now rewrite eqq, eqq0.
                 ** unfold df_R, df_eval_at_point; simpl.
                    rewrite eqq, eqq0.
                    unfold sign; simpl.
                    destruct (total_order_T 0 (d - d0)); [destruct s; lra | lra].
     - Case "VectorDot"%string.
       do 4 match_option_in H0.
       invcs H0.
       destruct H.
       specialize (IHdf1 _  σ v0 xx H eqq0).
       specialize (IHdf2 _  σ v0 xx H0 eqq2).
       apply (is_derive_ext (fun x0 => (@vsum floatish_R n)
                                         (fun i => ((df_R_vec σ df1 v0 x0 i) *
                                                   (df_R_vec σ df2 v0 x0 i))%R ))).
       + intros.
         unfold df_R_vec, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + apply is_derive_vsum.
         unfold df_R_vec, df_R, df_eval_at_point; simpl.
         unfold is_derive_vec; intros.
         generalize is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d i * d2 i + d0 i * d1 i)%R with
             (d0 i * (df_R_vec σ df2 v0 xx i) + (df_R_vec σ df1 v0 xx i) * d2 i).
         * apply HH; trivial.
         * unfold df_R_vec, df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "VectorSum"%string.
       match_option_in H0.
       invcs H0.
       specialize (IHdf _  σ v0 xx H eqq).
       assert (forall t, (vsum (df_R_vec σ df v0 t)) = df_R σ (VectorSum ann df) v0 t).
       + intros; simpl.
         unfold df_R_vec, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; unfold Rsqr; trivial.
       + apply (is_derive_ext (fun x0 => (@vsum floatish_R n) (df_R_vec σ df v0 x0))).
         * intros; simpl.
           now rewrite H0.
         * apply is_derive_vsum.
           now simpl in IHdf.
     - Case "MatrixSum"%string.
       match_option_in H0.
       invcs H0.
       specialize (IHdf _  σ v0 xx H eqq).
       assert (forall t, (msum (df_R_mat σ df v0 t)) = df_R σ (MatrixSum ann df) v0 t).
       + intros; simpl.
         unfold df_R_mat, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         rewrite e; unfold Rsqr; trivial.
       + apply (is_derive_ext (fun x0 => (@msum floatish_R m n) (df_R_mat σ df v0 x0))).
         * intros; simpl.
           now rewrite H0.
         * apply is_derive_msum.
           now simpl in IHdf.
     - Case "VectorElem"%string.
       match_option_in H0.
       specialize (IHdf d σ v0 xx H eqq); simpl in IHdf.
       invcs H0.
       apply (is_derive_ext (fun x0 => (df_R_vec σ df v0) x0 i)); intros.
       + unfold df_R_vec, df_R, df_eval_at_point. simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         now rewrite e.
       + unfold is_derive_vec in IHdf.
         apply IHdf.
     - Case "MatrixElem"%string.
       match_option_in H0.
       specialize (IHdf d σ v0 xx H eqq); simpl in IHdf.
       invcs H0.
       apply (is_derive_ext (fun x0 => (df_R_mat σ df v0) x0 i j)); intros.
       + unfold df_R_mat, df_R, df_eval_at_point. simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df); simpl; trivial.
         now rewrite e.
       + unfold is_derive_mat in IHdf.
         apply IHdf.
     - Case "MatrixVectorMult"%string.
       do 4 match_option_in H0.
       invcs H0.
       destruct H.
       specialize (IHdf1 _  σ v0 xx H eqq0).
       specialize (IHdf2 _  σ v0 xx H0 eqq2).
       unfold is_derive_vec; intros.
       apply (is_derive_ext
                (fun x0 => ((@matrix_vector_mult floatish_R m n)
                                (df_R_mat σ df1 v0 x0)
                                (df_R_vec σ df2 v0 x0)) i)).
       + intros.
         unfold df_R_vec, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         rewrite e, e0.
         unfold df_R_mat, df_R, df_eval_at_point; simpl.
         now rewrite e.
       + unfold matrix_vector_mult.
         apply is_derive_vsum.
         unfold is_derive_vec; intros.
         simpl.
         unfold df_R_vec, df_R, df_eval_at_point; simpl.
         unfold is_derive_mat; intros.
         generalize Derive.is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d i i0 * d2 i0 + d0 i i0 * d1 i0)%R with
             (d0 i i0 * (df_R_vec σ df2 v0 xx i0) + (df_R_mat σ df1 v0 xx i i0) * d2 i0)%R.
         * apply HH; trivial.
           simpl in IHdf1.
           unfold is_derive_mat in IHdf1.
           apply IHdf1.
         * unfold df_R_mat, df_R_vec, df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "MatrixVectorAdd"%string.
       do 2 match_option_in H0.
       invcs H0.
       destruct H.
       specialize (IHdf1 _  σ v0 xx H eqq).
       specialize (IHdf2 _  σ v0 xx H0 eqq0).
       unfold is_derive_mat; intros.
       apply (is_derive_ext
                (fun x0 => ((@matrix_vector_add floatish_R m n)
                              (df_R_mat σ df1 v0 x0)
                              (df_R_vec σ df2 v0 x0)) i j)).
       + intros.
         unfold df_R_mat, df_R_vec, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         rewrite e, e0.
         now unfold matrix_vector_add.
       + unfold matrix_vector_add; simpl.
         simpl in *.
         apply (@is_derive_plus R_AbsRing); simpl.
         apply IHdf1.
         apply IHdf2.
     - Case "MatrixMult"%string.
       do 4 match_option_in H0.
       invcs H0.
       destruct H.
       specialize (IHdf1 _  σ v0 xx H eqq0).
       specialize (IHdf2 _  σ v0 xx H0 eqq2).
       unfold is_derive_mat; intros.
       apply (is_derive_ext
                (fun x0 => ((@matrix_mult floatish_R m p n)
                                (df_R_mat σ df1 v0 x0)
                                (df_R_mat σ df2 v0 x0)) i j)).
       + intros.
         unfold df_R_mat, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + unfold matrix_mult.
         apply is_derive_vsum.
         unfold is_derive_vec; intros.
         simpl.
         unfold df_R_mat, df_R, df_eval_at_point; simpl.
         generalize Derive.is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d i i0 * d2 i0 j + d0 i i0 * d1 i0 j)%R with
             (d0 i i0 * (df_R_mat σ df2 v0 xx i0 j) + (df_R_mat σ df1 v0 xx i i0) * d2 i0 j)%R.
         * apply HH; trivial.
         * unfold df_R_mat, df_R_vec, df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "VectorPlus"%string.
       destruct H.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _  σ v0 xx H eqq).
       specialize (IHdf2 _  σ v0 xx H1 eqq0).
       unfold is_derive_vec; intro.
       simpl in *.
       unfold is_derive_vec in IHdf1.
       unfold is_derive_vec in IHdf2.
       specialize (IHdf1 i); specialize (IHdf2 i).
       apply (is_derive_ext (fun x0 => ((df_R_vec σ df1 v0 x0 i) + (df_R_vec σ df2 v0 x0 i))%R)).
       + intros.
         symmetry.
         unfold df_R_vec, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + generalize (@is_derive_plus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "VectorMinus"%string.
       destruct H.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _ σ v0 xx H eqq).
       specialize (IHdf2 _ σ v0 xx H1 eqq0).
       unfold is_derive_vec; intro.
       simpl in *.
       unfold is_derive_vec in IHdf1.
       unfold is_derive_vec in IHdf2.
       specialize (IHdf1 i); specialize (IHdf2 i).
       apply (is_derive_ext (fun x0 => ((df_R_vec σ df1 v0 x0 i) - (df_R_vec σ df2 v0 x0 i))%R)).
       + intros.
         symmetry.
         unfold df_R_vec, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + generalize (@is_derive_minus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "MatrixPlus"%string.
       destruct H.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _ σ v0 xx H eqq).
       specialize (IHdf2 _ σ v0 xx H1 eqq0).
       unfold is_derive_mat; intros.
       simpl in *.
       unfold is_derive_mat in IHdf1.
       unfold is_derive_mat in IHdf2.
       specialize (IHdf1 i j); specialize (IHdf2 i j).
       apply (is_derive_ext (fun x0 => ((df_R_mat σ df1 v0 x0 i j) + (df_R_mat σ df2 v0 x0 i j))%R)).
       + intros.
         symmetry.
         unfold df_R_mat, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + generalize (@is_derive_plus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "MatrixMinus"%string.
       destruct H.
       do 2 match_option_in H0.
       invcs H0.
       specialize (IHdf1 _ σ v0 xx H eqq).
       specialize (IHdf2 _ σ v0 xx H1 eqq0).
       unfold is_derive_mat; intros.
       simpl in *.
       unfold is_derive_mat in IHdf1.
       unfold is_derive_mat in IHdf2.
       specialize (IHdf1 i j); specialize (IHdf2 i j).
       apply (is_derive_ext (fun x0 => ((df_R_mat σ df1 v0 x0 i j) - (df_R_mat σ df2 v0 x0 i j))%R)).
       + intros.
         symmetry.
         unfold df_R_mat, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + generalize (@is_derive_minus R_AbsRing); simpl
         ; intros HH; now apply HH.
     - Case "VectorScalMult"%string.
       do 4 match_option_in H0.
       invcs H0.
       destruct H.
       specialize (IHdf1 _ σ v0 xx H eqq0).
       specialize (IHdf2 _ σ v0 xx H0 eqq2).
       unfold is_derive_vec; intros.
       apply (is_derive_ext (fun x0 => ((df_R σ df1 v0 x0) * (df_R_vec σ df2 v0 x0 i))%R)).
       + intro.
         unfold df_R_vec, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + generalize Derive.is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d * d2 i + d0 * d1 i)%R with
             (d0 * (df_R_vec σ df2 v0 xx i) + (df_R σ df1 v0 xx) * (d2 i))%R.
         * apply HH; trivial.
           simpl in IHdf1; simpl in IHdf2.
           unfold is_derive_vec in IHdf2.
           apply IHdf2.
         * unfold df_R_vec, df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "MatrixScalMult"%string.
       do 4 match_option_in H0.
       invcs H0.
       destruct H.
       specialize (IHdf1 _ σ v0 xx H eqq0).
       specialize (IHdf2 _ σ v0 xx H0 eqq2).
       unfold is_derive_mat; intros.
       apply (is_derive_ext (fun x0 => ((df_R σ df1 v0 x0) * (df_R_mat σ df2 v0 x0 i j))%R)).
       + intro.
         unfold df_R_mat, df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df1); simpl; trivial.
         destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         now rewrite e, e0.
       + generalize Derive.is_derive_mult
         ; unfold plus, mult; simpl; intros HH.
         replace (d * d2 i j + d0 * d1 i j)%R with
             (d0 * (df_R_mat σ df2 v0 xx i j) + (df_R σ df1 v0 xx) * (d2 i j))%R.
         * apply HH; trivial.
           simpl in IHdf1; simpl in IHdf2.
           unfold is_derive_mat in IHdf2.
           apply IHdf2.
         * unfold df_R_mat, df_R, df_eval_at_point; simpl.
           rewrite eqq; rewrite eqq1.
           lra.
     - Case "VectorApply"%string.
       destruct H.
       do 2 match_option_in H0.
       specialize (vectoro_to_ovector_forall_some_f H0); intros.
       specialize (IHdf2 d0 σ v0 xx H1 eqq0).
       unfold is_derive_vec; intro.
       specialize (H2 i); simpl in H2.
       match_option_in H2; invcs H2.
       simpl in IHdf2; simpl in IHdf1.
       specialize (IHdf1 d1).
       unfold is_derive_vec in IHdf2; specialize (IHdf2 i).
       generalize
         (@is_derive_comp R_AbsRing R_NormedModule
                          (df_R nil df1 v)
                          (fun x0 => (df_R_vec σ df2 v0 x0 i))); simpl; intros.
       specialize (H2 xx d1 (d0 i)).
       apply (is_derive_ext  (fun x : R => df_R Datatypes.nil df1 v (df_R_vec σ df2 v0 x i)))
       ; intros.
       + destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         unfold df_R_vec, df_eval_at_point; simpl.
         rewrite e.
         unfold df_R, df_eval_at_point; simpl.
         destruct (eval_fully_closed_total (mk_env_entry (v, DTfloat) (x i) :: nil) df1)
         ; simpl; trivial.
         unfold addBinding.
         rewrite e0.
         match_option.
         * specialize (vectoro_to_ovector_forall_some_f eqq2); intros.
           specialize (H3 i);simpl in H3.
           congruence.
         * apply vectoro_to_ovector_exists_None in eqq2.
           destruct eqq2.
           destruct (eval_fully_closed_total (mk_env_entry (v, DTfloat) (x x1) :: nil) df1)
           ; simpl; trivial.
           congruence.
       + apply H2.
         * unfold df_R_vec, df_R, df_eval_at_point; simpl.
           rewrite eqq.
           unfold df_R, df_eval_at_point in IHdf1.
           specialize (IHdf1 nil v (d i)).
           apply IHdf1; trivial.
         * apply IHdf2.
     - Case "MatrixApply"%string.
       destruct H.
       do 2 match_option_in H0.
       specialize (vectoro_to_ovector_forall_some_f H0); intros.
       specialize (IHdf2 d0 σ v0 xx H1 eqq0).
       unfold is_derive_mat; intros.
       specialize (H2 i); simpl in H2.
       unfold matrixo_to_omatrix in H0.
       specialize (vectoro_to_ovector_forall_some_f H2); intros.
       specialize (H3 j); simpl in H3.
       match_option_in H3; invcs H3.
       simpl in IHdf2; simpl in IHdf1.
       specialize (IHdf1 d1).
       unfold is_derive_mat in IHdf2; specialize (IHdf2 i j).
       generalize
         (@is_derive_comp R_AbsRing R_NormedModule
                          (df_R nil df1 v)
                          (fun x0 => (df_R_mat σ df2 v0 x0 i j)))
       ; simpl; intros.
       specialize (H3 xx d1 (d0 i j)).
       apply (is_derive_ext  (fun x : R => df_R Datatypes.nil df1 v (df_R_mat σ df2 v0 x i j)))
       ; intros.
       + destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         unfold df_R_mat, df_eval_at_point; simpl.
         rewrite e.
         unfold matrixo_to_omatrix.
         destruct (eval_fully_closed_total (mk_env_entry (v, DTfloat) (x i j) :: nil) df1)
         ; simpl; trivial.
         unfold df_R, df_eval_at_point, addBinding; simpl.
         rewrite e0.
         match_option.
         * specialize (vectoro_to_ovector_forall_some_f eqq2); intros.
           specialize (H4 i); simpl in H4.
           specialize (vectoro_to_ovector_forall_some_f H4); intros.
           specialize (H6 j); simpl in H6.
           congruence.
         * apply vectoro_to_ovector_exists_None in eqq2.
           destruct eqq2.
           apply vectoro_to_ovector_exists_None in e1.
           destruct e1.
           destruct (eval_fully_closed_total (mk_env_entry (v, DTfloat) (x x1 x2) :: nil) df1)
           ; simpl; trivial.
           congruence.
       + apply H3.
         * unfold df_R_mat, df_R, df_eval_at_point; simpl.
           rewrite eqq.
           specialize (IHdf1 nil v (d i j)).
           unfold df_R, df_eval_at_point in IHdf1; simpl in IHdf1.
           apply IHdf1; trivial.
         * apply IHdf2.
     - Case "VLossfun"%string.
       destruct H.
       do 3 match_option_in H0.
       invcs H0.
       specialize (vectoro_to_ovector_forall_some_f eqq1); simpl; intros.
       specialize (IHdf2 d0 σ v0 xx H1 eqq0).
       simpl in IHdf2; simpl in IHdf1.
       unfold is_derive_vec in IHdf2.
       unfold df_R, df_eval_at_point; simpl.
       generalize (is_derive_vsum
                     (fun x : R =>
                        match df_eval (addBinding σ v0 x) df2 with
                        | Some l' =>
                          match
                            vectoro_to_ovector
                              (fun i : {n' : nat | (n' < n)%nat} =>
                                 df_eval
                                   (mk_env_entry (v1, DTfloat) (l' i)
                                                 :: mk_env_entry (v2, DTfloat) (r i)
                                                 :: Datatypes.nil) df1)
                          with
                          | Some vv => vv
                          | None => fun _ => 0%R
                          end
                        | None => fun _ => 0%R
                        end)
                     xx v); intros.
       apply (is_derive_ext
                (fun x0 : R_AbsRing =>
                   vsum
                     match df_eval (addBinding σ v0 x0) df2 with
                     | Some l' =>
                       match
                         vectoro_to_ovector
                           (fun i : {n' : nat | (n' < n)%nat} =>
                              df_eval
                                (mk_env_entry (v1, DTfloat) (l' i)
                                              :: mk_env_entry (v2, DTfloat) (r i)
                                              :: Datatypes.nil) df1)
                       with
                       | Some vv => vv
                       | None => fun _ : {n' : nat | (n' < n)%nat} => 0
                       end
                     | None => fun _ : {n' : nat | (n' < n)%nat} => 0
                     end)); intros.
       + destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
         rewrite e.
         match_option.
         apply vsum0.
       + apply H2.
         unfold is_derive_vec; simpl; intros.
         generalize
           (@is_derive_comp R_AbsRing R_NormedModule
                            (df_R (addBinding nil v2 (r i)) df1 v1)
                            (fun x0 => (df_R_vec σ df2 v0 x0 i))); simpl; intros.
         apply (is_derive_ext
                  (fun x0 : R =>
                     df_R (addBinding Datatypes.nil v2 (r i)) df1 v1 (df_R_vec σ df2 v0 x0 i)));intros.
         * unfold df_R_vec, df_R, df_eval_at_point; simpl.
           destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
           rewrite e.
           destruct (eval_fully_closed_total
                       (addBinding (addBinding Datatypes.nil v2 (r i)) v1 (x i)) df1); simpl; trivial.
           rewrite e0.
           match_option.
           -- specialize (vectoro_to_ovector_forall_some_f eqq2); intros.
              specialize (H4 i); simpl in H4.
              unfold addBinding in e0.
              congruence.
           -- apply vectoro_to_ovector_exists_None in eqq2.
              destruct eqq2.
              destruct (eval_fully_closed_total
                          (mk_env_entry (v1, DTfloat) (x x1)
                                        :: mk_env_entry (v2, DTfloat) (r x1)
                                        :: Datatypes.nil) df1); trivial.
              congruence.
         * specialize (H0 i).
           match_option_in H0.
           inversion H0.
           apply H3; trivial.
           apply IHdf1; trivial.
           unfold addBinding, df_R_vec, df_eval_at_point; simpl.
           rewrite eqq.
           apply eqq2.
     - Case "MLossfun"%string.
       destruct H.
       do 3 match_option_in H0.
       invcs H0.
       destruct (Nat.eq_dec n 0); [congruence|].
       invcs H3.
       specialize (vectoro_to_ovector_forall_some_f eqq1); simpl; intros.
       specialize (IHdf2 d0 σ v0 xx H1 eqq0).
       simpl in IHdf2; simpl in IHdf1.
       unfold is_derive_mat in IHdf2.
       replace ((@msum floatish_R m n m0) / IZR (Z.of_nat n))%R with (/ (IZR (Z.of_nat n))%R * msum m0)%R by lra.
       apply (is_derive_ext (fun x0 =>  scal (Rinv (IZR (Z.of_nat n))%R)
                                        (scal (IZR (Z.of_nat n))%R
                                         (df_R σ (MLossfun ann v1 v2 df1 df2 r) v0 x0)))); intros.
       + unfold scal; simpl.
         unfold mult; simpl.
         field.
         apply IZR_neq; omega.
       + apply is_derive_scal.
         unfold df_R, df_eval_at_point; simpl.
         generalize (is_derive_msum
                       (fun x : R =>
                          match df_eval (addBinding σ v0 x) df2 with
                          | Some l' =>
                          match
                            matrixo_to_omatrix
                              (fun (i : {n' : nat | (n' < m)%nat})
                                   (j : {m' : nat | (m' < n)%nat}) =>
                                 df_eval
                                   (mk_env_entry (v1, DTfloat) (l' i j)
                                                 :: mk_env_entry (v2, DTfloat) (r i j)
                                                 :: Datatypes.nil) df1)
                          with
                          | Some vv => vv
                          | None => fun _ _ => 0%R
                          end
                        | None => fun _ _ => 0%R
                        end)
                     xx m0); intros.
         apply (is_derive_ext
                (fun x0 : R_AbsRing =>
                   msum
                     match df_eval (addBinding σ v0 x0) df2 with
                     | Some l' =>
                       match
                         matrixo_to_omatrix
                           (fun (i : {n' : nat | (n' < m)%nat})
                                (j : {m' : nat | (m' < n)%nat}) =>
                              df_eval
                                (mk_env_entry (v1, DTfloat) (l' i j)
                                              :: mk_env_entry (v2, DTfloat) (r i j)
                                              :: Datatypes.nil) df1)
                       with
                       | Some vv => vv
                       | None =>
                         fun (_ : {n' : nat | (n' < m)%nat})
                             (_ : {m' : nat | (m' < n)%nat}) => 0
                       end
                     | None => fun (_ : {n' : nat | (n' < m)%nat})
                                   (_ : {m' : nat | (m' < n)%nat}) => 0
                     end)); intros.
         * destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
           rewrite e.
           unfold matrixo_to_omatrix; simpl.
           match_option.
           -- unfold scal; simpl.
              unfold mult; simpl.
              generalize (msum v); unfold float; simpl; intros.
              field.
              rewrite <- INR_IZR_INZ.
              now apply INR_nzero_eq.
           -- unfold scal; simpl.
              unfold mult; simpl.
              replace (IZR (Z.of_nat n) * 0)%R with (0)%R by lra.
              unfold msum.
              erewrite vsum_ext; try apply vsum0; intro.
              rewrite vmap_nth.
              erewrite vsum_ext; try apply vsum0; intro.
              trivial.
         * apply H2.
           unfold is_derive_mat; simpl; intros.
           generalize
             (@is_derive_comp R_AbsRing R_NormedModule
                              (df_R (addBinding nil v2 (r i j)) df1 v1)
                              (fun x0 => (df_R_mat σ df2 v0 x0 i j))); simpl; intros.
           apply (is_derive_ext
                    (fun x0 : R =>
                       df_R (addBinding Datatypes.nil v2 (r i j)) df1 v1
                            (df_R_mat σ df2 v0 x0 i j)));intros.
           -- unfold df_R_mat, df_R, df_eval_at_point; simpl.
              destruct (eval_fully_closed_total (addBinding σ v0 t) df2); simpl; trivial.
              rewrite e.
              destruct (eval_fully_closed_total
                          (addBinding (addBinding Datatypes.nil v2 (r i j)) v1 (x i j)) df1)
              ; simpl; trivial.
              rewrite e0.
              match_option.
              ++ specialize (vectoro_to_ovector_forall_some_f eqq2); intros.
                 specialize (H4 i); simpl in H4.
                 specialize (vectoro_to_ovector_forall_some_f H4); intros.
                 specialize (H5 j); simpl in H5.
                 unfold addBinding in e0.
                 congruence.
              ++ unfold matrixo_to_omatrix in eqq2.
                 apply vectoro_to_ovector_exists_None in eqq2.
                 destruct eqq2.
                 apply vectoro_to_ovector_exists_None in e1.
                 destruct e1.
                 destruct (eval_fully_closed_total
                             (mk_env_entry (v1, DTfloat) (x x1 x2)
                                        :: mk_env_entry (v2, DTfloat) (r x1 x2)
                                        :: Datatypes.nil) df1); trivial.
                 congruence.
           -- specialize (H0 i).
              specialize (vectoro_to_ovector_forall_some_f H0); intros.
              specialize (H4 j); simpl in H4.
              match_option_in H4.
              inversion H4.
              apply H3; trivial.
              apply IHdf1; trivial.
              unfold addBinding, df_R_vec, df_eval_at_point; simpl.
              unfold df_R_mat, df_eval_at_point; simpl.
              rewrite eqq.
              apply eqq2.
    Qed.


Require Import HoTT.Classes.interfaces.abstract_algebra
               HoTT.Classes.interfaces.orders
               HoTT.Classes.implementations.assume_rationals
               HoTT.Classes.theory.rationals
               HoTT.Classes.theory.premetric
               HoTT.HSet HoTT.Basics.Trunc HProp HSet
               Types.Universe
               TruncType Types.Sigma
               HIT.quotient.

Require Import HoTTClasses.sierpinsky partiality dedekind.

Require Export Rlow Opens Functions
               Valuations LowerIntegrals
               D_op OpenFun.

(** * From Integrals to Valuations *)

(**  mu_I (U)  = I (1_U) *)
Definition Riesz1 (A : hSet) : IntPos A -> Val A.
Proof.
intros J.
exists (fun U:OS A => (I J (OpenFun U))).
+ red. intros U V.
  transitivity (I J (OpenFun U) + I J (OpenFun V)).
  unfold plus; reflexivity.
  rewrite <- (I_add J (OpenFun U) (OpenFun V)).
  transitivity
     ((I J( OpenFun (OS_join U V)))+
      (I J (OpenFun (OS_meet U V))));
  try reflexivity.
  rewrite <- (I_add J (OpenFun  (OS_join U V))
                    (OpenFun  (OS_meet U V))).
  rewrite OpenFun_mod, fplus_comm. reflexivity.
+ red. destruct J.
  assert (HO : @OpenFun A OS_empty = fun x => RlP_0).
  apply path_forall; intros z.
  rewrite OpenFun_def; reflexivity.
  rewrite HO. simpl. unfold Mdef in I_def. apply I_def.
+ red. intros U V H.
  apply I_mon.
  apply OpenFun_mon; trivial.
+ unfold OS_full; apply I_prob.
+ intros f.
  assert (H1 : Rlle (J (OpenFun (Cpo.lub f)))
           (J (fun x : A => RllubPos (fun n : nat =>
                (OpenFun (f n) x))))).
  apply I_mon.
  intros x.
  rewrite OpenFun_lub; unfold Rlle; auto.
  assert (H2 : Rlle (J (fun x : A => RllubPos (fun n : nat => OpenFun (f n) x)))
    (RllubPos (fun n : nat => J (OpenFun (f n))))).
  assert (X : forall x, (fun n : nat => OpenFun (f n)) x =
        (OpenFun_increasing_sequence f) x).
  intros x; reflexivity.
  assert (H3: Rlle  (J (fun x : A => RllubPos (fun n : nat => OpenFun (f n) x)))
      (J (fun x : A => RllubPos (fun n =>
           seq ((OpenFun_increasing_sequence f)) n x)))).
  apply I_mon.
  intros x.
  apply RllubPos_mon;
  intros n q Hn.
  rewrite <- X; trivial.
  assert (X' : (J (fun x : A => RllubPos (fun n : nat =>
                         OpenFun (f n) x))) =
               (J (fun x : A => RllubPos (fun n : nat =>
                   (OpenFun_increasing_sequence f) n x)))).
  simpl; reflexivity.
  rewrite X'.
  apply J.
  unfold Rlle in *; auto.
Defined.


From mathcomp
     Require Import all_ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Definition mySet (M : Type) := M -> Prop.
Definition belong {M : Type} (A : mySet M) (x : M) :
  Prop := A x.
Notation "x \In A" := (belong A x) (at level 11).
Axiom axiom_myset : forall (M : Type) (A : mySet M),
    forall (x : M), (x \In A) \/ ~(x \In A).

Definition myEmptySet {M : Type} : mySet M := fun _ => False.


From mathcomp Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq tuple fintype.
From mathcomp Require Import choice path bigop fintype.

(* The below file collects a number of lemms about ordinals (finitely-bounded nats) in ssreflect. *)

Lemma ltSS {a b} (H : a.+1 < b.+1) : a < b.
    done.
Defined.

Inductive ord_spec {n} : 'I_(n.+1) -> Type :=
| Ord0 i : i = @ord0 n -> ord_spec i
| OrdS i (j : 'I_n) : i = lift ord0 j -> ord_spec i.

(* The below lemmas allow us to induct up and down on the finite set [0...n]. *)

Definition ordP {n} (i : 'I_(n.+1)) : ord_spec i.
  destruct i as [x Hx].
  destruct x.
  apply Ord0.
  apply/eqP; rewrite eqE //=.
  apply (OrdS _ (Ordinal (ltSS Hx))).
  apply/eqP; rewrite eqE //=.
Defined.

Require Import Lia.

Lemma ltnS_neq_n {a b} (H : a < b.+1) (H' : a != b) : a < b.
  move/ltP: H => H.
  move/eqP: H' => h'.
  apply/ltP.
  lia.
Qed.

Inductive ord_spec_r {n} : 'I_(n.+1) -> Type :=
| OrdMax i : i = ord_max -> ord_spec_r i
| OrdPred i (j : 'I_n) : i = widen_ord (leqnSn n) j -> ord_spec_r i.

Definition ordP_r {n} (i : 'I_(n.+1)) : ord_spec_r i.
  destruct i as [x Hx].
  destruct (eqVneq x n).
  subst.
  apply OrdMax.
  apply/eqP; rewrite eqE //=.
  apply (OrdPred _ (Ordinal (ltnS_neq_n Hx i))).
  apply/eqP; rewrite eqE //=.
Defined.

Lemma ord_cast_ind {n} (p2 p1 : 'I_n) (P : 'I_n -> Prop) :
  P p1 ->
  val p1 = val p2 ->
  P p2.
  intros.
  have: p1 = p2.
  apply/eqP; rewrite eqE //= H0 //=.
  intro; subst; done.
Qed.

Lemma ord_indP {n} (P : 'I_(n.+1) -> Prop) :
  P ord0 ->
  (forall (j : 'I_n), P (widen_ord (leqnSn n) j) -> P (lift ord0 j)) ->
  (forall j, P j).
  intros.
  destruct j as [j Hj].
  induction j.
  eapply ord_cast_ind.
  apply H.
  done.
  have Hj1 : j < n by done.
  have Hj2 : j < n.+1.
  eapply leq_trans.
  apply Hj1.
  done.
  eapply (ord_cast_ind _ (lift ord0 (Ordinal Hj1))).
  apply H0.
  eapply ord_cast_ind.
  apply (IHj Hj2).
  done.
  done.
Qed.

Lemma ordP_r_max {n} (i : 'I_n.+1) : i = ord_max ->
                         exists h,
                         ordP_r i = OrdMax _ h.
  intros; subst.
  rewrite /ordP_r.
  simpl.
  destruct (eqVneq).
  have: e = erefl by apply eq_irrelevance.
  intro; subst.

  eexists.
  rewrite /eq_rect_r //=.
  exfalso.
  rewrite eq_refl in i; done.
Qed.

Lemma ordP_r_widen {n} (i : 'I_(n.+1)) :
  i < n ->
  exists j h,
  ordP_r i = OrdPred i j h.
  intros.
  rewrite /ordP_r.
  rewrite //=.
  destruct i as [i Hi].
  destruct eqVneq.
  subst.
  simpl in *.
  rewrite ltnn in H; done.
  eexists; eexists.
  done.
Qed.

Lemma subn_gt0_lt n m :
  n - m > 0 ->
  m < n.
  move: m; induction n; intros.
  rewrite /subn //= in H.
  intros.
  destruct m.
  done.

  have //= : m < n.
  apply IHn.
  rewrite subSS in H; done.
Qed.

Lemma ord_indP_r {n} (P : 'I_(n.+1) -> Prop) :
  P ord_max ->
  (forall (j : 'I_n), P (lift ord0 j) -> P (widen_ord (leqnSn n) j)) ->
  (forall j, P j).
  intros.
  remember (n - j) as k; symmetry in Heqk.
  move: j Heqk.
  induction k; intros.
  have : j = ord_max.
    apply/eqP; rewrite eqE //= eqn_leq; apply/andP; split.
    destruct j; done.

    move/eqP: Heqk => Heqk.
    rewrite subn_eq0 in Heqk; done.
 intro; subst; apply H.

 have: j < n.
   apply subn_gt0_lt.
   rewrite Heqk //=.
 intros.
 move/ordP_r_widen: x.
 elim; intro.
 elim; intro.
 subst.
 intros.
 apply H0.
 apply IHk.
 simpl.
 have -> : bump 0 x = x.+1.
 rewrite /bump //=.
 rewrite subnS.
 simpl in Heqk.
 rewrite Heqk.
 done.
Qed.


Require Export XR_lt_IZR.

Local Open Scope R_scope.

Lemma one_IZR_lt1 : forall n:Z, - R1 < IZR n < R1 -> n = 0%Z.
Proof.
  intros n [hl hr].
  apply Z.le_antisymm.
  {
    apply Z.lt_succ_r.
    apply lt_IZR.
    simpl.
    exact hr.
  }
  {
    apply Z.lt_succ_r.
    apply lt_IZR.
    simpl.
    unfold Z.succ.
    rewrite plus_IZR.
    simpl.
    apply Rplus_lt_reg_l with (-R1).
    rewrite Rplus_0_r.
    rewrite Rplus_comm.
    rewrite Rplus_assoc.
    rewrite Rplus_opp_r.
    rewrite Rplus_0_r.
    exact hl.
  }
Qed.


From Coq Require Import ZArith Reals QArith Qcanon micromega.Lia micromega.Lra.
From BY.Hierarchy Require Import CommutativeMonoid IntegralDomain.

Global Arguments equiv {_ _} _ _ / : assert.
Global Arguments op1 {_ _} _ _ / : assert.
Global Arguments op2 {_ _} _ _ / : assert.
Global Arguments id1 {_ _} / : assert.
Global Arguments id2 {_ _} / : assert.
Global Arguments inv1 {_ _} _ / : assert.
Global Arguments inv2 {_ _} _ / : assert.
Global Arguments left_act {_ _ _} _ _ / : assert.
Global Arguments right_act {_ _ _} _ _ / : assert.

Section nat.

  Global Instance Nateq_equiv : Equiv nat := eq.
  Global Instance Natadd_op1 : Op1 nat := Nat.add.
  Global Instance Natzero_id1 : Id1 nat := O.

  Global Arguments Nateq_equiv /.
  Global Arguments Natadd_op1 /.
  Global Arguments Natzero_id1 /.

  Global Instance Nat_commutative_monoid : CommutativeMonoid nat.
  Proof. repeat split; repeat red; intros; simpl in *; try lia. Qed.

End nat.

Section Z.

  Global Instance Zeq_equiv : Equiv Z := eq.
  Global Instance Zadd_op1 : Op1 Z := Z.add.
  Global Instance Zzero_id1 : Id1 Z := Z0.
  Global Instance Zopp_inv1 : Inv1 Z := Z.opp.
  Global Instance Zmult_op2 : Op2 Z := Z.mul.
  Global Instance Zone_id2 : Id2 Z := 1%Z.

  Global Arguments Zeq_equiv /.
  Global Arguments Zadd_op1 /.
  Global Arguments Zzero_id1 /.
  Global Arguments Zopp_inv1 /.
  Global Arguments Zmult_op2 /.
  Global Arguments Zone_id2 /.

  Global Arguments Z.mul : simpl never.

  Global Instance Z_integral_domain : IntegralDomain Z.
  Proof. repeat split; repeat red; intros; cbn in *; auto with zarith; nia. Qed.

  Global Instance Z_eq_dec : forall x y : Z, Decision (x = y) := Z.eq_dec.

End Z.

Section R.

  Global Instance Req_equiv : Equiv R := eq.
  Global Instance Rplus_op1 : Op1 R := Rplus.
  Global Instance Rzero_id1 : Id1 R := R0.
  Global Instance Ropp_inv1 : Inv1 R := Ropp.
  Global Instance Rmult_op2 : Op2 R := Rmult.
  Global Instance Rone_id2 : Id2 R := R1.

  Global Arguments Req_equiv /.
  Global Arguments Rplus_op1 /.
  Global Arguments Rzero_id1 /.
  Global Arguments Ropp_inv1 /.
  Global Arguments Rmult_op2 /.
  Global Arguments Rone_id2 /.

  Global Instance R_integral_domain : IntegralDomain R.
  Proof. repeat split; repeat red; simpl in *; intros; nra. Qed.

  Global Instance R_eq_dec : RelDecision (=@{R}) := Req_EM_T.

  Global Instance Rle_reflexive : Reflexive Rle. red; intros; lra. Qed.
  Global Instance Rle_transitive : Transitive Rle. red; intros; lra. Qed.

End R.

Require Import micromega.Lqa.

Section Q.

  Local Open Scope Q_scope.

  Global Instance Qeq_Equiv : Equiv Q := Qeq.
  Global Arguments Qeq_Equiv /.

  Global Instance Qadd_op1 : Op1 Q := Qplus.
  Global Instance Qzero_id1 : Id1 Q := 0%Q.
  Global Instance Qopp_inv1 : Inv1 Q := Qopp.
  Global Instance Qmult_op2 : Op2 Q := Qmult.
  Global Instance Qone_id2 : Id2 Q := 1%Q.
  Global Instance Qinv_inv2 : Inv2 Q := Qinv.

  Global Arguments Qadd_op1 /.
  Global Arguments Qzero_id1 /.
  Global Arguments Qopp_inv1 /.
  Global Arguments Qmult_op2 /.
  Global Arguments Qone_id2 /.
  Global Arguments Qinv_inv2 /.

  Global Instance Q_integral_domain : IntegralDomain Q.
  Proof. repeat split; repeat intro; cbn in *; nra. Qed.

  Global Instance Q_eq_dec : forall x y : Q, Decision (x ≡ y) := Qeq_dec.

End Q.

Section Qc.

  Local Open Scope Qc.

  Global Instance Qceq_equiv : Equiv Qc := eq.
  Global Arguments Qceq_equiv /.
  Global Instance Qcplus_op1 : Op1 Qc := Qcplus.
  Global Arguments Qcplus_op1 /.
  Global Instance Qczero_id1 : Id1 Qc := 0.
  Global Arguments Qczero_id1 /.
  Global Instance Qcopp_inv1 : Inv1 Qc := Qcopp.
  Global Arguments Qcopp_inv1 /.

  Global Instance Qcmult_op2 : Op2 Qc := Qcmult.
  Global Arguments Qcmult_op2 /.
  Global Instance Qcone_id2 : Id2 Qc := 1.
  Global Arguments Qcone_id2 /.

  Global Instance Qc_integral_domain : IntegralDomain Qc.
  Proof.
    repeat split; repeat red; intros; cbn in *; try field; try congruence.
    inversion H. apply Qcmult_integral. assumption.
  Qed.

End Qc.


Require Import GradebookModel List Bool.

(* This gives a more logical definition of the spec.
   It's missing the mutate part, but has the config part.
   It exists to back up a single claim in the paper that
   specs don't need to resemble programs. *)
Module LogicalGradebookModel.
  Export GradebookModel.

  (* The computational style shown above is useful for proof
     automation, but we can easily show it equivalent to
     a more logical style of definition. *)
  Definition correct_cfg' (cfg: Config) := forall id,
(*    (In id (students cfg) -> (~In id (tas cfg) /\ ~In id (profs cfg))) /\
    (In id (tas cfg) -> (~In id (students cfg) /\ ~In id (profs cfg))) /\
    (In id (profs cfg) -> (~In id (tas cfg) /\ ~In id (students cfg))) /\ *)
    (In id (students cfg) \/ In id (tas cfg) \/ In id (profs cfg) ->
      exists hash, lookup id (hashes cfg) = Some hash) /\
    (In id (students cfg) \/ In id (tas cfg) ->
      exists section, lookup id (sections cfg) = Some section).

  (** Proofs **)

  Lemma excludesWeaken : forall l a b, excludes l (a :: b) = true -> excludes l b = true.
    induction l.
      firstorder.
      intros. unfold excludes in H. remember (in_dec a (a0 :: b)) as InD. destruct InD. inversion H. fold excludes in H.
        pose (IHl a0 b H). unfold excludes. unfold in_dec in HeqInD. destruct (id_dec a a0); try congruence. unfold excludes in e. rewrite e.
      unfold in_dec. rewrite <- HeqInD. trivial.
  Qed.

  Lemma denoteIn : forall T (x : T) (l : list T), In x l -> exists a, exists b, l = a ++ x :: b.
    induction l.
      firstorder.
      intros. destruct H. exists (@nil T). exists l. simpl. subst. auto.
        destruct (IHl H). destruct H0. exists (a :: x0). exists x1. simpl. subst. auto.
  Qed.

  Lemma excludes_app : forall a b c, excludes (a ++ b) c = excludes a c && excludes b c.
    induction a.
      firstorder.
      simpl. intros. destruct (in_dec a c). auto. auto.
  Qed.

  Lemma denoteExcludes : forall (l1 l2 : list ID),
    excludes l1 l2 = true -> (forall i, In i l1 -> ~In i l2).
    induction l1.
      solve [ firstorder ].
      intros. destruct (denoteIn _ _ _ H0). destruct H1. rewrite H1 in H. rewrite excludes_app in H.
      isTrue (excludes (i :: x0) l2) H. unfold andb in H. destruct (excludes x l2); discriminate.
      simpl in H2. remember (in_dec i l2) as RM. destruct RM; try congruence.

      Lemma denoteNotInDec : forall i l2,
        false = in_dec i l2 -> ~In i l2.
        unfold not. induction l2.
          firstorder.
          simpl. destruct (id_dec i a). firstorder. firstorder.
      Qed.
      apply denoteNotInDec; auto.
  Qed.

  Lemma total_dec_app : forall T (a b : list ID) (c : list (ID * T)), total_dec (a ++ b) c = total_dec a c && total_dec b c.
    intros; induction a.
      auto.
      intros; simpl. destruct (lookup a c). rewrite IHa. auto. auto.
  Qed.

  Lemma denoteTotalDec : forall (T:Set) k l (m : list (ID * T)),
    In k l -> total_dec l m = true -> exists v, lookup k m = Some v.
    intros. induction l.
      inversion H.
      unfold In in H. destruct H.
        unfold total_dec in H0.
        remember (lookup a m) as RM. destruct RM. subst. exists t. firstorder. inversion H0.
        simpl in H0. destruct (lookup a m); [ | discriminate ]. apply IHl; assumption.
  Qed.

  Lemma denotation_total_dec : forall (T:Set) a (b : list (ID * T)),
    (forall id, In id a -> exists h, lookup id b = Some h) -> total_dec a b = true.
    induction a.
      firstorder.
      intros. simpl. remember (lookup a b) as RM. destruct RM. apply IHa. intros. apply H. unfold In. right. auto.
      assert (In a (a :: a0)). unfold In; left; auto. pose (H a H0). destruct e. congruence.
  Qed.

  Lemma denotation_excludes : forall X Y, (forall id, In id X -> ~In id Y) -> excludes X Y = true.
    induction X.
      firstorder.
      intros. simpl. pose (H a (in_eq _ _)). remember (in_dec a Y) as RM. destruct RM.
        symmetry in HeqRM. pose (denoteInDec _ _ HeqRM). congruence.
        apply IHX. intros. pose (H id).
        apply n0.
        remember (id_dec id a) as RM'. destruct RM'. rewrite e in *. apply in_eq. unfold In. right. auto.
  Qed.

  Theorem cfg_correct_eqiv : forall cfg,
    correct_cfg cfg = true <-> correct_cfg' cfg.
  Proof.
    split; intros.
    (** -> **)
    unfold correct_cfg,disjoint_dec in H. repeat rewrite total_dec_app in H. all. simpl in F. all.
    unfold correct_cfg'. intros.
    split; intros.
    destruct H0;
      [ eapply denoteTotalDec; eassumption
      | destruct H0; eapply denoteTotalDec; eassumption ].
    destruct H0; eapply denoteTotalDec; eassumption.

    (** <- **)
    unfold correct_cfg',correct_cfg in *. repeat rewrite total_dec_app. unfold disjoint_dec. simpl.
    each; ((apply denotation_total_dec; firstorder)).
  Qed.

End LogicalGradebookModel.


(** * 6.822 Formal Reasoning About Programs, Spring 2022 - Pset 13 *)

(* Author:
 * Samuel Gruetter (gruetter@mit.edu)
 *)

Require Import Frap MessagesAndRefinement Pset13Sig.

Module Impl.
(* We suggest that you start by reading Chapter 21 in the FRAP book.
   For this pset, you will need to understand everything in that chapter up to and
   including Theorem 19.2 ("If p1 <| p2, then every trace generated by p1 is
   also generated by p2").
   Also study the code in MessagesAndRefinement.v, because this
   pset depends on that code.

   As always, if you ever get stuck, you can help yourself to the hints at
   the bottom of Pset13Sig.v! *)

Arguments Nat.modulo: simpl never.

(* In this pset, we will define a small key-value store server.
   To simplify, it only accepts GET requests: *)
Inductive request :=
| GET (client_id key : nat).

Definition get_key (req : request) : nat :=
  match req with
  | GET _ key => key
  end.

(* There are two possible responses for a GET request: *)
Inductive response :=
| FOUND (client_id key value : nat)
| NOT_FOUND (client_id key : nat).

(* Given a key-value store (modeled as an fmap), a source channel, and an output channel,
   here's how we handle one request: *)
Definition request_handler (store : fmap nat nat) (source output : channel) : proc :=
  ??source(req: request);
  match req with
  | GET client_id key =>
    match store $? key with
    | Some v => !!output(FOUND client_id key v); Done
    | None => !!output(NOT_FOUND client_id key); Done
    end
  end.

(* Key-value stores might become very large, so that they don't fit on one single
   server's disk. Therefore, we split the store into two shards:
   One for all even keys, and one for all odd keys.
   Here's a predicate asserting that a full_store is split correctly into an
   even_store and an odd_store: *)
Definition split_store (full_store even_store odd_store : fmap nat nat) : Prop :=
  (forall k, k mod 2 = 0  -> even_store $? k = full_store $? k) /\
  (forall k, k mod 2 = 0  -> odd_store  $? k = None) /\
  (forall k, k mod 2 <> 0 -> even_store $? k = None) /\
  (forall k, k mod 2 <> 0 -> odd_store  $? k = full_store $? k).

(* The goal of this pset is to define a distributed key-value-store system
   implementation that does not need to save the full store anywhere, and only
   needs full_store to specify its correctness. *)

(* We use two intermediate channels forward_even and forward_odd, and add a
   request_dispatcher to forward requests to these channels: *)
Definition request_dispatcher (input forward_even forward_odd : channel) : proc :=
  ??input(req: request);
  if get_key req mod 2 ==n 0 then
    !!forward_even(req); Done
  else
    !!forward_odd(req); Done.

(* Our balanced request handler creates two intermediate channels and then combines the
   request dispatcher with two request handlers, one for even keys and one for odd keys: *)
Definition balanced_handler (even_store odd_store : fmap nat nat) (input output : channel) : proc :=
  New[input; output](forward_even);
  New[input; output; forward_even](forward_odd);
  request_dispatcher input forward_even forward_odd
  || request_handler even_store forward_even output
  || request_handler odd_store forward_odd output.

(* Here's the correctness property that we want to hold for our balanced_handler:
   Each I/O trace generated by balanced_handler should also be a trace generated
   by one single request_handler which uses the full_store. *)
Definition correctness: Prop := forall full_store even_store odd_store input output,
    split_store full_store even_store odd_store ->
    input <> output ->
    forall trace,
      couldGenerate (balanced_handler even_store odd_store input output) trace ->
      couldGenerate (request_handler full_store input output) trace.

(* We suggest that you start by testing your understanding by answering the
   following questions.
   They are graded as follows: If you complete all the Coq proofs, you will
   get full score, no matter what you write in the answers to these questions.
   On the other hand, if you can't finish the Coq proofs, you can get up to
   40 points for answering these questions, plus points for partial Coq proofs.

Question 1) For each of the following processes, briefly describe what they do:

a)  !!ch(v); k

b)  ??ch(x: T); k

c)  pr1 || pr2

d)  Dup pr

e)  Done

f)  New[ch1; ch2; ch3](ch4); k

g)  Block ch; k

Question 2) Is the "refines" relation symmetric?
That is, if "pr1 <| pr2", does that imply "pr2 <| pr1"?

Question 3) Which of "||" and ";" binds stronger?
In other words, does "pr1 || pr2 ; pr3" equal "pr1 || (pr2 ; pr3)" or
"(pr1 || pr2) ; pr3"?

Question 4) Draw a diagram of the balanced request handler and the channels it uses

Question 5) In order to prove refinements, we need to provide a simulation relation
R of type "proc -> proc -> Prop", and prove the three conditions defined by "simulates".
If we just pick "fun pr1 pr2 => True" for R, which of these three conditions can/cannot
be proven? And what if we pick "fun pr1 pr2 => False"?

Question 6) The specification (addN 2 input output) in MessagesAndRefinement.v performs
the following steps:

1) It starts as

         (??input(n : nat); !!output(n + 2); Done)

   where it reads an input n

2) and then becomes

         (!!output(n + 2); Done)

   where it outputs (n + 2)

3) and then becomes

         Done

Write down the same kind of explanation of steps for the implementation (add2_once input output):
You should get steps numbered from 1) to 5).

Question 7) In order to prove that the specification (addN 2 input output) can
simulate the implementation (add2_once input output), we have to show that each
implementation state has a corresponding specification state. Do so by filling
out the following table:

Impl  | Spec
state | state
------+------
  1   |
  2   |
  3   |
  4   |
  5   |

Question 8) If you completed the above table, you've actually just created a paper
proof of add2_once_refines_addN. Now study the Coq proof add2_once_refines_addN,
and look at the three subgoals opened after the call to first_order.
Where do they come from, and what does each of them ask you to prove?

*)

(* Now you should be ready to start proving correctness!
   NOTE: You MUST use refinement ("_ <| _") and "simulates" to earn full credit on this pset.
   Hint: You should follow the same approach as add2_once_refines_addN and define a relation
   similar to R_add2, with the following signature, where we use "fs", "es", and "os" as
   abbreviations for full_store, even_store, and odd_store: *)

(* HINT 1-2 (see Pset13Sig.v) *)
Inductive R (fs es os : fmap nat nat) (input output : channel) : proc -> proc -> Prop :=
(* FILL IN HERE *)
.

Definition R_alias_for_grading := R.
(* One more hint: You can use the "lists" tactic to prove any "NoDup" goals/contradictions. *)

(* And another hint: Here's some tactic which you might find handy in your proofs.
   Feel free to use and/or adapt it! *)

Ltac head e :=
  match e with
  | ?e _ => head e
  | _ => e
  end.

Ltac head_constructor e :=
  let e := eval cbv beta delta in e in (* this is quite agressive... *)
  let h := head e in
  is_constructor h.

Ltac t_step :=
  match goal with
  | |- _ => solve [propositional]
  | H : ?a = ?b |- _ => head_constructor a; head_constructor b; progress invert H
        (* the previous case can loop because repeat invert can loop,
           propositional earlier prunes the cases where this occurs in our proof *)
  | H : R _ _ _  _ _  _ _ |- _ => invert H
  | H:lstep ?c _ _ |- _ => head_constructor c; (apply invert_Recv in H; try subst) || invert H
  | H:lstepSilent ?c _ |- _ => head_constructor c; invert H
  | r : request |- _ => cases r
  | H : True |- _ => clear H
  | _ => progress (cbn [notUse Channel get_key] in *; simplify)
  | |- _ /\ _ => split
  | _ => solve [equality]
  end.

Ltac t := repeat t_step.

(* HINT 3-5 (see Pset13Sig.v) *)
Theorem balanced_handler_correct : correctness.
Proof.
Admitted.

(* OPTIONAL exercise (ungraded, very short):
   Another important property of refinment is that any subpart of a larger
   program can be replaced with a refined version of it, yielding a refined
   version of the larger program. You can try it out by wrapping our one-shot
   server in Dup and using the "impl <| spec" fact you proved as a part of
   the last theorem to show "Dup impl <| Dup spec". This should be trivial
   once you have found the appropariate lemma from FRAP and factored out the
   appropriate refinement claim from the last proof. *)
Lemma multicorrectness : forall full_store even_store odd_store input output,
  split_store full_store even_store odd_store ->
  input <> output ->
  forall trace,
    couldGenerate (Dup (balanced_handler even_store odd_store input output)) trace ->
    couldGenerate (Dup (request_handler full_store input output)) trace.
Proof.
Admitted.

End Impl.

Module ImplCorrect : Pset13Sig.S := Impl.