(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)
Set Implicit Arguments.
Local Infix "~p" := (@Permutation _) (at level 70).
(** ** MM reduces to eILL *)
Section Minsky.
(* We consider Minsky machines with n registers *)
Variable (n : nat).
(** register p (0<=p<n) is encoded by p its dual            is encoded by n+p  positions in the program (PC) are encoded from 2*n until (potential) infinity  **)
Let q (i : nat) : ll_vars := 2*n+i.
Let rx (p : pos n) := pos2nat p.
Let ry (p : pos n) := n+pos2nat p.
Let H_rx : forall p q, rx p = rx q -> p = q.
(* This encodes a list of instructions starting at PC=i  i:INC x    ~~~>  ((rx x) -o q(1+i)) -o (q i) i:DEC x p  ~~~>  (ry x & q p) -o q i and (rx x) -o q(1+i) -o (q i)  *)
Local Fixpoint mm_linstr_enc i l :=
match l with
| nil          => nil
| INC x   :: l => LL_INC  (rx x) (q (1+i)) (q i)                                  :: mm_linstr_enc (1+i) l
| DEC x p :: l => LL_FORK (ry x) (q p)     (q i) :: LL_DEC (rx x) (q (1+i)) (q i) :: mm_linstr_enc (1+i) l
end.
Local Fact mm_linstr_enc_app i l m : mm_linstr_enc i (l++m) = mm_linstr_enc i l ++ mm_linstr_enc (length l+i) m.
Local Fact subcode_mm_linstr_enc i x j l : (i,INC x::nil) <sc (j,l) -> In (LL_INC  (rx x) (q (1+i)) (q i)) (mm_linstr_enc j l).
Local Fact subcode_mm_linstr_dec i x p j l : (i,DEC x p::nil) <sc (j,l) -> incl (LL_FORK (ry x) (q p) (q i) :: LL_DEC (rx x) (q (1+i)) (q i) :: nil) (mm_linstr_enc j l).
Local Fact mm_linstr_enc_spec i ll A : In A (mm_linstr_enc i ll) -> (exists j x,   (j,INC x::nil)   <sc (i,ll)  /\   A = LL_INC  (rx x) (q (1+j)) (q j))
\/ (exists j x p, (j,DEC x p::nil) <sc (i,ll)  /\ ( A = LL_FORK (ry x) (q p)     (q j)
\/ A = LL_DEC  (rx x) (q (1+j)) (q j) ) ).
(* k is a position outside the program were execution has to stop *)
Variable (P : nat*(list (mm_instr n))) (k : nat) (Hk : out_code k P).
(* This encodes P into EILL commands  (q k)  terminates on an zero vector (ry j) terminates on a vector vec there is no (rx j)  *)
Definition Sig0 := LL_INC (q k) (q k) (q k)
:: map (fun c => LL_DEC (rx (fst c)) (ry (snd c)) (ry (snd c))) (pos_not_diag n)
++ map (fun j => LL_INC (ry j) (ry j) (ry j)) (pos_list n).
Definition SigI := match P with (i,l) => mm_linstr_enc i l end.
Definition Sig := Sig0 ++ SigI.
Notation "P // s -[ k ]-> t" := (sss_steps (@mm_sss _) P k s t).
Notation "P // s ->> t" := (sss_compute (@mm_sss _) P s t).
(* We define the semantics as in the paper ToCL 2013 (DLW & Galmiche) *)
Local Definition s (x : ll_vars) (v : vec nat n) : Prop.
Let H_s_rx : forall p v, s (rx p) v <-> v = vec_one p.
Let H_s_ry : forall p v, s (ry p) v <-> vec_pos v p = 0.
(* No need of the code of s anymore *)
Opaque s.
(* This is a notation for the trivial phase semantics *)
Notation "'[[' A ']]'" := (ll_tps s A) (at level 65).
(* i -o (_j_ -o _j_) *)
Let sem_x_y_y i j : i <> j -> [[ [i LL_DEC (rx i) (ry j) (ry j) ] ]] vec_zero.
Let sem_y_y_y j : [[ [i LL_INC (ry j) (ry j) (ry j) ] ]] vec_zero.
(* We need out_code k P here *)
Let sem_k v : [[£ (q k)]] v <-> v = vec_zero.
Let sem_k_k_k : [[ [i LL_INC (q k) (q k) (q k) ] ]] vec_zero.
Let Sig0_zero A : In A Sig0 -> [[ [iA] ]] vec_zero.
Let SigI_zero A : In A SigI -> [[ [iA] ]] vec_zero.

Theorem lemma_5_5 v i : Sig; vec_map_list v rx ⊦ q i -> P // (i,v) ->> (k,vec_zero).
Let prop_5_2_rec (p : pos n) v Ga :
vec_pos v p = 0
-> Sig0;                      Ga ⊦ ry p
-> Sig0; vec_map_list v rx ++ Ga ⊦ ry p.