(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)
(** * Object-level representation of Diophantine equations *)
(** ** Diophantine logic *)
Set Implicit Arguments.
Section diophantine_expressions.
Inductive dio_op := do_add | do_mul.
Definition do_eval o :=
match o with
| do_add => plus
| do_mul => mult
end.
Inductive dio_expression : Set :=
| de_cst  : nat -> dio_expression
| de_var  : nat -> dio_expression
| de_comp : dio_op -> dio_expression -> dio_expression -> dio_expression.
Definition de_add := de_comp do_add.
Definition de_mul := de_comp do_mul.
Fixpoint de_size e :=
match e with
| de_cst n => 1
| de_var x => 1
| de_comp _ p q => 1 + de_size p + de_size q
end.
Fixpoint de_size_Z e :=
(match e with
| de_cst n => 1
| de_var x => 1
| de_comp _ p q => 1 + de_size_Z p + de_size_Z q
end)%Z.
Fact de_size_Z_spec e : de_size_Z e = Z.of_nat (de_size e).
Fixpoint de_eval ν e  :=
match e with
| de_cst n => n
| de_var x => ν x
| de_comp o p q => do_eval o (de_eval ν p) (de_eval ν q)
end.
Fact de_eval_ext e ν ω : (forall x, ν x = ω x) -> de_eval ν e = de_eval ω e.
(* ρ σ ν *)
Fixpoint de_subst σ e :=
match e with
| de_cst n => de_cst n
| de_var x => σ x
| de_comp o p q => de_comp o (de_subst σ p) (de_subst σ q)
end.
Fact de_eval_subst σ ν e : de_eval ν (de_subst σ e) = de_eval (fun x => de_eval ν (σ x)) e.
Fact de_ren_size_Z ρ e : de_size_Z (de_ren ρ e) = de_size_Z e.
(* dv_lift : lifting of a diophantive valuation *)
Definition dv_lift X ν (x : X) n :=
match n with
| 0   => x
| S n => ν n
end.
Fixpoint df_pred f ν :=
match f with
| df_atm a b  => de_eval ν a  = de_eval ν b
| df_conj f g => df_pred f ν /\ df_pred g ν
| df_disj f g => df_pred f ν \/ df_pred g ν
| df_exst f   => exists n, df_pred f (dv_lift ν n)
end.
Fact df_pred_atm a b ν : df_pred (df_atm a b) ν = (de_eval ν a = de_eval ν b).
(* Lifting of a diophantine expression renaming *)
Definition der_lift ρ x := match x with 0 => 0 | S x => S (ρ x) end.
Fixpoint df_ren ρ f :=
match f with
| df_atm a b  => let σ := fun x => de_var (ρ x) in df_atm (de_subst σ a) (de_subst σ b)
| df_conj f g => df_conj (df_ren ρ f) (df_ren ρ g)
| df_disj f g => df_disj (df_ren ρ f) (df_ren ρ g)
| df_exst f   => df_exst (df_ren (der_lift ρ) f)
end.
Fact df_ren_size ρ f : df_size (df_ren ρ f) = df_size f.
Fact df_ren_size_Z ρ f : df_size_Z (df_ren ρ f) = df_size_Z f.
Fact df_pred_ren f ν ρ : df_pred (df_ren ρ f) ν <-> df_pred f (fun x => ν (ρ x)).
(* Lifting of a diophantine expression substitutions *)
Definition des_lift σ x := match x with 0 => de_var 0 | S x => de_ren S (σ x) end.
Fixpoint df_subst σ f :=
match f with
| df_atm a b  => df_atm (de_subst σ a) (de_subst σ b)
| df_conj f g => df_conj (df_subst σ f) (df_subst σ g)
| df_disj f g => df_disj (df_subst σ f) (df_subst σ g)
| df_exst f   => df_exst (df_subst (des_lift σ) f)
end.
Fact df_pred_subst f ν σ : df_pred (df_subst σ f) ν <-> df_pred f (fun x => de_eval ν (σ x)).
Definition df_lift := df_ren S.
Fact df_pred_lift f ν : df_pred (df_lift f) ν <-> df_pred f (fun x => ν (S x)).
Definition df_lt x y := df_exst (df_atm (de_add (de_cst 1) (de_add (de_var 0) (de_lift x))) (de_lift y)).
Fact df_lt_spec x y : df_pred (df_lt x y) ν <-> ⟦x⟧ < ⟦y⟧.
Definition df_eq x y := df_atm x y.
Fact df_eq_spec x y : df_pred (df_eq x y) ν <-> ⟦x⟧ = ⟦y⟧.
Definition df_div x y := df_exst (df_atm (de_lift y) (de_mul (de_var 0) (de_lift x))).
Fact df_div_spec x y : df_pred (df_div x y) ν <-> divides ⟦x⟧ ⟦y⟧.
End examples.
Definition dio_rel R := { f | forall ν, df_pred f ν <-> R ν }.
Notation 𝔻R := dio_rel.
Section dio_rel.
(** How to analyse diophantine relations ... these are proved by explicitely given the witness which we will avoid later on *)
Implicit Types R S : (nat -> nat) -> Prop.
Fact dio_rel_True : 𝔻R (fun _ => True).

(* Specifications: *)
Lemma dio_rel_ndivides x y : 𝔻P x -> 𝔻P y -> 𝔻R (fun ν => ~ divides (x ν) (y ν)).
Hint Resolve dio_rel_ndivides.