(**************************************************************)
(*   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.
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 "P '/BSM/' s ->> t" := (sss_compute (@bsm_sss _) P s t) (at level 70, no associativity).
Local Notation "P // s -[ k ]-> t" := (sss_steps (@mm_sss _) P k s t).
Local Notation "P // s -+> t" := (sss_progress (@mm_sss _) P s t).
Local Notation "P // s ->> t" := (sss_compute (@mm_sss _) P s t).
Local Notation "P // s -]] t" := (sss_compute_max (@mm_sss _) P s t).
Section compiler.
Ltac dest x y := destruct (pos_eq_dec x y) as [ | ]; [ subst x | ]; rew vec.
Variables (m : nat) (P : nat*list (bsm_instr m)).
(** each stack of the BSM corresponds to a (unique) register in the MM and there are extra registers: tmp1, tmp2 which must have value 0 at start they might change value during a simulated BSM instruction but when the instruction is finished, their values are back to 0 *)
Let n := 2+m.
Let tmp1 : pos n := pos0.
Let tmp2 : pos n := pos1.
Let reg p: pos n := pos_nxt (pos_nxt p).
Let Hv12 : tmp1 <> tmp2.             Proof. discriminate. Qed.
Let Hvr1 : forall p, reg p <> tmp1.  Proof. discriminate. Qed.
Let Hvr2 : forall p, reg p <> tmp2.  Proof. discriminate. Qed.
Let Hreg : forall p q, reg p = reg q -> p = q.
Fact bsm_linker_out_err i : out_code i P -> lnk i = err.
Notation Hc := bsm_coherence.
Let Hc1 i : in_code i P -> in_code (lnk i) Q.
Definition bsm_state_enc (v : vec (list bool) m) w :=
w#>tmp1 = 0
/\ w#>tmp2 = 0
/\ forall p, w#>(reg p) = stack_enc (v#>p).
(*** Soundness results *)
Fact bic_PUSH_Zero i x w s :
(i,PUSH x Zero::nil) <sc P
-> w#>(reg x) = stack_enc s
-> w#>tmp1 = 0
-> w#>tmp2 = 0
-> (lnk i, comp i (PUSH x Zero)) // (lnk i,w) -+> (lnk (1+i), w[(stack_enc (Zero::s))/reg x]).
Fact bic_PUSH_One i x w s :
(i,PUSH x One::nil) <sc P
-> w#>(reg x) = stack_enc s
-> w#>tmp1 = 0
-> w#>tmp2 = 0
-> (lnk i, comp i (PUSH x One)) // (lnk i,w) -+> (lnk (1+i), w[(stack_enc (One::s))/reg x]).
Fact bic_POP_void i x j k w :
(i,POP x j k::nil) <sc P
-> w#>(reg x) = stack_enc nil
-> w#>tmp1 = 0
-> w#>tmp2 = 0
-> (lnk i, comp i (POP x j k)) // (lnk i,w) -+> (lnk k, w).

Theorem bsm_compiler_sound st1 st2 w1 :
bsm_state_enc (snd st1) w1
-> P /BSM/ st1 ->> st2
-> exists w2,
bsm_state_enc (snd st2) w2
/\ Q // (lnk (fst st1),w1) ->> (lnk (fst st2),w2).