QRC1.Language
From mathcomp Require Import all_ssreflect finmap.
From QRC1 Require Import Preamble.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Declare Scope qsp_scope. (* quantified and strictly positive *)
Section Language.
Open Scope fset.
Definition VarName := nat.
Coercion nat_of_VarName (x : VarName) : nat := x.
Coercion VarName_of_nat (n : nat) : VarName := n.
(* We only deal with finite signatures *)
Record signature := Signature {
ConstName : finType;
PredName : finType;
arity : PredName -> nat;
}.
Delimit Scope qsp_scope with qsp.
Variable sig : signature.
Inductive term :=
| Var : VarName -> term
| Const : ConstName sig -> term.
Definition term_code (t : term) : nat + 'I_#|ConstName sig| :=
match t with
| Var x => inl x
| Const c => inr (enum_rank c)
end.
Definition term_decode (ct : nat + 'I_#|ConstName sig|) : term :=
match ct with
| inl n => Var n
| inr i => Const (enum_val i)
end.
Lemma term_codeK : cancel term_code term_decode.
Proof. by case => [// | /= ?]; rewrite enum_rankK. Qed.
Definition term_eqMixin := CanEqMixin term_codeK.
Canonical term_eqType := EqType term term_eqMixin.
Definition term_choiceMixin := CanChoiceMixin term_codeK.
Canonical term_choiceType := ChoiceType term term_choiceMixin.
Definition term_countMixin := CanCountMixin term_codeK.
Canonical term_countType := CountType term term_countMixin.
Definition termfv (t : term) : {fset VarName} :=
match t with
| Var x => [fset x]
| Const c => fset0
end.
Definition termconstants (t : term) : {fset ConstName sig} :=
match t with
| Var x => fset0
| Const c => [fset c]
end.
Inductive formula :=
| T : formula
| Pred : forall (P : PredName sig), (arity P).-tuple term -> formula
| Conj : formula -> formula -> formula
| Diam : formula -> formula
| All : VarName -> formula -> formula.
Bind Scope qsp_scope with formula.
Open Scope qsp_scope.
Notation "A /\ B" := (Conj A B)
(at level 80, B at level 80, format "A /\ B") : qsp_scope.
Notation "<> A" := (Diam A) (at level 40, format "<> A") : qsp_scope.
Fixpoint formula_code (A : formula)
: GenTree.tree (option (PredName sig * seq term)) :=
match A with
| T => GenTree.Leaf None
| Pred P ts => GenTree.Leaf (Some (P, val ts))
| A /\ B => GenTree.Node 0 [:: formula_code A; formula_code B]
| <> A => GenTree.Node 1 [:: formula_code A]
| All x A => GenTree.Node x.+2 [:: formula_code A]
end.
Fixpoint formula_decode
(c : GenTree.tree (option (PredName sig * seq term))) : formula :=
match c with
| GenTree.Leaf None => T
| GenTree.Leaf (Some (P, vts)) =>
if size vts == arity P then
@Pred P (insubd [tuple of nseq (arity P) (Var 0)] vts)
else T
| GenTree.Node 0 [:: c1; c2] => formula_decode c1 /\ formula_decode c2
| GenTree.Node 1 [:: c1] => <> (formula_decode c1)
| GenTree.Node k.+2 [:: c1] => All k (formula_decode c1)
| GenTree.Node _ _ => T
end.
Lemma formula_codeK : cancel formula_code formula_decode.
elim => //=.
- move=> P ts.
rewrite /insubd insubT; first by rewrite size_tuple.
move=> sizek; rewrite size_tuple eqxx /=.
by congr Pred; apply/val_eqP.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->.
Qed.
Definition formula_eqMixin := CanEqMixin formula_codeK.
Canonical formula_eqType := EqType formula formula_eqMixin.
Definition formula_choiceMixin := CanChoiceMixin formula_codeK.
Canonical formula_choiceType := ChoiceType formula formula_choiceMixin.
Definition formula_countMixin := CanCountMixin formula_codeK.
Canonical formula_countType := CountType formula formula_countMixin.
Fixpoint vars (A : formula) : {fset VarName} :=
match A with
| T => fset0
| Pred P ts => \bigcup_(t <- ts) termfv t
| B /\ C => vars B `|` vars C
| <> B => vars B
| All x B => x |` vars B
end.
(* free variables *)
Fixpoint fv (A : formula) : {fset VarName} :=
match A with
| T => fset0
| Pred P ts => \bigcup_(t <- ts) termfv t
| B /\ C => fv B `|` fv C
| <> B => fv B
| All x B => fv B `\ x
end.
(* bound variables *)
Fixpoint bv (A : formula) : {fset VarName} :=
match A with
| T | Pred _ _ => fset0
| B /\ C => bv B `|` bv C
| <> B => bv B
| All x B => x |` bv B
end.
Lemma varsE (A : formula) : vars A = fv A `|` bv A.
Proof.
elim: A => //=.
- by rewrite fsetU0.
- by move=> * /[!fsetU0].
- by move=> A -> B -> /[1!fsetUACA].
- move=> x A ->.
rewrite 2!fsetUA; congr (_ `|` _).
by rewrite fsetUDr fsetUC fsetDv fsetD0.
Qed.
Lemma fv_vars (A : formula) : fv A `<=` vars A.
Proof. by rewrite varsE fsubsetUl. Qed.
Lemma bv_vars (A : formula) : bv A `<=` vars A.
Proof. by rewrite varsE fsubsetUr. Qed.
Lemma fv_Allself (A : formula) (x : VarName) :
x \notin fv (All x A).
Proof. by rewrite fsetD11. Qed.
Lemma fv_Allother (A : formula) (x y : VarName) :
x <> y -> (x \in fv (All y A)) = (x \in fv A).
Proof. by rewrite /= in_fsetD1 => /eqP ->. Qed.
Definition closed (A : formula) : bool :=
fv A == fset0.
Lemma closed_Conj (A B : formula) :
closed (A /\ B) = closed A && closed B.
Proof. by rewrite /closed fsetU_eq0. Qed.
Lemma closed_Diam (A : formula) :
closed (<> A) = closed A.
Proof. by []. Qed.
Lemma closed_fv (A : formula) (x : VarName) :
closed A -> x \notin fv A.
Proof. by move=> /eqP ->. Qed.
Fixpoint constants (A : formula) : {fset ConstName sig} :=
match A with
| T => fset0
| Pred P ts => \bigcup_(t <- ts) termconstants t
| B /\ C => constants B `|` constants C
| <> B => constants B
| All x B => constants B
end.
Definition constantcount (A : formula) : nat :=
#|` constants A|.
Lemma constantcount_Conjl (A B : formula) :
constantcount A <= constantcount (A /\ B).
Proof. by apply: fsubset_leq_card; rewrite fsubsetUl. Qed.
Lemma constantcount_Conjr (A B : formula) :
constantcount B <= constantcount (A /\ B).
Proof. by apply: fsubset_leq_card; rewrite fsubsetUr. Qed.
Lemma constantcount_Diam (A : formula) :
constantcount (<> A) = constantcount A.
Proof. by []. Qed.
Lemma constantcount_All (x : VarName) (A : formula) :
constantcount (All x A) = constantcount A.
Proof. by []. Qed.
Fixpoint terms (A : formula) : {fset term} :=
match A with
| T => fset0
| Pred P ts => [fset t in (ts : seq term)]
| B /\ C => terms B `|` terms C
| <> B => terms B
| All x B => Var x |` terms B
end.
Reserved Notation "A `[ t1 <- t2 ]" (at level 8, format "A `[ t1 <- t2 ]").
Fixpoint sub (A : formula) (t1 t2 : term) : formula :=
match A with
| T => T
| Pred P ts =>
@Pred P [tuple of [seq if ti == t1 then t2 else ti | ti <- ts]]
| B /\ C => B`[t1 <- t2] /\ C`[t1 <- t2]
| <>B => <>B`[t1 <- t2]
| All y B => if Var y == t1 then All y B else All y B`[t1 <- t2]
end
where "A `[ t1 <- t2 ]" := (sub A t1 t2) : qsp_scope.
Lemma subtt (A : formula) (t : term) :
A`[t <- t] = A.
Proof.
elim: A => //=.
- move=> P ts; congr Pred.
by apply: eq_from_tnth => i; rewrite tnth_map; case: eqP.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> y A ->; case: eqP.
Qed.
Lemma sub_notfree (x : VarName) (t : term) (A : formula) :
x \notin fv A -> A`[Var x <- t] = A.
Proof.
elim: A => //=.
- move=> P ts /negP xnotfv.
congr Pred; apply: eq_from_tnth=> i; rewrite tnth_map.
case: eqP => [tnthx | //].
exfalso; apply: xnotfv.
apply /bigfcupP => /=.
exists (tnth ts i).
by rewrite mem_tnth.
by rewrite tnthx fset11.
- move=> A IHA B IHB.
rewrite in_fsetU negb_or => /andP [xnotinA xnotinB].
by rewrite IHA // IHB.
- by move=> A IHA xnotinA; rewrite IHA.
- move=> y A IHA; rewrite in_fsetD1 negb_and eq_sym.
case: ifP => [// | /eqP + /orP [/negPn /eqP eqyx | xnotinA]].
by rewrite eqyx.
by rewrite IHA.
Qed.
Lemma sub_notconstants (c : ConstName sig) (t : term) (A : formula) :
c \notin constants A -> A`[Const c <- t] = A.
Proof.
elim: A => //=.
- move=> P ts /negP cnotconst.
congr Pred; apply: eq_from_tnth => i /[!tnth_map].
case: eqP => [eqtnthc|//].
exfalso; apply: cnotconst.
apply/bigfcupP => /=.
by exists (tnth ts i); rewrite ?mem_tnth // eqtnthc fset11.
- by move=> A IHA B IHB /[!inE] /[!negb_or] /andP[/IHA -> /IHB ->].
- by move=> A IHA cnotinA /[!IHA].
- by move=> y A IHA cnotinA /[!IHA].
Qed.
Lemma sub_ConstC (A : formula) (x1 x2 : VarName)
(c1 c2 : ConstName sig) :
x1 <> x2 ->
A`[Var x1 <- Const c1]`[Var x2 <- Const c2] =
A`[Var x2 <- Const c2]`[Var x1 <- Const c1].
Proof.
move=> neqx12.
elim: A => //=.
- move=> P ts.
congr Pred.
apply: eq_from_tnth => i; rewrite 4!tnth_map.
case: (@eqP _ (tnth _ _)) => [-> | neqix1].
case: eqP => // _.
case: eqP => //.
by case: eqP => // [[]].
case: eqP => [// | neqix2].
by case: eqP.
- by move=> A -> B ->.
- by move=> A ->.
- move=> y A IHA.
case: eqP => [[->] | neqyx1].
do 2!(case: eqP => [[//] | _ /=]).
by rewrite eqxx.
case: eqP => [[->] /= | neqyx2 /=].
by rewrite eqxx eq_sym; case: eqP => [[]|].
do 2!(case: eqP => // _).
by rewrite IHA.
Qed.
Fixpoint freefor (A : formula) (x : VarName) (t : term) : bool :=
match A with
| T | Pred _ _ => true
| B /\ C => (freefor B x t) && (freefor C x t)
| <>B => freefor B x t
| All y B =>
(y == x) ||
(
(freefor B x t) &&
((x \in fv B) ==> (y \notin termfv t))
)
end.
Lemma freeforxx (A : formula) (x : VarName) :
freefor A x (Var x).
Proof.
elim: A => //=.
by move=> A -> B ->.
move=> y A ->.
by case: eqP => [-> // | /= neqxy]; apply /implyP => _; apply /fset1P.
Qed.
Hint Resolve freeforxx : core.
Lemma freefor_Const (A : formula) (x : VarName) (c : ConstName sig) :
freefor A x (Const c).
Proof.
elim: A => //=.
by move=> A -> B ->.
by move=> y A ->; rewrite implybT orbT.
Qed.
Lemma notfv_freefor (x : VarName) (t : term) (A : formula) :
x \notin fv A -> freefor A x t.
Proof.
elim: A => //=.
move=> A IHA B IHB.
rewrite in_fsetU negb_or => /andP [xnotinA xnotinB].
by rewrite IHA // IHB.
move=> y A IHA.
rewrite in_fsetD1 negb_and eq_sym.
case: eqP => [// | neqyx /orP [// | /negPf xnotinA /=]].
by rewrite IHA //= xnotinA.
Qed.
Lemma notvars_freefor (x y : VarName) (A : formula) :
y \notin vars A -> freefor A x (Var y).
Proof.
elim: A => //=.
move=> A IHA B IHB.
by rewrite inE negb_or => /andP [/IHA -> /IHB ->].
move=> z A IH.
rewrite !inE eq_sym negb_or => /andP [-> /IH ->].
by rewrite /= implybT orbT.
Qed.
Fixpoint freefort (A : formula) (t1 t2 : term) : bool :=
match A with
| T | Pred _ _ => true
| B /\ C => (freefort B t1 t2) && (freefort C t1 t2)
| <> B => freefort B t1 t2
| All y B =>
match t1 with
| Var x =>
(y == x) ||
(
(freefort B (Var x) t2) &&
((x \in fv B) ==> (y \notin termfv t2))
)
| Const c =>
(freefort B (Const c) t2) &&
((c \in constants B) ==> (y \notin termfv t2))
end
end.
Lemma freefort_freefor (A : formula) (x : VarName) (t : term) :
freefort A (Var x) t = freefor A x t.
Proof.
elim: A => //=.
by move=> A -> B ->.
by move=> y A ->.
Qed.
Lemma fv_sub_Var (A : formula) (x : VarName) (t : term) :
freefor A x t ->
fv A`[Var x <- t] = if x \in fv A then (fv A `\ x) `|` termfv t else fv A.
Proof.
elim: A => //=.
- move=> P ts _.
case: ifP.
move=> /bigfcupP /= [[y /andP [yints _] | c /andP [cints _]]] //=.
rewrite in_fsetE => /eqP ->.
apply/eqP/fset_eqP => /= z.
apply/bigfcupP/idP => /=.
move=> [t0 /andP [/mapP /= [t1 t1ints] + _]].
case: eqP => [eqt1y -> zint | neqt1y -> zint1].
by rewrite in_fsetE zint orbT.
rewrite in_fsetE; apply/orP; left.
rewrite 2!in_fsetE; apply/andP; split; last first.
by apply/bigfcupP; exists t1; rewrite ?t1ints.
apply/eqP => eqzy.
case: t1 t1ints neqt1y zint1 => [/= w | //].
rewrite in_fsetE => _ neqwy /eqP eqzw.
by apply: neqwy; rewrite -eqzw eqzy.
rewrite 3!in_fsetE => /orP [|].
move=> /andP [/eqP neqzy /bigfcupP /= [t' /andP [t'ints _] zint']].
exists t' => //; rewrite andbT.
apply/mapP; exists t' => //.
case: eqP => [eqt'y | //].
exfalso; apply: neqzy.
case: t' t'ints zint' eqt'y => [w /= _ | //].
by rewrite in_fsetE => /eqP -> [].
move=> zint; exists t => //.
rewrite andbT; apply/mapP.
by exists (Var y); rewrite ?eqxx.
move=> /negP xnotints.
congr (\bigcup_(_ <- _) _).
rewrite -[[seq _ | _ <- _]]/(val [tuple of [seq _ | _ <- _]]).
apply/eqP/val_eqP; apply: eq_from_tnth => i /[!tnth_map].
case: eqP => [eqtnthix|//].
exfalso; apply: xnotints.
apply/bigfcupP => /=; exists (tnth ts i).
by rewrite mem_tnth.
by rewrite eqtnthix /= inE.
- move=> A IHA B IHB /andP [freeA freeB]; rewrite in_fsetE.
case: ifP; last first.
move=> /negP /negP; rewrite negb_or => /andP [/negPf xnA /negPf xnB].
by rewrite IHA // IHB // xnA xnB.
have [/fsetIP [xinA xinB] _ |] := boolP (x \in fv A `&` fv B).
rewrite IHA // IHB // xinA xinB.
by rewrite fsetUAC fsetUA -fsetUA fsetUid fsetDUl.
rewrite in_fsetE negb_and=> /orP[/[dup]xnA /negPf xAf|/[dup]xnB /negPf xBf].
move=> /orP [| xinB]; first by rewrite xAf.
rewrite IHA // IHB // xAf xinB.
by rewrite fsetUA fsetDUl (mem_fsetD1 xnA).
move=> /orP [xinA |]; last by rewrite xBf.
rewrite IHA // IHB // xinA xBf.
by rewrite fsetUAC fsetDUl (mem_fsetD1 xnB).
- move=> y A IHA /orP [/eqP /[dup] eqyx -> | /andP [freeA /implyP ynotint]].
case: fsetDP => [[_ /fset1P] neqxy // |].
by rewrite eqxx.
case: eqP => [[->]|neqyx /=]; first by case: ifP => [/fsetDP [_ /fset1P] |].
case: ifP => [/fsetDP [xinA _]|].
rewrite IHA // xinA.
rewrite fsetDUl (mem_fsetD1 (ynotint xinA)) 2!fsetDDl.
suff -> : [fset x; y] = [fset y; x] by [].
by apply/eqP/fset_eqP => z; apply/fset2P/fset2P; rewrite or_comm.
rewrite in_fsetE => /negP/negP.
rewrite negb_and => /orP [/negPn /fset1P eqxy | xnotinA].
by exfalso; apply: neqyx; rewrite eqxy.
by rewrite sub_notfree.
Qed.
Lemma fv_sub_Const (A : formula) (c : ConstName sig) (t : term) :
freefort A (Const c) t ->
fv A`[Const c <- t] = if c \in constants A then fv A `|` termfv t else fv A.
Proof.
elim: A => //.
- move=> P ts _.
have [cints /=|/sub_notconstants -> //] := boolP (c \in _).
apply/fsetP => /= x; apply/bigfcupP/fsetUP => /=.
move=> [_ /andP[/mapP /= [t' t'ints ->]] _].
case: eqP => [_ eqxy|_ eqxt']; first by right.
by left; apply/bigfcupP; exists t' => // /[!andbT].
move=> [/bigfcupP /= [tx /[!andbT] txints eqxtx]|eqxt].
exists tx => // /[!andbT].
apply/mapP; exists tx => //.
case: tx eqxtx {txints} => [x' _|//].
by case: eqP.
exists t => // /[!andbT].
apply/mapP => /=.
move: cints => /bigfcupP /= [tc /[!andbT] tcints eqctc].
exists tc => //.
by case: tc eqctc {tcints} => [//|c' /= /[!inE] /eqP -> /[!eqxx]].
- move=> /= A IHA B IHB /andP[/IHA -> /IHB ->] /[!inE].
case: (c \in constants A) => /=.
case: (c \in constants B) => /=.
by rewrite fsetUACA fsetUid.
by rewrite -fsetUA (fsetUC (termfv t)) fsetUA.
case: (c \in constants B) => //=.
by rewrite fsetUA.
- move=> /= x A IHA /andP[/IHA ->].
case: (c \in constants A) => [/= neqxt|//].
by rewrite fsetDUl (mem_fsetD1 neqxt).
Qed.
Lemma vars_sub_Var (A : formula) (x : VarName) (t : term) :
vars A`[Var x <- t] =
if x \in fv A then
if x \in bv A then
vars A `|` termfv t
else (vars A `\ x) `|` termfv t
else vars A.
Proof.
have [|/sub_notfree -> //] := boolP (x \in fv A).
elim: A => //=.
- move=> P ts /bigfcupP /= [[x' /andP[+ _] /= /[!inE] /eqP eqxx'|//]].
rewrite -{}eqxx' => {x'} => xints.
apply/fsetP => /= y; apply/bigfcupP/idP => /=.
move=> [_ /andP[/mapP /= [[z|c] + ->]] _]; last by [].
case: (@eqP _ z x) => [-> /= _ /[!eqxx] /[!inE] -> /[!orbT] //|].
move=> neqzx zints; case: eqP => [[//]|_] /=.
rewrite !inE => /eqP ->; apply/orP; left.
case: eqP => [//|_ /=].
apply/bigfcupP; exists (Var z).
by rewrite zints.
by rewrite inE.
move=> /fsetUP [/[!inE] /andP [/eqP neqyx]|].
move=> /bigfcupP /= [[y' /andP [+ _] /[!inE] /eqP eqyy'|//]].
rewrite -{}eqyy' => {y'} yints.
exists (Var y); last by rewrite inE eqxx.
rewrite andbT; apply/mapP; exists (Var y) => //.
by case: eqP => [[]|].
case: t => [_ /[!inE] /eqP <-|//].
exists (Var y); last by rewrite inE eqxx.
by rewrite andbT; apply/mapP; exists (Var x); rewrite ?eqxx.
- have memr : forall X Y W z, z \in X -> X `|` (Y `\ z) `|` W = X `|` Y `|` W.
move=> /= K X Y W z zinX.
apply/fsetP => /= k /[!inE].
by case: eqP => [-> /[!zinX]|_ /=].
have meml : forall X Y W z, z \in Y -> (X `\ z) `|` Y `|` W = X `|` Y `|` W.
move=> /= K X Y W z zinX.
congr (_ `|` _).
rewrite fsetUC [in RHS]fsetUC.
rewrite -(fsetU0 (Y `|` X `\ z)) -(fsetU0 (Y `|` X)).
by apply: memr.
move=> A IHA B IHB /fsetUP[/[dup] xinfvA /IHA ->|/IHB ->].
have [/IHB ->|/[dup] xnotinfvB /sub_notfree ->] := boolP (x \in fv B).
rewrite inE; case: ifP => _ /=.
case: ifP => _; rewrite fsetUACA fsetUid //.
by apply: memr; move: {+}x xinfvA; apply/fsubsetP; apply: fv_vars.
have [xinbvB|xnotinbvB] := boolP (x \in bv B); rewrite fsetUACA fsetUid.
by apply: meml; move: {+}x xinbvB; apply/fsubsetP; apply: bv_vars.
by rewrite fsetDUl.
rewrite inE; case: ifP => _ /=.
by rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA.
have [xinbvB|xnotinbvB] := boolP (x \in bv B).
rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA.
by apply: meml; move: {+}x xinbvB; apply/fsubsetP; apply: bv_vars.
rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA fsetDUl.
rewrite (@mem_fsetD1 _ _ (vars B)) //.
by rewrite varsE inE negb_or xnotinfvB.
have [/[dup]xinfvA/IHA->|/[dup]xnotinfvA/sub_notfree->]:= boolP (x \in fv A).
rewrite inE.
case: ifP => _ /=.
case: ifP => _; rewrite fsetUACA fsetUid //.
by apply: memr; move: {+}x xinfvA; apply/fsubsetP; apply: fv_vars.
case: ifP => [xinbvB|_]; rewrite fsetUACA fsetUid //.
by apply: meml; move: {+}x xinbvB; apply/fsubsetP; apply: bv_vars.
by rewrite fsetDUl.
rewrite inE; case: ifP => _.
by rewrite orbT fsetUA.
have [xinbvA|xnotinbvA] /= := boolP (x \in bv A).
rewrite fsetUA.
by apply: memr; move: {+}x xinbvA; apply/fsubsetP; apply: bv_vars.
rewrite fsetUA fsetDUl.
rewrite (@mem_fsetD1 _ _ (vars A)) //.
by rewrite varsE inE negb_or xnotinfvA.
- move=> y A IHA /fsetDP [xinfvA /[!inE] /eqP neqxy].
rewrite eq_sym; case: eqP => [[//]|_]; case: eqP => [//|_ /=].
rewrite (IHA xinfvA).
case: ifP => _ /[1!fsetUA] //.
rewrite fsetDUl (@mem_fsetD1 _ _ [fset y]) //.
by rewrite inE; apply/eqP.
Qed.
Lemma vars_sub_Const (A : formula) (c : ConstName sig) (t : term) :
vars A`[Const c <- t] =
if c \in constants A then vars A `|` termfv t else vars A.
Proof.
have [|/sub_notconstants -> //] := boolP (c \in constants A).
elim: A => //=.
- move=> P ts /bigfcupP /= [[//|/= c' /[!inE] /andP[+ _] /eqP eqcc']].
rewrite -{}eqcc' => {c'} cints.
apply/fsetP => /= x; apply/bigfcupP/idP => /=.
move=> [_ /andP[/mapP /= [t' t'ints] ->] _].
case: eqP => _.
by rewrite inE => -> /[!orbT].
move=> xint' /[!inE]; apply/orP; left.
apply/bigfcupP; exists t' => //.
by rewrite t'ints.
move=> /fsetUP [/bigfcupP /= [vx /andP[vxints _] xinvx]|xint].
exists vx => //.
rewrite andbT; apply/mapP; exists vx => //.
case: eqP => //.
by case: {+}vx xinvx.
exists t => //.
rewrite andbT; apply/mapP; exists (Const c) => //.
by rewrite eqxx.
- move=> A IHA B IHB /fsetUP[/IHA ->|/IHB ->].
have [/IHB ->|/sub_notconstants ->] := boolP (c \in constants B).
by rewrite fsetUACA fsetUid.
by rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA.
have [/IHA ->|/sub_notconstants ->] := boolP (c \in constants A).
by rewrite fsetUACA fsetUid.
by rewrite fsetUA.
- move=> x A + cinA.
by move=> /(_ cinA) -> /[!fsetUA].
Qed.
Lemma vars_sub (A : formula) (t1 t2 : term) :
vars A`[t1 <- t2] `<=` vars A `|` termfv t2.
Proof.
case: t1 => [x|c].
rewrite vars_sub_Var.
case: ifP => [_|/[!fsubsetUl] //].
case: ifP => [//|_].
by rewrite fsetSU // fsubsetDl.
rewrite vars_sub_Const.
by case: ifP => [|/[!fsubsetUl]].
Qed.
Lemma notfv_sub (A : formula) (x : VarName) (c : ConstName sig) :
x \notin fv A`[Var x <- Const c].
Proof.
rewrite fv_sub_Var; last by rewrite freefor_Const.
case: ifP => [xinA | /negP /negP //].
by rewrite !inE /= orbF eqxx.
Qed.
Lemma subxyyx (A : formula) (x y : VarName) :
freefor A x (Var y) ->
y \notin fv A ->
A`[Var x <- Var y]`[Var y <- Var x] = A.
Proof.
elim: A => //=.
- move=> P ts _ /negP tnotints.
congr Pred; apply: eq_from_tnth => i; rewrite 2!tnth_map.
case: eqP; case: eqP => // _ eqiy.
exfalso; apply: tnotints.
apply/bigfcupP; exists (tnth ts i).
by rewrite mem_tnth.
by rewrite eqiy /= inE.
- move=> A IHA B IHB /andP[ffAxy ffBxy].
rewrite !inE negb_or => /andP[ynotinA ynotinB].
by rewrite IHA // IHB.
- move=> A IHA ffAxy ynotinA.
by rewrite IHA.
- move=> z A IHA.
case: eqP => [/= -> _|neqzx /=].
rewrite eqxx !inE negb_and.
case: eqP => [-> /[!subtt] //|/= neqyx ynotinA].
case: eqP => [//|_].
by rewrite sub_notfree.
case: eqP => [[]//|_].
rewrite !inE negb_and eq_sym => /andP[ffAxy /implyP neqzy].
move=> /orP[eqyz|].
have xnotinA := contra neqzy eqyz.
rewrite !sub_notfree //.
move: eqyz => /negPn /eqP ->.
by rewrite fv_Allself.
move=> ynotinA; move: neqzy.
have [xinA /(_ isT)|xnotinA _] := boolP (x \in fv A).
rewrite eq_sym /=.
case: eqP => [//|neqzy _].
case: eqP => [[//]|_].
by rewrite IHA.
rewrite (sub_notfree _ xnotinA) /= (sub_notfree _ ynotinA).
by case: eqP.
Qed.
Lemma closed_All (x : VarName) (A : formula) (c : ConstName sig) :
closed (All x A) = closed A`[Var x <- Const c].
Proof.
rewrite /closed /= fv_sub_Var; last by rewrite freefor_Const.
case: ifP.
by move=> _ /=; rewrite fsetU0.
move=> /negP xnotinA; rewrite fsetD_eq0 fsubset1.
suff -> : fv A == [fset x] = false by [].
by apply/eqP => eqfvAx; move: xnotinA; rewrite eqfvAx in_fsetE.
Qed.
Definition closedE := (closed_Conj, closed_Diam, closed_All).
Lemma freefor_sub_neq (x : VarName) (t t1 t2 : term) (A : formula) :
Var x <> t2 ->
freefort A t1 t2 ->
freefor A x t ->
freefor A`[t1 <- t2] x t.
Proof.
move: x t t1 t2; elim: A => //=.
move=> A IHA B IHB x t t1 t2 neqxt2 /andP[ffAt12 ffBt12] /andP[ffAxt ffBxt].
by rewrite IHA // IHB.
move=> y B IHB x t t1 t2 neqxt2.
case: t1 => [z1|c1 /andP[ffBc1t2 neqyt2] /=].
case: eqP => [<- _|neqyz1 /=]; first by rewrite eqxx.
rewrite freefort_freefor.
have -> /= : Var y == Var z1 = false by case: eqP => [[]|].
case: eqP => [//|neqyx /=].
move=> /andP[ffBz1t2 ynotint2].
have [xinB|xnotinB] /= := boolP (x \in fv B).
move=> /andP[ffxt ->].
rewrite implybT andbT.
by apply: IHB => //; rewrite freefort_freefor.
rewrite andbT => ffBxt.
rewrite IHB //=; last by rewrite freefort_freefor.
rewrite fv_sub_Var //.
case: ifP => [z1inB|]; last first.
by move: xnotinB; have [|] := boolP (x \in fv B).
rewrite !inE; apply/implyP => /orP[|].
move: xnotinB; have [//|] := boolP (x \in fv B).
by rewrite andbF.
move: neqxt2; case: {+}t2 => [w /=|//].
rewrite inE => + /eqP eqxw.
by rewrite eqxw.
case: eqP => [//|neqyx /=].
have [xinB|xnotinB] //= := boolP (x \in fv B).
move=> /andP[ffBxt ->].
rewrite implybT andbT.
by apply: IHB.
rewrite andbT => ffBxt.
rewrite IHB //=.
rewrite fv_sub_Const //.
move: xnotinB => /negPf xnotinB.
have [_|_] := boolP (c1 \in constants B); rewrite ?inE xnotinB //=.
case: t2 neqxt2 {ffBc1t2 neqyt2} => [x' + /= /[!inE]|//].
by case: eqP => [->|].
Qed.
Lemma freefor_sub_eq (x : VarName) (t1 t2 : term) (A : formula) :
freefort A t1 (Var x) ->
freefor A x t2 ->
freefort A t1 t2 ->
freefor A`[t1 <- Var x] x t2.
Proof.
elim: A => //=.
move=> A + B + /andP[??] /andP[??] /andP[??].
by move=> -> // ->.
move=> y B.
case: t1 => [z |c /= IHB] /[!inE].
case: eqP => /= [<- /[!eqxx] //|].
case: (@eqP _ (Var y) _) => [[//]|_ neqyz IHB /=].
case: eqP => [-> //|neqyx /=].
move=> /andP[ffBzx _] /andP[ffBxt2 xinB_neqyt2] /andP[ffBzt2 zinB_neqyt2].
rewrite IHB //=.
rewrite fv_sub_Var; last by rewrite -freefort_freefor.
by move: zinB_neqyt2; case: ifP => [/= _ -> /[!implybT]|].
case: eqP => [//|/= neqyx].
move=> /andP[ffBcx _] /andP[ffBxt2 xinB_neqyt2] /andP[ffBct2 cinB_neqyt2].
rewrite IHB //=.
rewrite fv_sub_Const //.
by move: cinB_neqyt2; case: ifP => [/= _ -> /[!implybT]|].
Qed.
Lemma constants_sub_Var (A : formula) (x y : VarName) :
constants A`[Var x <- Var y] = constants A.
Proof.
elim: A => //=.
- move=> P ts.
apply/eqP/fset_eqP => c; apply/bigfcupP/bigfcupP => /=.
move=> [[//|/= c' /andP [/mapP /= [t tints +] _] /fset1P eqcc']].
rewrite -eqcc' => {c' eqcc'}.
case: eqP => // _ eqct.
exists (Const c) => //=.
by rewrite eqct tints.
by apply/fset1P.
move=> [[//|/= c' /andP [+ _] /fset1P eqcc']].
rewrite -eqcc' => {c' eqcc'} cints.
exists (Const c); last by apply/fset1P.
rewrite andbT; apply/mapP => /=.
by exists (Const c).
- by move=> A -> B ->.
- by move=> z A IHA; case: eqP.
Qed.
Lemma constants_sub_Const (A : formula) (x : VarName)
(c : ConstName sig) :
constants A`[Var x <- Const c] =
if x \in fv A then c |` constants A else constants A.
Proof.
elim: A => //.
- move=> P ts.
case: ifP; last by move=> /negP/negP xnotinP; rewrite sub_notfree.
move=> /bigfcupP [[x' /= /andP [+ _] /fset1P eqxx' |//]].
rewrite -eqxx' => xints {x' eqxx'}.
apply/eqP/fset_eqP => c'; apply/bigfcupP/fsetUP => /=.
move=> [t /andP [/mapP /= [t' t'ints -> _]]].
case: eqP => [_ /= c'inc | neqt'x c'int']; first by left.
by right; apply/bigfcupP; exists t' => //; rewrite t'ints.
move=> [/fset1P -> {c'} | /bigfcupP /= [[//| c'' /andP [+ _] /=]]].
exists (Const c); last by apply/fset1P.
rewrite andbT; apply/mapP.
by exists (Var x) => //; rewrite eqxx.
move=> + /fset1P eqc'c''.
rewrite -eqc'c'' => c'ints {c'' eqc'c''}.
exists (Const c'); last by apply/fset1P.
by rewrite andbT; apply/mapP; exists (Const c').
- move=> /= A IHA B IHB.
case: ifP.
move=> /fsetUP [xinA | xinB].
rewrite IHA xinA IHB fsetUA.
case: ifP => // _.
by rewrite fsetUCA 2!fsetUA fsetUid.
rewrite IHA IHB xinB fsetUCA.
case: ifP => // _.
by rewrite 3!fsetUA fsetUid.
move=> /negP /negP; rewrite in_fsetE negb_or => /andP.
by rewrite IHA IHB => [] [/negPf -> /negPf ->].
- move=> /= y A IHA.
case: eqP => [[<-] /= | neqyx /=].
by case: fsetDP => [[_ /fset1P //]|//].
rewrite IHA.
case: (ifP (_ \in _ `\ _)) => [/fsetDP [-> ] // |].
move=> /negP/negP; rewrite in_fsetE negb_and => /orP [| /negPf -> //].
rewrite inE => /negPf /negbFE /eqP eqxy.
by exfalso; apply: neqyx; rewrite eqxy.
Qed.
Lemma constants_sub (A : formula) (x : VarName) (t : term) :
constants A`[Var x <- t] =
if x \in fv A then (termconstants t) `|` constants A else constants A.
Proof.
case: t => [y | c].
by rewrite /= fset0U constants_sub_Var; case: ifP.
by rewrite /= constants_sub_Const.
Qed.
Lemma constantcount_sub (x : VarName) (c : ConstName sig) (A : formula) :
constantcount A <= constantcount A`[Var x <- Const c] <= (constantcount A).+1.
Proof.
rewrite /constantcount constants_sub_Const.
case: ifP => _; last by apply/andP.
rewrite cardfsU1.
case: (_ \notin _) => /=.
by rewrite add1n; apply/andP.
by rewrite add0n; apply/andP.
Qed.
Reserved Notation "A `[ ts1 <-- ts2 ]"
(at level 8, format "A `[ ts1 <-- ts2 ]").
Fixpoint simsub (A : formula) (ts1 ts2 : seq term) : formula :=
match A with
| T => T
| Pred P ts =>
Pred [tuple of [seq if ti \in ts1 then
nth ti ts2 (index ti ts1)
else ti
| ti <- ts]]
| B /\ C => B`[ts1 <-- ts2] /\ C`[ts1 <-- ts2]
| <> B => <> B`[ts1 <-- ts2]
| All y B => if Var y \in ts1 then
if index (Var y) ts1 < size ts2 then
All y B`[ts1 <--
set_nth (Var y) ts2 (index (Var y) ts1) (Var y)]
else
(* y appears in ts1, but has no counterpart in ts2 *)
All y B`[ts1 <-- ts2]
else All y B`[ts1 <-- ts2]
end
where "A `[ ts1 <-- ts2 ]" := (simsub A ts1 ts2) : qsp_scope.
Lemma simsub0ts (A : formula) (ts : seq term) :
A`[[::] <-- ts] = A.
Proof.
elim: A => //=.
- move=> P ts'.
by congr Pred; apply: eq_from_tnth => i; rewrite tnth_map.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->.
Qed.
Lemma simsubts0 (A : formula) (ts : seq term) :
A`[ts <-- [::]] = A.
Proof.
elim: A => //=.
- move=> P ks.
congr Pred; apply: eq_from_tnth => i; rewrite tnth_map.
by rewrite nth_nil; case: ifP.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->; case: ifP.
Qed.
Lemma simsub1ts (A : formula) (t : term) (ts : seq term) :
A`[[:: t] <-- ts] = A`[t <- head t ts].
Proof.
elim: A t ts => //=.
- move=> P ts' t ts.
congr Pred; apply: eq_from_tnth => i; rewrite 2!tnth_map.
rewrite in_cons in_nil orbF.
case: eqP => [->|//].
by rewrite eqxx.
- by move=> A IHA B IHB t ts; rewrite IHA IHB.
- by move=> A IHA t ts; rewrite IHA.
- move=> x A IHA t ts.
rewrite !inE eq_sym.
case: eqP => [->|_].
case: ltnP.
case: ts IHA => [//|t' ts' /= IHA _].
by rewrite IHA /= subtt.
rewrite leqn0 => /eqP /size0nil ->.
by rewrite simsubts0.
by rewrite IHA.
Qed.
Lemma sub_simsub (A : formula) (t t' : term) :
A`[t <- t'] = A`[[:: t] <-- [:: t']].
Proof. by rewrite simsub1ts. Qed.
Lemma simsub_cons (A : formula) (t t' : term) (ts ts' : seq term) :
t' \notin ts ->
uniq (t :: ts) ->
A`[t :: ts <-- t' :: ts'] = A`[t <- t']`[ts <-- ts'].
Proof.
elim: A t t' ts ts' => //=.
- move=> P ks t t' ts ts' t'notints tnotints_uniqts.
congr Pred; apply: eq_from_tnth => i; rewrite !tnth_map.
rewrite eq_sym in_cons.
case: eqP => [eqksit/=|//].
case: ifP => [t'ints|//].
by move: t'notints; rewrite t'ints.
- move=> A IHA B IHB t t' ts ts' t'notints tnotints_uniqts.
by rewrite IHA // IHB.
- move=> A IHA t t' ts ts' t'notints tnotints_uniqts.
by rewrite IHA.
- move=> x A IHA t t' ts ts' t'notints tnotints_uniqts.
rewrite in_cons eq_sym.
case: eqP => [eqtx|neqtx]/=.
rewrite -eqtx.
case: ifP => [tints|_].
by exfalso; move: tnotints_uniqts; rewrite tints.
rewrite IHA //.
by rewrite subtt.
by move: tnotints_uniqts => /andP [-> _].
case: ifP => [xints|xnotints].
rewrite -[_.+1 < _.+1]/(index (Var x) ts < _).
by case: ltnP => _; rewrite IHA.
by rewrite IHA.
Qed.
Fixpoint modaldepth (A : formula) : nat :=
match A with
| T | Pred _ _ => 0
| B /\ C => maxn (modaldepth B) (modaldepth C)
| <> B => (modaldepth B).+1
| All _ B => modaldepth B
end.
Lemma modaldepth_sub (t t' : term) (A : formula) :
modaldepth A`[t <- t'] = modaldepth A.
Proof.
elim: A => //=.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> y A IHA; case: eqP.
Qed.
Fixpoint quantifierdepth (A : formula) : nat :=
match A with
| T | Pred _ _ => 0
| B /\ C => maxn (quantifierdepth B) (quantifierdepth C)
| <> B => quantifierdepth B
| All _ B => (quantifierdepth B).+1
end.
Lemma quantifierdepth_sub (t t' : term) (A : formula) :
quantifierdepth A`[t <- t'] = quantifierdepth A.
Proof.
elim: A => //=.
by move=> A -> B ->.
by move=> y A IHA; case: eqP => [// | /= _]; rewrite IHA.
Qed.
Fixpoint depth (A : formula) : nat :=
match A with
| T | Pred _ _ => 0
| B /\ C => (maxn (depth B) (depth C)).+1
| <> B | All _ B => (depth B).+1
end.
Lemma depth_sub (t t' : term) (A : formula) :
depth A`[t <- t'] = depth A.
Proof.
elim: A => //=.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> y A IHA; case: eqP => [// | /= _]; rewrite IHA.
Qed.
(* TODO the name is misleading, as this is just a sufficient condition for freshness *)
Definition termfresh (m : nat) (t : term) : bool :=
\max_(x <- termfv t) x < m.
Definition termfresh0 (t : term) : termfresh 0 t = false.
Proof. by rewrite /termfresh ltn0. Qed.
Lemma termfresh_Var (m : nat) (x : VarName) :
termfresh m (Var x) = (x < m).
Proof. by rewrite /termfresh /= big_seq_fset1. Qed.
Lemma termfresh_Const (m : nat) (c : ConstName sig) :
termfresh m (Const c) = (0 < m).
Proof. by rewrite /termfresh /= big_nil. Qed.
Definition fresh (m : nat) (A : formula) : bool :=
\max_(x <- vars A) x < m.
Lemma fresh0 (A : formula) : fresh 0 A = false.
Proof. by rewrite /fresh ltn0. Qed.
Lemma fresh_Pred (m : nat) (P : PredName sig) (ts : (arity P).-tuple term) :
fresh m.+1 (Pred ts) = all (termfresh m.+1) ts.
Proof.
rewrite /fresh /termfresh /= ltnS; apply/bigmax_leqP_list/allP => /=.
move=> H; case=> [x|c _] /=; rewrite ltnS; last by rewrite big_nil.
rewrite big_seq_fset1 => xints.
apply: H.
apply/bigfcupP; exists (Var x) => /=.
by rewrite xints.
by rewrite inE.
move=> H x /bigfcupP /= [+ /andP[+ _]].
case=> [y /=|//].
rewrite inE => /H /=.
by rewrite big_seq_fset1 ltnS => leqym /eqP ->.
Qed.
Lemma fresh_Conj (m : nat) (A B : formula) :
fresh m (A /\ B) = fresh m A && fresh m B.
Proof.
rewrite /fresh /= big_fsetU /=; last by apply: maxnn.
by rewrite gtn_max.
Qed.
Lemma fresh_Diam (m : nat) (A : formula) : fresh m (<> A) = fresh m A.
Proof. by []. Qed.
Lemma fresh_All (m : nat) (x : VarName) (A : formula) :
fresh m (All x A) = (x < m) && fresh m A.
Proof.
rewrite /fresh /= big_fsetU /=; last by apply: maxnn.
by rewrite gtn_max big_seq_fset1.
Qed.
Definition freshE := (termfresh_Var, termfresh_Const, fresh_Pred, fresh_Conj,
fresh_Diam, fresh_All).
Lemma fresh_monotone (n m : nat) (A : formula) :
n <= m -> fresh n A -> fresh m A.
Proof. by rewrite /fresh => leqnm ltAn; apply: (leq_trans ltAn). Qed.
End Language.
Notation "A /\ B" := (Conj A B)
(at level 80, B at level 80, format "A /\ B") : qsp_scope.
Notation "<> A" := (Diam A) (at level 40, format "<> A") : qsp_scope.
Notation "A `[ t1 <- t2 ]" := (sub A t1 t2)
(at level 8, format "A `[ t1 <- t2 ]") : qsp_scope.
Notation "A `[ ts1 <-- ts2 ]" := (simsub A ts1 ts2)
(at level 8, format "A `[ ts1 <-- ts2 ]") : qsp_scope.
Section Signature.
Open Scope qsp_scope.
Variable sig : signature.
(* Extend a signature with n new constants *)
Definition extend (n : nat) : signature :=
Signature [finType of ConstName sig + 'I_n] (@arity sig).
Definition termlift (n : nat) (t : term sig) : term (extend n) :=
match t with
| Var m => Var (extend n) m
| Const c => @Const (extend n) (inl c)
end.
Notation "t `!! n" := (termlift n t)
(at level 4, format "t `!! n") : qsp_scope.
Lemma termlift_inj (n : nat) : injective (termlift n).
Proof. by case=> [x [y [-> //]|//]|c [//|d [->]]]. Qed.
Reserved Notation "A !! n" (at level 4, format "A !! n").
Fixpoint lift (n : nat) (A : formula sig) : formula (extend n) :=
match A with
| T => T (extend n)
| Pred P ts => @Pred (extend n) P [tuple of (map (termlift n) ts)]
| A1 /\ A2 => A1!!n /\ A2!!n
| <> B => <> B!!n
| All x B => All x B!!n
end
where "A !! n" := (lift n A) : qsp_scope.
Lemma lift_inj (n : nat) : injective (lift n).
Proof.
elim.
- by case.
- move=> P ts; case=> //.
move=> P' + [eqPP']; rewrite -eqPP' => ts' eqtsts'.
have : [tuple of [seq i`!!n | i <- ts]] = [tuple of [seq i`!!n | i <- ts']].
by apply/val_eqP/eqP.
move=> {}eqtsts'.
congr Pred; apply/eq_from_tnth => i.
move: eqtsts' => /(congr1 (fun ts => tnth ts i)).
by rewrite !tnth_map => /= /termlift_inj.
- move=> A IHA B IHB; case=> //.
by move=> A' B' [/IHA -> /IHB ->].
- move=> A IHA; case=> //.
by move=> A' [/IHA ->].
- move=> x A IHA; case=> //.
by move=> x' A' [-> /IHA ->].
Qed.
(* (m : nat) is meant to be some natural number larger than any variable *)
(* appearing in our context. Thus we make sure that constants are replaced by *)
(* fresh variables *)
Definition termunlift (n m : nat) (t : term (extend n)) : term sig :=
match t with
| Var k => Var sig k
| Const (inl c) => Const c
| Const (inr c) => Var sig (m + c)
end.
Notation "t `$ m" := (termunlift m t)
(at level 4, format "t `$ m") : qsp_scope.
Lemma termunlift_inj (n m : nat) (t1 t2 : term (extend n)) :
termfresh m t1 ->
termfresh m t2 ->
t1`$m = t2`$m -> t1 = t2.
Proof.
case: t1 => [x|c] /=.
case: t2 => [y _ _ [-> //]|[//|/= k]].
rewrite !freshE => ltxm _ [eqxmk].
exfalso; move: ltxm; rewrite eqxmk.
by apply/negP; rewrite -leqNgt leq_addr.
case: c => [c|/= k].
by case: t2 => [//|[d _ _ [-> //]|//]].
case: t2 => [y _|c _ _] /=.
rewrite freshE => ltym [eqmky].
exfalso; move: ltym; rewrite -eqmky.
by apply/negP; rewrite -leqNgt leq_addr.
by case: c => [//|/= l [/addnI /eqP /val_eqP ->]].
Qed.
Reserved Notation "A $ m" (at level 4, format "A $ m").
Fixpoint unlift (n m : nat) (A : formula (extend n)) :
formula sig :=
match A with
| T => T sig
| Pred P ts => @Pred sig P [tuple of map (@termunlift n m) ts]
| A1 /\ A2 => A1$m /\ A2$m
| <> B => <> B$m
| All x B => All x B$m
end
where "A $ m" := (unlift m A) : qsp_scope.
Lemma unlift_inj (n m : nat) (A B : formula (extend n)) :
fresh m A ->
fresh m B ->
A$m = B$m -> A = B.
Proof.
elim: A B.
- by case.
- move=> P ts.
case: m => [|m]; first by rewrite fresh0.
case=> // P' + + + /= [eqPP'].
rewrite -eqPP' => ts'.
rewrite 2!freshE => /allP /= freshts /allP /= freshts' eqtsts'.
have : [tuple of [seq i`$m.+1 | i <- ts]]
= [tuple of [seq i`$m.+1 | i <- ts']].
by apply/val_eqP/eqP.
move=> {}eqtsts'.
congr Pred; apply/eq_from_tnth => i.
move: eqtsts' => /(congr1 (fun ts => tnth ts i)).
rewrite 2!tnth_map => /termunlift_inj; apply.
by apply: freshts; rewrite mem_tnth.
by apply: freshts'; rewrite mem_tnth.
- move=> A IHA A' IHA' /=.
case=> // B B'.
rewrite 2!freshE => /andP[freshA freshA'] /andP[freshB freshB'] /=.
by move=> [/(IHA _ freshA freshB) -> /(IHA' _ freshA' freshB') ->].
- move=> A IHA.
case=> // B.
by rewrite 2!freshE => /= freshA freshB [/(IHA _ freshA freshB) ->].
- move=> x A IHA.
case=> // y B.
rewrite 2!freshE => /andP[ltxm freshA] /andP[ltym freshB] /= [->].
by move=> /(IHA _ freshA freshB) ->.
Qed.
Lemma fv_unlift (n m : nat) (A : formula (extend n)) :
(fv A$m `<=` fv A `|` [fset (m + val c)%N | c in 'I_n])%fset.
Proof.
set X := [fset _ | _ in _]%fset.
elim: A => //=.
- move=> P ts.
apply/fsubsetP =>/=x /bigfcupP/=[tx/[!andbT] /mapP/=[[|]/=]].
move=> y yints eqtxv xintx.
apply/fsetUP; left.
apply/bigfcupP; exists (Var (extend n) y) => /=.
by rewrite yints.
by case: tx xintx eqtxv => [x' /[!inE] /eqP <- [->]|//].
move=> [c _|k kints -> /= /[!inE] /eqP ->].
by case: tx.
apply/orP; right.
by apply/imfsetP; exists k.
- move=> A IHA B IHB.
rewrite -(fsetUid X) fsetUACA.
by apply: fsetUSS.
- move=> x A /(fsetSD [fset x]%fset) IHA.
apply: (fsubset_trans IHA).
by rewrite fsetDUl fsetUSS // fsubD1set.
Qed.
Lemma vars_unlift (n m : nat) (A : formula (extend n)) :
(vars A$m `<=` vars A `|` [fset (m + val c)%N | c in 'I_n])%fset.
Proof.
elim: A => //=.
- move=> P ts.
apply/fsubsetP => /= x /bigfcupP/= [t' /andP[/mapP/= [t + ->] _]] {t'}.
case: t => [y /=|c].
rewrite !inE => yints /eqP ->.
apply/orP; left.
apply/bigfcupP; exists (Var _ y).
by rewrite yints.
by rewrite inE.
case: c => [//|/= k].
rewrite !inE => _ /eqP ->.
apply/orP; right.
by apply/imfsetP; exists k.
- set w := [fset _ | _ in _]%fset.
move=> A IHA B IHB.
have : (vars A `|` vars B `|` w = (vars A `|` w) `|` (vars B `|` w))%fset.
by rewrite fsetUACA fsetUid.
by move=> ->; apply: fsetUSS.
- move=> x A IHA.
by rewrite -fsetUA; apply: fsetUSS.
Qed.
Definition freshvars (n m : nat) : seq (term sig) :=
[seq Var sig (m + c) | c <- iota 0 n].
Lemma freshvarsE (n m : nat) :
freshvars n m = map (Var sig) (map (addn m) (iota 0 n)).
Proof. by rewrite -map_comp /=. Qed.
Lemma unlift_freshvars (n m k : nat) (A : formula (extend n)) :
fresh k A ->
A$m = (A$k)`[freshvars n k <-- freshvars n m].
Proof.
elim: A => //=.
- move=> P ts.
case: k => [|k]; first by rewrite fresh0.
rewrite freshE => /allP /= freshts.
congr Pred; apply: eq_from_tnth => i; rewrite 3!tnth_map.
case eqti: (tnth ts i) => [x /=|c].
case: ifP => [/mapP /= [c ciniotan [eqxkc]]|//].
exfalso.
move: (freshts _ (mem_tnth i ts)).
rewrite eqti freshE eqxkc.
by apply/negP; rewrite -leqNgt leq_addr.
move: c eqti => [c _|/= [j ltjn] eqtij] /=.
by case: ifP => [/mapP /= [x _]|].
case: ifP => [kjinfvk|/negP nkjinfvk].
rewrite index_map; last by move=> /= a b []/eqP; rewrite eqn_add2l =>/eqP.
rewrite -val_enum_ord -[j]/(val (Ordinal ltjn)) index_map; last first.
by apply: val_inj.
rewrite index_enum_ord /=.
rewrite (nth_map j); last by rewrite size_iota.
by rewrite nth_iota.
exfalso; apply: nkjinfvk.
apply/mapP => /=; exists j => //.
by rewrite mem_iota add0n leq0n ltjn.
- move=> A IHA B IHB.
rewrite freshE => /andP[freshA freshB].
by rewrite IHA // IHB.
- move=> A IHA; rewrite freshE => freshA.
by rewrite IHA.
- move=> x A IHA.
rewrite freshE => /andP[ltxk freshA].
case: ifP => [xinfvk|_]; last by rewrite IHA.
exfalso.
move: xinfvk => /mapP /= [i].
rewrite mem_iota add0n => /andP[_ ltin] [eqxki].
move: ltxk; rewrite eqxki.
by apply/negP; rewrite -leqNgt leq_addr.
Qed.
Lemma fresh_sub (n m : nat) (A : formula (extend n)) (t1 t2 : term (extend n)) :
termfresh m t2 ->
fresh m A ->
fresh m A`[t1 <- t2].
Proof.
case: m => [|m]; first by rewrite fresh0.
rewrite /fresh /termfresh !ltnS.
move=> /bigmax_leqP_list /= fresht2 /bigmax_leqP_list /= freshA.
apply/bigmax_leqP_list => /= x xinvars.
have /fsubsetP /(_ _) /(_ xinvars) := vars_sub A t1 t2.
move=> /fsetUP [xinA|xint2].
by apply: freshA.
by apply: fresht2.
Qed.
Lemma sub_fresh (n m : nat) (A : formula (extend n)) (t1 t2 : term (extend n)) :
termfresh m t1 ->
fresh m A`[t1 <- t2] ->
fresh m A.
Proof.
case: m => [|m]; first by rewrite fresh0.
rewrite /fresh /termfresh !ltnS.
case: t1 => [x /[!big_seq_fset1] leqxm|c _] /=.
rewrite vars_sub_Var.
case: ifP => [xinfvA|//].
case: ifP => _.
move=> /bigmax_leqP_list /= leqm.
apply/bigmax_leqP_list => /= y yinA.
by apply: leqm; rewrite inE yinA.
move=> /bigmax_leqP_list /= leqm.
apply/bigmax_leqP_list => /= y yinA.
case: (@eqP _ y x) => [-> //|/eqP neqyx].
by apply: leqm; rewrite !inE neqyx yinA.
rewrite vars_sub_Const.
case: ifP => [cinA|//].
move=> /bigmax_leqP_list /= leqm.
apply/bigmax_leqP_list => /= y yinA.
by apply: leqm; rewrite inE yinA.
Qed.
Lemma unlift_sub (n m : nat) (A : formula (extend n))
(t1 t2 : term (extend n)) :
fresh m A ->
termfresh m t1 ->
(A`[t1 <- t2])$m = A$m`[t1`$m <- t2`$m].
Proof.
move=> + fresht1; elim: A => //=.
- move=> P ts.
case: m fresht1 => [|m]; first by rewrite fresh0.
rewrite freshE => fresht1 /allP /= freshts.
congr Pred; apply: eq_from_tnth => i; rewrite !tnth_map.
case: (@eqP _ _`$_).
move=> /(termunlift_inj (freshts _ (mem_tnth i ts)) fresht1) ->.
by rewrite eqxx.
by case: eqP => [->|].
- by move=> A IHA B IHB /[!freshE] /andP[/IHA -> /IHB ->].
- by move=> A IHA /[!freshE] /IHA ->.
- move=> x A IHA /[!freshE] /andP[ltxm freshA].
case: (@eqP _ _ _`$_).
rewrite -[Var sig _]/((Var (extend n) _)`$m) => /termunlift_inj.
by rewrite freshE => /(_ ltxm) /(_ fresht1) -> /[!eqxx].
by case: eqP => [<- //|/= /[!IHA]].
Qed.
Lemma in_fv_unlift_fv (n m : nat) (x : VarName) (A : formula (extend n)) :
x < m ->
(x \in fv A$m) = (x \in fv A).
Proof.
move=> ltxm.
elim: A => //=.
- move=> P ts.
apply/bigfcupP/bigfcupP => /=.
move=> [t' /andP[/mapP /= [t tints ->] _] xintm].
exists t => [/[!tints] //|].
case: t tints xintm => [//|[//|/= k _]].
move=> /imfsetP /= [l /[!inE] /eqP -> eqxmk].
by exfalso; move: ltxm; apply/negP; rewrite -leqNgt eqxmk leq_addr.
move=> [t /andP[tints _] xint].
exists t`$m.
by rewrite andbT; apply/mapP; exists t.
by case: t tints xint.
- move=> A IHA B IHB.
by rewrite !inE IHA IHB.
- move=> y A IHA.
by rewrite !inE IHA.
Qed.
Lemma in_fv_unlift_constants (n m : nat) (k : 'I_n) (A : formula (extend n)) :
fresh m A ->
(m + k \in fv A$m) = (inr k \in constants A).
Proof.
elim: A => //=.
- move=> P ts freshmP.
apply/bigfcupP/bigfcupP => /=.
move=> [_ /andP[/mapP/=[t tints ->]] _ eqmktm].
exists t; first by rewrite tints.
case: t tints eqmktm => [x /[!inE] + /eqP eqmkx|]/=.
rewrite -{}eqmkx => {x} mkints.
exfalso.
move: freshmP; rewrite /fresh ltnNge => /negP; apply.
apply: (@leq_trans (m + k)); first by apply: leq_addr.
apply: leq_bigmax_list => /=.
apply/bigfcupP; exists (Var (extend n) (m + k)); first by rewrite andbT.
by rewrite inE.
case=> [//|k' /= _].
by rewrite !inE eqn_add2l => /val_eqP ->.
move=> [t /andP[tints _] eqkt].
exists (Var sig (m + k)); last by rewrite inE.
rewrite andbT; apply/mapP; exists t => //.
by case: t {tints} eqkt => [//|/= [c|k'] /[!inE] // /eqP [->]].
- by move=> A IHA B IHB /[!inE] /[!freshE] /andP[/IHA -> /IHB ->].
- move=> x A IHA /[!inE] /[!freshE] /andP[ltxm /IHA ->].
case: (_ \in _); last by rewrite andbF.
rewrite andbT; apply/eqP => eqmkx.
move: ltxm; rewrite ltnNge => /negP; apply.
by rewrite -eqmkx leq_addr.
Qed.
Lemma freefor_unlift (n m : nat) (A : formula (extend n)) (x : VarName)
(t : term (extend n)) :
x < m ->
fresh m A ->
freefor A$m x t`$m = freefor A x t.
Proof.
move=> ltxm.
case: t => [y|] /=.
move=> _; elim: A => //=.
by move=> A -> B ->.
move=> z A ->.
by rewrite in_fv_unlift_fv.
case => [c|/= k].
by rewrite !freefor_Const.
rewrite freefor_Const.
elim: A => //=.
by move=> A IHA B IHB /[!freshE] /andP [/IHA -> /IHB ->].
move=> y A IHA /[!freshE] /andP[ltym /IHA ->] /=.
case: eqP => [//|_ /=].
apply/implyP => _ /[!inE].
by apply/eqP => eqymk; move: ltym; apply/negP; rewrite -leqNgt eqymk leq_addr.
Qed.
Lemma constants_unlift (n m : nat) (A : formula (extend n))
(c : ConstName sig) :
c \in constants A$m -> inl c \in constants A.
Proof.
elim: A => //=.
move=> P ts /bigfcupP /= [_ /[!andbT] /mapP /= [t tints ->] cintm].
apply/bigfcupP; exists t.
by rewrite tints.
case: t cintm {tints} => [x|[d|k]] //=.
by rewrite !inE => /eqP ->.
by move=> A IHA B IHB /= /[!inE] /orP[/IHA ->|/IHB -> /[!orbT]].
Qed.
Lemma termliftK (n m : nat) (t : term sig) :
(t`!!n)`$m = t.
Proof. by case: t. Qed.
Lemma liftK (n m : nat) (A : formula sig) :
(A!!n)$m = A.
Proof.
elim: A => //=.
- move=> P ts.
congr Pred.
apply: eq_from_tnth => i.
rewrite 2!tnth_map.
by case: (tnth ts i).
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->.
Qed.
End Signature.
Notation "t `!! n" := (termlift n t)
(at level 4, format "t `!! n") : qsp_scope.
Notation "A !! n" := (lift n A)
(at level 4, format "A !! n") : qsp_scope.
Notation "t `$ m" := (termunlift m t)
(at level 4, format "t `$ m") : qsp_scope.
Notation "A $ m" := (unlift m A)
(at level 4, format "A $ m") : qsp_scope.
#[export] Hint Resolve freeforxx : core.
From QRC1 Require Import Preamble.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Declare Scope qsp_scope. (* quantified and strictly positive *)
Section Language.
Open Scope fset.
Definition VarName := nat.
Coercion nat_of_VarName (x : VarName) : nat := x.
Coercion VarName_of_nat (n : nat) : VarName := n.
(* We only deal with finite signatures *)
Record signature := Signature {
ConstName : finType;
PredName : finType;
arity : PredName -> nat;
}.
Delimit Scope qsp_scope with qsp.
Variable sig : signature.
Inductive term :=
| Var : VarName -> term
| Const : ConstName sig -> term.
Definition term_code (t : term) : nat + 'I_#|ConstName sig| :=
match t with
| Var x => inl x
| Const c => inr (enum_rank c)
end.
Definition term_decode (ct : nat + 'I_#|ConstName sig|) : term :=
match ct with
| inl n => Var n
| inr i => Const (enum_val i)
end.
Lemma term_codeK : cancel term_code term_decode.
Proof. by case => [// | /= ?]; rewrite enum_rankK. Qed.
Definition term_eqMixin := CanEqMixin term_codeK.
Canonical term_eqType := EqType term term_eqMixin.
Definition term_choiceMixin := CanChoiceMixin term_codeK.
Canonical term_choiceType := ChoiceType term term_choiceMixin.
Definition term_countMixin := CanCountMixin term_codeK.
Canonical term_countType := CountType term term_countMixin.
Definition termfv (t : term) : {fset VarName} :=
match t with
| Var x => [fset x]
| Const c => fset0
end.
Definition termconstants (t : term) : {fset ConstName sig} :=
match t with
| Var x => fset0
| Const c => [fset c]
end.
Inductive formula :=
| T : formula
| Pred : forall (P : PredName sig), (arity P).-tuple term -> formula
| Conj : formula -> formula -> formula
| Diam : formula -> formula
| All : VarName -> formula -> formula.
Bind Scope qsp_scope with formula.
Open Scope qsp_scope.
Notation "A /\ B" := (Conj A B)
(at level 80, B at level 80, format "A /\ B") : qsp_scope.
Notation "<> A" := (Diam A) (at level 40, format "<> A") : qsp_scope.
Fixpoint formula_code (A : formula)
: GenTree.tree (option (PredName sig * seq term)) :=
match A with
| T => GenTree.Leaf None
| Pred P ts => GenTree.Leaf (Some (P, val ts))
| A /\ B => GenTree.Node 0 [:: formula_code A; formula_code B]
| <> A => GenTree.Node 1 [:: formula_code A]
| All x A => GenTree.Node x.+2 [:: formula_code A]
end.
Fixpoint formula_decode
(c : GenTree.tree (option (PredName sig * seq term))) : formula :=
match c with
| GenTree.Leaf None => T
| GenTree.Leaf (Some (P, vts)) =>
if size vts == arity P then
@Pred P (insubd [tuple of nseq (arity P) (Var 0)] vts)
else T
| GenTree.Node 0 [:: c1; c2] => formula_decode c1 /\ formula_decode c2
| GenTree.Node 1 [:: c1] => <> (formula_decode c1)
| GenTree.Node k.+2 [:: c1] => All k (formula_decode c1)
| GenTree.Node _ _ => T
end.
Lemma formula_codeK : cancel formula_code formula_decode.
elim => //=.
- move=> P ts.
rewrite /insubd insubT; first by rewrite size_tuple.
move=> sizek; rewrite size_tuple eqxx /=.
by congr Pred; apply/val_eqP.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->.
Qed.
Definition formula_eqMixin := CanEqMixin formula_codeK.
Canonical formula_eqType := EqType formula formula_eqMixin.
Definition formula_choiceMixin := CanChoiceMixin formula_codeK.
Canonical formula_choiceType := ChoiceType formula formula_choiceMixin.
Definition formula_countMixin := CanCountMixin formula_codeK.
Canonical formula_countType := CountType formula formula_countMixin.
Fixpoint vars (A : formula) : {fset VarName} :=
match A with
| T => fset0
| Pred P ts => \bigcup_(t <- ts) termfv t
| B /\ C => vars B `|` vars C
| <> B => vars B
| All x B => x |` vars B
end.
(* free variables *)
Fixpoint fv (A : formula) : {fset VarName} :=
match A with
| T => fset0
| Pred P ts => \bigcup_(t <- ts) termfv t
| B /\ C => fv B `|` fv C
| <> B => fv B
| All x B => fv B `\ x
end.
(* bound variables *)
Fixpoint bv (A : formula) : {fset VarName} :=
match A with
| T | Pred _ _ => fset0
| B /\ C => bv B `|` bv C
| <> B => bv B
| All x B => x |` bv B
end.
Lemma varsE (A : formula) : vars A = fv A `|` bv A.
Proof.
elim: A => //=.
- by rewrite fsetU0.
- by move=> * /[!fsetU0].
- by move=> A -> B -> /[1!fsetUACA].
- move=> x A ->.
rewrite 2!fsetUA; congr (_ `|` _).
by rewrite fsetUDr fsetUC fsetDv fsetD0.
Qed.
Lemma fv_vars (A : formula) : fv A `<=` vars A.
Proof. by rewrite varsE fsubsetUl. Qed.
Lemma bv_vars (A : formula) : bv A `<=` vars A.
Proof. by rewrite varsE fsubsetUr. Qed.
Lemma fv_Allself (A : formula) (x : VarName) :
x \notin fv (All x A).
Proof. by rewrite fsetD11. Qed.
Lemma fv_Allother (A : formula) (x y : VarName) :
x <> y -> (x \in fv (All y A)) = (x \in fv A).
Proof. by rewrite /= in_fsetD1 => /eqP ->. Qed.
Definition closed (A : formula) : bool :=
fv A == fset0.
Lemma closed_Conj (A B : formula) :
closed (A /\ B) = closed A && closed B.
Proof. by rewrite /closed fsetU_eq0. Qed.
Lemma closed_Diam (A : formula) :
closed (<> A) = closed A.
Proof. by []. Qed.
Lemma closed_fv (A : formula) (x : VarName) :
closed A -> x \notin fv A.
Proof. by move=> /eqP ->. Qed.
Fixpoint constants (A : formula) : {fset ConstName sig} :=
match A with
| T => fset0
| Pred P ts => \bigcup_(t <- ts) termconstants t
| B /\ C => constants B `|` constants C
| <> B => constants B
| All x B => constants B
end.
Definition constantcount (A : formula) : nat :=
#|` constants A|.
Lemma constantcount_Conjl (A B : formula) :
constantcount A <= constantcount (A /\ B).
Proof. by apply: fsubset_leq_card; rewrite fsubsetUl. Qed.
Lemma constantcount_Conjr (A B : formula) :
constantcount B <= constantcount (A /\ B).
Proof. by apply: fsubset_leq_card; rewrite fsubsetUr. Qed.
Lemma constantcount_Diam (A : formula) :
constantcount (<> A) = constantcount A.
Proof. by []. Qed.
Lemma constantcount_All (x : VarName) (A : formula) :
constantcount (All x A) = constantcount A.
Proof. by []. Qed.
Fixpoint terms (A : formula) : {fset term} :=
match A with
| T => fset0
| Pred P ts => [fset t in (ts : seq term)]
| B /\ C => terms B `|` terms C
| <> B => terms B
| All x B => Var x |` terms B
end.
Reserved Notation "A `[ t1 <- t2 ]" (at level 8, format "A `[ t1 <- t2 ]").
Fixpoint sub (A : formula) (t1 t2 : term) : formula :=
match A with
| T => T
| Pred P ts =>
@Pred P [tuple of [seq if ti == t1 then t2 else ti | ti <- ts]]
| B /\ C => B`[t1 <- t2] /\ C`[t1 <- t2]
| <>B => <>B`[t1 <- t2]
| All y B => if Var y == t1 then All y B else All y B`[t1 <- t2]
end
where "A `[ t1 <- t2 ]" := (sub A t1 t2) : qsp_scope.
Lemma subtt (A : formula) (t : term) :
A`[t <- t] = A.
Proof.
elim: A => //=.
- move=> P ts; congr Pred.
by apply: eq_from_tnth => i; rewrite tnth_map; case: eqP.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> y A ->; case: eqP.
Qed.
Lemma sub_notfree (x : VarName) (t : term) (A : formula) :
x \notin fv A -> A`[Var x <- t] = A.
Proof.
elim: A => //=.
- move=> P ts /negP xnotfv.
congr Pred; apply: eq_from_tnth=> i; rewrite tnth_map.
case: eqP => [tnthx | //].
exfalso; apply: xnotfv.
apply /bigfcupP => /=.
exists (tnth ts i).
by rewrite mem_tnth.
by rewrite tnthx fset11.
- move=> A IHA B IHB.
rewrite in_fsetU negb_or => /andP [xnotinA xnotinB].
by rewrite IHA // IHB.
- by move=> A IHA xnotinA; rewrite IHA.
- move=> y A IHA; rewrite in_fsetD1 negb_and eq_sym.
case: ifP => [// | /eqP + /orP [/negPn /eqP eqyx | xnotinA]].
by rewrite eqyx.
by rewrite IHA.
Qed.
Lemma sub_notconstants (c : ConstName sig) (t : term) (A : formula) :
c \notin constants A -> A`[Const c <- t] = A.
Proof.
elim: A => //=.
- move=> P ts /negP cnotconst.
congr Pred; apply: eq_from_tnth => i /[!tnth_map].
case: eqP => [eqtnthc|//].
exfalso; apply: cnotconst.
apply/bigfcupP => /=.
by exists (tnth ts i); rewrite ?mem_tnth // eqtnthc fset11.
- by move=> A IHA B IHB /[!inE] /[!negb_or] /andP[/IHA -> /IHB ->].
- by move=> A IHA cnotinA /[!IHA].
- by move=> y A IHA cnotinA /[!IHA].
Qed.
Lemma sub_ConstC (A : formula) (x1 x2 : VarName)
(c1 c2 : ConstName sig) :
x1 <> x2 ->
A`[Var x1 <- Const c1]`[Var x2 <- Const c2] =
A`[Var x2 <- Const c2]`[Var x1 <- Const c1].
Proof.
move=> neqx12.
elim: A => //=.
- move=> P ts.
congr Pred.
apply: eq_from_tnth => i; rewrite 4!tnth_map.
case: (@eqP _ (tnth _ _)) => [-> | neqix1].
case: eqP => // _.
case: eqP => //.
by case: eqP => // [[]].
case: eqP => [// | neqix2].
by case: eqP.
- by move=> A -> B ->.
- by move=> A ->.
- move=> y A IHA.
case: eqP => [[->] | neqyx1].
do 2!(case: eqP => [[//] | _ /=]).
by rewrite eqxx.
case: eqP => [[->] /= | neqyx2 /=].
by rewrite eqxx eq_sym; case: eqP => [[]|].
do 2!(case: eqP => // _).
by rewrite IHA.
Qed.
Fixpoint freefor (A : formula) (x : VarName) (t : term) : bool :=
match A with
| T | Pred _ _ => true
| B /\ C => (freefor B x t) && (freefor C x t)
| <>B => freefor B x t
| All y B =>
(y == x) ||
(
(freefor B x t) &&
((x \in fv B) ==> (y \notin termfv t))
)
end.
Lemma freeforxx (A : formula) (x : VarName) :
freefor A x (Var x).
Proof.
elim: A => //=.
by move=> A -> B ->.
move=> y A ->.
by case: eqP => [-> // | /= neqxy]; apply /implyP => _; apply /fset1P.
Qed.
Hint Resolve freeforxx : core.
Lemma freefor_Const (A : formula) (x : VarName) (c : ConstName sig) :
freefor A x (Const c).
Proof.
elim: A => //=.
by move=> A -> B ->.
by move=> y A ->; rewrite implybT orbT.
Qed.
Lemma notfv_freefor (x : VarName) (t : term) (A : formula) :
x \notin fv A -> freefor A x t.
Proof.
elim: A => //=.
move=> A IHA B IHB.
rewrite in_fsetU negb_or => /andP [xnotinA xnotinB].
by rewrite IHA // IHB.
move=> y A IHA.
rewrite in_fsetD1 negb_and eq_sym.
case: eqP => [// | neqyx /orP [// | /negPf xnotinA /=]].
by rewrite IHA //= xnotinA.
Qed.
Lemma notvars_freefor (x y : VarName) (A : formula) :
y \notin vars A -> freefor A x (Var y).
Proof.
elim: A => //=.
move=> A IHA B IHB.
by rewrite inE negb_or => /andP [/IHA -> /IHB ->].
move=> z A IH.
rewrite !inE eq_sym negb_or => /andP [-> /IH ->].
by rewrite /= implybT orbT.
Qed.
Fixpoint freefort (A : formula) (t1 t2 : term) : bool :=
match A with
| T | Pred _ _ => true
| B /\ C => (freefort B t1 t2) && (freefort C t1 t2)
| <> B => freefort B t1 t2
| All y B =>
match t1 with
| Var x =>
(y == x) ||
(
(freefort B (Var x) t2) &&
((x \in fv B) ==> (y \notin termfv t2))
)
| Const c =>
(freefort B (Const c) t2) &&
((c \in constants B) ==> (y \notin termfv t2))
end
end.
Lemma freefort_freefor (A : formula) (x : VarName) (t : term) :
freefort A (Var x) t = freefor A x t.
Proof.
elim: A => //=.
by move=> A -> B ->.
by move=> y A ->.
Qed.
Lemma fv_sub_Var (A : formula) (x : VarName) (t : term) :
freefor A x t ->
fv A`[Var x <- t] = if x \in fv A then (fv A `\ x) `|` termfv t else fv A.
Proof.
elim: A => //=.
- move=> P ts _.
case: ifP.
move=> /bigfcupP /= [[y /andP [yints _] | c /andP [cints _]]] //=.
rewrite in_fsetE => /eqP ->.
apply/eqP/fset_eqP => /= z.
apply/bigfcupP/idP => /=.
move=> [t0 /andP [/mapP /= [t1 t1ints] + _]].
case: eqP => [eqt1y -> zint | neqt1y -> zint1].
by rewrite in_fsetE zint orbT.
rewrite in_fsetE; apply/orP; left.
rewrite 2!in_fsetE; apply/andP; split; last first.
by apply/bigfcupP; exists t1; rewrite ?t1ints.
apply/eqP => eqzy.
case: t1 t1ints neqt1y zint1 => [/= w | //].
rewrite in_fsetE => _ neqwy /eqP eqzw.
by apply: neqwy; rewrite -eqzw eqzy.
rewrite 3!in_fsetE => /orP [|].
move=> /andP [/eqP neqzy /bigfcupP /= [t' /andP [t'ints _] zint']].
exists t' => //; rewrite andbT.
apply/mapP; exists t' => //.
case: eqP => [eqt'y | //].
exfalso; apply: neqzy.
case: t' t'ints zint' eqt'y => [w /= _ | //].
by rewrite in_fsetE => /eqP -> [].
move=> zint; exists t => //.
rewrite andbT; apply/mapP.
by exists (Var y); rewrite ?eqxx.
move=> /negP xnotints.
congr (\bigcup_(_ <- _) _).
rewrite -[[seq _ | _ <- _]]/(val [tuple of [seq _ | _ <- _]]).
apply/eqP/val_eqP; apply: eq_from_tnth => i /[!tnth_map].
case: eqP => [eqtnthix|//].
exfalso; apply: xnotints.
apply/bigfcupP => /=; exists (tnth ts i).
by rewrite mem_tnth.
by rewrite eqtnthix /= inE.
- move=> A IHA B IHB /andP [freeA freeB]; rewrite in_fsetE.
case: ifP; last first.
move=> /negP /negP; rewrite negb_or => /andP [/negPf xnA /negPf xnB].
by rewrite IHA // IHB // xnA xnB.
have [/fsetIP [xinA xinB] _ |] := boolP (x \in fv A `&` fv B).
rewrite IHA // IHB // xinA xinB.
by rewrite fsetUAC fsetUA -fsetUA fsetUid fsetDUl.
rewrite in_fsetE negb_and=> /orP[/[dup]xnA /negPf xAf|/[dup]xnB /negPf xBf].
move=> /orP [| xinB]; first by rewrite xAf.
rewrite IHA // IHB // xAf xinB.
by rewrite fsetUA fsetDUl (mem_fsetD1 xnA).
move=> /orP [xinA |]; last by rewrite xBf.
rewrite IHA // IHB // xinA xBf.
by rewrite fsetUAC fsetDUl (mem_fsetD1 xnB).
- move=> y A IHA /orP [/eqP /[dup] eqyx -> | /andP [freeA /implyP ynotint]].
case: fsetDP => [[_ /fset1P] neqxy // |].
by rewrite eqxx.
case: eqP => [[->]|neqyx /=]; first by case: ifP => [/fsetDP [_ /fset1P] |].
case: ifP => [/fsetDP [xinA _]|].
rewrite IHA // xinA.
rewrite fsetDUl (mem_fsetD1 (ynotint xinA)) 2!fsetDDl.
suff -> : [fset x; y] = [fset y; x] by [].
by apply/eqP/fset_eqP => z; apply/fset2P/fset2P; rewrite or_comm.
rewrite in_fsetE => /negP/negP.
rewrite negb_and => /orP [/negPn /fset1P eqxy | xnotinA].
by exfalso; apply: neqyx; rewrite eqxy.
by rewrite sub_notfree.
Qed.
Lemma fv_sub_Const (A : formula) (c : ConstName sig) (t : term) :
freefort A (Const c) t ->
fv A`[Const c <- t] = if c \in constants A then fv A `|` termfv t else fv A.
Proof.
elim: A => //.
- move=> P ts _.
have [cints /=|/sub_notconstants -> //] := boolP (c \in _).
apply/fsetP => /= x; apply/bigfcupP/fsetUP => /=.
move=> [_ /andP[/mapP /= [t' t'ints ->]] _].
case: eqP => [_ eqxy|_ eqxt']; first by right.
by left; apply/bigfcupP; exists t' => // /[!andbT].
move=> [/bigfcupP /= [tx /[!andbT] txints eqxtx]|eqxt].
exists tx => // /[!andbT].
apply/mapP; exists tx => //.
case: tx eqxtx {txints} => [x' _|//].
by case: eqP.
exists t => // /[!andbT].
apply/mapP => /=.
move: cints => /bigfcupP /= [tc /[!andbT] tcints eqctc].
exists tc => //.
by case: tc eqctc {tcints} => [//|c' /= /[!inE] /eqP -> /[!eqxx]].
- move=> /= A IHA B IHB /andP[/IHA -> /IHB ->] /[!inE].
case: (c \in constants A) => /=.
case: (c \in constants B) => /=.
by rewrite fsetUACA fsetUid.
by rewrite -fsetUA (fsetUC (termfv t)) fsetUA.
case: (c \in constants B) => //=.
by rewrite fsetUA.
- move=> /= x A IHA /andP[/IHA ->].
case: (c \in constants A) => [/= neqxt|//].
by rewrite fsetDUl (mem_fsetD1 neqxt).
Qed.
Lemma vars_sub_Var (A : formula) (x : VarName) (t : term) :
vars A`[Var x <- t] =
if x \in fv A then
if x \in bv A then
vars A `|` termfv t
else (vars A `\ x) `|` termfv t
else vars A.
Proof.
have [|/sub_notfree -> //] := boolP (x \in fv A).
elim: A => //=.
- move=> P ts /bigfcupP /= [[x' /andP[+ _] /= /[!inE] /eqP eqxx'|//]].
rewrite -{}eqxx' => {x'} => xints.
apply/fsetP => /= y; apply/bigfcupP/idP => /=.
move=> [_ /andP[/mapP /= [[z|c] + ->]] _]; last by [].
case: (@eqP _ z x) => [-> /= _ /[!eqxx] /[!inE] -> /[!orbT] //|].
move=> neqzx zints; case: eqP => [[//]|_] /=.
rewrite !inE => /eqP ->; apply/orP; left.
case: eqP => [//|_ /=].
apply/bigfcupP; exists (Var z).
by rewrite zints.
by rewrite inE.
move=> /fsetUP [/[!inE] /andP [/eqP neqyx]|].
move=> /bigfcupP /= [[y' /andP [+ _] /[!inE] /eqP eqyy'|//]].
rewrite -{}eqyy' => {y'} yints.
exists (Var y); last by rewrite inE eqxx.
rewrite andbT; apply/mapP; exists (Var y) => //.
by case: eqP => [[]|].
case: t => [_ /[!inE] /eqP <-|//].
exists (Var y); last by rewrite inE eqxx.
by rewrite andbT; apply/mapP; exists (Var x); rewrite ?eqxx.
- have memr : forall X Y W z, z \in X -> X `|` (Y `\ z) `|` W = X `|` Y `|` W.
move=> /= K X Y W z zinX.
apply/fsetP => /= k /[!inE].
by case: eqP => [-> /[!zinX]|_ /=].
have meml : forall X Y W z, z \in Y -> (X `\ z) `|` Y `|` W = X `|` Y `|` W.
move=> /= K X Y W z zinX.
congr (_ `|` _).
rewrite fsetUC [in RHS]fsetUC.
rewrite -(fsetU0 (Y `|` X `\ z)) -(fsetU0 (Y `|` X)).
by apply: memr.
move=> A IHA B IHB /fsetUP[/[dup] xinfvA /IHA ->|/IHB ->].
have [/IHB ->|/[dup] xnotinfvB /sub_notfree ->] := boolP (x \in fv B).
rewrite inE; case: ifP => _ /=.
case: ifP => _; rewrite fsetUACA fsetUid //.
by apply: memr; move: {+}x xinfvA; apply/fsubsetP; apply: fv_vars.
have [xinbvB|xnotinbvB] := boolP (x \in bv B); rewrite fsetUACA fsetUid.
by apply: meml; move: {+}x xinbvB; apply/fsubsetP; apply: bv_vars.
by rewrite fsetDUl.
rewrite inE; case: ifP => _ /=.
by rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA.
have [xinbvB|xnotinbvB] := boolP (x \in bv B).
rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA.
by apply: meml; move: {+}x xinbvB; apply/fsubsetP; apply: bv_vars.
rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA fsetDUl.
rewrite (@mem_fsetD1 _ _ (vars B)) //.
by rewrite varsE inE negb_or xnotinfvB.
have [/[dup]xinfvA/IHA->|/[dup]xnotinfvA/sub_notfree->]:= boolP (x \in fv A).
rewrite inE.
case: ifP => _ /=.
case: ifP => _; rewrite fsetUACA fsetUid //.
by apply: memr; move: {+}x xinfvA; apply/fsubsetP; apply: fv_vars.
case: ifP => [xinbvB|_]; rewrite fsetUACA fsetUid //.
by apply: meml; move: {+}x xinbvB; apply/fsubsetP; apply: bv_vars.
by rewrite fsetDUl.
rewrite inE; case: ifP => _.
by rewrite orbT fsetUA.
have [xinbvA|xnotinbvA] /= := boolP (x \in bv A).
rewrite fsetUA.
by apply: memr; move: {+}x xinbvA; apply/fsubsetP; apply: bv_vars.
rewrite fsetUA fsetDUl.
rewrite (@mem_fsetD1 _ _ (vars A)) //.
by rewrite varsE inE negb_or xnotinfvA.
- move=> y A IHA /fsetDP [xinfvA /[!inE] /eqP neqxy].
rewrite eq_sym; case: eqP => [[//]|_]; case: eqP => [//|_ /=].
rewrite (IHA xinfvA).
case: ifP => _ /[1!fsetUA] //.
rewrite fsetDUl (@mem_fsetD1 _ _ [fset y]) //.
by rewrite inE; apply/eqP.
Qed.
Lemma vars_sub_Const (A : formula) (c : ConstName sig) (t : term) :
vars A`[Const c <- t] =
if c \in constants A then vars A `|` termfv t else vars A.
Proof.
have [|/sub_notconstants -> //] := boolP (c \in constants A).
elim: A => //=.
- move=> P ts /bigfcupP /= [[//|/= c' /[!inE] /andP[+ _] /eqP eqcc']].
rewrite -{}eqcc' => {c'} cints.
apply/fsetP => /= x; apply/bigfcupP/idP => /=.
move=> [_ /andP[/mapP /= [t' t'ints] ->] _].
case: eqP => _.
by rewrite inE => -> /[!orbT].
move=> xint' /[!inE]; apply/orP; left.
apply/bigfcupP; exists t' => //.
by rewrite t'ints.
move=> /fsetUP [/bigfcupP /= [vx /andP[vxints _] xinvx]|xint].
exists vx => //.
rewrite andbT; apply/mapP; exists vx => //.
case: eqP => //.
by case: {+}vx xinvx.
exists t => //.
rewrite andbT; apply/mapP; exists (Const c) => //.
by rewrite eqxx.
- move=> A IHA B IHB /fsetUP[/IHA ->|/IHB ->].
have [/IHB ->|/sub_notconstants ->] := boolP (c \in constants B).
by rewrite fsetUACA fsetUid.
by rewrite -fsetUA [termfv _ `|` _]fsetUC fsetUA.
have [/IHA ->|/sub_notconstants ->] := boolP (c \in constants A).
by rewrite fsetUACA fsetUid.
by rewrite fsetUA.
- move=> x A + cinA.
by move=> /(_ cinA) -> /[!fsetUA].
Qed.
Lemma vars_sub (A : formula) (t1 t2 : term) :
vars A`[t1 <- t2] `<=` vars A `|` termfv t2.
Proof.
case: t1 => [x|c].
rewrite vars_sub_Var.
case: ifP => [_|/[!fsubsetUl] //].
case: ifP => [//|_].
by rewrite fsetSU // fsubsetDl.
rewrite vars_sub_Const.
by case: ifP => [|/[!fsubsetUl]].
Qed.
Lemma notfv_sub (A : formula) (x : VarName) (c : ConstName sig) :
x \notin fv A`[Var x <- Const c].
Proof.
rewrite fv_sub_Var; last by rewrite freefor_Const.
case: ifP => [xinA | /negP /negP //].
by rewrite !inE /= orbF eqxx.
Qed.
Lemma subxyyx (A : formula) (x y : VarName) :
freefor A x (Var y) ->
y \notin fv A ->
A`[Var x <- Var y]`[Var y <- Var x] = A.
Proof.
elim: A => //=.
- move=> P ts _ /negP tnotints.
congr Pred; apply: eq_from_tnth => i; rewrite 2!tnth_map.
case: eqP; case: eqP => // _ eqiy.
exfalso; apply: tnotints.
apply/bigfcupP; exists (tnth ts i).
by rewrite mem_tnth.
by rewrite eqiy /= inE.
- move=> A IHA B IHB /andP[ffAxy ffBxy].
rewrite !inE negb_or => /andP[ynotinA ynotinB].
by rewrite IHA // IHB.
- move=> A IHA ffAxy ynotinA.
by rewrite IHA.
- move=> z A IHA.
case: eqP => [/= -> _|neqzx /=].
rewrite eqxx !inE negb_and.
case: eqP => [-> /[!subtt] //|/= neqyx ynotinA].
case: eqP => [//|_].
by rewrite sub_notfree.
case: eqP => [[]//|_].
rewrite !inE negb_and eq_sym => /andP[ffAxy /implyP neqzy].
move=> /orP[eqyz|].
have xnotinA := contra neqzy eqyz.
rewrite !sub_notfree //.
move: eqyz => /negPn /eqP ->.
by rewrite fv_Allself.
move=> ynotinA; move: neqzy.
have [xinA /(_ isT)|xnotinA _] := boolP (x \in fv A).
rewrite eq_sym /=.
case: eqP => [//|neqzy _].
case: eqP => [[//]|_].
by rewrite IHA.
rewrite (sub_notfree _ xnotinA) /= (sub_notfree _ ynotinA).
by case: eqP.
Qed.
Lemma closed_All (x : VarName) (A : formula) (c : ConstName sig) :
closed (All x A) = closed A`[Var x <- Const c].
Proof.
rewrite /closed /= fv_sub_Var; last by rewrite freefor_Const.
case: ifP.
by move=> _ /=; rewrite fsetU0.
move=> /negP xnotinA; rewrite fsetD_eq0 fsubset1.
suff -> : fv A == [fset x] = false by [].
by apply/eqP => eqfvAx; move: xnotinA; rewrite eqfvAx in_fsetE.
Qed.
Definition closedE := (closed_Conj, closed_Diam, closed_All).
Lemma freefor_sub_neq (x : VarName) (t t1 t2 : term) (A : formula) :
Var x <> t2 ->
freefort A t1 t2 ->
freefor A x t ->
freefor A`[t1 <- t2] x t.
Proof.
move: x t t1 t2; elim: A => //=.
move=> A IHA B IHB x t t1 t2 neqxt2 /andP[ffAt12 ffBt12] /andP[ffAxt ffBxt].
by rewrite IHA // IHB.
move=> y B IHB x t t1 t2 neqxt2.
case: t1 => [z1|c1 /andP[ffBc1t2 neqyt2] /=].
case: eqP => [<- _|neqyz1 /=]; first by rewrite eqxx.
rewrite freefort_freefor.
have -> /= : Var y == Var z1 = false by case: eqP => [[]|].
case: eqP => [//|neqyx /=].
move=> /andP[ffBz1t2 ynotint2].
have [xinB|xnotinB] /= := boolP (x \in fv B).
move=> /andP[ffxt ->].
rewrite implybT andbT.
by apply: IHB => //; rewrite freefort_freefor.
rewrite andbT => ffBxt.
rewrite IHB //=; last by rewrite freefort_freefor.
rewrite fv_sub_Var //.
case: ifP => [z1inB|]; last first.
by move: xnotinB; have [|] := boolP (x \in fv B).
rewrite !inE; apply/implyP => /orP[|].
move: xnotinB; have [//|] := boolP (x \in fv B).
by rewrite andbF.
move: neqxt2; case: {+}t2 => [w /=|//].
rewrite inE => + /eqP eqxw.
by rewrite eqxw.
case: eqP => [//|neqyx /=].
have [xinB|xnotinB] //= := boolP (x \in fv B).
move=> /andP[ffBxt ->].
rewrite implybT andbT.
by apply: IHB.
rewrite andbT => ffBxt.
rewrite IHB //=.
rewrite fv_sub_Const //.
move: xnotinB => /negPf xnotinB.
have [_|_] := boolP (c1 \in constants B); rewrite ?inE xnotinB //=.
case: t2 neqxt2 {ffBc1t2 neqyt2} => [x' + /= /[!inE]|//].
by case: eqP => [->|].
Qed.
Lemma freefor_sub_eq (x : VarName) (t1 t2 : term) (A : formula) :
freefort A t1 (Var x) ->
freefor A x t2 ->
freefort A t1 t2 ->
freefor A`[t1 <- Var x] x t2.
Proof.
elim: A => //=.
move=> A + B + /andP[??] /andP[??] /andP[??].
by move=> -> // ->.
move=> y B.
case: t1 => [z |c /= IHB] /[!inE].
case: eqP => /= [<- /[!eqxx] //|].
case: (@eqP _ (Var y) _) => [[//]|_ neqyz IHB /=].
case: eqP => [-> //|neqyx /=].
move=> /andP[ffBzx _] /andP[ffBxt2 xinB_neqyt2] /andP[ffBzt2 zinB_neqyt2].
rewrite IHB //=.
rewrite fv_sub_Var; last by rewrite -freefort_freefor.
by move: zinB_neqyt2; case: ifP => [/= _ -> /[!implybT]|].
case: eqP => [//|/= neqyx].
move=> /andP[ffBcx _] /andP[ffBxt2 xinB_neqyt2] /andP[ffBct2 cinB_neqyt2].
rewrite IHB //=.
rewrite fv_sub_Const //.
by move: cinB_neqyt2; case: ifP => [/= _ -> /[!implybT]|].
Qed.
Lemma constants_sub_Var (A : formula) (x y : VarName) :
constants A`[Var x <- Var y] = constants A.
Proof.
elim: A => //=.
- move=> P ts.
apply/eqP/fset_eqP => c; apply/bigfcupP/bigfcupP => /=.
move=> [[//|/= c' /andP [/mapP /= [t tints +] _] /fset1P eqcc']].
rewrite -eqcc' => {c' eqcc'}.
case: eqP => // _ eqct.
exists (Const c) => //=.
by rewrite eqct tints.
by apply/fset1P.
move=> [[//|/= c' /andP [+ _] /fset1P eqcc']].
rewrite -eqcc' => {c' eqcc'} cints.
exists (Const c); last by apply/fset1P.
rewrite andbT; apply/mapP => /=.
by exists (Const c).
- by move=> A -> B ->.
- by move=> z A IHA; case: eqP.
Qed.
Lemma constants_sub_Const (A : formula) (x : VarName)
(c : ConstName sig) :
constants A`[Var x <- Const c] =
if x \in fv A then c |` constants A else constants A.
Proof.
elim: A => //.
- move=> P ts.
case: ifP; last by move=> /negP/negP xnotinP; rewrite sub_notfree.
move=> /bigfcupP [[x' /= /andP [+ _] /fset1P eqxx' |//]].
rewrite -eqxx' => xints {x' eqxx'}.
apply/eqP/fset_eqP => c'; apply/bigfcupP/fsetUP => /=.
move=> [t /andP [/mapP /= [t' t'ints -> _]]].
case: eqP => [_ /= c'inc | neqt'x c'int']; first by left.
by right; apply/bigfcupP; exists t' => //; rewrite t'ints.
move=> [/fset1P -> {c'} | /bigfcupP /= [[//| c'' /andP [+ _] /=]]].
exists (Const c); last by apply/fset1P.
rewrite andbT; apply/mapP.
by exists (Var x) => //; rewrite eqxx.
move=> + /fset1P eqc'c''.
rewrite -eqc'c'' => c'ints {c'' eqc'c''}.
exists (Const c'); last by apply/fset1P.
by rewrite andbT; apply/mapP; exists (Const c').
- move=> /= A IHA B IHB.
case: ifP.
move=> /fsetUP [xinA | xinB].
rewrite IHA xinA IHB fsetUA.
case: ifP => // _.
by rewrite fsetUCA 2!fsetUA fsetUid.
rewrite IHA IHB xinB fsetUCA.
case: ifP => // _.
by rewrite 3!fsetUA fsetUid.
move=> /negP /negP; rewrite in_fsetE negb_or => /andP.
by rewrite IHA IHB => [] [/negPf -> /negPf ->].
- move=> /= y A IHA.
case: eqP => [[<-] /= | neqyx /=].
by case: fsetDP => [[_ /fset1P //]|//].
rewrite IHA.
case: (ifP (_ \in _ `\ _)) => [/fsetDP [-> ] // |].
move=> /negP/negP; rewrite in_fsetE negb_and => /orP [| /negPf -> //].
rewrite inE => /negPf /negbFE /eqP eqxy.
by exfalso; apply: neqyx; rewrite eqxy.
Qed.
Lemma constants_sub (A : formula) (x : VarName) (t : term) :
constants A`[Var x <- t] =
if x \in fv A then (termconstants t) `|` constants A else constants A.
Proof.
case: t => [y | c].
by rewrite /= fset0U constants_sub_Var; case: ifP.
by rewrite /= constants_sub_Const.
Qed.
Lemma constantcount_sub (x : VarName) (c : ConstName sig) (A : formula) :
constantcount A <= constantcount A`[Var x <- Const c] <= (constantcount A).+1.
Proof.
rewrite /constantcount constants_sub_Const.
case: ifP => _; last by apply/andP.
rewrite cardfsU1.
case: (_ \notin _) => /=.
by rewrite add1n; apply/andP.
by rewrite add0n; apply/andP.
Qed.
Reserved Notation "A `[ ts1 <-- ts2 ]"
(at level 8, format "A `[ ts1 <-- ts2 ]").
Fixpoint simsub (A : formula) (ts1 ts2 : seq term) : formula :=
match A with
| T => T
| Pred P ts =>
Pred [tuple of [seq if ti \in ts1 then
nth ti ts2 (index ti ts1)
else ti
| ti <- ts]]
| B /\ C => B`[ts1 <-- ts2] /\ C`[ts1 <-- ts2]
| <> B => <> B`[ts1 <-- ts2]
| All y B => if Var y \in ts1 then
if index (Var y) ts1 < size ts2 then
All y B`[ts1 <--
set_nth (Var y) ts2 (index (Var y) ts1) (Var y)]
else
(* y appears in ts1, but has no counterpart in ts2 *)
All y B`[ts1 <-- ts2]
else All y B`[ts1 <-- ts2]
end
where "A `[ ts1 <-- ts2 ]" := (simsub A ts1 ts2) : qsp_scope.
Lemma simsub0ts (A : formula) (ts : seq term) :
A`[[::] <-- ts] = A.
Proof.
elim: A => //=.
- move=> P ts'.
by congr Pred; apply: eq_from_tnth => i; rewrite tnth_map.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->.
Qed.
Lemma simsubts0 (A : formula) (ts : seq term) :
A`[ts <-- [::]] = A.
Proof.
elim: A => //=.
- move=> P ks.
congr Pred; apply: eq_from_tnth => i; rewrite tnth_map.
by rewrite nth_nil; case: ifP.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->; case: ifP.
Qed.
Lemma simsub1ts (A : formula) (t : term) (ts : seq term) :
A`[[:: t] <-- ts] = A`[t <- head t ts].
Proof.
elim: A t ts => //=.
- move=> P ts' t ts.
congr Pred; apply: eq_from_tnth => i; rewrite 2!tnth_map.
rewrite in_cons in_nil orbF.
case: eqP => [->|//].
by rewrite eqxx.
- by move=> A IHA B IHB t ts; rewrite IHA IHB.
- by move=> A IHA t ts; rewrite IHA.
- move=> x A IHA t ts.
rewrite !inE eq_sym.
case: eqP => [->|_].
case: ltnP.
case: ts IHA => [//|t' ts' /= IHA _].
by rewrite IHA /= subtt.
rewrite leqn0 => /eqP /size0nil ->.
by rewrite simsubts0.
by rewrite IHA.
Qed.
Lemma sub_simsub (A : formula) (t t' : term) :
A`[t <- t'] = A`[[:: t] <-- [:: t']].
Proof. by rewrite simsub1ts. Qed.
Lemma simsub_cons (A : formula) (t t' : term) (ts ts' : seq term) :
t' \notin ts ->
uniq (t :: ts) ->
A`[t :: ts <-- t' :: ts'] = A`[t <- t']`[ts <-- ts'].
Proof.
elim: A t t' ts ts' => //=.
- move=> P ks t t' ts ts' t'notints tnotints_uniqts.
congr Pred; apply: eq_from_tnth => i; rewrite !tnth_map.
rewrite eq_sym in_cons.
case: eqP => [eqksit/=|//].
case: ifP => [t'ints|//].
by move: t'notints; rewrite t'ints.
- move=> A IHA B IHB t t' ts ts' t'notints tnotints_uniqts.
by rewrite IHA // IHB.
- move=> A IHA t t' ts ts' t'notints tnotints_uniqts.
by rewrite IHA.
- move=> x A IHA t t' ts ts' t'notints tnotints_uniqts.
rewrite in_cons eq_sym.
case: eqP => [eqtx|neqtx]/=.
rewrite -eqtx.
case: ifP => [tints|_].
by exfalso; move: tnotints_uniqts; rewrite tints.
rewrite IHA //.
by rewrite subtt.
by move: tnotints_uniqts => /andP [-> _].
case: ifP => [xints|xnotints].
rewrite -[_.+1 < _.+1]/(index (Var x) ts < _).
by case: ltnP => _; rewrite IHA.
by rewrite IHA.
Qed.
Fixpoint modaldepth (A : formula) : nat :=
match A with
| T | Pred _ _ => 0
| B /\ C => maxn (modaldepth B) (modaldepth C)
| <> B => (modaldepth B).+1
| All _ B => modaldepth B
end.
Lemma modaldepth_sub (t t' : term) (A : formula) :
modaldepth A`[t <- t'] = modaldepth A.
Proof.
elim: A => //=.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> y A IHA; case: eqP.
Qed.
Fixpoint quantifierdepth (A : formula) : nat :=
match A with
| T | Pred _ _ => 0
| B /\ C => maxn (quantifierdepth B) (quantifierdepth C)
| <> B => quantifierdepth B
| All _ B => (quantifierdepth B).+1
end.
Lemma quantifierdepth_sub (t t' : term) (A : formula) :
quantifierdepth A`[t <- t'] = quantifierdepth A.
Proof.
elim: A => //=.
by move=> A -> B ->.
by move=> y A IHA; case: eqP => [// | /= _]; rewrite IHA.
Qed.
Fixpoint depth (A : formula) : nat :=
match A with
| T | Pred _ _ => 0
| B /\ C => (maxn (depth B) (depth C)).+1
| <> B | All _ B => (depth B).+1
end.
Lemma depth_sub (t t' : term) (A : formula) :
depth A`[t <- t'] = depth A.
Proof.
elim: A => //=.
- by move=> A -> B ->.
- by move=> A ->.
- by move=> y A IHA; case: eqP => [// | /= _]; rewrite IHA.
Qed.
(* TODO the name is misleading, as this is just a sufficient condition for freshness *)
Definition termfresh (m : nat) (t : term) : bool :=
\max_(x <- termfv t) x < m.
Definition termfresh0 (t : term) : termfresh 0 t = false.
Proof. by rewrite /termfresh ltn0. Qed.
Lemma termfresh_Var (m : nat) (x : VarName) :
termfresh m (Var x) = (x < m).
Proof. by rewrite /termfresh /= big_seq_fset1. Qed.
Lemma termfresh_Const (m : nat) (c : ConstName sig) :
termfresh m (Const c) = (0 < m).
Proof. by rewrite /termfresh /= big_nil. Qed.
Definition fresh (m : nat) (A : formula) : bool :=
\max_(x <- vars A) x < m.
Lemma fresh0 (A : formula) : fresh 0 A = false.
Proof. by rewrite /fresh ltn0. Qed.
Lemma fresh_Pred (m : nat) (P : PredName sig) (ts : (arity P).-tuple term) :
fresh m.+1 (Pred ts) = all (termfresh m.+1) ts.
Proof.
rewrite /fresh /termfresh /= ltnS; apply/bigmax_leqP_list/allP => /=.
move=> H; case=> [x|c _] /=; rewrite ltnS; last by rewrite big_nil.
rewrite big_seq_fset1 => xints.
apply: H.
apply/bigfcupP; exists (Var x) => /=.
by rewrite xints.
by rewrite inE.
move=> H x /bigfcupP /= [+ /andP[+ _]].
case=> [y /=|//].
rewrite inE => /H /=.
by rewrite big_seq_fset1 ltnS => leqym /eqP ->.
Qed.
Lemma fresh_Conj (m : nat) (A B : formula) :
fresh m (A /\ B) = fresh m A && fresh m B.
Proof.
rewrite /fresh /= big_fsetU /=; last by apply: maxnn.
by rewrite gtn_max.
Qed.
Lemma fresh_Diam (m : nat) (A : formula) : fresh m (<> A) = fresh m A.
Proof. by []. Qed.
Lemma fresh_All (m : nat) (x : VarName) (A : formula) :
fresh m (All x A) = (x < m) && fresh m A.
Proof.
rewrite /fresh /= big_fsetU /=; last by apply: maxnn.
by rewrite gtn_max big_seq_fset1.
Qed.
Definition freshE := (termfresh_Var, termfresh_Const, fresh_Pred, fresh_Conj,
fresh_Diam, fresh_All).
Lemma fresh_monotone (n m : nat) (A : formula) :
n <= m -> fresh n A -> fresh m A.
Proof. by rewrite /fresh => leqnm ltAn; apply: (leq_trans ltAn). Qed.
End Language.
Notation "A /\ B" := (Conj A B)
(at level 80, B at level 80, format "A /\ B") : qsp_scope.
Notation "<> A" := (Diam A) (at level 40, format "<> A") : qsp_scope.
Notation "A `[ t1 <- t2 ]" := (sub A t1 t2)
(at level 8, format "A `[ t1 <- t2 ]") : qsp_scope.
Notation "A `[ ts1 <-- ts2 ]" := (simsub A ts1 ts2)
(at level 8, format "A `[ ts1 <-- ts2 ]") : qsp_scope.
Section Signature.
Open Scope qsp_scope.
Variable sig : signature.
(* Extend a signature with n new constants *)
Definition extend (n : nat) : signature :=
Signature [finType of ConstName sig + 'I_n] (@arity sig).
Definition termlift (n : nat) (t : term sig) : term (extend n) :=
match t with
| Var m => Var (extend n) m
| Const c => @Const (extend n) (inl c)
end.
Notation "t `!! n" := (termlift n t)
(at level 4, format "t `!! n") : qsp_scope.
Lemma termlift_inj (n : nat) : injective (termlift n).
Proof. by case=> [x [y [-> //]|//]|c [//|d [->]]]. Qed.
Reserved Notation "A !! n" (at level 4, format "A !! n").
Fixpoint lift (n : nat) (A : formula sig) : formula (extend n) :=
match A with
| T => T (extend n)
| Pred P ts => @Pred (extend n) P [tuple of (map (termlift n) ts)]
| A1 /\ A2 => A1!!n /\ A2!!n
| <> B => <> B!!n
| All x B => All x B!!n
end
where "A !! n" := (lift n A) : qsp_scope.
Lemma lift_inj (n : nat) : injective (lift n).
Proof.
elim.
- by case.
- move=> P ts; case=> //.
move=> P' + [eqPP']; rewrite -eqPP' => ts' eqtsts'.
have : [tuple of [seq i`!!n | i <- ts]] = [tuple of [seq i`!!n | i <- ts']].
by apply/val_eqP/eqP.
move=> {}eqtsts'.
congr Pred; apply/eq_from_tnth => i.
move: eqtsts' => /(congr1 (fun ts => tnth ts i)).
by rewrite !tnth_map => /= /termlift_inj.
- move=> A IHA B IHB; case=> //.
by move=> A' B' [/IHA -> /IHB ->].
- move=> A IHA; case=> //.
by move=> A' [/IHA ->].
- move=> x A IHA; case=> //.
by move=> x' A' [-> /IHA ->].
Qed.
(* (m : nat) is meant to be some natural number larger than any variable *)
(* appearing in our context. Thus we make sure that constants are replaced by *)
(* fresh variables *)
Definition termunlift (n m : nat) (t : term (extend n)) : term sig :=
match t with
| Var k => Var sig k
| Const (inl c) => Const c
| Const (inr c) => Var sig (m + c)
end.
Notation "t `$ m" := (termunlift m t)
(at level 4, format "t `$ m") : qsp_scope.
Lemma termunlift_inj (n m : nat) (t1 t2 : term (extend n)) :
termfresh m t1 ->
termfresh m t2 ->
t1`$m = t2`$m -> t1 = t2.
Proof.
case: t1 => [x|c] /=.
case: t2 => [y _ _ [-> //]|[//|/= k]].
rewrite !freshE => ltxm _ [eqxmk].
exfalso; move: ltxm; rewrite eqxmk.
by apply/negP; rewrite -leqNgt leq_addr.
case: c => [c|/= k].
by case: t2 => [//|[d _ _ [-> //]|//]].
case: t2 => [y _|c _ _] /=.
rewrite freshE => ltym [eqmky].
exfalso; move: ltym; rewrite -eqmky.
by apply/negP; rewrite -leqNgt leq_addr.
by case: c => [//|/= l [/addnI /eqP /val_eqP ->]].
Qed.
Reserved Notation "A $ m" (at level 4, format "A $ m").
Fixpoint unlift (n m : nat) (A : formula (extend n)) :
formula sig :=
match A with
| T => T sig
| Pred P ts => @Pred sig P [tuple of map (@termunlift n m) ts]
| A1 /\ A2 => A1$m /\ A2$m
| <> B => <> B$m
| All x B => All x B$m
end
where "A $ m" := (unlift m A) : qsp_scope.
Lemma unlift_inj (n m : nat) (A B : formula (extend n)) :
fresh m A ->
fresh m B ->
A$m = B$m -> A = B.
Proof.
elim: A B.
- by case.
- move=> P ts.
case: m => [|m]; first by rewrite fresh0.
case=> // P' + + + /= [eqPP'].
rewrite -eqPP' => ts'.
rewrite 2!freshE => /allP /= freshts /allP /= freshts' eqtsts'.
have : [tuple of [seq i`$m.+1 | i <- ts]]
= [tuple of [seq i`$m.+1 | i <- ts']].
by apply/val_eqP/eqP.
move=> {}eqtsts'.
congr Pred; apply/eq_from_tnth => i.
move: eqtsts' => /(congr1 (fun ts => tnth ts i)).
rewrite 2!tnth_map => /termunlift_inj; apply.
by apply: freshts; rewrite mem_tnth.
by apply: freshts'; rewrite mem_tnth.
- move=> A IHA A' IHA' /=.
case=> // B B'.
rewrite 2!freshE => /andP[freshA freshA'] /andP[freshB freshB'] /=.
by move=> [/(IHA _ freshA freshB) -> /(IHA' _ freshA' freshB') ->].
- move=> A IHA.
case=> // B.
by rewrite 2!freshE => /= freshA freshB [/(IHA _ freshA freshB) ->].
- move=> x A IHA.
case=> // y B.
rewrite 2!freshE => /andP[ltxm freshA] /andP[ltym freshB] /= [->].
by move=> /(IHA _ freshA freshB) ->.
Qed.
Lemma fv_unlift (n m : nat) (A : formula (extend n)) :
(fv A$m `<=` fv A `|` [fset (m + val c)%N | c in 'I_n])%fset.
Proof.
set X := [fset _ | _ in _]%fset.
elim: A => //=.
- move=> P ts.
apply/fsubsetP =>/=x /bigfcupP/=[tx/[!andbT] /mapP/=[[|]/=]].
move=> y yints eqtxv xintx.
apply/fsetUP; left.
apply/bigfcupP; exists (Var (extend n) y) => /=.
by rewrite yints.
by case: tx xintx eqtxv => [x' /[!inE] /eqP <- [->]|//].
move=> [c _|k kints -> /= /[!inE] /eqP ->].
by case: tx.
apply/orP; right.
by apply/imfsetP; exists k.
- move=> A IHA B IHB.
rewrite -(fsetUid X) fsetUACA.
by apply: fsetUSS.
- move=> x A /(fsetSD [fset x]%fset) IHA.
apply: (fsubset_trans IHA).
by rewrite fsetDUl fsetUSS // fsubD1set.
Qed.
Lemma vars_unlift (n m : nat) (A : formula (extend n)) :
(vars A$m `<=` vars A `|` [fset (m + val c)%N | c in 'I_n])%fset.
Proof.
elim: A => //=.
- move=> P ts.
apply/fsubsetP => /= x /bigfcupP/= [t' /andP[/mapP/= [t + ->] _]] {t'}.
case: t => [y /=|c].
rewrite !inE => yints /eqP ->.
apply/orP; left.
apply/bigfcupP; exists (Var _ y).
by rewrite yints.
by rewrite inE.
case: c => [//|/= k].
rewrite !inE => _ /eqP ->.
apply/orP; right.
by apply/imfsetP; exists k.
- set w := [fset _ | _ in _]%fset.
move=> A IHA B IHB.
have : (vars A `|` vars B `|` w = (vars A `|` w) `|` (vars B `|` w))%fset.
by rewrite fsetUACA fsetUid.
by move=> ->; apply: fsetUSS.
- move=> x A IHA.
by rewrite -fsetUA; apply: fsetUSS.
Qed.
Definition freshvars (n m : nat) : seq (term sig) :=
[seq Var sig (m + c) | c <- iota 0 n].
Lemma freshvarsE (n m : nat) :
freshvars n m = map (Var sig) (map (addn m) (iota 0 n)).
Proof. by rewrite -map_comp /=. Qed.
Lemma unlift_freshvars (n m k : nat) (A : formula (extend n)) :
fresh k A ->
A$m = (A$k)`[freshvars n k <-- freshvars n m].
Proof.
elim: A => //=.
- move=> P ts.
case: k => [|k]; first by rewrite fresh0.
rewrite freshE => /allP /= freshts.
congr Pred; apply: eq_from_tnth => i; rewrite 3!tnth_map.
case eqti: (tnth ts i) => [x /=|c].
case: ifP => [/mapP /= [c ciniotan [eqxkc]]|//].
exfalso.
move: (freshts _ (mem_tnth i ts)).
rewrite eqti freshE eqxkc.
by apply/negP; rewrite -leqNgt leq_addr.
move: c eqti => [c _|/= [j ltjn] eqtij] /=.
by case: ifP => [/mapP /= [x _]|].
case: ifP => [kjinfvk|/negP nkjinfvk].
rewrite index_map; last by move=> /= a b []/eqP; rewrite eqn_add2l =>/eqP.
rewrite -val_enum_ord -[j]/(val (Ordinal ltjn)) index_map; last first.
by apply: val_inj.
rewrite index_enum_ord /=.
rewrite (nth_map j); last by rewrite size_iota.
by rewrite nth_iota.
exfalso; apply: nkjinfvk.
apply/mapP => /=; exists j => //.
by rewrite mem_iota add0n leq0n ltjn.
- move=> A IHA B IHB.
rewrite freshE => /andP[freshA freshB].
by rewrite IHA // IHB.
- move=> A IHA; rewrite freshE => freshA.
by rewrite IHA.
- move=> x A IHA.
rewrite freshE => /andP[ltxk freshA].
case: ifP => [xinfvk|_]; last by rewrite IHA.
exfalso.
move: xinfvk => /mapP /= [i].
rewrite mem_iota add0n => /andP[_ ltin] [eqxki].
move: ltxk; rewrite eqxki.
by apply/negP; rewrite -leqNgt leq_addr.
Qed.
Lemma fresh_sub (n m : nat) (A : formula (extend n)) (t1 t2 : term (extend n)) :
termfresh m t2 ->
fresh m A ->
fresh m A`[t1 <- t2].
Proof.
case: m => [|m]; first by rewrite fresh0.
rewrite /fresh /termfresh !ltnS.
move=> /bigmax_leqP_list /= fresht2 /bigmax_leqP_list /= freshA.
apply/bigmax_leqP_list => /= x xinvars.
have /fsubsetP /(_ _) /(_ xinvars) := vars_sub A t1 t2.
move=> /fsetUP [xinA|xint2].
by apply: freshA.
by apply: fresht2.
Qed.
Lemma sub_fresh (n m : nat) (A : formula (extend n)) (t1 t2 : term (extend n)) :
termfresh m t1 ->
fresh m A`[t1 <- t2] ->
fresh m A.
Proof.
case: m => [|m]; first by rewrite fresh0.
rewrite /fresh /termfresh !ltnS.
case: t1 => [x /[!big_seq_fset1] leqxm|c _] /=.
rewrite vars_sub_Var.
case: ifP => [xinfvA|//].
case: ifP => _.
move=> /bigmax_leqP_list /= leqm.
apply/bigmax_leqP_list => /= y yinA.
by apply: leqm; rewrite inE yinA.
move=> /bigmax_leqP_list /= leqm.
apply/bigmax_leqP_list => /= y yinA.
case: (@eqP _ y x) => [-> //|/eqP neqyx].
by apply: leqm; rewrite !inE neqyx yinA.
rewrite vars_sub_Const.
case: ifP => [cinA|//].
move=> /bigmax_leqP_list /= leqm.
apply/bigmax_leqP_list => /= y yinA.
by apply: leqm; rewrite inE yinA.
Qed.
Lemma unlift_sub (n m : nat) (A : formula (extend n))
(t1 t2 : term (extend n)) :
fresh m A ->
termfresh m t1 ->
(A`[t1 <- t2])$m = A$m`[t1`$m <- t2`$m].
Proof.
move=> + fresht1; elim: A => //=.
- move=> P ts.
case: m fresht1 => [|m]; first by rewrite fresh0.
rewrite freshE => fresht1 /allP /= freshts.
congr Pred; apply: eq_from_tnth => i; rewrite !tnth_map.
case: (@eqP _ _`$_).
move=> /(termunlift_inj (freshts _ (mem_tnth i ts)) fresht1) ->.
by rewrite eqxx.
by case: eqP => [->|].
- by move=> A IHA B IHB /[!freshE] /andP[/IHA -> /IHB ->].
- by move=> A IHA /[!freshE] /IHA ->.
- move=> x A IHA /[!freshE] /andP[ltxm freshA].
case: (@eqP _ _ _`$_).
rewrite -[Var sig _]/((Var (extend n) _)`$m) => /termunlift_inj.
by rewrite freshE => /(_ ltxm) /(_ fresht1) -> /[!eqxx].
by case: eqP => [<- //|/= /[!IHA]].
Qed.
Lemma in_fv_unlift_fv (n m : nat) (x : VarName) (A : formula (extend n)) :
x < m ->
(x \in fv A$m) = (x \in fv A).
Proof.
move=> ltxm.
elim: A => //=.
- move=> P ts.
apply/bigfcupP/bigfcupP => /=.
move=> [t' /andP[/mapP /= [t tints ->] _] xintm].
exists t => [/[!tints] //|].
case: t tints xintm => [//|[//|/= k _]].
move=> /imfsetP /= [l /[!inE] /eqP -> eqxmk].
by exfalso; move: ltxm; apply/negP; rewrite -leqNgt eqxmk leq_addr.
move=> [t /andP[tints _] xint].
exists t`$m.
by rewrite andbT; apply/mapP; exists t.
by case: t tints xint.
- move=> A IHA B IHB.
by rewrite !inE IHA IHB.
- move=> y A IHA.
by rewrite !inE IHA.
Qed.
Lemma in_fv_unlift_constants (n m : nat) (k : 'I_n) (A : formula (extend n)) :
fresh m A ->
(m + k \in fv A$m) = (inr k \in constants A).
Proof.
elim: A => //=.
- move=> P ts freshmP.
apply/bigfcupP/bigfcupP => /=.
move=> [_ /andP[/mapP/=[t tints ->]] _ eqmktm].
exists t; first by rewrite tints.
case: t tints eqmktm => [x /[!inE] + /eqP eqmkx|]/=.
rewrite -{}eqmkx => {x} mkints.
exfalso.
move: freshmP; rewrite /fresh ltnNge => /negP; apply.
apply: (@leq_trans (m + k)); first by apply: leq_addr.
apply: leq_bigmax_list => /=.
apply/bigfcupP; exists (Var (extend n) (m + k)); first by rewrite andbT.
by rewrite inE.
case=> [//|k' /= _].
by rewrite !inE eqn_add2l => /val_eqP ->.
move=> [t /andP[tints _] eqkt].
exists (Var sig (m + k)); last by rewrite inE.
rewrite andbT; apply/mapP; exists t => //.
by case: t {tints} eqkt => [//|/= [c|k'] /[!inE] // /eqP [->]].
- by move=> A IHA B IHB /[!inE] /[!freshE] /andP[/IHA -> /IHB ->].
- move=> x A IHA /[!inE] /[!freshE] /andP[ltxm /IHA ->].
case: (_ \in _); last by rewrite andbF.
rewrite andbT; apply/eqP => eqmkx.
move: ltxm; rewrite ltnNge => /negP; apply.
by rewrite -eqmkx leq_addr.
Qed.
Lemma freefor_unlift (n m : nat) (A : formula (extend n)) (x : VarName)
(t : term (extend n)) :
x < m ->
fresh m A ->
freefor A$m x t`$m = freefor A x t.
Proof.
move=> ltxm.
case: t => [y|] /=.
move=> _; elim: A => //=.
by move=> A -> B ->.
move=> z A ->.
by rewrite in_fv_unlift_fv.
case => [c|/= k].
by rewrite !freefor_Const.
rewrite freefor_Const.
elim: A => //=.
by move=> A IHA B IHB /[!freshE] /andP [/IHA -> /IHB ->].
move=> y A IHA /[!freshE] /andP[ltym /IHA ->] /=.
case: eqP => [//|_ /=].
apply/implyP => _ /[!inE].
by apply/eqP => eqymk; move: ltym; apply/negP; rewrite -leqNgt eqymk leq_addr.
Qed.
Lemma constants_unlift (n m : nat) (A : formula (extend n))
(c : ConstName sig) :
c \in constants A$m -> inl c \in constants A.
Proof.
elim: A => //=.
move=> P ts /bigfcupP /= [_ /[!andbT] /mapP /= [t tints ->] cintm].
apply/bigfcupP; exists t.
by rewrite tints.
case: t cintm {tints} => [x|[d|k]] //=.
by rewrite !inE => /eqP ->.
by move=> A IHA B IHB /= /[!inE] /orP[/IHA ->|/IHB -> /[!orbT]].
Qed.
Lemma termliftK (n m : nat) (t : term sig) :
(t`!!n)`$m = t.
Proof. by case: t. Qed.
Lemma liftK (n m : nat) (A : formula sig) :
(A!!n)$m = A.
Proof.
elim: A => //=.
- move=> P ts.
congr Pred.
apply: eq_from_tnth => i.
rewrite 2!tnth_map.
by case: (tnth ts i).
- by move=> A -> B ->.
- by move=> A ->.
- by move=> x A ->.
Qed.
End Signature.
Notation "t `!! n" := (termlift n t)
(at level 4, format "t `!! n") : qsp_scope.
Notation "A !! n" := (lift n A)
(at level 4, format "A !! n") : qsp_scope.
Notation "t `$ m" := (termunlift m t)
(at level 4, format "t `$ m") : qsp_scope.
Notation "A $ m" := (unlift m A)
(at level 4, format "A $ m") : qsp_scope.
#[export] Hint Resolve freeforxx : core.