Library logic

Require Import base.
Require Import prelim.

Module MuCalc.
Section mucalc. Context {LI:LOGIC_INPUT}.

  Hint Resolve accessable_refl accessable_trans.

  Definition kripke_monotone (X:world -> Prop) :=
    forall w w', accessable w w' -> X w -> X w'.

  Inductive typ :=
  | o : typ
  | arr : Type -> typ -> typ.

  Record env :=
    { Vars : Type
    ; Vars_dec : forall v v':Vars, {v=v'}+{v<>v'}
    ; Vars_typ : Vars -> typ
    }.

  Definition emptyE : env :=
  {| Vars := Empty_set
   ; Vars_dec := fun v _ => match v with end
   ; Vars_typ := fun v => match v with end
   |}.

  Program Definition extend (E:env) (t:typ) :=
    {| Vars := option (Vars E)
     ; Vars_typ := fun v => match v with None => t | Some v' => Vars_typ E v' end
     |}.

  Inductive formula (EN:env) (EP:env) : typ -> Type :=
  | atomic : forall (a:atom), formula EN EP o
  | var : forall v:Vars EP, formula EN EP (Vars_typ EP v)
  | modality : forall x, mode -> formula EN EP x -> formula EN EP x
  | impl : forall x, formula EP EN x -> formula EN EP x -> formula EN EP x
  | mu : forall x, formula EN (extend EP x) x -> formula EN EP x
  | nu : forall x, formula EN (extend EP x) x -> formula EN EP x
  | conj : forall A x, formula EN EP (arr A x) -> formula EN EP x
  | disj : forall A x, formula EN EP (arr A x) -> formula EN EP x
  | lam : forall A x, (A -> formula EN EP x) -> formula EN EP (arr A x)
  | app : forall A x, formula EN EP (arr A x) -> (A -> formula EN EP x).

  Definition conj' {X Y A x} (f:A -> formula X Y x) := conj X Y A x (lam X Y A x f).
  Definition disj' {X Y A x} (f:A -> formula X Y x) := disj X Y A x (lam X Y A x f).
  Definition nu' {X Y A x} f := nu X Y (arr A x) (lam _ _ _ _ f).
  Definition mu' {X Y A x} f := mu X Y (arr A x) (lam _ _ _ _ f).
  Global Implicit Arguments app.
  Global Implicit Arguments var.

  Definition TT {X Y x} : formula X Y x := conj' (fun v:Empty_set => match v with end).
  Definition FF {X Y x} : formula X Y x := disj' (fun v:Empty_set => match v with end).
  Definition f_and {X Y x} (f1 f2:formula X Y x) := conj' (fun x:bool => if x then f1 else f2).
  Definition f_or {X Y x} (f1 f2:formula X Y x) := disj' (fun x:bool => if x then f1 else f2).
  Definition neg {X Y x} (f:formula Y X x) := impl X Y x f FF.

  Fixpoint extend_many (xs:list typ) (E:env) :=
  match xs with
    | nil => E
    | x::xs => extend (extend_many xs E) x
  end.

  Fixpoint extend_many' (xs:list typ) (E:env) :=
  match xs with
    | nil => E
    | x::xs => extend_many' xs (extend E x)
  end.

  Fixpoint shift_var (x:typ) xs ys (EN EP:env)
  (inj:forall X (v:Vars X),
    formula EN (extend_many' ys X) (Vars_typ X v)) :
  forall
    (v:Vars (extend_many xs EP)),
    formula EN (extend_many' ys (extend_many xs (extend EP x))) (Vars_typ (extend_many xs EP) v) :=
    
    match xs as xs' return
      forall
        (v:Vars (extend_many xs' EP)),
        formula EN (extend_many' ys (extend_many xs' (extend EP x))) (Vars_typ (extend_many xs' EP) v)
    with
    | nil => fun v => inj (extend EP x) (Some v)
    | x'::xs' => fun v =>
      match v as v' return
       formula EN (extend_many' ys (extend_many (x'::xs') (extend EP x))) (Vars_typ (extend_many (x'::xs') EP) v')
      with
       | None => inj (extend_many (x'::xs') (extend EP x)) None
       | Some v' =>
         shift_var x xs' (x'::ys) EN EP (fun X v => inj (extend X x') (Some v)) v'
       end
    end.

  Definition shift_var' : forall (x:typ) xs (EN EP:env) (v:Vars (extend_many xs EP)),
  formula EN (extend_many xs (extend EP x)) (Vars_typ (extend_many xs EP) v) :=

    fun x xs EN EP => shift_var x xs nil EN EP (fun X v => var EN _ v).

  Fixpoint shift (x:typ) xs (EN EP:env) t (f:formula EN (extend_many xs EP) t) : formula EN (extend_many xs (extend EP x)) t :=
  match f in (formula _ _ t') return formula EN (extend_many xs (extend EP x)) t' with
    | atomic a => atomic _ _ a
    | var v => shift_var' x xs EN EP v
    | impl t f1 f2 => impl _ _ t (shift_neg x xs EN EP t f1) (shift x xs EN EP t f2)
    | modality t m f => modality _ _ t m (shift x xs EN EP t f)
    | conj A t f => conj _ _ A t (shift x xs EN EP _ f)
    | disj A t f => disj _ _ A t (shift x xs EN EP _ f)
    | mu x' f => mu _ _ x' (shift x (x'::xs) EN EP _ f)
    | nu x' f => nu _ _ x' (shift x (x'::xs) EN EP _ f)
    | lam A x' f => lam _ _ A x' (fun a:A => shift x xs EN EP _ (f a))
    | app A x' f a => @app _ _ A x' (shift x xs EN EP _ f) a
  end with shift_neg (x:typ) xs (EN EP:env) t (f:formula (extend_many xs EP) EN t) : formula (extend_many xs (extend EP x)) EN t :=
  match f in (formula _ _ t') return formula (extend_many xs (extend EP x)) EN t' with
    | atomic a => atomic _ _ a
    | var v => var _ _ v
    | impl t f1 f2 => impl _ _ t (shift x xs EN EP t f1) (shift_neg x xs EN EP t f2)
    | modality t m f => modality _ _ t m (shift_neg x xs EN EP t f)
    | conj A t f => conj _ _ A t (shift_neg x xs EN EP _ f)
    | disj A t f => disj _ _ A t (shift_neg x xs EN EP _ f)
    | mu x' f => mu _ _ x' (shift_neg x xs (extend EN x') EP _ f)
    | nu x' f => nu _ _ x' (shift_neg x xs (extend EN x') EP _ f)
    | lam A x' f => lam _ _ A x' (fun a:A => shift_neg x xs EN EP _ (f a))
    | app A x' f a => @app _ _ A x' (shift_neg x xs EN EP _ f) a
  end.

  Fixpoint shift_neg_many EN EP ys x (f':formula EN EP x) :
    formula (extend_many ys EN) EP x :=
  match ys as ys' return
    formula (extend_many ys' EN) EP x
  with
    | nil => f'
    | y'::ys' => shift_neg y' nil _ _ x (shift_neg_many EN EP ys' x f')
  end.

  Fixpoint replace_var EN EP x xs ys : forall
    (v:Vars (extend_many xs (extend EP x)))
    (f':formula EN EP x),
    (formula (extend_many ys EN) (extend_many xs EP) (Vars_typ (extend_many xs (extend EP x)) v)) :=

    match xs as xs' return forall
        (v:Vars (extend_many xs' (extend EP x)))
        (f':formula EN EP x),
        (formula (extend_many ys EN) (extend_many xs' EP) (Vars_typ (extend_many xs' (extend EP x)) v)) with

    | nil => fun v f' =>
        match v as v' return
          (formula (extend_many ys EN) EP (Vars_typ (extend EP x) v')) with
        | None => shift_neg_many EN EP ys x f'
        | Some v' => var _ EP v'
        end
    | x'::xs' => fun v f' =>
        match v as v' return
          (formula (extend_many ys EN) (extend_many (x'::xs') EP) (Vars_typ (extend_many (x'::xs') (extend EP x)) v')) with
        | None => var _ (extend_many (x'::xs') EP) None
        | Some v' => shift x' nil _ _ _ (replace_var EN EP x xs' ys v' f')
        end
    end.

  Fixpoint subst EN EP x xs ys t (f:formula (extend_many ys EN) (extend_many xs (extend EP x)) t)
                                 (f':formula EN EP x) :
                                (formula (extend_many ys EN) (extend_many xs EP) t) :=
    match f in (formula _ _ t') return (formula (extend_many ys EN) (extend_many xs EP) t') with
    | atomic a => atomic _ _ a
    | var v' => replace_var EN EP x xs ys v' f'
    | conj A x' f => conj _ _ A x' (subst EN EP x xs ys (arr A x') f f')
    | disj A x' f => disj _ _ A x' (subst EN EP x xs ys (arr A x') f f')
    | mu x' f => mu _ _ x' (subst EN EP x (x'::xs) ys x' f f')
    | nu x' f => nu _ _ x' (subst EN EP x (x'::xs) ys x' f f')
    | lam A x' f => lam _ _ A x' (fun a:A => subst EN EP x xs ys x' (f a) f')
    | app A x' f a => @app _ _ A x' (subst EN EP x xs ys (arr A x') f f') a
    | modality x' m f => modality _ _ x' m (subst EN EP x xs ys x' f f')
    | impl x' f1 f2 => impl _ _ x' (subst_neg EN EP x xs ys x' f1 f')
                                   (subst EN EP x xs ys x' f2 f')
    end
  with subst_neg EN EP x xs ys t
      (f:formula (extend_many xs (extend EP x)) (extend_many ys EN) t)
      (f':formula EN EP x) :
      (formula (extend_many xs EP) (extend_many ys EN) t) :=
    match f in (formula _ _ t') return (formula (extend_many xs EP) (extend_many ys EN) t') with
    | atomic a => atomic _ _ a
    | var v' => var _ _ v'
    | conj A x' f => conj _ _ A x' (subst_neg EN EP x xs ys (arr A x') f f')
    | disj A x' f => disj _ _ A x' (subst_neg EN EP x xs ys (arr A x') f f')
    | mu x' f => mu _ _ x' (subst_neg EN EP x xs (x'::ys) x' f f')
    | nu x' f => nu _ _ x' (subst_neg EN EP x xs (x'::ys) x' f f')
    | lam A x' f => lam _ _ A x' (fun a:A => subst_neg EN EP x xs ys x' (f a) f')
    | app A x' f a => @app _ _ A x' (subst_neg EN EP x xs ys (arr A x') f f') a
    | modality x' m f => modality _ _ x' m (subst_neg EN EP x xs ys x' f f')
    | impl x' f1 f2 => impl _ _ x' (subst EN EP x xs ys x' f1 f') (subst_neg EN EP x xs ys x' f2 f')
    end.

  Definition subst' EN EP x t
    (f:formula EN (extend EP x) t)
    (f':formula EN EP x)
    : formula EN EP t
    := subst EN EP x nil nil t f f'.


Fixpoint model_element (t:typ) : Type :=
    match t with
    | o => unit
    | arr A t' => prod A (model_element t')
    end.

Definition premodel (t:typ) : Type :=
    model_element t -> world -> Prop.

Definition model_property (t:typ) (m:premodel t) : Prop :=
    forall (x:model_element t), kripke_monotone (m x).

Definition model (t:typ) := sig (fun X => model_property t X).

Definition model_app t (mdl:model t) : model_element t -> world -> Prop := proj1_sig mdl.
Coercion model_app : model >-> Funclass.

Lemma model_kripke t (mdl:model t) :
  forall x w w', accessable w w' -> mdl x w -> mdl x w'.
Hint Resolve model_kripke.

Definition model_le {t} (m1 m2:model t) :=
  forall x w, m1 x w -> m2 x w.

Lemma model_eq : forall t (m1 m2:model t),
  model_le m1 m2 -> model_le m2 m1 -> m1 = m2.

Section fixpoints.
  Variable t:typ.

  Program Definition sup (XS:model t -> Prop) : model t :=
    fun x w => exists X, XS X /\ X x w.

  Program Definition inf (XS:model t -> Prop) : model t :=
    fun a w => forall X, XS X -> X a w.

  Variable F : model t -> premodel t.

  Definition min_model : model t :=
    inf (fun X:model t => forall a w, F X a w -> X a w).

  Definition max_model : model t :=
    sup (fun X:model t => forall a w, X a w -> F X a w).

End fixpoints.

Definition extend_mdl
    (EP:env)
    (mpos:forall v:Vars EP, model (Vars_typ EP v))
    (t:typ)
    (m:model t)
    (v:Vars (extend EP t)) :
    model (Vars_typ (extend EP t) v) :=

    match v with
    | None => m
    | Some v' => mpos v'
    end.

Fixpoint interp EN EP
             (mneg:forall v:Vars EN, model (Vars_typ EN v))
             (mpos:forall v:Vars EP, model (Vars_typ EP v))
             (t:typ)
             (f:formula EN EP t) {struct f}
             : premodel t :=

    match f in (formula _ _ t') return premodel t' with
    | atomic a => fun x w => interp_atom a w

    | var v => mpos v

    | impl t f1 f2 => fun x w => forall w', accessable w w' ->
                                  interp EP EN mpos mneg t f1 x w' ->
                                  interp EN EP mneg mpos t f2 x w'

    | mu t f => min_model t (fun m => interp EN (extend EP t) mneg (extend_mdl EP mpos t m) t f)

    | nu t f => max_model t (fun m => interp EN (extend EP t) mneg (extend_mdl EP mpos t m) t f)

    | conj A t f' => fun x w => forall a:A, interp EN EP mneg mpos (arr A t) f' (a,x) w

    | disj A t f' => fun x w => exists a:A, interp EN EP mneg mpos (arr A t) f' (a,x) w

    | modality t m f' => fun x =>
           interp_mode m (interp EN EP mneg mpos t f' x)

    | lam A t f => fun x w => interp EN EP mneg mpos t (f (fst x)) (snd x) w

    | app A t f a => fun x w => interp EN EP mneg mpos (arr A t) f (a,x) w
    end.

  Theorem interp_monotone : forall
    EN EP t (f:formula EN EP t)
    (mneg mneg':forall v, model (Vars_typ EN v))
    (mpos mpos':forall v, model (Vars_typ EP v)),

    (forall v x w w', accessable w w' -> mneg' v x w -> mneg v x w') ->
    (forall v x w w', accessable w w' -> mpos v x w -> mpos' v x w') ->
    
    forall x w w',
      accessable w w' ->
      interp _ _ mneg mpos t f x w ->
      interp _ _ mneg' mpos' t f x w'.

  Program Definition interp' EN EP
             (mneg:forall v:Vars EN, model (Vars_typ EN v))
             (mpos:forall v:Vars EP, model (Vars_typ EP v))
             (t:typ)
             (f:formula EN EP t)
             : model t
        := interp EN EP mneg mpos t f.

  Lemma interp'_monotone : forall EN EP t f
    (mneg mneg':forall v:Vars EN, model (Vars_typ EN v))
    (mpos mpos':forall v:Vars EP, model (Vars_typ EP v)),

    (forall v, model_le (mneg' v) (mneg v)) ->
    (forall v, model_le (mpos v) (mpos' v)) ->
    
    model_le (interp' EN EP mneg mpos t f) (interp' EN EP mneg' mpos' t f).


  Inductive model_exts : list typ -> Type :=
    | me_nil : model_exts nil
    | me_cons : forall t ts (x:model t),
          model_exts ts ->
          model_exts (t::ts).

  Fixpoint extend_mdl_many
    (EP:env)
    (mpos:forall v:Vars EP, model (Vars_typ EP v))
    (ts:list typ) (xs:model_exts ts) :
      forall (v:Vars (extend_many ts EP)),
             model (Vars_typ (extend_many ts EP) v) :=

    match xs in (model_exts ts') return
        forall (v:Vars (extend_many ts' EP)),
           model (Vars_typ (extend_many ts' EP) v)
    with
    | me_nil => mpos
    | me_cons t ts x xs' =>
       extend_mdl (extend_many ts EP)
         (extend_mdl_many EP mpos ts xs')
         t x
    end.

  Fixpoint extend_mdl_many'
    (EP:env)
    (mpos:forall v:Vars EP, model (Vars_typ EP v))
    (ts:list typ) (xs:model_exts ts) :
      forall (v:Vars (extend_many' ts EP)),
             model (Vars_typ (extend_many' ts EP) v) :=

    match xs in (model_exts ts') return
        forall (v:Vars (extend_many' ts' EP)),
           model (Vars_typ (extend_many' ts' EP) v)
    with
    | me_nil => mpos
    | me_cons t ts x xs' =>
         extend_mdl_many' _ (extend_mdl EP mpos _ x ) ts xs'
    end.

  Fixpoint extend_mdl_deep
    (EP:env)
    (x:typ)
    (xm:model x)
    (ts:list typ) :
      (forall v, model (Vars_typ (extend_many ts EP) v))->
      forall (v:Vars (extend_many ts (extend EP x))),
               model (Vars_typ (extend_many ts (extend EP x)) v) :=
    match ts as ts' return
      (forall v, model (Vars_typ (extend_many ts' EP) v))->
      forall (v:Vars (extend_many ts' (extend EP x))),
               model (Vars_typ (extend_many ts' (extend EP x)) v)
    with
    | nil => fun mpos => extend_mdl EP mpos x xm
    | t::ts' => fun mpos v =>
                   match v as v' return
                     model (Vars_typ (extend_many (t::ts') (extend EP x)) v')
                   with
                   | None => mpos None
                   | Some v' =>
                      extend_mdl_deep EP x xm ts' (fun v => mpos (Some v)) v'
                   end
    end.

  Lemma interp_shift_var_lemma : forall EN EP x xs ys yms
    (inj : forall (X : env) (v : Vars X),
            formula EN (extend_many' ys X) (Vars_typ X v))
    mt mneg mpos v z w,

   (forall X mneg mpos v z w,
      interp EN (extend_many' ys X) mneg
      (extend_mdl_many' X mpos ys yms)
      (Vars_typ X v) (inj X v) z w
      <-> mpos v z w) ->

   (interp EN (extend_many' ys (extend_many xs (extend EP x))) mneg
     (extend_mdl_many' _ (extend_mdl_deep EP x mt xs mpos) ys yms) (Vars_typ (extend_many xs EP) v)
     (shift_var x xs ys EN EP inj v) z w <-> (mpos v) z w).

  Inductive sz : Type :=
    | szO : sz
    | szS : sz -> sz
    | szL : forall A:Type, (A -> sz) -> sz.

  Fixpoint fsize {EN EP x} (f:formula EN EP x) : sz :=
    match f with
    | atomic _ => szO
    | var _ => szO
    | modality t _ f => szS (fsize f)
    | impl t f1 f2 => szL bool (fun x => if x then fsize f1 else fsize f2)
    | mu t f => szS (fsize f)
    | nu t f => szS (fsize f)
    | conj A x f => szS (fsize f)
    | disj A x f => szS (fsize f)
    | lam A x f => szL A (fun a => fsize (f a))
    | app A x f a => szS (fsize f)
    end.

  Lemma szL_inj : forall A f f',
    szL A f = szL A f' -> f = f'.

  Lemma interp_shift_lemma : forall fsz,
     (forall EN EP x xs t mneg mpos mt (f:formula EN (extend_many xs EP) t) z w, fsize f = fsz ->
       (interp EN (extend_many xs (extend EP x))
         mneg (extend_mdl_deep EP _ mt xs mpos) t (shift x xs EN EP t f) z w <->
       interp EN (extend_many xs EP) mneg mpos t f z w)) /\

     (forall EN EP x xs t mneg mpos mt (f : formula (extend_many xs EN) EP t) z w, fsize f = fsz ->
       (interp (extend_many xs (extend EN x)) EP
        (extend_mdl_deep EN _ mt xs mneg) mpos t (shift_neg x xs EP EN t f) z w <->
        interp (extend_many xs EN) EP mneg mpos t f z w)).

  Lemma interp_shift_neg_many_lemma : forall EN EP x ys yms f' mneg mpos z w,
   interp (extend_many ys EN) EP
     (fun v0 : Vars (extend_many ys EN) => extend_mdl_many EN mneg ys yms v0)
     (fun v0 : Vars EP => mpos v0) x
     (shift_neg_many EN EP ys x f') z w <-> interp EN EP mneg mpos x f' z w.

  Lemma subst_var_spec : forall EN EP,
   forall (xs : list typ) xms (x : typ) (ys : list typ)
     (v : Vars (extend_many xs (extend EP x))) (f' : formula EN EP x)
     (yms : model_exts ys)
     (mneg : forall v0 : Vars EN, model (Vars_typ EN v0))
     (mpos : forall v0 : Vars EP, model (Vars_typ EP v0)),
   let mneg' :=
     fun v0 : Vars (extend_many ys EN) => extend_mdl_many EN mneg ys yms v0 in
   let mpos' :=
     fun v0 : Vars (extend_many xs EP) => extend_mdl_many EP mpos xs xms v0 in
   forall (z : model_element (Vars_typ (extend_many xs (extend EP x)) v))
     (w : world),
   interp (extend_many ys EN) (extend_many xs EP) mneg' mpos'
     (Vars_typ (extend_many xs (extend EP x)) v)
     (replace_var EN EP x xs ys v f') z w <->
   (extend_mdl_deep EP x (interp' EN EP mneg mpos x f') xs mpos' v) z w.

 Theorem subst_spec_full : forall fsz EN EP xs ys x t
    (f':formula EN EP x)
    (xms:model_exts xs)
    (yms:model_exts ys)
    (mneg:forall v, model (Vars_typ EN v))
    (mpos:forall v, model (Vars_typ EP v)),

    let mneg' v := extend_mdl_many EN mneg ys yms v in
    let mpos' v := extend_mdl_many EP mpos xs xms v in
    let mpos'' :=
      extend_mdl_deep EP x (interp' EN EP mneg mpos x f') xs mpos' in

    (forall f z w, fsize f = fsz ->
      (interp (extend_many ys EN) (extend_many xs EP)
         mneg' mpos' t (subst EN EP x xs ys t f f') z w <->

       interp (extend_many ys EN) (extend_many xs (extend EP x))
         mneg' mpos'' t f z w)) /\

    (forall f z w, fsize f = fsz ->
      (interp (extend_many xs EP) (extend_many ys EN)
        mpos' mneg' t (subst_neg EN EP x xs ys t f f') z w <->

       interp (extend_many xs (extend EP x)) (extend_many ys EN)
         mpos'' mneg' t f z w)).

  Corollary subst_spec' : forall EN EP x t
    mneg mpos
    (f':formula EN EP x)
    (f :formula EN (extend EP x) t),

    forall z w,
      interp EN EP mneg mpos t (subst' EN EP x t f f') z w <->
      interp EN (extend EP x) mneg
        (extend_mdl EP mpos x (interp' EN EP mneg mpos x f')) t f z w.

  Corollary subst_spec : forall EN EP x t
    mneg mpos
    (f':formula EN EP x)
    (f :formula EN (extend EP x) t),

    interp' EN EP mneg mpos t (subst' EN EP x t f f') =
    interp' EN (extend EP x) mneg
        (extend_mdl EP mpos x (interp' EN EP mneg mpos x f')) t f.

  Definition entails {EN EP t} (f1 f2:formula EN EP t) :=
    forall mneg mpos, model_le
      (interp' EN EP mneg mpos t f1)
      (interp' EN EP mneg mpos t f2).

  Definition f_eq {EN EP t} (f1 f2:formula EN EP t) :=
    forall mneg mpos,
      interp' EN EP mneg mpos t f1 =
      interp' EN EP mneg mpos t f2.

  Lemma mu_equation : forall EN EP x f,
    f_eq (mu EN EP x f) (subst' EN EP x x f (mu _ _ x f)).

  Lemma nu_equation : forall EN EP x f,
    f_eq (nu EN EP x f) (subst' EN EP x x f (nu _ _ x f)).

  Let E0 := emptyE.

  Definition cformula := formula E0 E0.

  Program Definition interp_cformula t : cformula t -> model t :=
    interp' E0 E0 (fun v => match v with end) (fun v => match v with end) t.

  Definition valid (f:cformula o) :=
    forall w, interp_cformula o f tt w.


  Lemma modus_ponens : forall t (f1 f2 f3:formula E0 E0 t),
    entails f1 (impl _ _ t f2 f3) <->
    entails (f_and f1 f2) f3.

  Lemma beta_rule : forall A t (f:A -> formula E0 E0 t) a,
    f_eq (app (lam _ _ A t f) a) (f a).

  Lemma entails_TT : forall t (f:formula E0 E0 t),
    entails f TT.

  Lemma FF_entails : forall t (f:formula E0 E0 t),
    entails FF f.

  Lemma conj_intro : forall A t G (f:formula E0 E0 (arr A t)),
    (forall a, entails G (app f a)) ->
    entails G (conj _ _ A t f).

  Lemma conj_elim : forall A t G (f:formula E0 E0 (arr A t)) a,
    entails (app f a) G ->
    entails (conj _ _ A t f) G.

  Lemma disj_intro : forall A t G (f:formula E0 E0 (arr A t)) a,
    entails G (app f a) ->
    entails G (disj _ _ A t f).

  Lemma disj_elim : forall A t G (f:formula E0 E0 (arr A t)),
    (forall a, entails (app f a) G) ->
    entails (disj _ _ A t f) G.

  Inductive characteristic_formula (CF : world -> cformula o) : Prop :=
    { CF_self : forall w, interp_cformula o (CF w) tt w
    ; CF_other : forall w1 w2,
         interp_cformula o (CF w1) tt w2 ->
         accessable w1 w2
    }.

  Section characteristic_consequences.
    Variable CF : world -> cformula o.
    Hypothesis HCF : characteristic_formula CF.

    Theorem expressivity : forall w w',
      accessable w w' <-> interp_cformula o (CF w) tt w'.

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

    Definition representation (X:model o) : cformula o :=
      disj' (fun w_:{ w:world | X tt w } => (CF (proj1_sig w_))).

    Program Definition model_apply A t (a:A) (X:model (arr A t)) : model t :=
      fun x w => X (a,x) w.

    Fixpoint representation' (t:typ) : model t -> cformula t :=
      match t as t' return model t' -> cformula t' with
        | o => representation
        | arr A t' => fun X =>
          lam E0 E0 A t' (fun a:A => representation' t' (model_apply A t' a X))
      end.

    Lemma representation_denotation : forall (X:model o) w,
      X tt w <-> interp_cformula o (representation X) tt w.

    Lemma representation'_denotation : forall t (X:model t) z w,
      X z w <-> interp_cformula t (representation' t X) z w.

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

  Theorem characteristic_iff_denotable_models :
    (exists CF, characteristic_formula CF) <->
    (forall t (X:model t), exists f:cformula t, interp_cformula t f = X).

End mucalc.
End MuCalc.