Library bf_ref_logic

Require Import base.
Require Import prelim.
Require Import lts_ref.
Require Import branch_ref.
Require Import back_forth_ref.
Require Import logic.

Module BF_REF_LOGIC.
Section bf_ref_logic. Context {Obs:ObservationSystem}.
Import BF_REF. Import BRANCH_REF.

  Inductive bf_mode : Type :=
  | dia : option O -> bf_mode
  | dia_back : option O -> bf_mode
  | box : option O -> bf_mode
  | box_back : option O -> bf_mode.

  Definition bf_interp_mode (m:bf_mode) (P:history -> Prop) (w:history) : Prop :=
    match m with
      | dia o =>
        exists h, weak_must_extend (hsys w) (hrun w) o h /\ P {| hsys := hsys w; hrun := h |}
      | dia_back o =>
        exists h, weak_may_extend (hsys w) h o (hrun w) /\ P {| hsys := hsys w; hrun := h |}
      | box o =>
        forall h, weak_may_extend (hsys w) (hrun w) o h -> P {| hsys := hsys w; hrun := h |}
      | box_back o =>
        forall h, weak_may_extend (hsys w) h o (hrun w) -> P {| hsys := hsys w; hrun := h |}
    end.

  Program Instance bf_ref_div_logic_input : LOGIC_INPUT :=
  { world := history
  ; accessable := hist_accessable back_forth
  ; mode := bf_mode
  ; atom := Empty_set
  ; interp_mode := bf_interp_mode
  ; interp_atom a := match a with end
  }.

  Import MuCalc.

  Lemma proof_dual1 : forall ob (P Q:cformula o),
    entails P (modality _ _ o (box ob) Q) <->
    entails (modality _ _ o (dia_back ob) P) Q.

  Lemma proof_dual2 : forall ob (P Q:cformula o),
    entails P (modality _ _ o (box_back ob) Q) ->
    entails (modality _ _ o (dia ob) P) Q.

  Definition classical_world w :=
      forall t (f:cformula t) z,
        interp_cformula t (f_or f (neg f)) z w.

  Let E0 := emptyE.

  Definition safety : formula emptyE emptyE o :=
      nu E0 E0 o
        (conj' (fun ob:option O =>
           f_and (modality _ _ o (box ob) (var E0 (extend E0 o) None))
          (f_and (modality _ _ o (box_back ob) (var E0 (extend E0 o) None))
            (f_or (modality _ _ o (box ob) FF)
                  (modality _ _ o (dia ob) TT))))).

  Lemma safety_defined : forall X (s:run X) (ob:O),
    interp_cformula _ safety tt (hst s) ->
    exists x, contains (curr s) x.

  Lemma safe_classical {Classic:EM} : forall X (s:run X) (ob:O),
    safe_run X s -> classical_world (hst s).

  Section safeify.
    Variable X:LTS.

    Definition safeify_state := option (state X).
    Definition safeify_steps s ob s' :=
      match s with
      | None => contains s' None
      | Some s0 =>
          match s' with
          | into (Some s0') => steps X s0 ob (into s0')
          | into None => steps X s0 ob (mho _)
          | mho => False
          end
      end.

    Definition safeify : LTS :=
    {| state := safeify_state
     ; steps := safeify_steps
     |}.

    Program Definition mk_safeify (st:lift (state X)) : lift (option (state X)) :=
      match st with
      | into x => into (Some x)
      | mho => into None
      end.

    Program Definition unsafeify (st:lift (option (state X))) : lift (state X) :=
      match st with
      | into (Some x) => into x
      | _ => mho _
      end.

    Lemma safeify_refines : forall s,
      refines branch X safeify s (mk_safeify s).

    Lemma safeify_safe : forall s,
      safe_state safeify (into s).

    Lemma safeify_safe' : forall s,
      safe_state safeify (mk_safeify s).

    Fixpoint safeify_prerun (l:prerun X) : prerun safeify :=
      match l with
      | nil => nil
      | (x,a)::l => (mk_safeify x,a)::safeify_prerun l
      end.

    Program Definition safeify_run (r:run X) : run safeify :=
      {| curr := mk_safeify (curr r)
       ; prev := safeify_prerun (prev r) |}.

    Lemma safeify_run_safe : forall r,
      safe_run safeify (safeify_run r).

    Lemma safeify_run_acc : forall r,
      prelim.accessable (hst r) (hst (safeify_run r)).
  End safeify.

  Fixpoint initial_state_prerun X (c:lstate X) (r:prerun X) : lstate X :=
    match r with
    | nil => c
    | (x,_)::r' => initial_state_prerun X x r'
    end.

  Definition initial_state X (r:run X) := initial_state_prerun X (curr r) (prev r).

  Lemma safe_run_initial : forall X r,
    safe_run X r <-> safe_state X (initial_state X r).

  Program Definition safe_run_model (obs:O) : model o :=
    fun _ w => safe_run (hsys w) (hrun w).

  Lemma may_extend_initial : forall X h a h',
    may_extend X h a h' ->
    initial_state X h = initial_state X h'.

  Lemma weak_may_extend_initial : forall X h a h',
    weak_may_extend X h a h' ->
    initial_state X h = initial_state X h'.

  Lemma neg_safety_unsat {Classic:EM} (obs:O) : forall w,
    ~interp_cformula o (neg safety) tt w.

  Lemma classical_safety {Classic:EM} (obs:O) : forall w,
    classical_world w ->
    interp_cformula o safety tt w.

  Lemma safety_safe_curr : forall X (s:run X) (ob:O),
    interp_cformula _ safety tt (hst s) ->
    safe_state X (curr s).

  Lemma safety_safe_prerun : forall X (s:run X) (ob:O),
    interp_cformula _ safety tt (hst s) ->
    safe_prerun X (prev s).

  Lemma safety_safe_run : forall X (s:run X) (ob:O),
    interp_cformula _ safety tt (hst s) ->
    safe_run X s.

  Definition safe_world (w:prelim.world) := safe_run _ (hrun w).

  Theorem safe_classification {Classic:EM} : forall (ob:O) w,
    (safe_world w <-> classical_world w) /\
    (safe_world w <-> interp_cformula o safety tt w).

  Section characteristic.
    Variable X:LTS.
    Let E1 := extend emptyE (arr (run X) o).

    Definition CF_body (h:run X) (ob:option O) : formula E0 E1 o :=
       f_and (conj' (fun x':{ h' | weak_must_extend X h ob h'} => modality E0 E1 o (dia ob) (app (var E0 E1 None) (proj1_sig x'))))
      (f_and (conj' (fun x':{ h' | weak_may_extend X h' ob h} => modality E0 E1 o (dia_back ob) (app (var E0 E1 None) (proj1_sig x'))))
      (f_and (modality E0 E1 o (box ob) (disj' (fun x':{ h' | weak_may_extend X h ob h'} => (app (var E0 E1 None) (proj1_sig x')))))
             (modality E0 E1 o (box_back ob) (disj' (fun x':{ h' | weak_may_extend X h' ob h} => (app (var E0 E1 None) (proj1_sig x')))))
      )).

    Definition CF_main : formula E0 E0 (arr (run X) o) :=
      nu E0 E0 (arr (run X) o)
        (lam E0 E1 (run X) o (fun h:run X =>
          (conj' (fun ob:option O => CF_body h ob))
        )).

    Lemma characteristic_self : forall s,
      interp_cformula _ CF_main (s,tt) (hst s).

    Lemma characteristic_other : forall s w,
      interp_cformula _ CF_main (s,tt) w ->
      prelim.accessable (hst s) w.
  End characteristic.

  Definition CF (w:prelim.world) : cformula o :=
    app (CF_main (hsys w)) (hrun w).

  Theorem CF_is_characteristic : characteristic_formula CF.

  Theorem completeness : forall w w',
    prelim.accessable w w' <->
    (forall t (f:formula E0 E0 t) z,
      interp_cformula t f z w -> interp_cformula t f z w').

  Theorem models_denotable : forall t (X:model t), exists f:cformula t,
    interp_cformula t f = X.

End bf_ref_logic.
End BF_REF_LOGIC.