Require Import Relations. (* Standard library module *)
Module Type COMPILER_INTERFACE.
(** This typeclass is a simple organizational trick that allows
me to get close to the informal mathematical practice
of saying "fix in advance a set O of observations." *)
Class ObservationSystem :=
{ O : Type; observations_inhabited : O }.
(** The inverse of a relation. *)
Definition inv {X Y} (R:X -> Y -> Prop) : Y -> X -> Prop
:= fun y x => R x y.
(** The lift of a type. This type is essntially the same as option,
but with different names for the constructors to avoid confusion. *)
Inductive lift (X:Type) :=
| into : forall (x:X), lift X
| mho : lift X.
Implicit Arguments into [[X]].
(** Defines when a lifted state [q] contains an actual state [x]. *)
Definition contains X (q:lift X) (x:X) :=
match q with
| into q' => q' = x
| mho => False
end.
Implicit Arguments contains.
(** Some basic facts about contains. *)
Axiom contains_uniq : forall X (q:lift X),
forall x y, contains q x -> contains q y -> x = y.
Axiom contains_eq : forall X (x y:lift X),
contains x = contains y -> x = y.
Axiom contains_same : forall X (x y:lift X) (x' y':X),
contains x x' -> contains y y' -> x' = y' -> x = y.
Definition lift_map A B (f:A -> B) (x:lift A) : lift B :=
match x with
| into x' => into (f x')
| mho => mho _
end.
Implicit Arguments lift_map.
(** The defininition of and a few simple facts about paths.
This definition of paths is slightly different from the
one presented earlier in that it does not require the
final state in the path to satisfy the property [P].
This definition is slightly more convenient. *)
Section paths.
Variables X:Type.
Variable R:X -> X -> Prop.
Inductive path_where (P:X -> Prop) : X -> X -> Prop :=
| path_nil : forall x, path_where P x x
| path_cons : forall x1 x2 x3,
P x1 -> R x1 x2 ->
path_where P x2 x3 ->
path_where P x1 x3.
Axiom path_rt : forall P x1 x2,
path_where P x1 x2 -> clos_refl_trans X R x1 x2.
Axiom path_cons_right : forall P x1 x2 x3,
path_where P x1 x2 ->
P x2 -> R x2 x3 ->
path_where P x1 x3.
Axiom path_trans : forall P x1 x2 x3,
path_where P x1 x2 ->
path_where P x2 x3 ->
path_where P x1 x3.
Axiom path_inv_right : forall P x1 x2,
path_where P x1 x2 ->
x1 = x2 \/
(exists x',
path_where P x1 x' /\
P x' /\ R x' x2).
Axiom path_where_incl : forall (P1 P2: X -> Prop) x1 x2,
path_where P1 x1 x2 ->
(forall x, P1 x -> P2 x) ->
path_where P2 x1 x2.
End paths.
(** Now we get to the meat of the interface. Here, we define
tau-ELTSs and the notions of refinement we want. This
is all done in a section to make it easy for all the
definitions to refer to the [ObservationSystem]
declared at the beginning. *)
Section compiler_interface. Context {Obs:ObservationSystem}.
(** Coq does not provide useful induction schemes for the
inductive refinements below, so we turn off automatic
generation of induction schemes and do it manually. *)
Unset Elimination Schemes.
(** This record defines what I call a tau-ELTS in the
main body of the thesis. [None] represents
tau actions, and [Some x] represent observable action [x]. *)
Record LTS :=
{ state : Type
; steps : state -> option O -> lift state -> Prop
}.
Definition lstate X := lift (state X).
(** May and must stepping are defined in a slightly different
(but equivalent) way to the main body of the thesis. *)
Definition must_step (X:LTS) (s:lstate X) o (s':lstate X) :=
exists s_, contains s s_ /\ steps X s_ o s'.
Definition may_step (X:LTS) (s:lstate X) o (s':lstate X) :=
(forall s_, contains s s_ -> steps X s_ o s') /\
(forall s'_, contains s' s'_ -> exists s_, contains s s_).
Definition must_step_star (X:LTS) :=
clos_refl_trans (lstate X) (fun s s' => must_step X s None s').
Definition may_step_star (X:LTS) :=
clos_refl_trans (lstate X) (fun s s' => may_step X s None s').
(** A few frequently-useful facts about may and must stepping. *)
Axiom must_may_step : forall X s o s',
must_step X s o s' ->
may_step X s o s'.
Axiom may_step_step : forall A a o a',
may_step A (into a) o a' ->
steps A a o a'.
Axiom must_may_step_star : forall X x y,
must_step_star X x y ->
may_step_star X x y.
(** A [transition_diagram] is the body of an operator on relations.
All the refinements I define below are explicitly built as
the Knaster-Tarski greatest fixpoint of such an operator. *)
Definition transition_diagram :=
forall (X Y:LTS) (R:lstate X -> lstate Y -> Prop), lstate X -> lstate Y -> Prop.
(** [td_and] allows us to combine two transition diagrams by conjunction. *)
Definition td_and (T1 T2:transition_diagram) : transition_diagram :=
fun X Y R x y => T1 X Y R x y /\ T2 X Y R x y.
(** A relation [R] is a refinement of type [T] if every pair in
the relation is also in [T] applied to [R]. *)
Definition refinement (T:transition_diagram) X Y (R:lstate X -> lstate Y -> Prop) :=
forall x y, R x y -> T X Y R x y.
(** A relation [R] is a bisimulation of type [T] iff it is a refinement
and its inverse is a refinement. *)
Definition bisimulation (T:transition_diagram) X Y (R:lstate X -> lstate Y -> Prop) :=
forall x y, R x y -> T X Y R x y /\ T Y X (inv R) y x.
(** [x] is refined by [y] if there is a refinement relation
that relates them. This definition constructs the
greatest fixpoint of the operator [T] *)
Definition refines T X Y x y :=
exists R, refinement T X Y R /\ R x y.
(** [x] is bisimilar by [y] if there is a bisimulation relation
that relates them. This definition constructs the
greatest fixpoint of the operator [T] conjoined
with its inverse. *)
Definition bisimilar T X Y x y :=
exists R, bisimulation T X Y R /\ R x y.
(** Bisimilarity is symmetric, by construction. *)
Axiom bisimilar_sym : forall T X Y x y,
bisimilar T X Y x y -> bisimilar T Y X y x.
(** The next few propositions allow us to
break apart and put together compound refinements. *)
Axiom refinement_and : forall T1 T2 X Y R,
refinement T1 X Y R ->
refinement T2 X Y R ->
refinement (td_and T1 T2) X Y R.
Axiom and_refinement : forall T1 T2 X Y R,
refinement (td_and T1 T2) X Y R ->
refinement T1 X Y R /\ refinement T2 X Y R.
Axiom bisimulation_and : forall T1 T2 X Y R,
bisimulation T1 X Y R ->
bisimulation T2 X Y R ->
bisimulation (td_and T1 T2) X Y R.
Axiom and_bisimulation : forall T1 T2 X Y R,
bisimulation (td_and T1 T2) X Y R ->
bisimulation T1 X Y R /\ bisimulation T2 X Y R.
(** The inductive version of branching behavioral refinement. *)
Inductive branch_forward_ind X Y R : lstate X -> lstate Y -> Prop :=
branch_forward_ind_intro : forall x y,
(forall o x', must_step X x o x' ->
(o = None /\ R x' y /\ branch_forward_ind X Y R x' y) \/
exists y', exists y'',
path_where _ (fun a b => must_step Y a None b) (R x) y y' /\
must_step Y y' o y'' /\ R x y' /\ R x' y'') ->
branch_forward_ind X Y R x y.
Inductive branch_backward_ind X Y R : lstate X -> lstate Y -> Prop :=
branch_backward_ind_intro : forall x y,
(forall o y', may_step Y y o y' ->
(o = None /\ R x y' /\ branch_backward_ind X Y R x y') \/
exists x', exists x'',
path_where _ (fun a b => may_step X a None b) (fun x => R x y) x x' /\
may_step X x' o x'' /\ R x' y /\ R x'' y') ->
branch_backward_ind X Y R x y.
(** The induction schemes for branching behavioral refinement *)
Axiom branch_forward_ind_ind
: forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
(forall (x : lstate X) (y : lstate Y),
(forall (o : option O) (x' : lstate X),
must_step X x o x' ->
o = None /\ R x' y /\ P x' y \/
(exists y' : lstate Y,
exists y'' : lstate Y,
path_where (lstate Y)
(fun a b : lstate Y => must_step Y a None b)
(R x) y y' /\ must_step Y y' o y'' /\ R x y' /\ R x' y'')) ->
P x y) ->
forall (l : lstate X) (l0 : lstate Y),
branch_forward_ind X Y R l l0 -> P l l0.
Axiom branch_backward_ind_ind
: forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
(forall (x : lstate X) (y : lstate Y),
(forall (o : option O) (y' : lstate Y),
may_step Y y o y' ->
o = None /\ R x y' /\ P x y' \/
(exists x' : lstate X,
exists x'' : lstate X,
path_where (lstate X)
(fun a b : lstate X => may_step X a None b)
(fun x0 : lstate X => R x0 y) x x' /\
may_step X x' o x'' /\ R x' y /\ R x'' y')) ->
P x y) ->
forall (l : lstate X) (l0 : lstate Y),
branch_backward_ind X Y R l l0 -> P l l0.
(** The inductive version of branching behavioral refinement,
without stuttering. These are called inductive
pre-branching behavioral refinements in the body of the thesis. *)
Inductive branch_forward_ind_no_stutter X Y R : lstate X -> lstate Y -> Prop :=
branch_forward_ind_no_sutter_intro : forall x y,
(forall o x', must_step X x o x' ->
(o = None /\ R x' y /\ branch_forward_ind_no_stutter X Y R x' y) \/
exists y', exists y'',
must_step_star Y y y' /\
must_step Y y' o y'' /\ R x y' /\ R x' y'') ->
branch_forward_ind_no_stutter X Y R x y.
Inductive branch_backward_ind_no_stutter X Y R : lstate X -> lstate Y -> Prop :=
branch_backward_ind_no_stutter_intro : forall x y,
(forall o y', may_step Y y o y' ->
(o = None /\ R x y' /\ branch_backward_ind_no_stutter X Y R x y') \/
exists x', exists x'',
may_step_star X x x' /\
may_step X x' o x'' /\ R x' y /\ R x'' y') ->
branch_backward_ind_no_stutter X Y R x y.
(** The induction schemes for non-stuttering branching
behavioral refinement. *)
Axiom branch_forward_ind_no_stutter_ind
: forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
(forall (x : lstate X) (y : lstate Y),
(forall (o : option O) (x' : lstate X),
must_step X x o x' ->
o = None /\ R x' y /\ P x' y \/
(exists y' : lstate Y,
exists y'' : lstate Y,
must_step_star Y y y' /\
must_step Y y' o y'' /\ R x y' /\ R x' y'')) ->
P x y) ->
forall (l : lstate X) (l0 : lstate Y),
branch_forward_ind_no_stutter X Y R l l0 -> P l l0.
Axiom branch_backward_ind_no_stutter_ind
: forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
(forall (x : lstate X) (y : lstate Y),
(forall (o : option O) (y' : lstate Y),
may_step Y y o y' ->
o = None /\ R x y' /\ P x y' \/
(exists x' : lstate X,
exists x'' : lstate X,
may_step_star X x x' /\
may_step X x' o x'' /\ R x' y /\ R x'' y')) ->
P x y) ->
forall (l : lstate X) (l0 : lstate Y),
branch_backward_ind_no_stutter X Y R l l0 -> P l l0.
(** The transition diagram for inductive branching behavioral refinement is
just the conjunction of the forward and backward directions. *)
Definition branch_ind : transition_diagram :=
td_and branch_forward_ind branch_backward_ind.
(** Likewise for the non-stuttering version. *)
Definition branch_ind_no_stutter : transition_diagram :=
td_and branch_forward_ind_no_stutter branch_backward_ind_no_stutter.
(** Once we take the greatest fixpoint, the stuttering and non-stuttering
refinements are the same. *)
Axiom branch_ind_stutter_eq : forall X Y x y,
refines branch_ind X Y x y <-> refines branch_ind_no_stutter X Y x y.
Axiom bisim_branch_ind_stutter_eq : forall X Y x y,
bisimilar branch_ind X Y x y <-> bisimilar branch_ind_no_stutter X Y x y.
(** Inductive branching behavioral refinement is a preorder. *)
Axiom refines_ind_refl : forall X x,
refines branch_ind X X x x.
Axiom refines_ind_trans : forall X Y Z x y z,
refines branch_ind X Y x y ->
refines branch_ind Y Z y z ->
refines branch_ind X Z x z.
(** Inductive branching behavioral bisimulation is an equivalence. *)
Axiom bisim_ind_refl : forall X x,
bisimilar branch_ind X X x x.
Axiom bisim_ind_trans : forall X Y Z x y z,
bisimilar branch_ind X Y x y ->
bisimilar branch_ind Y Z y z ->
bisimilar branch_ind X Z x z.
(** These refinements are fixpoints of their generating operators. *)
Axiom refines_ind_refinement : forall X Y,
refinement branch_ind X Y (refines branch_ind X Y).
Axiom refines_ind_no_stutter_refinement : forall A B,
refinement branch_ind_no_stutter A B (refines branch_ind_no_stutter A B).
(** [x] enables the observation [o] if there is some transition
from [x] producing [o] *)
Definition enables {X:LTS} (x:lstate X) (o:option O) :=
exists x', must_step X x o x'.
(** This is the inductive presentation of the forward direction of
choice refinement. It is equal to the version presented in
the main body of the thesis (up to the excluded middle). *)
Inductive choice_forward (X Y:LTS) (R:lstate X -> lstate Y -> Prop) (y:lstate Y) :
lstate X -> Prop :=
| choice_forward_intro : forall x,
R x y ->
(forall o, enables x o ->
enables y o \/ enables y None \/
(exists x', must_step X x None x' /\ choice_forward X Y R y x')) ->
choice_forward X Y R y x.
(** The induction scheme for the forward direction of choice refinement. *)
Axiom choice_forward_ind
: forall (X Y : LTS) (R : lstate X -> lstate Y -> Prop)
(y : lstate Y) (P : lstate X -> Prop),
(forall x : lstate X,
R x y ->
(forall o, enables x o ->
enables y o \/ enables y None \/
exists x' : lstate X, must_step X x None x' /\ P x') ->
P x) -> forall s : lstate X, choice_forward X Y R y s -> P s.
(** We needed to state the inductive definition with the
desired order of arguements reversed, so this definition flips them. *)
Definition choice_forward' X Y R x y := choice_forward X Y R y x.
(** Choice refinement is the forward choice direction conjoined
with the backward direction of behavioral refinement. *)
Definition choice : transition_diagram :=
td_and choice_forward' branch_backward_ind.
(** There is also a non-stuttering version. *)
Definition choice_no_stutter : transition_diagram :=
td_and choice_forward' branch_backward_ind_no_stutter.
(** The non-stuttering version is the same, once we take the fixpoint. *)
Axiom stuttering_choice_refines_eq : forall X Y x y,
refines choice_no_stutter X Y x y <-> refines choice X Y x y.
(** Behavioral choice refinement is a preorder. *)
Axiom refines_choice_refl : forall A x,
refines choice A A x x.
Axiom choice_refines_trans : forall X Y Z x y z,
refines choice X Y x y ->
refines choice Y Z y z ->
refines choice X Z x z.
(** Both version are the fixpoints of their generating operators. *)
Axiom refines_choice_refinement : forall A B,
refinement choice A B (refines choice A B).
Axiom refines_choice_no_stutter_refinement : forall A B,
refinement choice_no_stutter A B (refines choice_no_stutter A B).
(** Behavioral refinement implies choice refinement. *)
Axiom refines_branch_ind_choice : forall X Y x y,
refines branch_ind X Y x y ->
refines choice X Y x y.
(** The remaining definitions and propositions are useful for reasoning
about undefined behavior. *)
Definition void_lts : LTS := Build_LTS Empty_set (fun _ _ _ => False).
Axiom refines_ind_mho : forall X Y y,
refines branch_ind X Y (mho _) y.
Axiom refines_ind_mho_step_star : forall A B x,
refines branch_ind A B x (mho _) ->
must_step_star A x (mho _).
Axiom refines_ind_mho_tau : forall X Y x o x',
refines branch_ind X Y x (mho _) ->
may_step X x o x' ->
refines branch_ind X Y x' (mho _).
Definition reachable' (X:LTS) : lstate X -> lstate X -> Prop :=
clos_refl_trans _ (fun a b => exists o, may_step X a o b).
Axiom refines_ind_mho_star : forall X Y x x',
refines branch_ind X Y x (mho _) ->
reachable' X x x' ->
refines branch_ind X Y x' (mho _).
Axiom choice_refines_mho_step_star : forall A B x,
refines choice A B x (mho _) ->
must_step_star A x (mho _).
Axiom refines_mho_forward_no_stutter : forall A B C (R:lstate A -> lstate B -> Prop) a,
(forall x, refines branch_ind A C x (mho _) -> R x (mho _)) ->
refines branch_ind A C a (mho _) ->
branch_forward_ind_no_stutter A B R a (mho _).
Inductive goes_wrong (X:LTS) : lstate X -> Prop :=
| go_wrong_now : goes_wrong X (mho _)
| go_wrong_later : forall x,
(exists x', steps X x None x') ->
(forall o x', steps X x o x' -> o = None /\ goes_wrong X x') ->
goes_wrong X (into x).
Axiom goes_wrong_ind
: forall (X : LTS) (P : lstate X -> Prop),
P (mho (state X)) ->
(forall x : state X,
(exists x', steps X x None x') ->
(forall (o : option O) (x' : lift (state X)),
steps X x o x' -> o = None /\ P x') ->
P (into x)) -> forall l : lstate X, goes_wrong X l -> P l.
Axiom refines_ind_mho_goes_wrong : forall A B x,
refines branch_ind A B x (mho _) ->
goes_wrong A x.
Axiom refines_ind_goes_wrong : forall A B x y,
refines branch_ind A B x y ->
goes_wrong B y -> goes_wrong A x.
Axiom prove_branch_ind_bisim : forall A B R,
refinement branch_forward_ind_no_stutter A B R ->
refinement branch_forward_ind_no_stutter B A (inv R) ->
(forall x y, R x y -> goes_wrong B y -> goes_wrong A x) ->
(forall x y, R x y -> goes_wrong A x -> goes_wrong B y) ->
(forall x y, R x y -> bisimilar branch_ind A B x y).
End compiler_interface.
Hint Resolve @must_may_step.
End COMPILER_INTERFACE.
(** These are imports from the main proof development. We will
use these to impliement the module type just defined. *)
Require prelim.
Require lts_ref.
Require branch_ref.
Require choice_beh_ref.
(** The interface we defined above is literally just a subset
of the overall development. *)
Module CompilerInterface <: COMPILER_INTERFACE.
Include prelim.
Include branch_ref.BRANCH_REF.
Include choice_beh_ref.CHOICE_BEH_REF.
End CompilerInterface.
(** For some reason, Coq doesn't allow the previous module
to be matched opaquely, but it will allow the following
definition, which does match opaquely. I don't know why. *)
Module CI : COMPILER_INTERFACE := CompilerInterface.