(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*             Yannick Forster            [+]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(*                             [+] Affiliation Saarland Univ. *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)
(** ** Compiler from MM to FRACTRAN *)
Set Implicit Arguments.
Tactic Notation "rew" "length" := autorewrite with length_db.
Local Notation "e #> x" := (vec_pos e x).
Local Notation "e [ v / x ]" := (vec_change e x v).
Local Notation "I // s -1> t" := (mm_sss I s t).
Local Notation "P /MM/ s → t" := (sss_step (@mm_sss _) P s t) (at level 70, no associativity).
Local Notation "P /MM/ s -[ k ]-> t" := (sss_steps (@mm_sss _) P k s t) (at level 70, no associativity).
Local Notation "P /MM/ s ↓" := (sss_terminates (@mm_sss _) P s) (at level 70, no associativity).
Local Notation "l /F/ x → y" := (fractran_step l x y) (at level 70, no associativity).
Local Notation "l /F/ x -[ k ]-> y" := (fractran_steps l k x y) (at level 70, no associativity).
Set Implicit Arguments.
(* Fractran simulates MM *)
(*       let a MM program 1: INC ... k: DEC ... n: _ *)
(*       with variables x1...xm *)
(*    we use p1...pn,q1...qm distinct primes and  *)
(*    encode the state (i,v1,...,vm) *)
(*    as p1^0*...*pi^1*...*pn^0*q1^v1*...*qm^vm *)
(*    i: INC xu   ---> (qu*p(i+1) / pi) *)
(*    i: DEC xu j ---> (p(i+1) / pi*qu) and (pj / pi) (the second constraint should appear AFTER in the list) *)
Definition encode_state {n} (c : nat * vec nat n) := ps (fst c) * @exp n 0 (snd c).
Definition encode_inc n  i (u : pos n) := (ps (i + 1) * qs u, ps i).
Definition encode_dec n  i (u : pos n) (_ : nat) := (ps (i + 1), ps i * qs u).
Definition encode_dec2 n i (u : pos n) j := (ps j, ps i).
Definition encode_one_instr m i (rho : mm_instr m) :=
match rho with
| INC u   => encode_inc i u :: nil
| DEC u j => encode_dec i u j :: encode_dec2 i u j :: nil
end.
Fixpoint encode_mm_instr m i (l : list (mm_instr m)) : list (nat * nat) :=
match l with
| nil          => nil
| rho :: l => encode_one_instr i rho ++ encode_mm_instr (S i) l
end.
Fact encode_mm_instr_app m i l r : @encode_mm_instr m i (l++r) = encode_mm_instr i l++encode_mm_instr (length l+i) r.
Fact encode_mm_instr_regular n i l : Forall (fun c => fst c <> 0 /\ snd c <> 0) (@encode_mm_instr n i l).
Fact encode_mm_instr_regular' n i l : fractran_regular (@encode_mm_instr n i l).
Fact encode_mm_instr_in_inv n i P el c er :
@encode_mm_instr n i P = el++c::er
-> exists l rho r, P = l++rho::r /\ In c (encode_one_instr (length l+i) rho).
Local Notation divides_mult_inv := prime_div_mult.
Local Ltac inv H := inversion H; subst; clear H.
Opaque ps qs.

(* Specifications: *)
Lemma divides_encode_state i k n v : divides (ps i) (@encode_state n (k,v)) -> i = k.
Lemma skip_steps m k l r k' (v v' : vec _ m) :
@mm_no_self_loops m (k, l ++ r)
-> encode_mm_instr (k + length l) r /F/ encode_state (k + length l,v) → encode_state (k',v')
-> encode_mm_instr k (l ++ r)       /F/ encode_state (k + length l,v) → encode_state (k',v').