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.