(* Time-stamp: "2018-02-09 17:01:14 pierre" *)
(****************************************************************)
(*                       yinYang.v                             *)
(*                                                              *)
(**          © Pierre Lescanne  (December 2015)                 *)
(*                                                              *)
(*              LIP (ENS-Lyon, CNRS, INRIA)                     *)
(*                                                              *)
(*                                                              *)
(*  Developed in  V8.4pl4               January -- May   2016   *)
(****************************************************************)

Section YinYang.

Add LoadPath ".".

Require Import games_Choice_Dependent.

(* Setting sets for agents and choices *)
Inductive AliceBob : Set := | Alice | Bob.
Inductive DorR : Set := | down | right.
Inductive YinYang: Set := | ying | yang.
Definition Choice: AliceBob -> Set := fun a => DorR.

Arguments StratProf [Agent Utility Choice].
Arguments Game [Agent Utility Choice].
Arguments UAssignment [Agent Utility Choice] s H a.
Arguments game [Agent Utility Choice] s.
Arguments StratProf_decomposition [Agent Utility Choice] s.
Arguments Convergent [Agent Utility Choice] s.
Arguments AlwaysConvergent [Agent Utility Choice] s.
Arguments convLeaf [Agent Utility Choice] f.
Arguments convNode [Agent Utility Choice] a c next _.
Arguments SPE [Agent Utility Choice] preference  s.
Arguments Uassign [Agent Utility Choice] s a u.
Arguments good [Agent Utility Choice] preference s.
Arguments gEqual [Agent Utility Choice] g1 g2.
Arguments Divergent  [Agent Utility Choice] s.
Arguments AlwaysGood  [Agent Utility Choice] preference s.

Notation "<< f >>" := (sLeaf AliceBob YinYang Choice  f).
Notation "<< a , c , next >>" :=
  (sNode AliceBob YinYang Choice a c next).
Notation "[ x , y ]" :=
  (fun a:AliceBob => match a with Alice => x | Bob => y end).
Notation "<| f |>" := (gLeaf  AliceBob YinYang Choice f).
Notation "<| a , next |>" := (gNode AliceBob YinYang Choice a next).

Notation "s1 +++ s2" :=
  (fun c:DorR => match c with down => s1 | right => s2 end)
  (at level 30).
Notation "↓ s " := (Convergent s) (at level 5).
Notation "⇓ s" := (AlwaysConvergent s)
                    (at level 15).
Notation "↑ s " := (Divergent s) (at level 5).
Notation "g == g'" := (gEqual g g') (at level 80).

Ltac decomp := rewrite <- StratProf_decomposition; simpl.

(* --------------------------------- *)
(**    Infinite Game Zero One        *)
(* --------------------------------- *)

(* Definitions *)
CoFixpoint yinYangAcBs := <<Alice, right, <<[yang,ying]>> +++ yinYangBsAc>>
  with yinYangBsAc := <<Bob, down, <<[ying,yang]>> +++ yinYangAcBs>>.

CoFixpoint yinYangAsBc := <<Alice, down, <<[yang,ying]>> +++ yinYangBcAs>>
  with yinYangBcAs := <<Bob, right, <<[ying,yang]>> +++ yinYangAsBc>>.

CoFixpoint yinYangAcBc := <<Alice, right, <<[yang,ying]>> +++ yinYangBcAc>>
  with yinYangBcAc := <<Bob, right, <<[ying,yang]>> +++ yinYangAcBc>>.

(* == Lemmas on utility assignments == *)

(* A continue Bob stops *)

Lemma UassignYyBsAcya: Uassign yinYangBsAc Alice ying.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangBsAc); simpl.
  apply UassignNode.
  apply UassignLeaf.
Qed.

Lemma UassignYyBsAcyi: Uassign yinYangBsAc Bob yang.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangBsAc); simpl.
  apply UassignNode.
  apply UassignLeaf.
Qed.

Lemma UassignYyAcBsyi: Uassign yinYangAcBs Bob yang.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangAcBs); simpl.
  apply UassignNode.
  apply UassignYyBsAcyi.
Qed.

(* A stops Bob continues *)
Lemma UassignYyAsBcyi: Uassign yinYangAsBc Alice yang.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangAsBc); simpl.
  apply UassignNode.
  apply UassignLeaf.
Qed.

Lemma UassignYyAsBcya: Uassign yinYangAsBc Bob ying.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangAsBc); simpl.
  apply UassignNode.
  apply UassignLeaf.
Qed.

Lemma UassignYyBcAsyi: Uassign yinYangBcAs Alice yang.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangBcAs); simpl.
  apply UassignNode.
  apply UassignYyAsBcyi.
Qed.

Lemma UassignYyBcAsya:  Uassign yinYangBcAs Bob ying.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangBcAs); simpl.
  apply UassignNode.
  apply UassignYyAsBcya.
Qed.

(* Lemmas on Convergence of strategy profiles *)
Lemma ConvYyBsAc: ↓ yinYangBsAc.
Proof.
  decomp.
  apply ConvNode.
  apply ConvLeaf.
Qed.

Lemma ConvYyAcBs: ↓ yinYangAcBs.
Proof.
  decomp.
  decomp.
  apply ConvNode.
  apply ConvYyBsAc.
Qed.

Lemma ConvYyAsBc: ↓ yinYangAsBc.
Proof.
  decomp;apply ConvNode; apply ConvLeaf.
Qed.

Lemma ConvYyBcAs: ↓ yinYangBcAs.
Proof.
  decomp; apply ConvNode; apply ConvYyAsBc.
Qed.

(* Lemmas on Always Convergence of strategy profiles *)
Lemma AlwsConvYyAcBs: ⇓ yinYangAcBs.
Proof.
  cofix AlwsConvYyAcBs;
  decomp; apply AlwaysNode;
  [apply ConvNode; apply ConvYyBsAc |
   induction c'; [apply AlwaysLeaf | decomp; apply AlwaysNode; [apply ConvNode; apply ConvLeaf |
                                                                 induction c'; [apply AlwaysLeaf | apply AlwsConvYyAcBs]]]].
Qed.

Lemma AlwsConvYyBsAc: ⇓ yinYangBsAc.
Proof.
  decomp; apply AlwaysNode;
  [apply ConvNode; apply ConvLeaf |
   induction c'; [apply AlwaysLeaf | apply AlwsConvYyAcBs]].
Qed.

Lemma AlwsConvYyBcAs: ⇓ yinYangBcAs.
Proof.
  cofix AlwsConvYyBcAs;
  decomp; apply AlwaysNode;
  [apply ConvNode; apply ConvYyAsBc |
   induction c'; [apply AlwaysLeaf |
                   decomp; apply AlwaysNode;
                   [apply ConvNode; apply ConvLeaf|
                    induction c'; [apply AlwaysLeaf | apply AlwsConvYyBcAs]]]].
Qed.

Lemma AlwsConvYyAsBc: ⇓ yinYangAsBc.
Proof.
  decomp; apply AlwaysNode;
  [apply ConvNode; apply ConvLeaf |
   induction c'; [apply AlwaysLeaf | apply AlwsConvYyBcAs]].
Qed.

(* Equality of the underlying game *)
Lemma sameGameBcAc_BsAc: game yinYangBcAc == game yinYangBsAc.
Proof.
  cofix sameGameBcAc_BsAc.
  rewrite <- StratProf_decomposition with (s:=yinYangBcAc);
  rewrite <- StratProf_decomposition with (s:=yinYangBsAc);
  simpl;
  rewrite gameNode; rewrite gameNode; apply gEqualNode;
  induction c;
  [apply refGEqual |
   rewrite <- StratProf_decomposition with (s:=yinYangAcBc);
     rewrite <- StratProf_decomposition with (s:=yinYangAcBs);
     simpl;
     rewrite gameNode; rewrite gameNode; apply gEqualNode;
     induction c; [apply refGEqual | apply sameGameBcAc_BsAc]].
Qed.

Lemma sameGameAcBc_AcBs: game yinYangAcBc == game yinYangAcBs.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangAcBc);
  rewrite <- StratProf_decomposition with (s:=yinYangAcBs);
  simpl.
  rewrite gameNode; rewrite gameNode; apply gEqualNode.
  induction c; [apply refGEqual | apply sameGameBcAc_BsAc].
Qed.

Lemma sameGameBcAs_BcAc: game yinYangBcAc == game yinYangBcAs.
Proof.
  cofix sameGameBcAc_BsAc.
  rewrite <- StratProf_decomposition with (s:=yinYangBcAc);
  rewrite <- StratProf_decomposition with (s:=yinYangBcAs);
  simpl.
  rewrite gameNode; rewrite gameNode; apply gEqualNode.
  induction c.
  apply refGEqual.
  rewrite <- StratProf_decomposition with (s:=yinYangAcBc);
  rewrite <- StratProf_decomposition with (s:=yinYangAsBc);
  simpl.
  rewrite gameNode; rewrite gameNode; apply gEqualNode.
  induction c; [apply refGEqual | apply sameGameBcAc_BsAc].
Qed.

Lemma sameGameAcBc_AsBc: game yinYangAcBc == game yinYangAsBc.
Proof.
  rewrite <- StratProf_decomposition with (s:=yinYangAcBc);
  rewrite <- StratProf_decomposition with (s:=yinYangAsBc);
  simpl.
  rewrite gameNode; rewrite gameNode; apply gEqualNode.
  induction c; [apply refGEqual | apply sameGameBcAs_BcAc].
Qed.

(* SPE *)
Lemma SPEYyAcBs: SPE eq yinYangAcBs.
Proof.
  cofix SPEYyAcBs;
  decomp;
  apply SPENode with (c':=right)(u:=ying)(u':=ying);
  [apply AlwaysNode; [apply ConvNode; apply ConvYyBsAc |
                      induction c';  [apply AlwaysLeaf | apply AlwsConvYyBsAc]] |
   apply UassignYyBsAcya |
   apply UassignYyBsAcya |
   reflexivity |
   decomp ; apply SPENode with (c':=right)(u:=yang)(u':=yang);
   [apply AlwaysNode; [apply ConvNode; apply ConvLeaf |
                       induction c'; [apply AlwaysLeaf | apply AlwsConvYyAcBs]] |
    apply UassignYyAcBsyi |
    apply UassignLeaf |
    reflexivity |
    apply SPEYyAcBs]].
Qed.

Lemma SPEYyBsAc: SPE eq yinYangBsAc.
Proof.
  cofix SPEYyBsAc.
  decomp.
  apply SPENode with (c':=right)(u:=yang)(u':=yang).
  apply AlwaysNode.
  apply ConvNode.
  apply ConvLeaf.
  induction c'.
  apply AlwaysLeaf.
  apply AlwsConvYyAcBs.
  apply UassignYyAcBsyi.
  apply UassignLeaf.
  reflexivity.
  apply SPEYyAcBs.
Qed.

Lemma SPEYyAsBc: SPE eq yinYangAsBc.
Proof.
  cofix SPEYyAsBc.
  decomp.
  apply SPENode with (c':=right)(u:=yang)(u':=yang).
  apply AlwaysNode.
  apply ConvNode.
  apply ConvLeaf.
  induction c'.
  apply AlwaysLeaf.
  apply AlwsConvYyBcAs.
  apply UassignYyBcAsyi.
  apply UassignLeaf.
  reflexivity.
  decomp.
  apply SPENode with (c':=right)(u:=ying)(u':=ying).
  apply AlwaysNode.
  apply ConvNode.
  apply ConvYyAsBc.
  induction c'.
  apply AlwaysLeaf.
  apply AlwsConvYyAsBc.
  apply UassignYyAsBcya.
  apply UassignYyAsBcya.
  reflexivity.
  apply SPEYyAsBc.
Qed.

Lemma SPEYyBcAs: SPE eq yinYangBcAs.
Proof.
  decomp.
  apply SPENode with (c':=right)(u:=ying)(u':=ying).
  apply AlwaysNode.
  apply ConvNode.
  apply ConvYyAsBc.
  induction c'.
  apply AlwaysLeaf.
  apply AlwsConvYyAsBc.
  apply UassignYyAsBcya.
  apply UassignYyAsBcya.
  reflexivity.
  apply SPEYyAsBc.
Qed.

(* Good *)
Lemma GoodYyAcBc: good eq yinYangAcBc.
Proof.
  decomp.
  apply goodNode with (next':= <<[yang,ying]>> +++ yinYangBsAc).
  split.
  rewrite gameNode; rewrite gameNode.
  apply gEqualNode.
  induction c.
  rewrite gameLeaf.
  apply gEqualLeaf.
  apply sameGameBcAc_BsAc.
  apply SPENode with (c':=right)(u:=ying)(u':=ying).
  apply AlwaysNode.
  apply ConvNode.
  apply ConvYyBsAc.
  induction c'.
  apply AlwaysLeaf.
  apply AlwsConvYyBsAc.
  apply UassignYyBsAcya.
  apply UassignYyBsAcya.
  reflexivity.
  apply SPEYyBsAc.
Qed.

Lemma GoodYyBcAc: good eq yinYangBcAc.
Proof.
  decomp.
  apply goodNode with (next':= <<[ying,yang]>> +++ yinYangAsBc).
  split.
  rewrite gameNode; rewrite gameNode.
  apply gEqualNode.
  induction c.
  rewrite gameLeaf.
  apply gEqualLeaf.
  apply sameGameAcBc_AsBc.
  apply SPENode with (c':=right)(u:=ying)(u':=ying).
  apply AlwaysNode.
  apply ConvNode.
  apply ConvYyAsBc.
  induction c'.
  apply AlwaysLeaf.
  apply AlwsConvYyAsBc.
  apply UassignYyAsBcya.
  apply UassignYyAsBcya.
  reflexivity.
  apply SPEYyAsBc.
Qed.

(* Always Good AcBc *)
Lemma AlwaysGoodYyAcBc: AlwaysGood eq yinYangAcBc.
Proof.
  cofix AlwaysGoodYyAcBc.
  decomp.
  apply AlwaysNode.
  replace (<< Alice, right, << [yang,ying] >> +++ yinYangBcAc >>) with yinYangAcBc.
  apply GoodYyAcBc.
  rewrite <- StratProf_decomposition with (s:=yinYangAcBc); simpl; reflexivity.
  induction c'.
  apply AlwaysLeaf.
  decomp.
  apply AlwaysNode.
  replace (<< Bob, right, << [ying,yang] >> +++ yinYangAcBc >>) with yinYangBcAc.
  apply GoodYyBcAc.
  rewrite <- StratProf_decomposition with (s:=yinYangBcAc); simpl; reflexivity.
  induction c'; [apply AlwaysLeaf | apply AlwaysGoodYyAcBc].
Qed.

(* Divergent *)
Lemma DivergenceYyAcBc: ↑ yinYangAcBc.
Proof.
  cofix DivergenceYyAcBc.
  decomp.
  apply divNode.
  decomp.
  apply divNode.
  apply DivergenceYyAcBc.
Qed.

End YinYang.


Require Import Bool Arith List Omega.
Require Import Recdef Morphisms.
Require Import Program.Tactics.
Require Import Relation_Operators.
Require FMapList.
Require FMapFacts.
Require Import Classical.
Require Import Coq.Classes.RelationClasses.
Require Import OrderedType OrderedTypeEx DecidableType.
Require Import Sorting.Permutation.
Import ListNotations.
Module NatMap := FMapList.Make Nat_as_OT.

Definition address := nat.
Definition version := nat.
Definition value := nat.
Definition lock := bool.
Definition variable := nat.
Definition store := NatMap.t value.
Definition heap :=  address -> option (value * lock * version).
Definition tid := nat.
(*
Inductive log : Type :=
|Read : address -> version -> log -> log
|Write : address -> value -> log -> log
|NilLog : log.

Function log_read_only (l:log) : Prop :=
  match l with
   | NilLog => True
   | Read _ _ s => log_read_only s
   | Write _ _ _ => False
  end.

Inductive operation :=
|  read: address -> variable -> operation
|  write: address -> value -> operation.

Definition transaction := list operation.

Inductive trans_state : Type :=
| TS: forall (s: store) (h: heap) (l: log), trans_state.

Inductive trans_step1 : relation trans_state :=
| TS_read: forall s h addr l var val lck ver,
	h addr = Some (val, lck, ver) ->
	lck = false ->
	trans_step1 (TS s h l) (TS (NatMap.add var val s) h (Read addr ver l))
|TS_write: forall s h addr l val,
	trans_step1 (TS s h l) (TS s h (Write addr val l)).
*)
(*
1. What operations do we need to support? For example, non-transactional operations, write from a read, etc
2. What is the difference between the inductive style that we are using and the functional style?
   We followed your style in osview.
3. What is the next step?
4. How to model concurrency?

forall traces t, if t is sto_trace, then there exists a reorder trace t' where t' reorders t and t' is a sto-trace
and t' is a serial trace

Let's say each trace is each element belongs to a transaction
serial means all operations on a transaction grouped

Action:=
|start_txn: tid -> action
|read_item: tid -> addr -> action
|write_item: tid -> addr -> value -> action
|try_commit_txn: tid -> action
|lock_write_item: tid -> addr -> action
|validate_read_item: tid -> addr -> version -> action
|abort_txn: tid -> action
|complete_write_item: tid -> addr -> value -> action
|invalid_write_item: tid -> addr -> value -> action
|commit_txn: tid -> action
|obtain_global_tid (must call after all write items are locked)

global_tid order produces the same result, same memory and every read returns the same value

sto_trace may should be inductive type
should probably have a reorder operation
How do you define reorder? How do you define serial?
Do you want to use os_step trick of collecting explicit history?
** Reordering definition is important **
*)
Inductive action:=
|dummy: action
|start_txn: action
|read_item: version -> action
|write_item: value -> action
|try_commit_txn: action
|lock_write_item: action
|validate_read_item: Prop -> action
|abort_txn: action
(*|restart_txn: action*)
|complete_write_item: (*value -> action*)version -> action
(*|unlock_write_item: version -> action*)
(*|invalid_write_item: value -> action*)
|commit_txn: version -> action
|seq_point: action.
(*|obtain_global_tid: action.*)
(*sp later than last lock, but must before the first commit*)
Definition trace := list (tid * action).

(*
Returns all tid*action with tid tid in the trace.
*)
Definition trace_filter_tid tid tr : trace :=
    filter (fun pr => fst pr =? tid) tr.

(*
Returns all commit actions in the trace.
*)
Definition trace_filter_commit tr: trace :=
    filter (fun pr => match snd pr with
                      | commit_txn _ => true
                      | _ => false
                      end) tr.
(*
Returns all write actions in the trace.
*)
Definition trace_filter_write tr: trace :=
    filter (fun pr => match snd pr with
                      | write_item _ => true
                      | _ => false
                      end) tr.

(*
Returns all read actions in the trace.
*)
Definition trace_filter_read tr: trace :=
    filter (fun pr => match snd pr with
                      | read_item _ => true
                      | _ => false
                      end) tr.

(*
Returns all commit & complete_write actions in the trace for updating commit version
*)
Definition trace_filter_commit_complete tr: trace :=
    filter (fun pr => match snd pr with
                      | commit_txn _ => true
                      | complete_write_item _ => true
                      | _ => false
                      end) tr.

(*
Returns the last action of the transaction tid
Returns dummy if there is no transaction with id tid.
*)
Definition trace_tid_last tid t: action :=
    hd dummy (map snd (trace_filter_tid tid t)).

(*
Returns the version number of the last commit
If there is no commit in the trace, returns 0.
*)
Definition trace_commit_last t: version :=
  match hd dummy (map snd (trace_filter_commit t)) with
	| commit_txn n => n
	| _ => 0
  end.

(*
Returns the value of the last write
If there is no write in the trace, returns 0.
*)
Definition trace_write_last t: value :=
  match hd dummy (map snd (trace_filter_write t)) with
	| write_item n => n
	| _ => 0
  end.

(*
Returns the version number of the last commit/complete_write
If there is no commit in the trace, returns 0.
*)
Definition trace_commit_complete_last t: version :=
  match hd dummy (map snd (trace_filter_commit_complete t)) with
	| commit_txn n => n
  | complete_write_item n => n
	| _ => 0
  end.

(*
Returns all lock_write_item actions in the trace.
*)
Definition trace_filter_lock tr: trace :=
    filter (fun pr => match snd pr with
                      | lock_write_item => true
                      | _ => false
                      end) tr.

(*
All commit and abort have unlock_write_item.
If a transaction contains either of the actions, the transaction has unlock
*)
Definition trace_filter_unlock tr: trace :=
    filter (fun pr => match snd pr with
                      | commit_txn _ => true
                      | abort_txn => true
                      | _ => false
                      end) tr.

(*
Returns the length of a trace
*)
Function length (tr: trace) : nat :=
  match tr with
  | [] => 0
  | _ :: tr' => S (length tr')
  end.

(*
Returns True if there exists no lock_write_item
Returns False if there exists locks
*)
Definition check_lock_or_unlock tr: Prop :=
  match
    length (trace_filter_lock tr) <=? length (trace_filter_unlock tr)
  with
	| true => True
	| false => False
  end.

(*
Returns true if an action is not a write action
Returns false if an action is a write action.
*)
Definition action_no_write e : Prop :=
  match e with
  | write_item  _  => False
  | _ => True
  end.

(*
Returns true if an action is not a commit_txn action
Returns false if an action is a commit_txn action.
*)
Definition action_no_commit e : Prop :=
  match e with
  | commit_txn _ => False
  | _ => True
  end.

(*
Returns true if the transaction tid's trace has no writes
Returns false otherwise.
*)
Definition trace_no_writes tid t: Prop :=
  Forall action_no_write (map snd (trace_filter_tid tid t)).

(*
Returns true if the transaction tid's trace has no commits
Returns false otherwise.
*)
Definition trace_no_commits tid t: Prop :=
  Forall action_no_commit (map snd (trace_filter_tid tid t)).

(*
Returns all read_item versions in a trace of a particular transaction.
*)
Function read_versions tr: list version :=
  match tr with
   | [] => []
   | (read_item v) :: tail =>  v :: read_versions tail
   | _ :: tail => read_versions tail
  end.

(*
Returns all read_item versions of tid in a trace tr.
*)
Definition read_versions_tid tid tr: list version :=
  read_versions (map snd (trace_filter_tid tid tr)).

(*
Returns True if reads are valid
Returns False otherwise
*)
Function check_version (vs : list version) (v : version) : Prop :=
  match vs with
  | [] => True
  | hd :: tail => if hd =? v then check_version tail v
                  else False
  end.

(*
Returns all start/read/write actions in the trace.
*)
Definition trace_filter_startreadwrite tid tr: trace :=
    filter (fun pr => (fst pr =? tid) &&
                      (match snd pr with
                      | read_item _ => true
                      | write_item _ => true
                      | start_txn => true
                      | _ => false
                      end)) tr.

(*
Returns all newtid with start/read/write actions in the trace.
*)
(*
Function trace_rollback (newtid: nat) (newver: version) (tr:trace): trace :=
    match tr with
    | [] => []
    | (tid, read_item _) :: tr'
      => [(newtid, read_item newver)] ++ trace_rollback newtid newver tr'
    | (tid, write_item val) :: tr'
      => [(newtid, write_item val)] ++ trace_rollback newtid newver tr'
    | (tid, start_txn) :: tr'
      => [(newtid, start_txn)] ++ trace_rollback newtid newver tr'
    | _ :: tr' => trace_rollback newtid newver tr'
  end.
*)

Inductive sto_trace : trace -> Prop :=

| empty_step : sto_trace []

| start_txn_step: forall t tid,
    trace_tid_last tid t = dummy (* this tid doesn’t have start_txn*)
    -> sto_trace t
    -> sto_trace ((tid, start_txn)::t)

| read_item_step: forall t tid val oldver,
    trace_tid_last tid t = start_txn (* start/read/write before read*)
		\/ trace_tid_last tid t = read_item oldver
    \/ trace_tid_last tid t = write_item val
    (*check locked or not*)
    -> check_lock_or_unlock t
    -> sto_trace t
    -> sto_trace ((tid, read_item (trace_commit_last t)) :: t)

| write_item_step: forall t tid oldval val ver,
    trace_tid_last tid t = start_txn
		\/ trace_tid_last tid t = read_item ver
    \/ trace_tid_last tid t = write_item oldval
    -> sto_trace t
    -> sto_trace ((tid, write_item val) :: t)

| try_commit_txn_step: forall t tid ver val,
			trace_tid_last tid t = read_item ver
			\/ trace_tid_last tid t = write_item val
			-> sto_trace t
			-> sto_trace ((tid, try_commit_txn)::t)

| lock_write_item_step: forall t tid,
			trace_tid_last tid t = try_commit_txn
			/\ ~ trace_no_writes tid t
      -> check_lock_or_unlock t
			-> sto_trace t
			-> sto_trace ((tid, lock_write_item) :: t)

| validate_read_item_step: forall t tid,
			(trace_tid_last tid t = try_commit_txn /\ trace_no_writes tid t ) (*read only*)
			\/ trace_tid_last tid t = lock_write_item (*lock write*)
			-> sto_trace t
			-> sto_trace ((tid, validate_read_item (check_version (read_versions_tid tid t)  (trace_commit_last t) ))::t)

(****************************************)
(*| abort_readonly_txn_step: forall t tid,
      trace_tid_last tid t = validate_read_item False (*invalid*)
      /\ trace_no_writes tid t
      -> sto_trace t
      -> sto_trace ((tid, abort_txn) :: t)

| abort_write_txn_step: forall t tid,
      trace_tid_last tid t = validate_read_item False (*invalid*)
      /\ ~ trace_no_writes tid t
      -> sto_trace t
      -> sto_trace ([(tid, abort_txn); (tid, unlock_write_item (trace_commit_last t))] ++ t)*)
(****************************************)

| abort_txn_step: forall t tid,
      trace_tid_last tid t = validate_read_item False
      -> sto_trace t
      -> sto_trace ((tid, abort_txn) :: t) (*abort will contain unlock....*)

| complete_write_item_step: forall t tid,
			trace_tid_last tid t = validate_read_item True (*valid read*)
      /\ ~ trace_no_writes tid t
      -> sto_trace t
      -> sto_trace ((tid, complete_write_item (S (trace_commit_last t))) :: t)

(*| unlock_write_item_step: forall t tid ver,
      trace_tid_last tid t = complete_write_item ver
			/\ ~ trace_no_writes tid t (*locked*)
      -> sto_trace t
      -> sto_trace ((tid, unlock_write_item ver) :: t)*)

(****************************************)
(*| commit_readonly_txn_step: forall t tid,
      (trace_tid_last tid t = validate_read_item True /\ trace_no_writes tid t)(*read only*)
      -> sto_trace t
      -> sto_trace ((tid, commit_txn (trace_commit_last t)) :: t)

| commit_write_txn_step: forall t tid ver,
      trace_tid_last tid t = unlock_write_item ver(*unlock the write*)
      -> sto_trace t
      -> sto_trace ((tid, commit_txn ver) :: t).*)
(****************************************)

(*sequential point*)
| seq_point_step: forall t tid ver,
      (trace_tid_last tid t = validate_read_item True
        /\ trace_no_writes tid t)
      \/ (trace_tid_last tid t = complete_write_item ver
			  /\ ~ trace_no_writes tid t)
      -> trace_no_commits tid t
      -> sto_trace t
      -> sto_trace ((tid, seq_point) :: t)

| commit_txn_step: forall t tid,
      trace_tid_last tid t = seq_point
      -> sto_trace t
      -> sto_trace ((tid, commit_txn (trace_commit_complete_last t)) :: t).
Hint Constructors sto_trace.

Hint Constructors sto_trace.

(*we don't need to rollback, once a transaction aborts, it will 'disappear'. A new transaction will do its work.*)
(*| restart_txn_step: forall t tid newtid,
      trace_tid_last tid t = abort_txn (*we get abort and then restart*)
      -> sto_trace t
    (*our restart is to add back*)
      -> sto_trace ((trace_rollback newtid (trace_commit_last t) (trace_filter_startreadwrite tid t)) ++ t).*)

Example sto_trace_example_rollback:
sto_trace [(3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

assert (trace_commit_complete_last [(3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 1).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step; rewrite H.
unfold trace_tid_last. simpl. auto.
clear H.

apply seq_point_step with (ver := 1).
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes. simpl.
repeat apply Forall_cons; simpl; auto.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto.

assert ((check_version (read_versions_tid 3 ([(3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step.
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes.
repeat apply Forall_cons; simpl; auto. rewrite H.
clear H.

apply try_commit_txn_step with (ver:= 1) (val:= 0).
unfold trace_tid_last. simpl. left. auto.

(*assert (trace_rollback 3 (trace_commit_last [(1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) (trace_filter_startreadwrite 1 [(1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) = [(3, read_item 1); (3, start_txn)]).
unfold trace_rollback. simpl.
unfold trace_commit_last. simpl. auto.

assert ([(3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = [(3, read_item 1); (3, start_txn)] ++ [(1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]). auto.
rewrite H0. rewrite <- H.
apply restart_txn_step. unfold trace_tid_last. simpl. auto. clear H H0.
*)

assert (trace_commit_last [(3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 1).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H.
apply read_item_step with (val:=0) (oldver:=0); rewrite H.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto. clear H.

apply start_txn_step.
unfold trace_tid_last. simpl. auto.

apply abort_txn_step.
unfold trace_tid_last. simpl. auto.

assert ((check_version (read_versions_tid 1 ([(1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = False)).
unfold check_version. simpl. auto.
rewrite <- H.
apply validate_read_item_step.
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes. simpl.
repeat apply Forall_cons; simpl; auto.
clear H.

apply try_commit_txn_step with (ver:= 0) (val:= 4).
unfold trace_tid_last. simpl. auto.

assert (trace_commit_complete_last [ (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 1).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step; rewrite H.
unfold trace_tid_last. simpl. auto.

apply seq_point_step with (ver:=1). right.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H0. inversion H4. inversion H8. inversion H12. inversion H16.
simpl in H19. auto.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto.
(*
apply unlock_write_item_step.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. inversion H7. inversion H11. inversion H15.
simpl in *. auto.
*)
clear H.
assert (trace_commit_last ([(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) = 0).
{ unfold trace_commit_last. simpl. auto. }
assert (1 = S (trace_commit_last [(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])).
{ rewrite H. auto. }
rewrite H0.

apply complete_write_item_step; rewrite <-H0.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H1. inversion H5. inversion H9. inversion H13.
simpl in *. auto.
clear H H0.
assert ((check_version (read_versions_tid 2 ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step.
unfold trace_tid_last. simpl. right. auto. clear H.

apply lock_write_item_step. split.
unfold trace_tid_last. simpl. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. simpl in *. auto.
unfold check_lock_or_unlock. simpl. auto.

apply try_commit_txn_step with (ver := 0) (val:= 4).
unfold trace_tid_last. simpl. auto.

apply write_item_step with (ver:=0) (oldval:=0).
unfold trace_tid_last. simpl. right. left. auto.

assert (trace_commit_last [(2, read_item 0); (2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H.
apply read_item_step with (val:=0) (oldver:=0); rewrite H. clear H.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

assert (trace_commit_last [(2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H0.
apply read_item_step with (val:=0) (oldver:=0); rewrite H0. clear H H0.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

apply start_txn_step. unfold trace_tid_last. auto.
apply start_txn_step. unfold trace_tid_last. auto.

apply empty_step.

Example sto_trace_example_commit:
sto_trace [(2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

assert (trace_commit_complete_last [(2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)] = 1).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step.
unfold trace_tid_last; rewrite H. simpl. auto. rewrite H. clear H.

apply seq_point_step with (ver:= 1).
unfold trace_tid_last. simpl. right. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. inversion H7. inversion H11. inversion H15.
simpl in H18. auto.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto.

assert (trace_commit_last ([(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point);  (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) = 0).
{ unfold trace_commit_last. simpl. auto. }
assert (1 = S (trace_commit_last [(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point);  (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0);(2, read_item 0); (2, start_txn); (1, start_txn)])).
{ rewrite H. auto. }
rewrite H0.

apply complete_write_item_step; rewrite <-H0.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H1. inversion H5. inversion H9. inversion H13.
simpl in *. auto.
clear H H0.
assert ((check_version (read_versions_tid 2 ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step; rewrite H.
unfold trace_tid_last. simpl. right. auto. clear H.

apply lock_write_item_step. split.
unfold trace_tid_last. simpl. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. simpl in *. auto.
unfold check_lock_or_unlock. simpl. auto.

apply try_commit_txn_step with (ver := 0) (val:= 4).
unfold trace_tid_last. simpl. auto.

apply write_item_step with (ver:=0) (oldval:=0).
unfold trace_tid_last. simpl. right. left. auto.

assert (trace_commit_complete_last [ (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 0).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step; rewrite H.
unfold trace_tid_last. simpl. auto.

apply seq_point_step with (ver:= 0).
unfold trace_tid_last. simpl. left. split. auto.
clear H.
unfold trace_no_writes. simpl.
repeat apply Forall_cons; simpl; auto. clear H.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto. clear H.

assert ((check_version (read_versions_tid 1 ([(1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step.
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes.
repeat apply Forall_cons; simpl; auto.
clear H.

apply try_commit_txn_step with (ver:= 0) (val:= 0).
unfold trace_tid_last. simpl. left. auto.

assert (trace_commit_last [(2, read_item 0); (2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H.

apply read_item_step with (val:=0) (oldver:=0); rewrite H. clear H.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

assert (trace_commit_last [(2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H0.

apply read_item_step with (val:=0) (oldver:=0); rewrite H0. clear H H0.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

apply start_txn_step. unfold trace_tid_last. auto.
apply start_txn_step. unfold trace_tid_last. auto.

apply empty_step.

Definition example_txn:=
[(2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (2, read_item 0); (2, start_txn); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (1, start_txn)].

Definition example_txn2:=
[(3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

(*
Returns the serialized sequence of transactions in the STO trace based on seq_point of each transaction
The first element (tid) of the sequence is the first transaction that completes in the serial trace
Note that STO-trace is constructed in a reverse order: the first (tid * action) pair is the last operation in the trace
*)

Function seq_list (sto_trace: trace): list nat:=
  match sto_trace with
  | [] => []
  | (tid, seq_point) :: tail => seq_list tail ++ [tid]
  | _ :: tail => seq_list tail
  end.

Eval compute in seq_list example_txn.

Eval compute in seq_list example_txn2.

Lemma seq_list_not_seqpoint tid action t:
  sto_trace ((tid, action) :: t) ->
  action <> seq_point ->
  ~ In tid (seq_list ((tid, action) :: t))
  -> ~ In tid (seq_list t).
Proof.
  intros; destruct action; simpl in *; auto.
Qed.

Lemma seq_list_seqpoint tid action t:
  sto_trace ((tid, action) :: t) ->
  action = seq_point ->
  In tid (seq_list ((tid, action) :: t)).
Proof.
  intros; subst; simpl.
  apply in_or_app. right. simpl. auto.
Qed.

Lemma t_last_seqpoint t tid:
  sto_trace t ->
  trace_tid_last tid t = seq_point
  -> In (tid, seq_point) t.
Proof.
  intros.
  unfold trace_tid_last in H0.
  unfold trace_filter_tid in H0.
  Search (filter).
  inversion H; subst; try discriminate.
  destruct (Nat.eq_dec tid tid0)

Lemma seq_list_commit tid action n t:
  sto_trace ((tid, action) :: t) ->
  action = commit_txn n ->
  In tid (seq_list ((tid, action) :: t)).
Proof.
  intros. subst.
  inversion H.
Admitted.

(*
This function creates a serialized trace.
Just like STO-trace, the order is reversed: that is, the first (tid*action) pair in the serial trace
constructed by this function is the last operation performed in this trace
*)
(*
Function create_serialized_trace (sto_trace: trace) (seqls : list nat): trace:=
  match seqls with
  | [] => []
  | head :: tail
    => create_serialized_trace sto_trace tail ++ trace_filter_tid head sto_trace
  end.
*)
Function create_serialized_trace (sto_trace: trace) (sto_trace_copy: trace): trace:=
  match sto_trace with
  | [] => []
  | (tid, seq_point) :: tail
    => trace_filter_tid tid sto_trace_copy ++ create_serialized_trace tail sto_trace_copy
  | _ :: tail => create_serialized_trace tail sto_trace_copy
  end.

Eval compute in create_serialized_trace example_txn example_txn.

Eval compute in create_serialized_trace example_txn2 example_txn2.

Lemma last_seq_point tid t:
  sto_trace t ->
  trace_tid_last tid t = seq_point
  -> In tid (seq_list t).
Proof.
  intros.
  induction H; simpl; try discriminate.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H3 in H4. simpl in H4. inversion H4.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H4.
  apply IHsto_trace in H4. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H3 in H4. simpl in H4. inversion H4.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H4.
  apply IHsto_trace in H4. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  admit.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
Admitted.

Lemma seq_list_action tid action n t:
  sto_trace ((tid, action) :: t) ->
  action = seq_point \/ action = commit_txn n
  <-> In tid (seq_list ((tid, action) :: t)).
Proof.
  intros. split. intros. destruct H0.
  rewrite H0. simpl. apply in_or_app. right. simpl. auto.
  rewrite H0 in *.
  inversion H.
  simpl.
  apply last_seq_point; auto.
  admit.
Admitted.

Lemma seq_list_action_neg tid action n t:
  sto_trace ((tid, action) :: t) ->
  action <> seq_point /\ action <> commit_txn n
  <-> ~ In tid (seq_list ((tid, action) :: t)).
Proof.
  intros. split.
  intros.
  intuition.
  apply seq_list_action with (n := n) in H .
  destruct H. apply H0 in H1. destruct H1; auto.
  intros.
  intuition.
  apply seq_list_action with (n := n) in H .
  destruct H.
  assert (action = seq_point \/ action = commit_txn n). { left. auto. }
  apply H in H3. auto.
  apply seq_list_action with (n := n) in H .
  destruct H.
  assert (action = seq_point \/ action = commit_txn n). { right. auto. }
  apply H in H3. auto.
Qed.

Lemma serial_action tid action n t:
  sto_trace ((tid, action) :: t) ->
  action <> seq_point /\ action <> commit_txn n
  -> create_serialized_trace ((tid, action) :: t) (seq_list ((tid, action) :: t)) =
     create_serialized_trace t (seq_list t).
Proof.
  intros.
  inversion H; subst.
  assert (start_txn <> seq_point /\ start_txn <> commit_txn n
  -> ~ In tid (seq_list ((tid, start_txn) :: t))).
  { apply seq_list_action_neg. auto. }
  assert (~ In tid (seq_list ((tid, start_txn) :: t))).
  { apply H1 in H0. auto. }
  simpl.
  remember (seq_list t) as ts.
  induction ts.
  simpl. auto.
  simpl.
(*  apply seq_list_in in H2.
  rewrite <- Heqts in H2.
  apply not_in_cons in H2. destruct_pairs.
  assert ((tid =? a) = false). { apply Nat.eqb_neq. auto. }
  rewrite H7.

  destruct (Nat.eq_dec tid a).
  assert (true = (tid =? a)). { apply Nat.eqb_eq in e. auto. }
  rewrite <- H1.
*)

Admitted.

(*
This lemma proves that the seq_point of each transaction in a STO-trace determines its serialized order in the serial trace
*)

Lemma seq_list_equal trace:
  sto_trace trace ->
  seq_list (create_serialized_trace (trace) (seq_list trace)) = seq_list trace.
Proof.
  intros. simpl.
  induction H.
  - simpl. auto.
  - simpl. assert (trace_tid_last tid0 t <> seq_point).
    rewrite H. intuition. inversion H1.

Admitted.

Lemma seq_list_equal_old tid action trace:
  sto_trace trace ->
  (action = seq_point <->
  seq_list (create_serialized_trace ((tid, action) :: trace) (seq_list ((tid, action) :: trace))) = seq_list trace ++ [tid]).
Proof.
  split.
  intros. subst.
  simpl.
  -
Admitted.

(*
This lemma proves that the sequences of other actions in each transaction in a STO-trace does not
affect its order in the serial trace
*)
Lemma seq_list_equal2 tid action trace:
  ~(action = seq_point) ->
  seq_list (create_serialized_trace ((tid, action) :: trace) (seq_list trace)) = seq_list trace.
Proof.
Admitted.

(*
Check whether an element a is in the list l
*)
Fixpoint In_bool (a:nat) (l:list nat) : bool :=
  match l with
    | [] => false
    | b :: m => (b =? a) || In_bool a m
  end.

(*
The function checks if a trace is a serial trace by making sure that
tid is only increaing as we traverse the trace
In this function, we assume that the trace is in the correct order.
That is, the first (tid*action) in the trace is actually the first one that gets to be executed
*)
Function check_is_serial_trace (tr: trace) (tidls: list nat): Prop :=
  match tr with
  | [] => True
  | (tid, _) :: tail => if (negb (tid =? (hd 0 tidls))) && (In_bool tid tidls)
                          then False
                          else check_is_serial_trace tail (tid :: tidls)
  end.

Definition is_serial_trace tr: Prop :=
  check_is_serial_trace tr [].

Eval compute in is_serial_trace [(2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (2, read_item 0); (2, start_txn); (3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn)].

Eval compute in is_serial_trace [(3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

Eval compute in is_serial_trace example_txn.

Lemma is_serial trace:
  is_serial_trace (create_serialized_trace trace (seq_list trace)).
Proof.
  unfold is_serial_trace.
  functional induction create_serialized_trace trace (seq_list trace).
  simpl. auto.

(*
This function executes STO trace in the reverse order
The goal is to record all read and write actions of all *committed* transactions
*)
Function exec (sto_trace: trace) (commit_tid: list nat) : list (tid * action) :=
  match sto_trace with
  | [] => []
  | (tid, action) :: tail => if (In_bool tid commit_tid)
            then match action with
                | read_item _ => (tid, action) :: exec tail commit_tid
                | write_item _ => (tid, action) :: exec tail commit_tid
                | _ => exec tail commit_tid
                 end
            else exec tail commit_tid
  end.

Eval compute in exec example_txn (seq_list example_txn).

(*
This function returns all values that is written in a trace to a memory location
*)
Function tid_write_value (trace: trace) : list value :=
  match trace with
  | [] => []
  | (_, write_item val) :: tail => val :: tid_write_value tail
  | _ :: tail => tid_write_value tail
  end.

(*
This function returns a list of pair that records write values of each tids in the trace
the first element in a pair is tid
the second element is all the write values written by the transaction with the id tid
*)
Function get_write_value (trace: trace) (tids: list nat) : list (nat * (list value)):=
  match tids with
  | [] => []
  | head :: tail => (head, tid_write_value (trace_filter_tid head trace)) :: get_write_value trace tail
  end.

Definition get_write_value_out (sto_trace: trace) : list (nat * (list value)) :=
  get_write_value sto_trace (seq_list sto_trace).

Eval compute in get_write_value_out example_txn.

(*
This function compares values in two lists one by one
The value at each position in one list should be the same as that in the other list
*)
Function compare_value (ls1: list value) (ls2: list value): bool:=
  match ls1, ls2 with
  | [], [] => true
  | _ , [] => false
  | [], _ => false
  | h1::t1, h2::t2 => if h1=?h2 then compare_value t1 t2 else false
  end.

(*
We compare writes of two traces in this function
If they have the same write sequence, then the function will return True
****************************************************
We assume that two traces have the same tids in the same sequence
Should we actually add tid1 =? tid2 in the code to remove this assumption?
****************************************************
*)
Function compare_write_list (ls1: list (nat * (list value))) (ls2:list (nat * (list value))): Prop :=
  match ls1, ls2 with
  | [], [] => True
  | _ , [] => False
  | [], _ => False
  | (tid1, ver1)::t1, (tid2, ver2)::t2
        => if (tid1 =? tid2 ) && (compare_value ver1 ver2) then compare_write_list t1 t2
            else False
  end.

Definition write_synchronization trace1 trace2: Prop:=
  compare_write_list (get_write_value_out trace1) (get_write_value_out trace2).

(*
The function returns the last write value of a STO-trace
*)
Definition last_write_value trace: nat:=
  trace_write_last (exec trace (seq_list trace)).

Eval compute in last_write_value example_txn.
(*
Definition write_synchronization trace1 trace2: Prop:=
  if (last_write_value trace1) =? (last_write_value trace2)
  then True
  else False.
*)
Eval compute in write_synchronization example_txn (create_serialized_trace example_txn (seq_list example_txn)).

Lemma serialized_trace_app_no_sp:
  forall t tid a, sto_trace t -> a <> seq_point ->
    create_serialized_trace t (seq_list t) =
    create_serialized_trace ((tid, a)::t) (seq_list ((tid, a)::t)).
Proof.
  intros.
  assert (seq_list t = seq_list ((tid0, a) :: t)) by (induction a; simpl; intuition).
  rewrite <- H1.
  assert (~ In tid0 (seq_list t)). {
  inversion H. Focus 2.
  remember (seq_list t) as splist. clear H1. clear Heqsplist.
  functional induction (create_serialized_trace ((tid0, a) :: t) splist).
  -- auto.
  -- simpl. assert (tid0 =? head = false). admit.
     rewrite H1. admit.

(*
A STO-trace and its serial trace should have the same writes.
**************************************************
Should we prove that create_serialized_trace function actually prove the correct serial trace of the
STO-trace
**************************************************
*)
 Lemma write_equivalence trace:
  sto_trace trace ->
  let serialized_trace := create_serialized_trace trace (seq_list trace) in
  write_synchronization trace serialized_trace.

Proof.
  intros.
  induction H.
  - unfold write_synchronization. unfold get_write_value_out. simpl. auto.
  - unfold write_synchronization.
    unfold write_synchronization in IHsto_trace.
    assert (get_write_value_out t = get_write_value_out ((tid0, start_txn) :: t)).
    { unfold get_write_value_out. simpl. clear H. clear serialized_trace.
      unfold get_write_value_out in IHsto_trace. simpl in IHsto_trace.
      assert (seq_list (create_serialized_trace t (seq_list t)) = seq_list t). admit.
      rewrite H in IHsto_trace. clear H. remember (seq_list t) as tids. clear Heqtids.
      functional induction (get_write_value t tids).
      -- simpl. auto.
      --
 simpl. destruct (Nat.eq_dec tid0 head).
         --- admit. (* This case is not possible. skip for now *)
         --- apply Nat.eqb_neq in n. rewrite n.
             assert (get_write_value t tail = get_write_value ((tid0, start_txn) :: t) tail).
             { remember ((head, tid_write_value (trace_filter_tid head t))
                 :: get_write_value t tail) as ls1.
               remember (get_write_value (create_serialized_trace t (head :: tail))
                   (head :: tail)) as ls2.
               functional induction (compare_write_list ls1 ls2).
                ---- inversion Heqls2.
                ---- discriminate.
                ---- discriminate.
                ---- assert (t1 <> (head, tid_write_value (trace_filter_tid head t))
         :: get_write_value t tail). admit. admit.
                ---- auto. intuition. } admit. }
      rewrite serialized_trace.

assert (create_serialized_trace t (head :: tail) == create_serialized_trace t tail).

 simpl in *.

  - unfold write_synchronization. unfold get_write_value_out.
    assert (seq_list (create_serialized_trace ((tid0, start_txn) :: t) (seq_list ((tid0, start_txn) :: t))) = seq_list t).
    {
      remember (start_txn) as action.
      apply seq_list_equal2. rewrite Heqaction. intuition. inversion H2.
    }

  rewrite H3.
Admitted.*)

(*
Now we proceed to the read part of the proof.
*)

(*
This function returns the version numbers of all the reads in a trace
*)
Function tid_read_version (trace: trace) : list version :=
  match trace with
  | [] => []
  | (_, read_item ver) :: tail => ver :: tid_read_version tail
  | _ :: tail => tid_read_version tail
  end.

(*
This function groups all versions of reads of a transaction in a trace.
This returns a list of pairs
The first element of a pair is the tid
The second element is a list of all versions of the reads from the transaction tid
*)
Function get_read_version (trace: trace) (tids: list nat) : list (nat * (list version)):=
  match tids with
  | [] => []
  | head :: tail => (head, tid_read_version (trace_filter_tid head trace)) :: get_read_version trace tail
  end.

Definition get_read_version_out (trace: trace) : list (nat * (list version)) :=
  get_read_version trace (seq_list trace).

Eval compute in get_read_version_out example_txn.

Eval compute in get_read_version_out example_txn2.

(*
This function compares all read versions of two list
This is the same as compare all write in previous functions
*)
Function compare_version (ls1: list version) (ls2: list version): bool:=
  match ls1, ls2 with
  | [], [] => true
  | _ , [] => false
  | [], _ => false
  | h1::t1, h2::t2 => if h1=?h2 then compare_version t1 t2 else false
  end.

Function compare_read_list (ls1: list (nat * (list version))) (ls2:list (nat * (list version))): Prop :=
  match ls1, ls2 with
  | [], [] => True
  | _ , [] => False
  | [], _ => False
  | (tid1, ver1)::t1, (tid2, ver2)::t2
        => if (tid1 =? tid2 ) && (compare_version ver1 ver2) then compare_read_list t1 t2
            else False
  end.

Definition read_synchronization trace1 trace2: Prop:=
  compare_read_list (get_read_version_out trace1) (get_read_version_out trace2).

Eval compute in read_synchronization example_txn (create_serialized_trace example_txn (seq_list example_txn)).

Eval compute in compare_read_list [(1, [0;0]); (2, [1;1])] [(1, [0]);(2, [1;1])].

(*
A STO-trace and its serial trace should have the same reads.
*)
Lemma read_consistency trace:
  sto_trace trace
  -> sto_trace (create_serialized_trace trace (seq_list trace))
  -> is_serial_trace (create_serialized_trace trace (seq_list trace))
  -> read_synchronization trace (create_serialized_trace trace (seq_list trace)).
Admitted.

(*
Two traces can be considered equivalent in execution if they produce the same reads and writes
*)
Definition Exec_Equivalence trace1 trace2: Prop:=
  write_synchronization trace1 trace2 /\ read_synchronization trace1 trace2.

Eval compute in Exec_Equivalence example_txn (create_serialized_trace example_txn (seq_list example_txn)).

(*
The capstone theorem: prove serializability of a sto-trace
*)
Theorem txn_equal t:
  sto_trace t
  -> exists t', sto_trace t'
  -> is_serial_trace t'
  -> Exec_Equivalence t t'.
Proof.
  exists (create_serialized_trace t (seq_list t)).
  intros.
  unfold Exec_Equivalence. split.
  apply write_consistency; auto.
  apply read_consistency; auto.
Qed.


Require Export D.

(** **** Exercise: 1 star (update_neq)  *)
Theorem update_neq : forall x2 x1 n st,
  x2 <> x1 ->
  (update st x2 n) x1 = (st x1).
Proof.
  intros. unfold update. apply neq_id. assumption.
Qed.


Require Export preambule_nat preambule_liste.

Import ListNotations.

(*
 * Préambule.
 * P1. listes
 * Théorie catégorique des préfixes et des suffixes
 * Elle vise à définir les [pré|suf]fixes d'une concaténation facilement.
 * Préfixe, suffixe : deux transformations naturelles du foncteur Liste vers le
 * foncteur monadique (Curseur -> Liste _ * Curseur) où Curseur
 * représente l'ensemble des intervalles [0, n[ ou [n, +infini[ suivant les cas.
 *)

(* Préambule - sur les monades *)

Definition extensionMonadiqueFonctionUnaire{A B : Type}
           (M : Type -> Type)
           (unite : forall {X}, X -> M X)
           (liaison : forall {X Y}, M X -> (X -> M Y) -> M Y)
           (f : A -> B)
  : M A -> M B
  := fun m  =>
       liaison
         m
         (fun a => unite (f a) ).

Definition extensionMonadiqueFonctionBinaire{A B C : Type}
           (M : Type -> Type)
           (unite : forall {X}, X -> M X)
           (liaison : forall {X Y}, M X -> (X -> M Y) -> M Y)
           (f : A -> B -> C)
  : M A -> M B -> M C
  := fun m1 m2 =>
       liaison
         m1
         (fun a =>
           liaison
             m2
             (fun b => unite (f a b) )).

(* Deux monades : Liste et Reglage *)

(* Liste ( := list) est un foncteur. *)

Definition applicationListe{A B : Type} : (* map *)
  (A -> B) -> list A -> list B.
  fix REC 2.
  intros f l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    exact (f tl :: REC f rl).
  }
Defined.

(* Liste est une monade. *)

Definition uniteListe{A : Type} (* unit *)
  : A -> list A
  := fun a => [a].

Definition liaisonListe{A B : Type} (* bind *)
  : list A -> (A -> list B) -> list B.
  fix REC 1.
  intros l calculParam.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    exact (calculParam tl ++ REC rl calculParam).
  }
Defined.

(* La monade d'état *)

Definition Etat(E T : Type)
  : Type
  := (E -> T * E). (* E état, T observé *)

(* Pour tout E, (Etat E) est un foncteur. TODO propriétés *)

Definition applicationEtat{E A B : Type} : (* map *)
  (A -> B) -> Etat E A -> Etat E B.
  intros f ta.
  intro e.
  exact (f (fst (ta e)), snd (ta e)).
Defined.

(* Etat est une monade. TODO propriétés *)

Definition uniteEtat{E A : Type} (* unit *)
  : A -> Etat E A.
  intros a e.
  exact (a, e).
Defined.

Print uniteEtat.

Definition liaisonEtat{E A B : Type} (* bind *)
  : Etat E A -> (A -> Etat E B) -> Etat E B.
  intros ta calculParam e.
  exact(calculParam (fst (ta e)) (snd (ta e))).
Defined.

(* Le réglage, instance de l'état *)

Definition Reglage(V T : Type)  (* Tuner *)
  : Type
  := Etat V (list T). (* V variant, liste observée de T  *)

(* Pour tout V, (Reglage V) est un foncteur. TODO propriétés *)

Definition applicationReglage{V A B : Type} : (* map *)
  (A -> B) -> Reglage V A -> Reglage V B.
  intros f ra.
  intro v.
  exact (applicationListe f (fst (ra v)), snd (ra v)).
Defined.

Inductive Curseur (* Cursor *)
  : Type
  :=
  | VAL : forall n : nat, Curseur.

Definition valeurCurseur(c : Curseur) : nat.
  destruct c as [n].
  exact n.
Defined.

Inductive Fenetre (* Window *)
  : Type
  :=
  | PLAGE : forall n d : nat, Fenetre.

Definition plageFenetre(f : Fenetre) : nat * nat.
  destruct f as [n d].
  exact (n, d).
Defined.

(* Prefixe est une transformation naturelle du foncteur Liste vers le foncteur (Reglage Curseur). *)
(* TODO propriétés *)
Definition prefixeRC{T : Type}
  : list T -> Reglage Curseur T.
  fix REC 1.
  intros l c.
  destruct l as [ | tl rl].
  {
    exact ([], c).
  }
  {
    destruct c as [[ | pn]].
    {
      exact([], VAL 0).
    }
    {
      exact (tl :: fst (REC rl (VAL pn)), snd (REC rl (VAL pn))).
    }
  }
Defined.

(* Suffixe est une transformation naturelle du foncteur Liste vers le foncteur ReglageCurseur. *)
(* TODO propriétés *)

Definition suffixeRC{T : Type}
  : list T -> Reglage Curseur T.
  fix REC 1.
  intros l c.
  destruct l as [ | tl rl].
  {
    exact ([], c).
  }
  {
    destruct c as [[ | pn]].
    {
      exact(tl :: rl, VAL 0).
    }
    {
      exact (REC rl (VAL pn)).
    }
  }
Defined.

Definition suffixe{T : Type}
  : nat -> list T -> list T.
  fix REC 2.
  intros n l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    destruct n as [ | pn].
    {
      exact(tl :: rl).
    }
    {
      exact (REC pn rl).
    }
  }
Defined.

Definition prefixe{T : Type}
  : nat -> list T -> list T.
  fix REC 2.
  intros n l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    destruct n as [ | pn].
    {
      exact [].
    }
    {
      exact (tl :: (REC pn rl)).
    }
  }
Defined.

(* Sous-liste *)

Definition sousListeRF{T : Type}
  : list T -> Reglage Fenetre T.
  fix REC 1.
  intros l v.
  destruct l as [ | tl rl].
  {
    exact ([], v).
  }
  {
    destruct v as [n d].
    destruct n as [ | pn].
    {
      destruct d as [ | pd].
      {
        exact ([], PLAGE 0 0).
      }
      {
        exact (tl :: (fst (REC rl (PLAGE 0 pd))), snd (REC rl (PLAGE 0 pd))).
      }
    }
    {
      exact (REC rl (PLAGE pn d)).
    }
  }
Defined.

(* sous liste n d l := l[n:n+d[ *)
Definition sousListe{T : Type}
  : nat -> nat -> list T -> list T.
  fix REC 3.
  intros n d l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    destruct n as [ | pn].
    {
      destruct d as [ | pd].
      {
        exact [].
      }
      {
        exact (tl :: (REC 0 pd rl)).
      }
    }
    {
      exact (REC pn d rl).
    }
  }
Defined.

Definition valeur{T : Type}(n : nat)(l : list T)
  : list T
  := sousListe n 1 l.

(* concaténation monadique *)

Definition concatenationMonadiqueR{V T : Type}
  : Reglage V T -> Reglage V T -> Reglage V T
  := extensionMonadiqueFonctionBinaire
       (@Etat V)
       (@uniteEtat V)
       (@liaisonEtat V)
       (@app T).

(* Voie directe plus simple *)
Definition concatenationR{V T : Type}
  : Reglage V T -> Reglage V T -> Reglage V T.
  intros r1 r2.
  intro v.
  exact (
      fst (r1 v) ++ fst (r2 (snd(r1 v)))
      ,
      snd (r2 (snd(r1 v)))
      ).
Defined.