Library prelim

Require Import base.
Require Import Arith.
Require Import Omega.

Class ObservationSystem := { O : Type; observations_inhabited : O }.

Class EM := { classic : forall P:Prop, P \/ ~P }.

Lemma NNPP {Classic:EM} : forall P:Prop, ~~P -> P.

Class LOGIC_INPUT :=
  { world : Type
  ; accessable : world -> world -> Prop

  ; accessable_refl : forall w, accessable w w
  ; accessable_trans : forall w1 w2 w3,
    accessable w1 w2 -> accessable w2 w3 -> accessable w1 w3

  ; atom : Type
  ; mode : Type

  ; interp_atom : atom -> world -> Prop

  ; interp_mode : mode -> (world -> Prop) -> world -> Prop
    
  ; interp_atom_accessable : forall a w1 w2,
    accessable w1 w2 -> interp_atom a w1 -> interp_atom a w2

  ; interp_mode_accessable : forall m (P:world -> Prop),
    (forall w1 w2, accessable w1 w2 -> P w1 -> P w2) ->
    (forall w1 w2, accessable w1 w2 ->
      interp_mode m P w1 -> interp_mode m P w2)

  ; interp_mode_monotone : forall m (P1 P2:world -> Prop),
    (forall w, P1 w -> P2 w) ->
    (forall w, interp_mode m P1 w -> interp_mode m P2 w)
  }.

Class ORDERED_LOGIC_INPUT (LI:LOGIC_INPUT) :=
  { order_mode : mode -> mode -> Prop
  ; order_mode_trans : forall m1 m2 m3,
    order_mode m1 m2 -> order_mode m2 m3 ->
    order_mode m1 m3
  ; order_mode_total : forall m1 m2,
     order_mode m1 m2 \/ m1 = m2 \/ order_mode m2 m1
  ; order_mode_wf : well_founded order_mode

  ; order_atom : atom -> atom -> Prop
  ; order_atom_trans : forall a1 a2 a3,
    order_atom a1 a2 -> order_atom a2 a3 ->
    order_atom a1 a3
  ; order_atom_total : forall a1 a2,
    order_atom a1 a2 \/ a1 = a2 \/ order_atom a2 a1
  ; order_atom_wf : well_founded order_atom
  }.

Inductive lift (X:Type) :=
  | into : forall (x:X), lift X
  | mho : lift X.
Implicit Arguments into [[X]].

Definition contains X (q:lift X) (x:X) :=
  match q with
  | into q' => q' = x
  | mho => False
  end.
Implicit Arguments contains.

Lemma contains_uniq : forall X (q:lift X),
  forall x y, contains q x -> contains q y -> x = y.

Lemma contains_eq : forall X (x y:lift X),
  contains x = contains y -> x = y.

Lemma contains_same : forall X (x y:lift X) (x' y':X),
  contains x x' -> contains y y' -> x' = y' -> x = y.

Lemma contains_nn : forall X (q:lift X),
  ~~(exists x, contains q x) -> exists x, contains q x.

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.

Definition lift_join A (x:lift (lift A)) : lift A :=
  match x with
    | into (into x') => into x'
    | _ => mho _
    end.
Implicit Arguments lift_join.



Lemma select_subset {Classic:EM} : forall A (l:list A) (P:A -> Prop),
  exists l',
    forall a, In a l' <-> (In a l /\ P a).

Definition inv {X Y} (R:X -> Y -> Prop) : Y -> X -> Prop
  := fun y x => R x y.

Definition comp {X Y Z} (R1:X -> Y -> Prop) (R2:Y -> Z -> Prop) : X -> Z -> Prop
  := fun x z => exists y, R1 x y /\ R2 y z.

Definition rel_union {X Y} (RP:(X -> Y -> Prop) -> Prop) x y :=
  exists R, RP R /\ R x y.

Definition set_map {A B} (f:A -> B) (P:A -> Prop) : B -> Prop :=
  fun b => exists a, P a /\ b = f a.

Definition set_map' {A B} (f:B -> A) (P:A -> Prop) : B -> Prop :=
  fun b => P (f b).

Lemma inv_intro : forall X Y (R:X -> Y -> Prop) x y,
  R x y -> inv R y x.

Lemma comp_intro : forall X Y Z (R1:X -> Y -> Prop) (R2:Y -> Z -> Prop),
  forall x y z, R1 x y -> R2 y z -> comp R1 R2 x z.

Lemma union_intro : forall X Y (RP:(X -> Y -> Prop) -> Prop) R x y,
  RP R -> R x y -> rel_union RP x y.

Hint Resolve inv_intro comp_intro union_intro.

Lemma inv_inv : forall X Y (R:X -> Y -> Prop),
  inv (inv R) = R.

Lemma inv_comp : forall X Y Z (R1:X -> Y -> Prop) (R2: Y -> Z -> Prop),
  inv (comp R1 R2) = comp (inv R2) (inv R1).

Lemma inv_union : forall X Y (RP:(X->Y->Prop) -> Prop),
  inv (rel_union RP) = rel_union (set_map inv RP).

Lemma inv_eq : forall X,
  inv eq = @eq X.

Definition lift_rel {X Y} (R:X -> Y -> Prop) (x:lift X) (y:lift Y) : Prop :=
  forall x0, contains x x0 -> exists y0, contains y y0 /\ R x0 y0.

Lemma lift_rel_incl : forall X Y (R:X -> Y -> Prop) x y,
  R x y ->
  lift_rel R (into x) (into y).

Lemma lift_rel_incl' : forall X Y (R:X -> Y -> Prop) x y,
  lift_rel R (into x) (into y) ->
  R x y.

Lemma lift_rel_mono : forall X Y (R1 R2:X -> Y -> Prop),
  (forall x y, R1 x y -> R2 x y) ->
  (forall x y, lift_rel R1 x y -> lift_rel R2 x y).

Lemma lift_rel_comp : forall X Y Z (R1:X -> Y -> Prop) (R2:Y -> Z -> Prop) x z,
  comp (lift_rel R1) (lift_rel R2) x z ->
  lift_rel (comp R1 R2) x z.

Hint Resolve lift_rel_comp lift_rel_incl.

Lemma impossible_list : forall A (l1 l2 l3:list A) a,
  l1 = l2 ++ a :: l3 ++ l1 -> False.

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.

  Lemma path_rt : forall P x1 x2,
    path_where P x1 x2 -> clos_refl_trans X R x1 x2.

  Lemma path_cons_right : forall P x1 x2 x3,
    path_where P x1 x2 ->
    P x2 ->
    R x2 x3 ->
    path_where P x1 x3.

  Lemma path_trans : forall P x1 x2 x3,
    path_where P x1 x2 ->
    path_where P x2 x3 ->
    path_where P x1 x3.

  Lemma 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).

  Lemma 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.