Section SigExt.
Hint Unfold axioms.funcomp : core.
Definition sig_ext (Sigma : Signature) : Signature :=
match Sigma with
B_S Funcs fun_ar Preds pred_ar =>
B_S (Funcs + nat)
(fun f => match f with inl f' => fun_ar f' | inr _ => 0 end)
Preds
pred_ar
end.
Global Instance dec_sig_ext_Funcs {Sigma : Signature} (H : eq_dec Funcs) : eq_dec (@Funcs (sig_ext Sigma)).
Proof with subst; try (now left + (right; intros[=]; resolve_existT; congruence)).
destruct Sigma. intros [] []...
- decide (f = f0)...
- decide (n = n0)...
Qed.
Global Instance dec_sig_ext_Preds {Sigma : Signature} (H : eq_dec Preds) : eq_dec (@Preds (sig_ext Sigma)).
Proof with subst; try (now left + (right; intros[=]; resolve_existT; congruence)).
destruct Sigma. exact H.
Qed.
Global Instance enumT_sig_ext_Funcs {Sigma : Signature} {f} {H : list_enumerator__T f Funcs} : inf_list_enumerable__T (@Funcs (sig_ext Sigma)).
Proof with (try eapply cum_ge'; eauto; lia).
destruct Sigma. exists (fix f n := match n with 0 => List.map inl (L_T 0) | S n' => f n' ++ (inr n') :: List.map inl (L_T n') end).
1: eauto. intros [f0|]. 2: exists (S n); in_app 2... destruct (el_T f0) as [m Hin]. exists (S m). in_app 3. in_collect f0...
Qed.
Global Instance enumT_sig_ext_Preds {Sigma : Signature} {f} {H : list_enumerator__T f Preds} : inf_list_enumerable__T (@Preds (sig_ext Sigma)).
Fixpoint sig_lift_term' F F_ar P P_ar (t : @term (B_S F F_ar P P_ar)) :
(@term (sig_ext (B_S F F_ar P P_ar))) :=
match t with
| var_term x => var_term x
| Func f v => @Func (sig_ext (B_S F F_ar P P_ar)) (inl f) (map (fun x => sig_lift_term' x) v)
end.
Definition sig_lift_term {Sigma : Signature} : @term Sigma -> @term (sig_ext Sigma) :=
match Sigma return @term Sigma -> @term (sig_ext Sigma) with
B_S Funcs fun_ar Preds pred_ar as S => fun t => sig_lift_term' t
end.
Hint Unfold sig_lift_term : core.
Fixpoint sig_lift' F F_ar P P_ar (phi : @form (B_S F F_ar P P_ar)) :
(@form (sig_ext (B_S F F_ar P P_ar))) :=
match phi with
| Fal => Fal
| Pred p v => @Pred (sig_ext (B_S F F_ar P P_ar)) p (map sig_lift_term v)
| Impl phi psi => Impl (sig_lift' phi) (sig_lift' psi)
| All phi => All (sig_lift' phi)
end.
Definition sig_lift {Sigma : Signature} : @form Sigma -> @form (sig_ext Sigma) :=
match Sigma return @form Sigma -> @form (sig_ext Sigma) with
B_S Funcs fun_ar Preds pred_ar as Sig => fun phi => sig_lift' phi
end.
Hint Unfold sig_lift : core.
Fixpoint fin_minus (n m : nat) : (n < m) + {x | x = n - m} :=
match n, m with
| n', 0 => inr (exist (fun x => x = n' - 0) n' eq_refl)
| 0, S m' => inl (le_n_S 0 m' (Nat.le_0_l m'))
| S n', S m' =>
match fin_minus n' m' with
| inr (exist _ x H) => inr (exist _ x H)
| inl H => inl (le_n_S (S n') m' H)
end
end.
Definition vsubs {Sigma : Signature} (n m : nat) (v : vector term n) (x : nat) : term :=
match fin_minus x n with
| inl i => nth_order v i
| inr (exist _ y _) => var_term (y + m)
end.
Hint Unfold vsubs : core.
Fixpoint sig_drop_term' F F_ar P P_ar (n : nat) (t : @term (sig_ext (B_S F F_ar P P_ar))) :
@term (B_S F F_ar P P_ar) :=
match t with
| var_term x => var_term x
| Func (inl f') v => @Func (B_S F F_ar P P_ar) f' (map (fun x => sig_drop_term' n x) v)
| Func (inr y) _ => var_term (n + y)
end.
Definition sig_drop_term {Sigma : Signature} (n : nat) : @term (sig_ext Sigma) -> @term Sigma :=
match Sigma return @term (sig_ext Sigma) -> @term Sigma with
B_S Funcs fun_ar Preds pred_ar as S => sig_drop_term' n
end.
Hint Unfold sig_drop_term : core.
Fixpoint sig_drop' F F_ar P P_ar (n : nat) (phi : @form (sig_ext (B_S F F_ar P P_ar))) :
@form (B_S F F_ar P P_ar) :=
match phi with
| Fal => Fal
| Pred p v => @Pred (B_S F F_ar P P_ar) p (map (sig_drop_term n) v)
| Impl phi psi => Impl (sig_drop' n phi) (sig_drop' n psi)
| All phi => All (sig_drop' (S n) phi)
end.
Definition sig_drop {Sigma : Signature} (n : nat) : @form (sig_ext Sigma) -> @form Sigma :=
match Sigma return @form (sig_ext Sigma) -> @form Sigma with
B_S Funcs fun_ar Preds pred_ar as Sig => sig_drop' n
end.
Hint Unfold sig_drop : core.
Definition ext_c' f f_ar P P_ar (n : nat) : term := @Func (sig_ext (B_S f f_ar P P_ar)) (inr n) Vector.nil.
Definition ext_c {Sigma : Signature} (n : nat) : @term (sig_ext Sigma) :=
match Sigma with
B_S f f_ar P P_ar => ext_c' f_ar P_ar n
end.
Definition pref {Sigma : Signature} (n : nat) (rho : nat -> term) (x : nat) : term :=
match fin_minus x n with
| inl i => var_term x
| inr (exist _ y _) => rho y
end.
Definition raise {Sigma : Signature} (n : nat) (x : nat) : term := var_term (n + x).
Hint Unfold ext_c' pref raise : core.

Lemma lift_drop_inverse {Sigma : Signature} phi :
sig_drop 0 (subst_form ext_c (sig_lift phi)) = phi.