(** A list of moves [(src1, dst1), ..., (srcN, dstN)] can be given three different semantics, as environment transformers. The first semantics corresponds to a parallel assignment: [dst1, ..., dstN] are set to the initial values of [src1, ..., srcN]. *)
Fixpoint exec_par (m: moves) (e: env) {struct m}: env :=
match m with
| nil => e
| (s, d) :: m' => update d (e s) (exec_par m' e)
end.
(** The second semantics corresponds to a sequence of individual assignments: first, [dst1] is set to the initial value of [src1]; then, [dst2] is set to the current value of [src2] after the first assignment; etc. *)
Fixpoint exec_seq (m: moves) (e: env) {struct m}: env :=
match m with
| nil => e
| (s, d) :: m' => exec_seq m' (update d (e s) e)
end.
(** The third semantics is also sequential, but executes the moves in reverse order, starting with [srcN, dstN] and finishing with [src1, dst1]. *)
Fixpoint exec_seq_rev (m: moves) (e: env) {struct m}: env :=
match m with
| nil => e
| (s, d) :: m' =>
let e' := exec_seq_rev m' e in
update d (e' s) e'
end.
(** * Specification of the non-deterministic algorithm *)
(** Rideau and Serpette's parallel move compilation algorithm is first specified as a non-deterministic set of rewriting rules operating over triples [(mu, sigma, tau)] of moves.  We define these rules as an inductive predicate [transition] relating triples of moves, and its reflexive transitive closure [transitions]. *)
Inductive state: Type :=
State (mu: moves) (sigma: moves) (tau: moves) : state.
Definition no_read (mu: moves) (d: reg) : Prop :=
~In d (srcs mu).
Inductive transition: state -> state -> Prop :=
| tr_nop: forall mu1 r mu2 sigma tau,
transition (State (mu1 ++ (r, r) :: mu2) sigma tau)
(State (mu1 ++ mu2) sigma tau)
| tr_start: forall mu1 s d mu2 tau,
transition (State (mu1 ++ (s, d) :: mu2) nil tau)
(State (mu1 ++ mu2) ((s, d) :: nil) tau)
| tr_push: forall mu1 d r mu2 s sigma tau,
transition (State (mu1 ++ (d, r) :: mu2) ((s, d) :: sigma) tau)
(State (mu1 ++ mu2) ((d, r) :: (s, d) :: sigma) tau)
| tr_loop: forall mu sigma s d tau,
transition (State mu (sigma ++ (s, d) :: nil) tau)
(State mu (sigma ++ (temp s, d) :: nil) ((s, temp s) :: tau))
| tr_pop: forall mu s0 d0 s1 d1 sigma tau,
no_read mu d1 -> d1 <> s0 ->
transition (State mu ((s1, d1) :: sigma ++ (s0, d0) :: nil) tau)
(State mu (sigma ++ (s0, d0) :: nil) ((s1, d1) :: tau))
| tr_last: forall mu s d tau,
no_read mu d ->
transition (State mu ((s, d) :: nil) tau)
(State mu nil ((s, d) :: tau)).
Definition transitions: state -> state -> Prop :=
clos_refl_trans state transition.
(** ** Well-formedness properties of states *)
(** A state [mu, sigma, tau] is well-formed if the following properties hold:  - [mu] concatenated with [sigma] is a ``mill'', that is, no destination appears twice (predicate [is_mill] below). - No temporary register appears in [mu] (predicate [move_no_temp]). - No temporary register appears in [sigma] except perhaps as the source of the last move in [sigma] (predicate [temp_last]). - [sigma] is a ``path'', that is, the source of a move is the destination of the following move. *)
Definition is_mill (m: moves) : Prop :=
list_norepet (dests m).
Definition is_not_temp (r: reg) : Prop :=
forall d, r <> temp d.
Definition move_no_temp (m: moves) : Prop :=
forall s d, In (s, d) m -> is_not_temp s /\ is_not_temp d.
Definition temp_last (m: moves) : Prop :=
match List.rev m with
| nil => True
| (s, d) :: m' => is_not_temp d /\ move_no_temp m'
end.
Definition is_first_dest (m: moves) (d: reg) : Prop :=
match m with
| nil => True
| (s0, d0) :: _ => d = d0
end.
Inductive is_path: moves -> Prop :=
| is_path_nil:
is_path nil
| is_path_cons: forall s d m,
is_first_dest m s ->
is_path m ->
is_path ((s, d) :: m).
Inductive state_wf: state -> Prop :=
| state_wf_intro:
forall mu sigma tau,
is_mill (mu ++ sigma) ->
move_no_temp mu ->
temp_last sigma ->
is_path sigma ->
state_wf (State mu sigma tau).
(** Some trivial properties of srcs and dests. *)

(* Specifications: *)
Lemma dests_append:
forall m1 m2, dests (m1 ++ m2) = dests m1 ++ dests m2.
Lemma dests_decomp:
forall m1 s d m2, dests (m1 ++ (s, d) :: m2) = dests m1 ++ d :: dests m2.
Lemma srcs_append:
forall m1 m2, srcs (m1 ++ m2) = srcs m1 ++ srcs m2.
Lemma srcs_decomp:
forall m1 s d m2, srcs (m1 ++ (s, d) :: m2) = srcs m1 ++ s :: srcs m2.
Lemma srcs_dests_combine:
forall s d,
List.length s = List.length d ->
srcs (List.combine s d) = s /\
dests (List.combine s d) = d.
Lemma dests_append:
forall m1 m2, dests (m1 ++ m2) = dests m1 ++ dests m2.
Lemma dests_decomp:
forall m1 s d m2, dests (m1 ++ (s, d) :: m2) = dests m1 ++ d :: dests m2.
Lemma srcs_append:
forall m1 m2, srcs (m1 ++ m2) = srcs m1 ++ srcs m2.
Lemma srcs_decomp:
forall m1 s d m2, srcs (m1 ++ (s, d) :: m2) = srcs m1 ++ s :: srcs m2.
Lemma srcs_dests_combine:
forall s d,
List.length s = List.length d ->
srcs (List.combine s d) = s /\
dests (List.combine s d) = d.