Library LambdaES_nb_occ


Require Import Metatheory.
Require Import LambdaES_Defs LambdaES_Tactics.
Require Import LambdaES_Infrastructure.

Definitions

nb_occ

Counts the number of occurences of the bound variable k in t
Fixpoint nb_occ_k (k : nat) (t : trm) : nat :=
  match t with
  | trm_bvar i => if k === i then 1 else 0
  | trm_fvar x => 0
  | trm_abs t1 => nb_occ_k (S k) t1
  | trm_app t1 t2 => (nb_occ_k k t1) + (nb_occ_k k t2)
  | trm_sub t1 t2 => (nb_occ_k (S k) t1) + (nb_occ_k k t2)
  end.

Number of bounded variables pointing directly above the term
Definition nb_occ_0 (t : trm) : nat := nb_occ_k 0 t.

Nb_occ

Counts the number of occurences of the free variable x in t
Fixpoint Nb_occ (x: var) (t: trm) : nat :=
 match t with
 | trm_bvar k => 0
 | trm_fvar z => if z == x then 1 else 0
 | trm_abs t' => Nb_occ x t'
 | trm_app t1 t2 => Nb_occ x t1 + Nb_occ x t2
 | t1[t2] => Nb_occ x t1 + Nb_occ x t2
end.

Tactics

Elim tactics for the various nb_occ ? = 0
Ltac local_elim_nb_occ H :=
  match type of H with
  | nb_occ_k 0 (trm_bvar ?n) = 0 => case_eq n ; intros ; subst ; simpl in H ; try elim_zero_one ; try auto
  | nb_occ_k _ (trm_bvar _) = 0 => simpl in H ; case_nat ; try elim_zero_one ; try auto
  | nb_occ_k _ (trm_fvar _) = 0 => clear H
  | nb_occ_k _ (trm_abs _) = 0 => simpl in H
  | nb_occ_k ?k (trm_app ?t1 ?t2) = 0 =>
      simpl in H ;
      let Hfresh1 := fresh H in
      let Hfresh2 := fresh H in
      assert (nb_occ_k k t1 = 0) as Hfresh1 by omega ;
      assert (nb_occ_k k t2 = 0) as Hfresh2 by omega ;
      clear H
  | nb_occ_k ?k (?t1[?t2]) = 0 =>
      simpl in H ;
      let Hfresh1 := fresh H in
      let Hfresh2 := fresh H in
      assert (nb_occ_k (S k) t1 = 0) as Hfresh1 by omega ;
      assert (nb_occ_k k t2 = 0) as Hfresh2 by omega ;
      clear H
  end.

Ltac local_elim_nb_occ_0 H :=
match type of H with
| nb_occ_0 _ = 0 => unfold nb_occ_0 in H ; local_elim_nb_occ H
end.

Ltac elim_nb_occ :=
match goal with
| H : nb_occ_0 _ = 0 |- _ => unfold nb_occ_0 in H ; local_elim_nb_occ H
| H : nb_occ_k _ _ = 0 |- _ => local_elim_nb_occ H
end.

Lemmas

About Nb_occ


If a variable does not appear in a trm, substituting it leaves the trm intact
Lemma Nb_occ_open_var : forall t x y, ~(x = y) -> Nb_occ x t = Nb_occ x (t^y).
Proof.
  intros t. unfold open. generalize 0.
  basic_trm_induction t using (case_nat ; auto ; simpl ; case_var ; auto).
Qed.

Open a trm with a variable z does not change the number of occurences of the variable x
Lemma Nb_open : forall x z t n, x<> z -> Nb_occ x (t^z) = n -> Nb_occ x t = n.
Proof.
  intros x z t n x_neq_z.
  unfolds open. generalize 0 as k.
  gen n.
  induction t ; intros m k Nb_occ_.
    compare k n ; intro ; simpls ; case_nat ; simpls ; auto.
      case_var. assumption.
      simpl in *. assumption.
    simpls. apply IHt with (k:=S k). assumption.
    simpls.
    assert(exists n1, Nb_occ x ({k ~> trm_fvar z}t1) = n1).
    exists (Nb_occ x ({k ~> trm_fvar z}t1)). reflexivity.
    assert(exists n2, Nb_occ x ({k ~> trm_fvar z}t2) = n2).
    exists (Nb_occ x ({k ~> trm_fvar z}t2)). reflexivity.
    destruct H as [n1 H].
    destruct H0 as [n2 H0].
    rewrite IHt1 with (k:=k) (n:=n1) ; auto.
    rewrite IHt2 with (k:=k) (n:=n2) ; auto.
    rewrite H, H0 in Nb_occ_.
    assumption.
    simpls.
    assert(exists n1, Nb_occ x ({S k ~> trm_fvar z}t1) = n1).
    exists (Nb_occ x ({S k ~> trm_fvar z}t1)). reflexivity.
    assert(exists n2, Nb_occ x ({k ~> trm_fvar z}t2) = n2).
    exists (Nb_occ x ({k ~> trm_fvar z}t2)). reflexivity.
    destruct H as [n1 H].
    destruct H0 as [n2 H0].
    rewrite IHt1 with (k:=S k) (n:=n1) ; auto.
    rewrite IHt2 with (k:=k) (n:=n2) ; auto.
    rewrite H, H0 in Nb_occ_.
    assumption.
Qed.

Lemma Nb_occ_close : forall t x y, ~(x=y) -> Nb_occ y t = Nb_occ y (close t x).
Proof.
  intros ; unfold close. generalize 0.
  basic_trm_induction t using (repeat (case_var ; simpl ; auto)).
Qed.

Lemma Nb_occ_subs_decompose : forall t y u, Nb_occ y u + Nb_occ y t = Nb_occ y (t[u]).
Proof.
  intros. assert(forall x y, x + y = y + x) as H by (intros ; omega).
  basic_trm_induction t.
Qed.

Lemma Nb_occ_notin : forall t y, y \notin fv t -> Nb_occ y t = 0.
Proof.
  intros. induction t ; simpl ; auto.
    case_var.
      elim H. simpl. VSD.fsetdec.
      reflexivity.
    simpl in H. rewrite IHt1 ; [|VSD.fsetdec]. rewrite IHt2 ; [|VSD.fsetdec]. reflexivity.
    simpl in H. rewrite IHt1 ; [|VSD.fsetdec]. rewrite IHt2 ; [|VSD.fsetdec]. reflexivity.
Qed.

Lemma Nb_occ_open : forall t x u, x \notin fv u -> Nb_occ x t = Nb_occ x (t^^u).
Proof.
  intros t. unfold open. generalize 0.
  induction t ; intros n' x u x_notin_u ; simpls ; try eauto.
    case_nat.
      rewrite Nb_occ_notin ; auto.
      simpl. reflexivity.
Qed.

Lemma subst_Nb_occ : forall a b t u, a \notin fv u -> a <> b -> Nb_occ a ([b ~> u]t) = Nb_occ a t.
Proof.
  intros. induction t ; simpls ; auto.
  case_var* ; case_var*. apply Nb_occ_notin ; auto.
Qed.

About nb_occ


Lemma nb_occ_subst : forall t u k, (nb_occ_k k t = 0) -> ({k ~> u} t = t).
Proof.
  intro t. basic_trm_induction t prefixed_by (try elim_nb_occ).
Qed.

a body with no arrows pointing outside is a term
Lemma nb_occ_body_term : forall (t : trm), body t -> nb_occ_0 t = 0 -> term t.
Proof.
  intros t H1 H2. destruct H1 as [? H1]. pick_fresh y. specialize (H1 y).
  assert (term ({0 ~> trm_fvar y} t)) as H3 by auto.
  rewrite nb_occ_subst in H3; [|auto].
  assumption.
Qed.

Lemma nb_occ_open_gen : forall t x k n, (n < k) -> nb_occ_k k ({n ~> (trm_fvar x)}t) = nb_occ_k k t.
Proof.
  intro t.
  basic_trm_induction t using (repeat (case_nat* ; stupid_hyp)).
Qed.
Hint Rewrite nb_occ_open_gen : nb_occ.

Lemma nb_occ_term : forall t, term t -> forall k, nb_occ_k k t = 0.
intros t H. induction H as [|? ? ? H1|? ? ? H1 ? H2|? ? ? ? H1].
  reflexivity.
  intro k ; simpl. pick_fresh y. rewrite <-H1 with (k:=S k) (x:= y) ; auto. unfold open.
      rewrite nb_occ_open_gen ; auto ; try omega.
  intro ; simpl. rewrite H1 ; rewrite H2 ; auto.
  intro k ; simpl. pick_fresh y. rewrite <-H1 with (k:=S k) (x:= y) ; auto.
      unfold open ; rewrite nb_occ_open_gen ; auto ; try omega.
      rewrite IHterm ; auto.
Qed.
Hint Rewrite nb_occ_term : nb_occ.

Lemma nb_occ_0_term : forall t, term t -> nb_occ_0 t = 0.
Proof.
  intros. apply nb_occ_term ; auto.
Qed.

About Nb_occ and nb_occ


Lemma nb_occ_close_decompose : forall t y, nb_occ_0 t + Nb_occ y t = nb_occ_0 (close t y).
Proof.
  assert (forall a b c d, a + b + (c + d) = a + c + (b + d))as Harith by (intros ; omega).
  intros t ?. unfold close. unfold nb_occ_0. generalize 0.
  basic_trm_induction t using (case_var ; simpl ; auto ; case_nat ; auto).
Qed.

Lemma nb_occ_open_decompose : forall t y, nb_occ_0 t + Nb_occ y t = Nb_occ y (t^y).
Proof.
  intros. unfold nb_occ_0. unfold open. generalize 0.
  basic_trm_induction t.
  case_nat ; simpl ; [|reflexivity]. case_var ; simpl ; auto.
Qed.

Lemma nb_occ_open_decompose_simpl : forall t y, y \notin fv t -> nb_occ_0 t = Nb_occ y (t^y).
Proof.
  intros. rewrite <- nb_occ_open_decompose.
  rewrite Nb_occ_notin ; auto.
Qed.

Lemma nb_occ_close_decompose_simpl : forall t y, y \notin fv t -> nb_occ_0 t = nb_occ_0 (close t y).
Proof.
  intros. rewrite <- nb_occ_close_decompose.
  rewrite Nb_occ_notin ; auto.
Qed.

Rewriting databse for Nb_occ

Hint Rewrite ->Nb_occ_notin using (solve [auto]) : nb_occ_rewrite.
Hint Rewrite <-Nb_occ_subs_decompose : nb_occ_rewrite.
Hint Rewrite <-Nb_occ_close using (solve [auto]) : nb_occ_rewrite.
Hint Rewrite <-Nb_occ_open_var using (solve [auto]) : nb_occ_rewrite.
Hint Rewrite <-Nb_occ_open using (solve [auto]) : nb_occ_rewrite.
Hint Rewrite <-nb_occ_close_decompose : nb_occ_rewrite.
Hint Rewrite <-nb_occ_open_decompose : nb_occ_rewrite.
Hint Rewrite nb_occ_0_term using (solve [auto]) : nb_occ_rewrite.