Class UnaryDiff f := {UnaryDiff_f' : R -> R ;
UnaryDiff_H : forall x, is_derive f x (UnaryDiff_f' x)}.
Class UnaryDiff' f := {UnaryDiff'_f' : R -> R ; UnaryDiff'_df : R -> Prop ;
UnaryDiff'_H : forall x, UnaryDiff'_df x -> is_derive f x (UnaryDiff'_f' x)}.
Global Instance UnaryDiff_exp : UnaryDiff exp.
Ltac reify_helper a b z d :=
match a with
| Cst _ =>
match b with
| Cst _ => constr:(Cst d)
| _ => z
end
| _ => z
end.
Ltac reify fct nb :=
let rec reify_aux fct l i :=
match fct with
| ?f ?a => let e := reify a nb in reify_aux f (e :: l) (S i)
| _ => constr:((fct, rev l, i))
end in
match fct with
| var ?i =>
eval vm_compute in (Var (nb - i))
| Rplus ?a ?b =>
let a' := reify a nb in
let b' := reify b nb in
reify_helper a' b' (Binary Eplus a' b') fct
| Ropp ?a =>
let a' := reify a nb in
match a' with
| Cst _ => constr:(Cst fct)
| _ => constr:(Unary Eopp a')
end
| Rminus ?a ?b =>
let a' := reify a nb in
let b' := reify b nb in
reify_helper a' b' (Binary Eplus a' (Unary Eopp b')) fct
| Rmult ?a ?b =>
let a' := reify a nb in
let b' := reify b nb in
reify_helper a' b' (Binary Emult a' b') fct
| Rinv ?a =>
let a' := reify a nb in
match a' with
| Cst _ => constr:(Cst fct)
| _ => constr:(Unary Einv a')
end
| Rdiv ?a ?b =>
let a' := reify a nb in
let b' := reify b nb in
reify_helper a' b' (Binary Emult a' (Unary Einv b')) fct
| RInt ?f ?a ?b =>
let f := eval cbv beta in (f (var (S nb))) in
let f' := reify f (S nb) in
let a' := reify a nb in
let b' := reify b nb in
constr:(Int f' a' b')
| pow ?f ?n =>
reify ((fun x => pow x n) f) nb
| context [var ?i] =>
match fct with
| ?f ?a =>
let e := reify a nb in
let ud := constr:(_ : UnaryDiff f) in
constr:(Unary (Efct f (@UnaryDiff_f' f ud) (@UnaryDiff_H f ud)) e)
| ?f ?a =>
let e := reify a nb in
let ud := constr:(_ : UnaryDiff' f) in
constr:(Unary (Efct' f (@UnaryDiff'_f' f ud) (@UnaryDiff'_df f ud) (@UnaryDiff'_H f ud)) e)
| _ =>
match reify_aux fct (Nil expr) O with
| (?f,?le,?k) => constr:(AppExt k f le)
end
end
| _ => constr:(Cst fct)
end.

Lemma auto_derive_helper :
forall (e : expr) l n,
let '(a,b) := D e n in
interp_domain l (simplify_domain b) ->
is_derive (fun x => interp (set_nth R0 l n x) e) (nth R0 l n) (interp l a).