(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)
(** ** Elementary diophantine constraints *)
Set Implicit Arguments.
Section interval.
(** A small interval & valuation library *)
Definition interval := (nat * nat)%type. (* (a,b) <~~~> [a,b[ *)
Implicit Types (i j : interval).
Definition in_interval i x := let (a,b) := i in a <= x < b.
Definition out_interval i x := let (a,b) := i in x < a \/ b <= x.
Definition interval_disjoint i j := forall x, in_interval i x -> in_interval j x -> False.
Definition interval_union (i j : interval) :=
match i, j with (a1,b1),(a2,b2) => (min a1 a2, max b1 b2) end.
Fact in_out_interval i x : in_interval i x -> out_interval i x -> False.
Fact interval_union_left i j x : in_interval i x -> in_interval (interval_union i j) x.
Fact interval_union_right i j x : in_interval j x -> in_interval (interval_union i j) x.
Definition valuation_union i1 (g1 : nat -> nat) i2 g2 :
interval_disjoint i1 i2
-> { g | (forall x, in_interval i1 x -> g x = g1 x)
/\ (forall x, in_interval i2 x -> g x = g2 x) }.
Definition valuation_one_union k v i1 (g1 : nat -> nat) i2 g2 :
~ in_interval (interval_union i1 i2) k
-> interval_disjoint i1 i2
-> { g | g k = v /\ (forall x, in_interval i1 x -> g x = g1 x)
/\ (forall x, in_interval i2 x -> g x = g2 x) }.
End interval.
Section diophantine_system.
(* v : cst = nat      constant (natural number) p q : par = nat    parameter x y z : var = nat  existentially quantified variable  equations are of 4 types 1) x = v 2) x = p 3) x = y + z 4) x = y * z  We represent a relation between parameters R by a list of equations l and one variable x : var such that a) for any value f : nat -> nat of the params, l[f] has a solution b) for any value f : nat -> nat of the params,  R f <-> ((x=0)::l)[f] has a solution  How do we simulate poly1 = poly2 linearly ?  poly1 = (eqn1,x) where x is output poly2 = (eqn2,y) where y is output  example poly1 = p*(q+r) gives eqn1:= (0=1*2, 1=p, 2=3+4, 3=q, 4=r) and x:=0  then we simulate poly1 = poly2 with  poly1 = poly2 <-> (eqn1 U eqn2 U { w=y+u, w=x+v, z=u+v }, z)  where u v z w are fresh  We implement conjunction (cap), disjunction (cup) and exists so that we get a linear encoding  cap) R by (lR,xR) and S by (lS,xS) we assume (lR,xR) and (lS,xS) do not share existential variables (always possible by renaming those of S)  R cap S = (lR U lS U { z = x+y },z) where z is fresh  cup) R cup S = (lR U lS U { z = x*y },z)  exists) ∃n.R f{p<-n} = (lR[p<-0], ...)  *)
Inductive dio_elem_expr : Set :=
| dee_nat  : nat -> dio_elem_expr   (* c : constant *)
| dee_var  : nat -> dio_elem_expr   (* v : existentially quant. var *)
| dee_par  : nat -> dio_elem_expr   (* p : parameter *)
| dee_comp : dio_op -> nat -> nat -> dio_elem_expr. (* v1 op v2 *)
Notation dee_add := (dee_comp do_add).
Notation dee_mul := (dee_comp do_mul).
(* ρ σ ν φ *)
Definition dee_eval φ ν e :=
match e with
| dee_nat n => n
| dee_var v => φ v
| dee_par i => ν i
| dee_comp o v w => do_eval o (φ v) (φ w)
end.
Definition dee_vars e x  :=
match e with
| dee_nat _ => False
| dee_var v => x = v
| dee_par _ => False
| dee_comp _ v w => x = v \/ x = w
end.
Fact dee_eval_ext e φ1 ν1 φ2 ν2  :
(forall x, dee_vars e x -> φ1 x = φ2 x)
-> (forall x, ν1 x = ν2 x)
-> dee_eval φ1 ν1 e = dee_eval φ2 ν2 e.
Definition dc_move k c := (k+fst c, dee_move k (snd c)).
Fact dc_eval_move k φ ν c : dc_eval φ ν (dc_move k c) <-> dc_eval (fun x => φ (k+x)) ν c.
Fact dc_vars_move k c x : dc_vars (dc_move k c) x <-> exists y, x = k + y /\ dc_vars c y.
Definition dc_dec k c := (fst c, dee_dec k (snd c)).
Fact dc_eval_dec φ ν k c : dc_eval φ ν (dc_dec k c) <-> dc_eval φ  (fun x => match x with 0 => φ k | S x => ν x end) c.
Fact de_size_ge_1 e : 1 <= de_size e.
(* If equations in de_eqns e x are satisfied in φ, then φ x must be equal to de_eval ν e *)
Fact dc_Forall_eval φ ν e x : Forall (dc_eval φ ν) (de_eqns e x) -> de_eval ν e = φ x.
(* Converselly, equations in de_eqns e x are satisfiable *)
Fact dc_eval_exists_Forall ν e x : { φ | Forall (dc_eval φ ν) (de_eqns e x) }.
Let compare_lemma x y : { u : nat & { v | u+x = v+y } }.
(* poly1 = poly2 <-> (eqn1 U eqn2 U { w=x+u, w=y+v, z=u+v }, z) *)
Let g0 (n x0 x1 x2 x3 m : nat) := if le_lt_dec n m then
match m - n with
| 0 => x0
| 1 => x1
| 2 => x2
| _ => x3
end
else x3.
Let g0_0 (n x0 x1 x2 x3 : nat) : g0 n x0 x1 x2 x3 n = x0.
Let g0_1 (n x0 x1 x2 x3 : nat) : g0 n x0 x1 x2 x3 (n+1) = x1.
Let g0_2 (n x0 x1 x2 x3 : nat) : g0 n x0 x1 x2 x3 (n+2) = x2.
Let g0_3 (n x0 x1 x2 x3 : nat) : g0 n x0 x1 x2 x3 (n+3) = x3.
(* x1+(x2*5) at 4 ~~> v4 = v5 + v6, v5 = x1, v6 = v7 * v8, v7 = x2, v8 = 5 x3 at 9        ~~> v9 = x3  x1+(x2*5) = x3 at 0 ~~> v3 = v1 + v4, v3 = v2 + v9, v0 = v1 + v2 *)

(* Specifications: *)
Lemma dio_repr_at_eq n e1 e2 : dio_repr_at (fun ν => de_eval ν e1 = de_eval ν e2) n (4+de_size e1+de_size e2) (3+de_size e1+de_size e2).
Lemma dio_repr_at_conj R1 a1 n1 p1 R2 a2 n2 p2 n :
dio_repr_at R1 a1 n1 p1
-> dio_repr_at R2 a2 n2 p2
-> a1+n1 <= a2
-> n = 1+a2+n2-a1
-> dio_repr_at (fun ν => R1 ν /\ R2 ν) a1 n (1+p1+p2).