Library iface

Require Import Relations.
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.

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.
Likewise for the non-stuttering version.
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.
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.
There is also a non-stuttering version.
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.
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.