Module Argument.
Notation "t ⊍ u" := (mset_term_plus t u) (at level 40).
Notation "'h' t" := (mset_term_h t) (at level 38).
Notation "•0" := mset_term_zero.
Coercion mset_term_var : nat >-> mset_term.
Fixpoint tower m n :=
match n with
| 0 => []
| S n => (tower m n) ++ (tower m n) ++ (tower m n) ++ (tower m n) ++ [m*n]
end.
Definition unify_sat n :
{A | A ++ (map (fun i => 2*i) (seq 0 n)) ≡ (seq 0 n) ++ map S A}.
(* embed nat^3 into nat to provide fresh variables *)
Definition embed '(x, y, z) := NatNat.nat2_to_nat (NatNat.nat2_to_nat (x, y), z).
Definition unembed n := let (xy, z) := NatNat.nat_to_nat2 n in
(NatNat.nat_to_nat2 xy, z).
Opaque embed unembed.
Definition encode_bound (x: nat): list constraint :=
let X n := embed (x, n, 0) in
[
((X 1) ⊍ (X 2), •0 ⊍ (h (X 1))); (* X 1 = [0..n-1], X 2 = [n] *)
((X 3) ⊍ (X 4), •0 ⊍ (h (h (X 3)))); (* X 3 = [0,2,..2*(m-1)], X 4 = [2*m] *)
((X 5) ⊍ (X 3), (X 1) ⊍ (h (X 5))); (* n = m *)
((h (X 6)) ⊍ (X 0), (X 2) ⊍ ((X 6) ⊍ ((X 6) ⊍ ((X 6) ⊍ (X 6)))));
((h (h (X 7))) ⊍ (X 0), (X 4) ⊍ ((X 7) ⊍ ((X 7) ⊍ ((X 7) ⊍ (X 7))))) (* X 0 = [0..0] of length 2^n *)
].
Definition encode_bound_spec {φ x} : mset_sat φ (encode_bound x) ->
Forall (fun a => 0 = a) (φ (embed (x, 0, 0))).
(* [0] ++ [0,1] ++ [0,1,2] ++ ...*)
Definition pyramid n := flat_map (seq 0) (seq 0 n).
(* from a H10UC valuation φ construct a valuation for FMsetC *)
Definition construct_valuation (φ: nat -> nat) (n: nat): list nat :=
match unembed n with
| (x, 0, 0) => repeat 0 (4^(φ x))
| (x, 1, 0) => seq 0 (φ x)
| (x, 2, 0) => [(φ x)]
| (x, 3, 0) => map (fun i => 2*i) (seq 0 (φ x))
| (x, 4, 0) => [2*(φ x)]
| (x, 5, 0) => proj1_sig (unify_sat (φ x))
| (x, 6, 0) => tower 1 (φ x)
| (x, 7, 0) => tower 2 (φ x)
| (x, 0, 1) => repeat 0 (φ x)
| (x, 1, 1) => repeat 0 (length (pyramid (φ x)))
| (x, 2, 1) => repeat 0 (4^(φ x) - (φ x))
| (x, 3, 1) => repeat 0 (4^(φ x) - (length (pyramid (φ x))))
| (x, 4, 1) => seq 0 (φ x)
| (x, 5, 1) => [(φ x)]
| (x, 6, 1) => pyramid (φ x)
| (x, 7, 1) => flat_map pyramid (seq 0 (φ x))
| _ => []
end.
(* each n : nat is represented by a multiset containing n zeroes *)
Definition encode_nat (x: nat) : list constraint :=
let X n := embed (x, n, 1) in
[
(X 0 ⊍ X 2, mset_term_var (embed (x, 0, 0))); (* X 0 = [0..0] *)
(X 1 ⊍ X 3, mset_term_var (embed (x, 0, 0))); (* X 1 = [0..0] *)
(X 4 ⊍ X 5, •0 ⊍ (h (X 4))); (* X 4 = [0..m-1], X 5 = [m]*)
(X 4 ⊍ X 6, X 0 ⊍ (h (X 6))); (* m = length (X 0), length (X 6) ~ m * m *)
(X 6 ⊍ X 7, X 1 ⊍ (h (X 7))) (* length X 1 ~ m * m *)
].
(* represent constraints of shape 1 + x + y * y = z *)
Definition encode_constraint x y z :=
encode_bound x ++ encode_bound y ++ encode_bound z ++
encode_nat x ++ encode_nat y ++ encode_nat z ++
let x := embed (x, 0, 1) in
let yy := embed (y, 1, 1) in
let y := embed (y, 0, 1) in
let z := embed (z, 0, 1) in
[ (•0 ⊍ x ⊍ yy ⊍ yy ⊍ y, mset_term_var z) ].
(* encode a single H10UC constraint as a list of FMsetC constraints *)
Definition encode_h10uc '(x, y, z) := encode_constraint x y z.
End Argument.

(* many-one reduction from H10UC to FMsetC *)
Theorem reduction : H10UC_SAT ⪯ FMsetTC_SAT.