Section Sem.
Variable K : Kripke.
Fixpoint sem (rho: substitution (domain K))(t:term){struct t} : domain K :=
match t with
| Var x => match assoc _ x rho with
| Some a => a
| None => vars K x
end
| App f t' => funs K f (sem rho t')
end.
End Sem.
Notation "w <= w'" := (wle _ w w').
Set Implicit Arguments.
Reserved Notation "w ||- A" (at level 70).
Definition context := list formula.
Variable fresh : variable -> context -> Prop.
Variable fresh_out : context -> variable.
Fixpoint force (K:Kripke)(rho: substitution (domain K))(w:worlds K)(A:formula)
{struct A} : Type :=
match A with
| Atom (p,t) => atoms K w (p, sem K rho t)
| A --> B => forall w', w <= w' -> force K rho w' A -> force K rho w' B
| Forall x A => forall w', w <= w' -> forall t, force K ((x,t)::remove_assoc _ x rho) w' A
end.
Notation "w ||- A" := (force _ nil w A).
Reserved Notation "Gamma |- A" (at level 70).
Reserved Notation "Gamma ; A |- C" (at level 70, A at next level).
Inductive context_prefix (Gamma:context) : context -> Type :=
| CtxPrefixRefl : context_prefix Gamma Gamma
| CtxPrefixTrans : forall A Gamma', context_prefix Gamma Gamma' -> context_prefix Gamma (cons A Gamma').
Inductive in_context (A:formula) : list formula -> Prop :=
| InAxiom : forall Gamma, in_context A (cons A Gamma)
| OmWeak : forall Gamma B, in_context A Gamma -> in_context A (cons B Gamma).
Inductive prove : list formula -> formula -> Type :=
| ProofImplyR : forall A B Gamma, prove (cons A Gamma) B
-> prove Gamma (A --> B)
| ProofForallR : forall x A Gamma, (forall y, fresh y (A::Gamma)
-> prove Gamma (subst A x (Var y))) -> prove Gamma (Forall x A)
| ProofCont : forall A Gamma Gamma' C, context_prefix (A::Gamma) Gamma'
-> (prove_stoup Gamma' A C) -> (Gamma' |- C)
where "Gamma |- A" := (prove Gamma A)
with prove_stoup : list formula -> formula -> formula -> Type :=
| ProofAxiom Gamma C: Gamma ; C |- C
| ProofImplyL Gamma C : forall A B, (Gamma |- A)
-> (prove_stoup Gamma B C) -> (prove_stoup Gamma (A --> B) C)
| ProofForallL Gamma C : forall x t A, (prove_stoup Gamma (subst A x t) C)
-> (prove_stoup Gamma (Forall x A) C)
where " Gamma ; B |- A " := (prove_stoup Gamma B A).
Canonical Structure Universal := Build_Kripke
context
context_prefix
CtxPrefixRefl
context_prefix_trans
term
Var
App
(fun Gamma P => Gamma |- Atom P)
universal_weakening.

Axiom subst_formula_atom :
forall rho p t,
Atom (p, sem _ rho t) = subst_formula rho (Atom (p,t)).