Section H10C_SAT_to_SysF_INH.
Variable h10cs : list h10c. (* instance of the Diophantine constraint problem *)
Fixpoint variable_bound (h10cs : list h10c) : nat :=
match h10cs with
| [] => 0
| (h10c_one x) :: h10cs => 1 + x + variable_bound h10cs
| (h10c_plus x y z) :: h10cs => 1 + x + y + z + variable_bound h10cs
| (h10c_mult x y z) :: h10cs => 1 + x + y + z + variable_bound h10cs
end.
Definition δ := variable_bound h10cs. (* fresh variable offset *)
(* constants as as defined in [1] *)
Definition tt := 0. (* ▴ *)
Definition ut := 1.
Definition st := 2.
Definition pt := 3.
Definition b1t := 4.
Definition b2t := 5.
Definition b3t := 6.
(* calligraphic C in paper *)
Definition GammaC := map poly_var (seq 0 7).
Arguments GammaC : simpl never.
Definition dt := 7. (* † *)
(* t → † where d is a offset to have free De-Bruijn indices *)
Definition to_d' d (t: poly_type) := poly_arr t (poly_var (d+dt)).
Definition to_d := to_d' 0.
(* universe encoding *)
Definition Ut' d t := many_poly_arr [poly_arr (to_d' d t) (poly_var (d+b1t)); poly_arr t (poly_var (d+b2t))] (poly_var (d+ut)).
Definition Ut := Ut' 0.
(* sum encoding *)
Definition St' d := fun '(t1, t2, t3) =>
many_poly_arr [poly_arr (to_d' d t1) (poly_var (d+b1t)); poly_arr (to_d' d t2) (poly_var (d+b2t)); poly_arr (to_d' d t3) (poly_var (d+b3t))] (poly_var (d+st)).
Definition St := St' 0.
(* product encoding *)
Definition Pt' d := fun '(t1, t2, t3) =>
many_poly_arr [poly_arr (to_d' d t1) (poly_var (d+b1t)); poly_arr (to_d' d t2) (poly_var (d+b2t)); poly_arr (to_d' d t3) (poly_var (d+b3t))] (poly_var (d+pt)).
Definition Pt := Pt' 0.
Definition zt' d := d + 10.
Definition zt := zt' 0. (* zero; 1+zt is one, 2+zt is two, ...*)
Definition t_u :=
poly_abs (many_poly_arr [
Ut' 1 (poly_var 0); (* forall x *)
Ut' 1 (poly_var 0);
Ut' 1 (poly_var 0);
Ut' 1 (poly_var 0);
poly_abs (many_poly_arr [ (* exists y *)
Ut' 2 (poly_var 0); (* y is in universe *)
St' 2 ((poly_var 1), (poly_var (1+ zt' 2)), (poly_var 0)); (* x + 1 = y *)
St' 2 ((poly_var 0), (poly_var (0+ zt' 2)), (poly_var 0)); (* y + 0 = 0 *)
Pt' 2 ((poly_var 0), (poly_var (0+ zt' 2)), (poly_var (0+ zt' 2))) (* y * 0 = 0*)
] (poly_var (2+tt)))
] (poly_var (1+tt))).
Definition t_s :=
many_poly_abs 5 (many_poly_arr [
poly_arr (St' 5 ((poly_var 0), (poly_var 3), (poly_var 4))) (poly_var (5+tt)); (* have a + d = e *)
Ut' 5 (poly_var 0); Ut' 5 (poly_var 1); Ut' 5 (poly_var 2); Ut' 5 (poly_var 3); Ut' 5 (poly_var 4); (* for a b c d e such that *)
St' 5 ((poly_var 0), (poly_var 1), (poly_var 2)); (* a + b = c *)
St' 5 ((poly_var 1), (poly_var (1 + zt' 5)), (poly_var 3)); (* b + 1 = d *)
St' 5 ((poly_var 2), (poly_var (1 + zt' 5)), (poly_var 4)) (* c + 1 = e *)
] (poly_var (5+tt))).
Definition t_p :=
many_poly_abs 5 (many_poly_arr [
poly_arr (Pt' 5 ((poly_var 0), (poly_var 3), (poly_var 4))) (poly_var (5+tt)); (* have a * d = e *)
Ut' 5 (poly_var 0); Ut' 5 (poly_var 1); Ut' 5 (poly_var 2); Ut' 5 (poly_var 3); Ut' 5 (poly_var 4); (* for a b c d e such that *)
Pt' 5 ((poly_var 0), (poly_var 1), (poly_var 2)); (* a * b = c *)
St' 5 ((poly_var 1), (poly_var (1 + zt' 5)), (poly_var 3)); (* b + 1 = d *)
St' 5 ((poly_var 2), (poly_var 0), (poly_var 4)) (* c + a = e *)
] (poly_var (5+tt))).
Definition h10c_poly_type (c: h10c) : poly_type :=
match c with
| (h10c_one x) => St' δ (poly_var x, poly_var (δ + zt), poly_var (δ+1+zt))
| (h10c_plus x y z) => St' δ (poly_var x, poly_var y, poly_var z)
| (h10c_mult x y z) => Pt' δ (poly_var x, poly_var y, poly_var z)
end.
Definition t_cs :=
many_poly_abs δ (many_poly_arr (map (fun x => Ut' δ (poly_var x)) (seq 0 δ) ++ map h10c_poly_type h10cs) (poly_var (δ + tt))).
Definition Gamma0 := [t_u; t_s; t_p; t_cs].
(* type environment describing the universe { 0 } *)
Definition GammaH := Gamma0 ++
(map Ut (map (fun x => poly_var (x + zt)) [0; 1])) ++
(map St [
(poly_var zt, poly_var zt, poly_var zt);
(poly_var (1+zt), poly_var zt, poly_var (1+zt));
(poly_var zt, poly_var (1+zt), poly_var (1+zt))]) ++
(map Pt [(poly_var zt, poly_var zt, poly_var zt); (poly_var (1+zt), poly_var zt, poly_var zt)]).
Arguments Gamma0 : simpl never.
Arguments Ut' : simpl never.
Arguments St' : simpl never. Arguments St : simpl never.
Arguments Pt' : simpl never. Arguments Pt : simpl never.
(* t is equivalent in GammaC to n (up to zt translation) *)
Definition encodes_nat (t: poly_type) (n: nat) :=
iipc2 GammaC (poly_arr (to_d (poly_var (n + zt))) (to_d t)) /\
iipc2 GammaC (poly_arr (to_d t) (to_d (poly_var (n + zt)))).
Definition encodes_sum := fun '(t1, t2, t3) =>
exists n1 n2 n3, encodes_nat t1 n1 /\ encodes_nat t2 n2 /\ encodes_nat t3 n3 /\ n1 + n2 = n3.
Definition encodes_prod := fun '(t1, t2, t3) =>
exists n1 n2 n3, encodes_nat t1 n1 /\ encodes_nat t2 n2 /\ encodes_nat t3 n3 /\ n1 * n2 = n3.

Lemma subst_poly_type_h10c_poly_type {ts c} : let σ := (fold_right scons poly_var (rev ts)) in δ = length ts ->
subst_poly_type σ (h10c_poly_type c) =
match c with
| (h10c_one x) => St (σ x, poly_var zt, poly_var (1+zt))
| (h10c_plus x y z) => St (σ x, σ y, σ z)
| (h10c_mult x y z) => Pt (σ x, σ y, σ z)
end.