(**************************************************************)
(*   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.
Reserved Notation "i '//' r '-1>' s" (at level 70, no associativity).
Reserved Notation "P '//' r ':1>' s" (at level 70, no associativity).
Reserved Notation "P '//' r '-[' n ']->' s" (at level 70, no associativity).
Reserved Notation "P '//' r '-+>' s" (at level 70, no associativity).
Reserved Notation "P '//' r '->>' s" (at level 70, no associativity).
Reserved Notation "P '//' r '-]]' s" (at level 70, no associativity).
Reserved Notation "P '//' r '~~>' s" (at level 70, no associativity).
Reserved Notation "P '//' r ↓" (at level 70, no associativity).
Section Small_Step_Semantics.
(** * Code A generic library to implement Small Step Semantics on programs described by lists of instructions that modify a state and a Program Counter (PC)  An important part of the library is devoted to show locality lemmas that related computation inside sub-programs to outer programs  This is ESSENTIAL to be able to show properties compositionally, ie to derive properties of program from properties of sub-programs *)
(** ** Syntax *)
Variable (instr : Set) (data : Type).
(* A state contain the PC (current instruction) and data *)
Notation state := (nat * data)%type.
Variable one_step : instr -> state -> state -> Prop.
Notation "i // s -1> t" := (one_step i s t) (at level 70, no associativity).
Notation "s ⟬ i ⦒  t" := (one_step i s t) (at level 70, no associativity).
Hypothesis (sss_fun : forall i s t1 t2, i // s -1> t1 -> i // s -1> t2 -> t1 = t2).
Hypothesis (sss_dec : forall i st1 st2, { i // st1 -1> st2 } + { ~ i // st1 -1> st2 }).
(* A code is a contiguous list of instructions starting at some position *)
Notation code := (nat * list instr)%type.
(** ** Semantics *)
(* This a one step computation *)
Definition sss_step P st1 st2 := exists k l i r d, P = (k,l++i::r)
/\ st1 = (k+length l,d)
/\ i // st1 -1> st2.
Notation "P // r :1> s" := (sss_step P r s)  (at level 70, no associativity).
(* Functionality of one step computations *)
Fact sss_step_fun P s t1 t2 : P // s :1> t1 -> P // s :1> t2 -> t1 = t2.
(* A "more general/usable" constructor *)
Fact in_sss_step k l i r st1 st2 : fst st1 = k+length l
->       i     // st1  -1>  st2
-> (k,l++i::r) // st1  :1>  st2.
Fact sss_step_supcode P Q st st' :
P <sc Q -> in_code (fst st) P -> Q // st :1> st' -> P // st :1> st'.
(* sss_step is decidable *)
Fact sss_step_dec P st1 st2 : { P // st1 :1> st2 } + { ~ P // st1 :1> st2 }.
(* This is a n steps computation *)
Inductive sss_steps (P : code) : nat -> state -> state -> Prop :=
| in_sss_steps_0 : forall st,                  P // st   -[0]->    st
| in_sss_steps_S : forall n st1 st2 st3,       P // st1   :1>      st2
->   P // st2  -[n]->    st3
->   P // st1  -[S n]->  st3
where "P // r -[ n ]-> s" := (sss_steps P n r s).
(* More usable constructors *)
Fact sss_steps_0 P st1 st2 : st1 = st2 -> P // st1 -[0]-> st2.
Fact sss_steps_trans P n m st1 st2 st3 :
P // st1 -[n]-> st2 -> P // st2 -[m]-> st3 -> P // st1 -[n+m]-> st3 .
(* Inversion lemma *)
Fact sss_steps_0_inv P st1 st2 : P // st1 -[0]-> st2 -> st1 = st2.
Fact sss_steps_inv P k st1 st3 :
P // st1 -[k]-> st3
-> (k = 0 /\ st1 = st3)
+ { k' | exists st2, k = S k'
/\ P // st1 :1> st2
/\ P // st2 -[k']-> st3 }%type.
Fact sss_steps_S_inv' P st1 st3 k :
P // st1 -[S k]-> st3
-> exists st2,    P // st1 :1> st2
/\ P // st2 -[k]-> st3.
Fact sss_steps_fun P k s t1 t2 :
P // s -[k]-> t1
-> P // s -[k]-> t2
-> t1 = t2.
Fact sss_steps_plus_inv P n m st1 st3 :
P // st1 -[n+m]-> st3
-> exists st2, P // st1 -[n]-> st2
/\ P // st2 -[m]-> st3.
Definition sss_progress P st1 st2 := exists k, 0 < k /\ P // st1 -[k]-> st2.
Definition sss_compute  P st1 st2 := exists k, P // st1 -[k]-> st2.
Notation "P // r -+> s" := (sss_progress P r s).
Notation "P // r ->> s" := (sss_compute P r s).
Fact sss_progress_compute P st1 st2 : P // st1 -+> st2 -> P // st1 ->> st2.
Fact sss_steps_compute P n st1 st2 : P // st1 -[n]-> st2 -> P // st1 ->> st2.
Fact subcode_sss_steps P Q k st1 st2: P <sc Q -> P // st1 -[k]-> st2 -> Q // st1 -[k]-> st2.
Fact subcode_sss_progress P Q st1 st2: P <sc Q -> P // st1 -+> st2 -> Q // st1 -+> st2.
Fact subcode_sss_compute P Q st1 st2: P <sc Q -> P // st1 ->> st2 -> Q // st1 ->> st2.
Fact subcode_sss_compute_trans P Q st1 st2 st3 :
P <sc Q -> P // st1 ->> st2 -> Q // st2 ->> st3 -> Q // st1 ->> st3.
Fact subcode_sss_compute_linstr k li P st1 st2 st :
(fst st1,li) // st1 -[k]-> st2
-> (fst st1,li) <sc P
-> P // st2 ->> st
-> P // st1 ->> st.
Fact subcode_sss_compute_instr P i st1 st2 st3 :
i // st1 -1> st2
->  (fst st1,i::nil) <sc P
->  P // st2 ->> st3
->  P // st1 ->> st3.
(* Then are reverse inclusion lemmas *)
Fact subcode_sss_step_inv P Q st1 st2 :
P <sc Q
-> in_code (fst st1) P
-> Q // st1 :1> st2
-> P // st1 :1> st2.
Definition sss_output P st st' := P // st ->> st' /\ out_code (fst st') P.
Notation "P // x ~~> y" := (sss_output P x y).
Definition sss_terminates P st := exists st', P // st ~~> st'.
Notation "P // x ↓" := (sss_terminates P x).
Fact subcode_sss_terminates_instr P i st1 st2 :
i // st1 -1> st2
->  (fst st1,i::nil) <sc P
->  P // st2 ↓
->  P // st1 ↓.
(* No computation is possible *)
Definition sss_stall ii st := forall st', ~ ii // st -1> st'.
Definition sss_step_stall P st := forall st', ~ P // st :1> st'.
Fact sss_steps_stall_inv P p s1 s2 : sss_step_stall P s1 -> P // s1 -[p]-> s2 -> p = 0 /\ s1 = s2.
Fact sss_steps_stall_fun P p q s1 s2 :
sss_step_stall P s2
-> P // s1 -[p]-> s2
-> P // s1 -[q]-> s2
-> p = q.
Definition sss_compute_max P s1 s2 := (P // s1 ->> s2 /\ sss_step_stall P s2).
Notation " P // s1 -]] s2 " := (sss_compute_max P s1 s2).
(* No computation outside the code *)
Fact sss_out_step_stall P st : out_code (fst st) P -> sss_step_stall P st.
Fact sss_stall_step_stall ii P st :
(fst st,ii::nil) <sc P
-> sss_stall ii st
-> sss_step_stall P st.
Fact sss_stall_step_0 ii P q st st' :
(fst st,ii::nil) <sc P
-> sss_stall ii st
-> P // st -[q]-> st' -> q = 0 /\ st = st'.
Fact sss_step_stall_inv P st :
sss_step_stall P st
-> { ii | (fst st,ii::nil) <sc P /\ sss_stall ii st }
+ { out_code (fst st) P }.
Fact sss_steps_stall k P st st' :
out_code (fst st) P
-> P // st -[k]-> st'
-> k = 0 /\ st = st'.
(** This is a critical lemma about the locality of computations  If P is subcode of Q and a computation in Q starts in P and ends outside of P, then it is decomposed in a first computation in P ending outside of P and a second computation in Q  *)

(* Specifications: *)
Lemma subcode_sss_steps_inv P Q k st1 st3 :
P <sc Q
-> in_code  (fst st1) P
-> out_code (fst st3) P
-> Q // st1 -[k]-> st3
-> exists k1 k2 st2,
P // st1 -[k1]-> st2
/\ Q // st2 -[k2]-> st3
/\ k = k1+k2
/\ out_code (fst st2) P.
Lemma subcode_sss_compute_inv P Q st1 st3 :
P <sc Q
-> out_code (fst st3) P
-> Q // st1 ->> st3
-> exists st2,
P // st1 ->> st2
/\ Q // st2 ->> st3
/\ out_code (fst st2) P.