Require Import String.
Require Import bin_rels.
Require Import eq_rel.
Require Import universe.
Require Import LibTactics.
Require Import tactics.
Require Import Coq.Bool.Bool.
Require Import Coq.Program.Tactics.
Require Import Omega.
Require Import Coq.Program.Basics.
Require Import Coq.Lists.List.
Require Import Coq.Init.Notations.
Require Import UsefulTypes.
Require Import Coq.Classes.DecidableClass.
Require Import Coq.Classes.Morphisms.
Require Import list.

Require Import Recdef.
Require Import Eqdep_dec.
Require Import varInterface.
Require Import terms.
Open Scope list_scope.

(** printing #  $\times$ #×# *)
(** printing <=>  $\Leftrightarrow$ #⇔# *)
(** printing $  $\times$ #×# *)
(** printing &  $\times$ #×# *)

(** Here are some handy definitions that will
    reduce the verbosity of some of our later definitions
*)

Generalizable Variable Opid.

Section terms2Generic.

Context {NVar VarClass} {deqnvar : Deq NVar} {varcl freshv} {varclass: @VarType NVar VarClass deqnvar varcl freshv}
`{hdeq: Deq Opid} {gts : GenericTermSig Opid}.
Notation NTerm := (@NTerm NVar Opid).
Notation BTerm := (@BTerm NVar Opid).

Definition nobnd (f:NTerm) : BTerm := bterm [] f.

(** %\noindent \\*% We define similar abstractions for other [Opid]s.
    This document does not show them. As mentioned before, one can click
    at the hyperlinked filename that is closest above to open a
    webpage that shows complete contents of this file.
*)

Lemma fold_nobnd :
  forall t, bterm [] t = nobnd t.
Proof using.
  unfold nobnd; auto.
Qed.

(*
Definition mk_esquash (R : NTerm) :=
  oterm (Can NEsquash) [nobnd R].
*)

(* Picks a variable that is not in the set of free variables of a given term *)
Definition newvar (t : NTerm) := fresh_var (free_vars t).

(* Delete. use flat_map instead *)
Fixpoint free_vars_list (terms : list NTerm) :=
  match terms with
    | [] => []
    | t :: ts => free_vars t ++ free_vars_list ts
  end.

(* ------ SIMPLE OPERATORS ON TERMS ------ *)

(*
Fixpoint depth (t : NTerm) : nat :=
  match t with
  | vterm _ => 1
  | oterm op bterms => lsum map depth_bterm bterms
  end
 with depth_bterm (lv : list NVar) (nt : NTerm) :=
  match bt with
  | bterm lv nt => depth nt
  end.
*)

End terms2Generic.

Fixpoint size {NVar:Type} {Opid:Type} (t : @NTerm NVar Opid) : nat :=
  match t with
  | vterm _ => 1
  | oterm op bterms => S (addl (map (@size_bterm NVar _) bterms))
  end
 with size_bterm {NVar:Type} {Opid:Type} (bt: @BTerm NVar Opid) :nat :=
  match bt with
  | bterm lv nt => @size NVar Opid nt
  end.

Fixpoint wft {NVar:Type} {Opid:Type} {gts : GenericTermSig Opid} (t : @NTerm NVar Opid) : bool :=
  match t with
    | vterm _ => true
    | oterm o bts =>
      andb (beq_list deq_nat (map (@num_bvars NVar _) bts) (OpBindings o))
           (ball (map wftb bts))
  end
with wftb {NVar:Type} {Opid:Type} {gts : GenericTermSig Opid} (bt : @BTerm NVar Opid) : bool :=
  match bt with
    | bterm vars t => wft t
  end.

Scheme  Equality for list.

  Fixpoint NTerm_beq {NVar:Type} {Opid:Type} `{Deq NVar} `{Deq Opid}
    (t1 t2: @NTerm NVar Opid) : bool :=
  match (t1, t2) with
  | (terms.vterm v1, terms.vterm v2) => decide (v1=v2)
  | (terms.oterm o1 lbt1, terms.oterm o2 lbt2)
    => andb (decide (o1=o2)) (list_beq _ (@BTerm_beq NVar Opid _ _) lbt1 lbt2)
  |(_,_)=> false
  end
with BTerm_beq {NVar:Type} {Opid:Type}  `{Deq NVar} `{Deq Opid} (t1 t2:
@BTerm NVar Opid) : bool :=
  match (t1, t2) with
  | (terms.bterm lv1 t1, terms.bterm lv2 t2) =>
    andb (decide (lv1=lv2)) (@NTerm_beq NVar Opid _ _ t1 t2)
  end.

(*
Lemma NTerm_beq_correct {NVar:Type} {Opid:Type} `{Deq NVar} `{Deq Opid}
(a b: @terms.NTerm NVar Opid):  NTerm_beq a b = true <=> a = b.
Admitted.
*)

Section terms3Generic.

Context {NVar VarClass} {deqnvar : Deq NVar}
  {varcl freshv} {varclass: @VarType NVar VarClass deqnvar varcl freshv}
  `{hdeq: Deq Opid} {gts : GenericTermSig Opid}.
Notation NTerm := (@NTerm NVar Opid).
Notation BTerm := (@BTerm NVar Opid).

(* ------ INDUCTION ON TERMS ------ *)

Lemma size_subterm2 :
  forall (o:Opid) (lb : list BTerm) (b : BTerm) ,
    LIn b lb
    ->  size_bterm b <  size (oterm o lb).
Proof using.
  simpl. induction lb; intros ? Hin; inverts Hin as; simpl; try omega.
  intros Hin. apply IHlb in Hin; omega.
Qed.

Lemma size_subterm3 :
  forall (o:Opid) (lb : list BTerm) (nt : NTerm) (lv : list NVar) ,
    LIn (bterm lv nt) lb
    ->  size nt <  size (oterm o lb).
Proof using.
 introv X.
 apply size_subterm2 with (o:=o) in X. auto.
Qed.

Lemma NTerm_better_ind3 :
  forall P : NTerm -> Type,
    (forall n : NVar, P (vterm n))
    -> (forall (o : Opid) (lbt : list BTerm),
          (forall (nt: NTerm),
              size nt < size (oterm o lbt)
              -> P nt
          )
          -> P (oterm o lbt)
       )
    -> forall t : NTerm, P t.
Proof using.
 intros P Hvar Hbt.
 assert (forall n t, size t = n -> P t) as Hass.
 Focus 2. intros. apply Hass with (n := size t) ; eauto; fail.

 induction n as [n Hind] using comp_ind_type.
 intros t Hsz.
 destruct t.
 apply Hvar.
 apply Hbt. introv Hs.
 apply Hind with (m := size nt) ; auto.
 subst.
 assert(size nt < size (oterm o l)); auto.
Qed.

Lemma NTerm_better_ind2 :
  forall P : NTerm -> Type,
    (forall n : NVar, P (vterm n))
    -> (forall (o : Opid) (lbt : list BTerm),
          (forall (nt nt': NTerm) (lv: list NVar),
             (LIn (bterm lv nt) lbt)
              -> size nt' <= size nt
              -> P nt'
          )
          -> P (oterm o lbt)
       )
    -> forall t : NTerm, P t.
Proof using.
 intros P Hvar Hbt.
 apply  NTerm_better_ind3; eauto.
 intros ? ? H.
 apply Hbt.
 intros ? ? ? Hin Hs. apply H.
 eapply le_lt_trans;[apply Hs|].
 eapply size_subterm3; eauto.
Qed.

Lemma NTerm_BTerm_ind :
  forall (PN : NTerm -> Type) (PB : BTerm -> Type),
    (forall n : NVar, PN (vterm n))
    -> (forall (o : Opid) (lbt : list BTerm),
          (forall b,
             (LIn b lbt) -> PB b
          )
          -> PN (oterm o lbt)
       )
    -> (forall (lv: list NVar) (nt : NTerm),
          PN nt -> PB (bterm lv nt)
       )
    -> ((forall t : NTerm, PN t) *  (forall t : BTerm, PB t)).
Proof using.
   introv Hv Hind Hb.
   assert (forall A B, A -> (A -> B) -> (A*B)) as H by tauto.
   apply H; clear H.
- apply  NTerm_better_ind2; auto.
   introv Hx. apply Hind. introv Hin. destruct b. eauto.
- intro Hnt. intro b. destruct b. eauto.
Qed.

Lemma NTerm_better_ind :
  forall P : NTerm -> Type,
    (forall n : NVar, P (vterm n))
    -> (forall (o : Opid) (lbt : list BTerm),
          (forall (nt : NTerm) (lv: list NVar),
             (LIn (bterm lv nt) lbt) -> P nt
          )
          -> P (oterm o lbt)
       )
    -> forall t : NTerm, P t.
Proof using.
 introv Hv Hind. apply  NTerm_better_ind2; auto.
 introv Hx. apply Hind. introv Hin. eapply Hx in Hin; eauto.
Qed.

Tactic Notation "nterm_ind" ident(h) ident(c) :=
  induction h using NTerm_better_ind;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Tactic Notation "nterm_ind" ident(h) "as" simple_intropattern(I)  ident(c) :=
  induction h as I using NTerm_better_ind;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Tactic Notation "nterm_ind1" ident(h) "as" simple_intropattern(I)  ident(c) :=
  induction h as I using NTerm_better_ind;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Tactic Notation "nterm_ind1s" ident(h) "as" simple_intropattern(I)  ident(c) :=
  induction h as I using NTerm_better_ind2;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Lemma num_bvars_on_bterm :
  forall (l:list NVar) (n : NTerm),
    num_bvars (@bterm NVar Opid l n) = length l.
Proof using.
  unfold num_bvars; simpl; sp.
Qed.

Definition wf_term (t : NTerm) := wft t = true.

Definition wf_bterm (bt : BTerm) := wftb bt = true.

Lemma wf_term_proof_irrelevance :
  forall t,
  forall x y : wf_term t,
    x = y.
Proof using.
  intros.
  apply UIP_dec.
  apply bool_dec.
Qed.

Definition wf_term_extract :=
  fun (t : NTerm) (x : wf_term t) =>
    match x return (x = match x with
                          | eq_refl => eq_refl (wft t)
                        end)
    with
      | eq_refl => eq_refl eq_refl
    end.

(*
Definition wf_term_extract1 :=
  fun (t : NTerm) (x : wf_term t) =>
    match x in _ = b return match b with
                     | true => x = eq_refl (wft t)
                   end
    with
      | eq_refl => eq_refl eq_refl
    end.

Lemma wf_term_extract2 :
  forall t : NTerm,
  forall x : wf_term t,
    x = eq_refl (wft t).
*)

(*Lemma yyy : forall A (x : A) (pf : x = x), pf = eq_refl x.
Lemma xxx : forall t (x : wft t = true), x = eq_refl (wft t).*)

Lemma nt_wf_eq :
  forall t,
    nt_wf t <=> wf_term t.
Proof using.
  clear varclass varcl freshv deqnvar VarClass.
  unfold wf_term.
  nterm_ind t as [|o lbt ind] Case; simpl; intros.

  - Case "vterm".
    split; sp.

  - Case "oterm".
    split_iff SCase.

    + SCase "->"; intro w.
      inversion w; subst.
      allrw.
      rewrite beq_list_refl; simpl.
      trw ball_true; sp.
      alltrewrite in_map_iff; sp; subst.
      apply_in_hyp wf; destruct wf; allsimpl.
      discover; sp. firstorder.

    + SCase "<-"; sp.
      remember (beq_list deq_nat (map num_bvars lbt) (OpBindings o)).
      destruct b; allsimpl; sp.
      alltrewrite ball_true.
      constructor; sp.
      destruct l.
      apply_in_hyp e.
      constructor.
      apply e.
      apply_hyp.
      alltrewrite in_map_iff.
      exists (bterm l n); simpl; sp.

      remember (OpBindings o).
      clear Heql.
      revert l Heqb.
Local Opaque deq_nat.
      induction lbt; allsimpl.
      destruct l; allsimpl; sp.
      destruct l; allsimpl; sp.
      rewrite decide_decideP in Heqb.
      destruct (decideP (num_bvars a = n)); subst; sp.
      apply cons_eq.
      apply IHlbt; sp.
      apply ind with (lv := lv); sp.
Qed.

Lemma nt_wf_implies :
  forall t, nt_wf t -> wf_term t.
Proof using.
  sp; apply nt_wf_eq; sp.
Qed.

Lemma wf_term_eq :
  forall t, wf_term t <=> nt_wf t.
Proof using.
  intro; generalize (nt_wf_eq t); sp.
  symm; auto.
Qed.

Lemma bt_wf_eq :
  forall bt, bt_wf bt <=> wf_bterm bt.
Proof using.
  sp; split; intro w.
  inversion w; subst; unfold wf_bterm; simpl.
  fold (wf_term nt).
  apply wf_term_eq; auto.
  destruct bt; allunfold wf_bterm; allsimpl.
  fold (wf_term n) in w.
  constructor.
  apply nt_wf_eq; auto.
Qed.

(*
Inductive nt_wfb (t:NTerm) : bool :=
 match t with
 | vterm _ => true
 | bterm _ rt => nt_wfb rt
 | oterm o lnt : (eq map (num_bvars) lnt  OpBindings o).
*)

Definition closedb (t : NTerm) := nullb (free_vars(t)).
Definition closed_bt (bt : BTerm) := free_vars_bterm bt = [].

Definition isprogram_bt (bt : BTerm) := closed_bt bt # bt_wf bt.

(** Our definition [isprog] below is is logically equivalent to [isprogram],
    but unlike [isprogram], it is easy to prove that
    for any [t], all members(proofs) of [isprog t] are equal.
    An interested reader can look at the lemma
    %\coqexternalref{UIP\_dec}
    {http://coq.inria.fr/distrib/8.4pl2/stdlib/Coq.Logic.Eqdep\_dec}
    {\coqdocdefinition{UIP\_dec}}% from that standard library.
    As mentioned before, clicking on the lemma name in
    the previous sentence should open
    the corresponding webpage of the Coq standard library.
    Instead, one can also look at the lemma [isprog_eq] below and
    safely ignore these technicalites.

*)
Definition isprog (t : NTerm) := (nullb (free_vars t) && wft t) = true.

Definition isprog_bt (bt : BTerm) :=
  (nullb (free_vars_bterm bt) && wftb bt) = true.

Definition isprog_vars (vs : list NVar) (t : NTerm) :=
  (sub_vars (free_vars t) vs && wft t) = true.

Lemma closed_nt :
  forall op bts,
    closed (oterm op bts)
    <=>
    forall bt, LIn bt bts -> closed_bt bt.
Proof using.
  sp; unfold closed, closed_bt; simpl; trw flat_map_empty; split; sp.
Qed.

Lemma closed_nt0 : forall o (nt:NTerm), closed (oterm o [bterm [] nt]) -> closed nt.
Proof using.
  intros. unfold closed in H. simpl in H. apply app_eq_nil in H. repnd.
  clears_last. unfold closed. assumption.
Qed.

Lemma closed_null_free_vars :
  forall (t:NTerm),
    closed t <=> null (free_vars t).
Proof using.
  unfold closed; sp.
  trw null_iff_nil; sp.
Qed.

Lemma isprog_proof_irrelevance :
  forall t,
  forall x y : isprog t,
    x = y.
Proof using.
  intros.
  apply UIP_dec.
  apply bool_dec.
Qed.

Lemma isprog_vars_proof_irrelevance :
  forall t vs,
  forall x y : isprog_vars vs t,
    x = y.
Proof using.
  intros.
  apply UIP_dec.
  apply bool_dec.
Qed.

Require Import tactics.
Lemma isprogram_eq :
  forall t,
    isprogram t <=> isprog t.
Proof using.
  unfold isprog, isprogram.
  nterm_ind t Case; simpl; intros.

  - Case "vterm".
    split; sp. unfold closed in *; allsimpl; sp.

  - Case "oterm".
    split_iff SCase.

    + SCase "->".
      intros i; destruct i as [ cl wf ].
      inversion cl; subst.
      inversion wf; subst.
      repeat (rw andb_eq_true).
      rewrite fold_assert.
      allrw <- null_iff_nil.
      rw ball_map_true.
      rw assert_nullb; sp.

      rewrite fold_assert.
      rw assert_beq_list; auto.

      destruct x; allsimpl.
      fold (wf_term n).
      apply wf_term_eq.
      apply_in_hyp p; inversion p; subst; sp.

    + SCase "<-"; intros.
      repeat (allrewrite andb_true); repd.
      allrw fold_assert.
      allrw assert_nullb.
      allrw null_iff_nil.
      allrw assert_beq_list.
      allrw ball_map_true; sp.
      constructor; sp.
      apply_in_hyp p.
      destruct l; allsimpl.
      constructor.
      allfold (wf_term n).
      apply wf_term_eq; auto.
Qed.

Lemma isprogram_implies :
  forall t, isprogram t -> isprog t.
Proof using.
  sp; apply isprogram_eq; sp.
Qed.

Lemma isprog_implies :
  forall t : NTerm, isprog t -> isprogram t.
Proof using.
  sp; apply isprogram_eq; sp.
Qed.

Lemma isprog_eq :
  forall t, isprog t <=> isprogram t.
Proof using.
  intro; symm; apply isprogram_eq; auto.
Qed.

Lemma isprogram_bt_eq :
  forall bt,
    isprogram_bt bt <=> isprog_bt bt.
Proof using.
  intro; unfold isprogram_bt, isprog_bt, closed_bt; split; sp.
  allrw; simpl.
  fold (wf_bterm bt).
  apply bt_wf_eq; auto.
  alltrewrite andb_eq_true; sp.
  allrewrite fold_assert.
  alltrewrite assert_nullb.
  alltrewrite null_iff_nil; sp.
  destruct bt; constructor.
  alltrewrite andb_eq_true; sp; allsimpl.
  allfold (wf_term n).
  apply nt_wf_eq; auto.
Qed.

Lemma isprog_vars_eq :
  forall t vs,
    isprog_vars vs t <=> subsetv (free_vars t) vs # nt_wf t.
Proof.
  unfold isprog_vars; sp.
  rw andb_eq_true.
  rewrite fold_assert.
  rewrite assert_sub_vars.
  rw nt_wf_eq; sp.
Qed.

Lemma isprog_vars_if_isprog :
  forall vs t, isprog t -> isprog_vars vs t.
Proof using.
  introv ip.
  rw isprog_vars_eq.
  rw isprog_eq in ip.
  destruct ip; sp.
  unfold closed in *; allrw; sp.
Qed.

Lemma isprog_vars_app_l :
  forall t vs1 vs2,
    isprog_vars vs2 t
    -> isprog_vars (vs1 ++ vs2) t.
Proof using.
  sp; alltrewrite isprog_vars_eq; sp.
  unfold subset in *.
  apply subset_app_l; sp.
Qed.

Definition areprograms ts := forall t, LIn t ts -> isprogram t.

Lemma areprograms_nil : areprograms [].
Proof using.
  unfold areprograms; simpl; sp.
Qed.

Lemma areprograms_snoc :
  forall t ts,
    areprograms (snoc ts t) <=> areprograms ts # isprogram t.
Proof using.
  unfold areprograms; sp; split; sp; try (apply_hyp; rw in_snoc; sp).
  alltrewrite in_snoc; sp; subst; sp.
Qed.

Lemma areprograms_cons :
  forall t ts, areprograms (t :: ts) <=> isprogram t # areprograms ts.
Proof using.
  unfold areprograms; sp; simpl; split; sp; subst; sp.
Qed.

Lemma areprograms_app :
  forall ts1 ts2,
    areprograms (ts1 ++ ts2) <=> areprograms ts1 # areprograms ts2.
Proof using.
  unfold areprograms; sp; split; sp.
  apply_hyp; rw in_app_iff; sp.
  apply_hyp; rw in_app_iff; sp.
  alltrewrite in_app_iff; sp.
Qed.

Lemma isprogram_vterm :
  forall v, isprogram (vterm v) <=> False.
Proof using.
  unfold isprogram, closed; simpl; sp; split; sp.
Qed.

(*
Ltac repnd :=
  repeat match goal with
           | [ H : _ # _ |- _ ] =>
               let name := fresh H in destruct H as [name H]
           | [ H : _ # _ |- _ ] =>
               let name := fresh H in destruct H as [name H]
         end.
*)

Theorem isprogram_ot_iff :
  forall o bts,
    isprogram (oterm o bts)
    <=>
    (map num_bvars bts = OpBindings o
     # forall bt, LIn bt bts -> isprogram_bt bt).
Proof using.
  intros. sp_iff Case.

  - Case "->".
    intros Hisp.
    unfold isprogram in Hisp. repnd.
    inverts Hisp0 as Hflat. inverts Hisp.
    split;auto. intros bt Hin.
    unfold isprogram_bt.
    rw flat_map_empty in Hflat.
    apply_in_hyp p; sp.

  - Case "<-".
    intros eq; destruct eq as [Hmap Hstclose].
    unfold isprogram, closed.

    split; try (constructor); auto;
    try (simpl; apply flat_map_empty);
    intros a ain;
    apply Hstclose in ain; inversion ain; sp.
Qed.

Theorem nt_wf_ot_implies :
  forall lv o (nt1 : NTerm) bts,
    nt_wf (oterm o  bts)
    -> LIn (bterm lv nt1) bts
    -> nt_wf nt1.
Proof using. intros ? ? ? ? Hwf Hin. inverts Hwf as Hwf Hmap.
  assert (bt_wf (bterm lv nt1)) as Hbf by (apply Hwf; auto).
  inverts Hbf. auto.
Qed.

Lemma newvar_prop :
  forall (t: NTerm), ! LIn (newvar t) (free_vars t).
Proof using.
  unfold newvar; sp.
  allapply fresh_var_not_in; sp.
Qed.

(*
Lemma newvar_not_in_free_vars :
  forall (t: NTerm),
    ! LIn nvarx (free_vars t)
    -> newvar t = nvarx.
Proof using.
  sp.
  unfold newvar.
  apply fresh_var_nvarx; sp.
Qed.

Lemma newvar_prog :
  forall t,
    isprog t
    -> newvar t = nvarx.
Proof using.
  sp.
  unfold newvar.
  apply isprog_eq in H.
  inversion H.
  unfold closed in H0.
  rewrite H0; sp.
Qed.
*)

(*
(** A value is a program with a canonical operator *)
Inductive isvalue : NTerm -> [univ] :=
  | isvl : forall (c : CanonicalOp) (bts : list BTerm ),
           isprogram (oterm (Can c) bts)
           -> isvalue (oterm (Can c) bts).

Inductive isovalue : NTerm -> Prop :=
  | isovl : forall (c : CanonicalOp) (bts : list BTerm),
              nt_wf (oterm (Can c) bts)
              -> isovalue (oterm (Can c) bts).

Lemma isvalue_closed :
  forall t, isvalue t -> closed t.
Proof using.
  introv isv; inversion isv.
  allunfold isprogram; sp.
  unfold isprogram in *.
  tauto.
Qed.

Lemma isvalue_program :
  forall t, isvalue t -> isprogram t.
Proof using.
  introv isv; inversion isv; sp.
Qed.
*)

(* ------ programs ------ *)

Definition WTerm  := { t : NTerm  | wf_term t }.
Definition WBTerm := { bt : BTerm | wf_bterm bt }.

(*
  (* first of all, isprog is NOT a boolean. also, the reader will
    be left wondering what UIP_dec is*)

  where [isprog] is the Boolean version of [isprogram]
  (using a Boolean version of [isprogram] makes it easy to prove that
  closed terms are equal by proving that the underlying [NTerm]s are
  equals using [UIP_dec]).

*)

(**

  The [CTerm] type below is useful in compactly stating definitions
  that are only meaningful for closed terms. A [CTerm] is a pair
  of an [NTerm] [t] and a proof that [t] is closed.
  This [CTerm] type will be handy in compactly
  defining the Nuprl type system where types are defined as partial
  equivalence relations on closed terms.

*)

Definition CTerm  := { t : NTerm  | isprog t }.
Definition get_cterm (t : CTerm) := let (a,_) := t in a.

Definition BCTerm := { bt : BTerm | isprog_bt bt }.

(**

  We also define a type of terms that specifies what are the possible
  free variables of its inhabitants.  A term is a [(CVTerm vs)] term
  if the set of its free variables is a subset of [vs].  This type is
  also useful to define the Nuprl type system.  For example, to define
  a closed family of types such as a closed function type of the form
  $\NUPRLfunction{x}{A}{\NUPRLsuba{B}{z}{x}}$, $A$ has to be closed
  and the free variables of $B$ can only be $z$.

*)

Definition CVTerm (vs : list NVar) := { t : NTerm | isprog_vars vs t }.

Definition CVTerm3 := forall a b c, CVTerm [a;b;c].

Definition mk_cvterm (vs : list NVar) (t : NTerm) (p : isprog_vars vs t) :=
  exist (isprog_vars vs) t p.

Definition get_wterm (t : WTerm) := let (a,_) := t in a.
Definition get_cvterm (vs : list NVar) (t : CVTerm vs) := let (a,_) := t in a.
Definition get_bcterm (bt : BCTerm) := let (a,_) := bt in a.

Definition selectbt (bts: list BTerm) (n:nat) : BTerm :=
  nth n bts (bterm [] (vterm nvarx)).

(*
Definition isnoncan (t: NTerm):=
match t with
| vterm _ => False
| oterm o _ => match o with
               | Can _ => False
               | NCan _ => True
               end
end.
*)
Lemma wf_cterm :
  forall t, wf_term (get_cterm t).
Proof.
  introv; (  repeat match goal with
           | [ H : CTerm |- _ ] => destruct H
           | [ H : CVTerm _ |- _ ] => destruct H
         end
); simpl.
  allrw isprog_eq; unfold isprogram in *; repnd; allrw nt_wf_eq; sp.
Qed.

End terms3Generic.

Ltac irr_step :=
  match goal with
    | [ H1 : isprog ?a, H2 : isprog ?a |- _ ] =>
        assert (H2 = H1) by apply isprog_proof_irrelevance; subst
    | [ H1 : isprog_vars ?vs ?a, H2 : isprog_vars ?vs ?a |- _ ] =>
        assert (H2 = H1) by apply isprog_vars_proof_irrelevance; subst
  end.

Ltac irr := repeat irr_step.

Ltac destruct_cterms :=
  repeat match goal with
           | [ H : CTerm |- _ ] => destruct H
           | [ H : CVTerm _ |- _ ] => destruct H
         end.

Ltac dest_cterm H :=
  let t := type of H in
  match goal with
    | [ x : CTerm |- _ ] =>
      match t with
        | context[x] => destruct x
      end
    | [ x : CVTerm _ |- _ ] =>
      match t with
        | context[x] => destruct x
      end
  end.

(** A faster version of destruct_cterms.  We avoid destructing all of them. *)
Ltac dest_cterms H := repeat (dest_cterm H).

Ltac clear_deps h :=
  repeat match goal with
           | [ H : context[h] |- _ ] => clear H
         end.
Tactic Notation "nterm_ind" ident(h) ident(c) :=
  induction h using NTerm_better_ind;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Tactic Notation "nterm_ind" ident(h) "as" simple_intropattern(I)  ident(c) :=
  induction h as I using NTerm_better_ind;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Tactic Notation "nterm_ind1" ident(h) "as" simple_intropattern(I)  ident(c) :=
  induction h as I using NTerm_better_ind;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Tactic Notation "nterm_ind1s" ident(h) "as" simple_intropattern(I)  ident(c) :=
  induction h as I using NTerm_better_ind2;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].

Ltac fold_terms_step :=
  match goal with
    | [ |- context[bterm [] ?x] ] => fold (nobnd x)
    | [ |- context[vterm ?v] ] => fold (mk_var v)
  end.

Ltac fold_terms := repeat fold_terms_step.

Ltac boolvar_step :=
  match goal with
    | [ |- context[beq_var ?v ?v] ] => rw <- beq_var_refl
    | [ |- context[memvar ?v ?s] ] =>
        let name := fresh "b" in
          remember (memvar v s) as name;
        match goal with
          | [ H : name = memvar v s |- _ ] =>
              symmetry in H;
              destruct name;
              [ rewrite fold_assert in H;
                  trw_h assert_memvar H;
                  simpl in H
              | trw_h not_of_assert H;
                  trw_h assert_memvar H;
                  simpl in H
              ]
        end
    | [ |- context[beq_var ?v1 ?v2] ] =>
        let name := fresh "b" in
          remember (beq_var v1 v2) as name;
        match goal with
          | [ H : name = beq_var v1 v2 |- _ ] =>
            destruct name;
              [ apply beq_var_true in H; subst
              | apply beq_var_false in H
              ]
        end
    | [ H : context[beq_var ?v ?v] |- _ ] => rw <- beq_var_refl in H
  end.

Ltac boolvar := repeat boolvar_step.
Ltac unfold_all_mk :=
       allunfold mk_var
       ;allunfold nobnd.

Hint Immediate wf_cterm : wf.
(* Hint Constructors isvalue. *)
Hint Constructors nt_wf bt_wf.

Ltac rwselectbt :=
match goal with
|[ H1: bterm ?lv ?nt = selectbt ?lbt ?n , H2 : context [selectbt ?lbt ?n] |- _ ] => rewrite <- H1 in H2
|[ H1: selectbt ?lbt ?n = bterm ?lv ?nt  , H2 : context [selectbt ?lbt ?n] |- _ ] => rewrite H1 in H2
|[ H1: bterm ?lv ?nt = selectbt ?lbt ?n  |-  context [selectbt ?lbt ?n] ] => rewrite <- H1
|[ H1: selectbt ?lbt ?n = bterm ?lv ?nt  |-  context [selectbt ?lbt ?n] ] => rewrite H1
end.

Tactic Notation "ntermd" ident(h) "as" simple_intropattern(I)  ident(c) :=
  destruct h as I;
  [ Case_aux c "vterm"
  | Case_aux c "oterm"
  ].
Ltac prove_or :=
  try (left;cpx;fail);
  try (right;cpx;fail);
  try (left;left;cpx;fail);
  try (left;right;cpx;fail);
  try (right;left;cpx;fail);
  try (right;right;cpx;fail).

Ltac fold_selectbt :=
match goal with
[ |- context [nth ?n ?lbt (bterm [] (vterm nvarx))] ] =>
  fold (selectbt lbt n)
end.

(*
Ltac d_isnoncan H :=
  match type of H with
    isnoncan ?t => let tlbt := fresh t "lbt" in let tnc := fresh t "nc" in
              let tt := fresh "temp" in
              destruct t as [tt|tt tlbt];[inverts H as H; fail|];
              destruct tt as [tt|tnc]; [inverts H as H; fail|]
  end.
*)

Section terms4Generic.

Context {NVar VarClass} {deqnvar : Deq NVar} {varcl freshv}
{varclass: @VarType NVar VarClass deqnvar varcl freshv}
  `{hdeq : Deq Opid} {gts : GenericTermSig Opid}.
Notation NTerm := (@NTerm NVar Opid).
Notation BTerm := (@BTerm NVar Opid).

Lemma cterm_eq :
  forall t u,
    get_cterm t = get_cterm u
    -> t = u.
Proof using.
  introv; destruct_cterms; simpl; sp; subst.
  rewrite dep_pair_eq
    with (eq0 := eq_refl)
           (pb := i); auto.
  apply UIP_dec.
  apply bool_dec.
Qed.

Lemma cvterm_eq :
  forall vs t u,
    get_cvterm vs t = get_cvterm vs u
    -> t = u.
Proof using.
  introv; destruct_cterms; simpl; sp; subst.
  rewrite dep_pair_eq
    with (eq0 := eq_refl)
           (pb := i); auto.
  apply UIP_dec.
  apply bool_dec.
Qed.

Lemma free_vars_cterm :
  forall t, free_vars (get_cterm t) = [].
Proof using.
  introv; destruct_cterms; simpl.
  allrw isprog_eq; unfold isprogram in *; repnd; allrw; sp.
Qed.

Definition mk_cterm (t : NTerm) (p : isprogram t) :=
  exist isprog t (isprogram_implies t p).

Definition mk_ct (t : NTerm) (p : isprog t) := exist isprog t p.

Definition mk_wterm (t : NTerm) (p : wf_term t) := exist (@wf_term NVar _ _) t p.

Definition mk_wterm' (t : NTerm) (p : nt_wf t) :=
  exist wf_term t (nt_wf_implies t p).

(* Definition iscvalue (t : CTerm) : Type :=
  isvalue (get_cterm t).
 *)

Lemma mk_cv_pf :
  forall (vs : list NVar) (t:CTerm),
    @isprog_vars NVar _ Opid _ vs (@get_cterm NVar _ Opid _ t).
Proof.
  destruct t; simpl.
  rw @isprog_eq in i; destruct i.
  rw @isprog_vars_eq; simpl; sp.
  unfold closed in *.
  allrw; sp.
Qed.

(** From a closed term, we can always make a term whose variables
 * are contained in vs: *)
Definition mk_cv (vs : list NVar) (t : @CTerm NVar _ Opid _) : @CVTerm NVar _ Opid _ vs :=
  exist (isprog_vars vs) (@get_cterm NVar _ Opid _ t) (mk_cv_pf vs t).

Lemma programs_bt_to_program :
  forall bts : list BCTerm,
  forall op,
    map (fun bt => num_bvars (get_bcterm bt)) bts = OpBindings op
    -> isprogram (oterm op (map get_bcterm bts)).
Proof using.
  sp; unfold isprogram; sp.
  rewrite closed_nt in *; sp.
  allrw in_map_iff; sp; subst.
  destruct a; destruct x; allsimpl.
  clear_deps i.
  rw <- @isprogram_bt_eq in i.
  inversion i; sp.
  constructor; sp.
  allrw in_map_iff; sp; subst.
  destruct a; destruct x; allsimpl.
  clear_deps i.
  rw <- @isprogram_bt_eq in i.
  inversion i; sp.
  rewrite <- H.
  rewrite map_map; unfold compose; sp.
Qed.

(* ---------------------------------------------------- *)

Definition list_rel {A} {B} (R : A -> B -> Prop) (ll : list A) (lr : list B) :=
  (length ll = length lr)
  #
  forall p1  p2 , LIn (p1, p2) (combine ll lr)
                  -> R p1 p2.

(** gets the nth element of a list of bterms. if n is out of range, it returns the variable x
*)

(* Howe defines T(L) as B_0(L) (no bterm constructor)
  and T_0(L) as closed terms of T(L)
  so, a term T_0(L) cannot have the vterm constructor
 at the root
 This a superset of T_0(L)
*)
Inductive not_vbterm: NTerm -> Type :=
  | nvbo : forall (op : Opid) (bts : list BTerm ),
           not_vbterm (oterm op bts).

(** this should not be required anymore. a closed NTerm is automatically not_vbterm. Proof below*)
Definition not_vbtermb (t : NTerm) : bool :=
  match t with
  | oterm _ _ => true
  | _ => false
  end.

Theorem closed_notvb : forall t: NTerm , (closed t) -> (not_vbterm t).
Proof using.
  intros ? Hclose. destruct t.
  unfold closed in Hclose. simpl in Hclose.
  inversion Hclose. constructor.
Qed.

Theorem selectbt_in :
  forall n (bts : list BTerm),
    n < length bts -> LIn (selectbt bts n) bts.
Proof using.
  intros. unfold selectbt.
  apply nth_in; auto.
Qed.

Lemma selectbt_cons :
  forall bt (bts : list BTerm) n,
    selectbt (bt :: bts) n = if beq_nat n 0 then bt else selectbt bts (n - 1).
Proof using.
  unfold selectbt; simpl; sp.
  destruct n; simpl; sp.
  destruct n; simpl; sp.
Qed.

(* Lemma isvalue_wf :
  forall c bts,
    isvalue (oterm (Can c) bts)
    -> map num_bvars bts = OpBindings (Can c).
Proof using. intros ? ?  Hval.
 inverts Hval as Hpr. inverts Hpr as Hclose Hwf.
 inverts Hwf; auto.
Qed.
 *)

(* Lemma isvalue_wf2: forall c bts,
  (isvalue (oterm (Can c) bts))
  -> length bts= length(OpBindings (Can c)).
Proof using. intros ? ?  Hval. apply isvalue_wf in Hval.
 (* fequalhyp H length.  why does this fail*)

 assert (length (map num_bvars bts) = length (OpBindings (Can c)))
   as Hlen by (rewrite Hval; reflexivity) .
 rewrite map_length in Hlen. auto.
Qed.
 *)

Notation bterm := (@bterm NVar Opid).
Lemma isprogram_wf3: forall o bts,
  (isprogram (oterm o bts))
  -> forall n, (n<length bts) -> (num_bvars (selectbt bts n))= nth n (OpBindings o) 0.
Proof using. intros ? ?  Hprog. apply isprogram_ot_iff  in Hprog. repnd.
 intros ? Hlt.
assert(nth n (map num_bvars bts) 0= nth n (OpBindings o) 0)
  as Hnth by (rewrite Hprog0; reflexivity).
 unfold selectbt.
 instlemma (@map_nth BTerm nat num_bvars
  bts (bterm [] (vterm nvarx))) as Hmapn.
 assert((num_bvars (bterm [] (vterm nvarx))) =0).
 compute; auto . rewrite H in Hmapn. rewrite Hmapn in Hnth. auto.
Qed.

(* Lemma isvalue_wf3: forall o bts,
  (isvalue (oterm o bts))
  -> forall n, (n<length bts) -> (num_bvars (selectbt bts n))= nth n (OpBindings o) 0.
Proof using. intros ? ?  Hval ? Hlt.
 inverts Hval as Hprog. apply isprogram_wf3 with (n:=n) in Hprog ; auto.
Qed. *)

Theorem var_not_prog : forall v,  (isprogram (vterm v)) -> void.
Proof using.
  unfold not. intros v Hpr.
  inversion Hpr as [Hclose ?].
  unfold closed in Hclose. simpl in Hclose. inversion Hclose.
Qed.

Lemma implies_isprogram_bt :
  forall bts,
    (forall l : BTerm, LIn l bts -> bt_wf l)
    -> flat_map free_vars_bterm bts = []
    -> forall bt : BTerm, LIn bt bts -> isprogram_bt bt.
Proof using.
  intros bts Hbf Hflat ? Hin.
  unfold isprogram_bt, closed_bt; split; auto.
  rw flat_map_empty in Hflat. apply Hflat; auto.
Qed.

Theorem ntbf_wf :
  forall (nt : NTerm) , (bt_wf (bterm [] nt)) -> nt_wf nt.
Proof using.
  introv Hin. inverts Hin. auto.
Qed.

Lemma implies_isprogram_bt0 :
  forall t ,
    isprogram (t)
    -> isprogram_bt (bterm [] t).
Proof using.
  unfold isprogram_bt, closed_bt, isprogram, closed; simpl; sp.
Qed.

Theorem is_program_ot_bts0 :
  forall o nt,
    isprogram nt
    -> OpBindings o = [0]
    -> isprogram (oterm o [bterm [] nt]).
Proof using.
  introv Hpr Hop. unfold isprogram, closed in *; simpl; repnd.
  split;auto. autorewrite with list. auto.

  constructor; sp; allsimpl; sp; subst; sp.
Qed.

Theorem is_program_ot_nth_nobnd :
  forall o nt1 bts,
    isprogram (oterm o  bts)
    -> LIn (bterm [] nt1) bts
    -> isprogram nt1.
Proof using. intros ? ? ? Hisp Hin. apply isprogram_ot_iff in Hisp. repnd.
  apply Hisp in Hin. inverts Hin as Hclose Hbf. inverts Hbf.
  unfold closed_bt in Hclose. simpl in Hclose.
  split; auto.
Qed.

Theorem is_program_ot_fst_nobnd :
  forall o nt1 bts,
    isprogram (oterm o ((bterm [] nt1):: bts))
    -> isprogram nt1.
Proof using.
  intros ? ? ? Hisp.
  apply is_program_ot_nth_nobnd with (nt1:=nt1) in Hisp; sp.
Qed.

Theorem is_program_ot_snd_nobnd :
  forall o bt1 nt2 bts, isprogram (oterm o ((bt1)::(bterm [] nt2):: bts))
   -> isprogram nt2.
Proof using. intros ? ? ? ? Hisp.
  apply is_program_ot_nth_nobnd with (nt1:=nt2) in Hisp; simpl; sp.
Qed.

Theorem is_program_ot_subst1 :
  forall o nt1 bts nt1r,
    isprogram (oterm o ((bterm [] nt1):: bts))
    -> isprogram nt1r
    -> isprogram (oterm o ((bterm [] nt1r):: bts)).
Proof using. intros ? ? ?  ? Hisp Hispst. unfold isprogram.
    unfold closed. simpl.
    inverts Hisp as Hclos Hisp. unfold closed in Hclos. simpl in Hclos.
    apply app_eq_nil in Hclos. repnd.
    inverts Hispst as Hclosst Hispst. unfold closed in Hclosst.
    rewrite Hclosst. rewrite Hclos. split;auto.
    invertsn Hisp. constructor;auto.
    intros ? Hin. inverts Hin. constructor; auto.
    apply Hisp. right; auto.
Qed.

Theorem is_program_ot_subst2 :
  forall o bt1 nt2 bts nt2r,
    isprogram (oterm o (bt1::(bterm [] nt2):: bts))
    -> isprogram nt2r
    -> isprogram (oterm o (bt1::(bterm [] nt2r):: bts)).
Proof using. intros ? ? ? ?  ? Hisp Hispst. unfold isprogram.
    unfold closed. simpl.
    inverts Hisp as Hclos Hisp. inverts Hispst as Hclosst Hwfst.
    unfold closed in *. simpl.
    unfold closed in Hclos. allsimpl.
   simpl_vlist. rewrite Hclosst. rewrite Hclos0.
   simpl. split;auto.
   inverts Hisp as Hisp Hm. constructor;simpl; auto.
   intros ? Hin. dorn Hin;subst;auto. apply Hisp; auto.
   left; auto.
   dorn Hin; subst; auto.
   apply Hisp. right;right;auto.
Qed.

Theorem is_program_ot_nth_wf :
  forall lv o nt1 bts,
    isprogram (oterm o  bts)
    -> LIn (bterm lv nt1) bts
    -> nt_wf nt1.
Proof using. intros ? ? ? ? Hisp Hin. apply isprogram_ot_iff in Hisp. repnd.
  assert (isprogram_bt (bterm lv nt1)) as Hass by (apply Hisp; auto).
  inverts Hass as Hass Hbt. inversion Hbt; auto.
Qed.

Lemma combine_vars_map_sp :
  forall vars,
    combine vars (map (@vterm NVar Opid) vars) = map (fun v => (v, vterm v)) vars.
Proof using.
  induction vars; simpl; sp.
  rewrite IHvars; sp.
Qed.

Lemma combine_vars_map :
  forall A,
  forall f : NVar -> A,
  forall vars,
    combine vars (map f vars) = map (fun v => (v, f v)) vars.
Proof using.
  induction vars; simpl; sp.
  rewrite IHvars; sp.
Qed.

Theorem in_selectbt: forall bt (bts : list BTerm),  LIn bt bts ->
    {n : nat $ n < length bts # selectbt bts n = bt}.
Proof using.
  intros ? ? Hin. induction bts. inverts Hin.
  invertsn Hin.
  - exists 0. split; simpl; auto. omega.
  - destruct IHbts; auto. exists (S x). repnd.
    split; simpl; try omega. auto.
Qed.

(**useful for rewriting in complicated formulae*)
Theorem ntot_wf_iff: forall o bts, nt_wf (oterm o bts)
    <=> map num_bvars bts = OpBindings o # forall n : nat,
     n < length bts -> bt_wf (selectbt bts n).
Proof using. introv. sp_iff Case; introv H.
  Case "->". inverts H as Hbf Hmap. split; auto.
    introv Hlt. apply Hbf. apply selectbt_in; auto.
  Case "<-". repnd. constructor; auto.
    introv Hin. apply in_selectbt in Hin.
    exrepnd. rw <- Hin0;auto.
Qed.

(**useful for rewriting in complicated formulae*)
Theorem bt_wf_iff: forall lv (nt : NTerm), bt_wf (bterm lv nt)
    <=> nt_wf nt.
Proof using. sp_iff Case; introv H.
  Case "->". inverts H as Hwf;  auto.
  Case "<-".  constructor; auto.
Qed.

Definition nvarxbt := bterm [] (vterm nvarx) .

Lemma isprogram_get_cterm :
  forall a, isprogram (get_cterm a).
Proof using.
  destruct a; sp; simpl.
  rw isprogram_eq; sp.
Qed.

Lemma oterm_eq :
  forall o1 o2 l1 l2,
    o1 = o2
    -> l1 = l2
    -> (@oterm NVar Opid) o1 l1 = oterm o2 l2.
Proof using.
  sp; allrw; sp.
Qed.

Notation oterm := (@oterm NVar Opid).
Notation vterm := (@vterm NVar Opid).

Inductive liftRBt (R : (NTerm) -> (NTerm) -> Prop)
  : (@BTerm) -> (@BTerm) -> Prop :=
  liftRbt : forall lv ntl ntr, R ntl ntr
                          -> liftRBt R
                              (bterm lv ntl)
                              (bterm lv ntr).

Require Import SetoidList.
(* Move to SquiggleEq and heterogenize *)
Lemma liftRBTeqlist (R : NTerm ->  NTerm -> Prop) es lbt:
  eqlistA (liftRBt R) (map (bterm []) es) lbt
  -> exists esp, eqlistA R es esp /\ lbt = map (bterm []) esp.
Proof using.
  revert es lbt.
  induction es; intros ? Heq; inverts Heq.
  + eexists. split. constructor. refl.
  + inverts H1. apply IHes in H3. exrepnd. eexists. split. econstructor; eauto.
      subst. auto.
Qed.

Lemma liftRbt_eqlista   (R : NTerm ->  NTerm -> Prop)  vs vsp:
  eqlistA R vs vsp ->
  eqlistA (liftRBt R) (map (bterm []) vs) (map (bterm []) vsp).
Proof using.
  intros H. induction H; constructor; auto.
  constructor; auto.
Qed.

  Lemma liftRbtsiglist {dcon:Type} (R: NTerm -> NTerm -> Prop):
    forall  (bs : list (dcon * BTerm)) (lbtp : list BTerm),
  eqlistA (liftRBt R) (map snd bs) lbtp ->
  map (fun x : dcon * BTerm => num_bvars (snd x)) bs = map num_bvars lbtp.
Proof using.
  intros ? ? Heq. remember (map snd bs) as msb. revert dependent bs.
  induction Heq; intros; destruct bs; invertsn Heqmsb; auto.
  simpl. f_equal; eauto.
  inverts H; auto.
Qed.

Lemma bterm_eq :
  forall l1 l2 n1 n2,
    l1 = l2
    -> n1 = n2
    -> bterm l1 n1 = bterm l2 n2.
Proof using.
  sp; allrw; sp.
Qed.

Theorem selectbt_map {gtsi gtso}: forall lbt n
  (f: (@terms.BTerm NVar gtsi) -> (@terms.BTerm NVar gtso)) ,
  n<length lbt
  -> selectbt (map f lbt) n = f (selectbt lbt n).
Proof using.
  induction lbt; introv Hlt. inverts Hlt.
  simpl. destruct n; subst. reflexivity.
  unfold selectbt in *. allsimpl.
  assert (n < (length lbt)) by omega.
  auto.
Qed.

Theorem eq_maps_bt: forall (B : Type) (f : BTerm -> B)
  (g : BTerm -> B) (la lc : list BTerm),
  length la = length lc
  -> (forall n : nat, n < length la
       -> f (selectbt la n) = g (selectbt lc n))
  -> map f la = map g lc.
Proof using. unfold selectbt. introv H2 H3. apply eq_maps2 in H3; auto.
Qed.

Lemma vterm_inj: injective_fun vterm.
Proof using.
    introv Hf. inverts Hf. auto.
Qed.

Lemma map_eq_lift_vterm:  forall lvi lvo,
  map vterm lvi = map vterm lvo -> lvi = lvo.
Proof using.
 intros.
  apply map_eq_injective with (f:=vterm); auto.
  exact vterm_inj.
Qed.

(*
Global Instance deqNterm : Deq NTerm.
Proof.
  intros a b. exists (NTerm_beq a b).
  apply NTerm_beq_correct.
Defined.
*)

Global Instance deq_nterm : DeqSumbool NTerm.
Proof using deqnvar hdeq.
  intros x.
  nterm_ind1 x as [v1 | o1 lbt1 Hind] Case; intros y.

  - Case "vterm".
    destruct y as [v2 | o lbt2]; [  | right; intro Hc; inverts Hc].
    destruct (decideP (v1=v2)); subst;
    [ left; auto; fail
    | right; intro Hc; inverts Hc; sp
    ].

  - Case "oterm".
    destruct y as [v2 | o2 lbt2]; [ right; intro Hc; inverts Hc | ].
    destruct (decideP (o1=o2)); subst; [  | right; intro Hc; inverts Hc;sp].
    assert ((lbt1=lbt2) + (lbt1 <> lbt2)) as Hbt.
    Focus 2.
    dorn Hbt; subst; [left; auto | right; intro Hc; inverts Hc;sp ]; fail.
    revert lbt2.
    induction lbt1.
    destruct lbt2; [left; auto | right; intro Hc; inverts Hc;sp ]; fail.
    destruct lbt2;  [ right; intro Hc; inverts Hc; fail | ].
    destruct a as [lv1 nt1]. destruct b as [lv2 nt2].
    lapply (IHlbt1);
      [ | introv Hin; apply Hind with (lv:=lv); eauto; right; auto].
    intro bdec.
    destruct (bdec lbt2); subst; [  | right; intro Hc; inverts Hc;sp;fail ].
    destruct (decideP (lv1=lv2));
      subst; [ | right; intro Hc; inverts Hc;sp;fail ].
    destruct (Hind nt1 lv2 (injL(eq_refl _) ) nt2); subst;
    [left; auto |  right; intro Hc; inverts Hc;sp ].
Defined.

Lemma lin_lift_vterm :
  forall v lv,
    LIn v lv <=> LIn (vterm v) (map vterm lv).
Proof using.
  induction lv; [sp | ]. simpl.
  rw <- IHlv; split; intros hp; try (dorn hp); sp; subst; sp.
  inverts hp. sp.
Qed.

Lemma map_removevars:
forall lvi lvr,
  map vterm (remove_nvars lvi lvr)
  = @lremove _ _ (map vterm lvi) (map vterm lvr).
Proof using.
(*   simpl.
  clear gts. *)
  intros. apply map_diff_commute.
  introv Hc. inverts Hc. auto.
Qed.

Open Scope list_scope.

Definition all_vars_bt (bt : BTerm) := free_vars_bterm bt ++ bound_vars_bterm bt.

Lemma all_vars_ot : forall o lbt,
  eq_set
    (all_vars (oterm o lbt))
    (flat_map all_vars_bt lbt).
Proof using.
  intros. unfold all_vars. simpl. unfold all_vars_bt.
  rewrite <- flat_map_fapp. refl.
Qed.

Theorem nil_remove_nvars_iff: forall l1 l2 : list NVar,
   (remove_nvars l1 l2) = [] <=> (forall x : NVar, LIn x l2 -> LIn x l1).
Proof using.
  intros. rw <- null_iff_nil. apply null_remove_nvars.
Qed.

Theorem nil_rv_single_iff: forall lv v ,
   (remove_nvars lv [v]) = [] <=> (LIn v lv).
Proof using.
  intros. rw <- null_iff_nil. rw null_remove_nvars.
  split; intro Hyp.
  apply Hyp. left. auto.
  introv Hin. apply in_list1 in Hin; subst; auto.
Qed.

Theorem selectbt_eq_in:  forall lv nt lbt n,
  bterm lv nt = selectbt lbt n
  -> n < length lbt
  -> LIn (bterm lv nt) lbt.
Proof using.
  introv Heq Hlt. rw Heq.
  apply selectbt_in; trivial.
Qed.

Lemma flat_map_closed_terms:
  forall (lnt : list NTerm), lforall closed lnt
    -> flat_map free_vars lnt = [].
Proof using.
  unfold lforall, closed. introv Hfr.
  apply flat_map_empty. trivial.
Qed.

Lemma flat_map_progs:
  forall lnt, lforall isprogram lnt
    -> flat_map free_vars lnt = [].
Proof using.
  unfold lforall, closed. introv Hfr.
  apply flat_map_empty. introv Hin.
  apply Hfr in Hin. inverts Hin. auto.
Qed.

Theorem disjoint_lbt_bt :
  forall vs lbt lv nt,
    disjoint vs (flat_map bound_vars_bterm lbt)
    -> LIn (bterm lv nt) lbt
    -> disjoint vs lv.
Proof using.
  introv Hink1 Hin.
  apply disjoint_sym in Hink1; rw disjoint_flat_map_l in Hink1.
  apply Hink1 in Hin.
  simpl in Hin. rw disjoint_app_l in Hin.
  repnd; apply disjoint_sym. trivial.
Qed.

Definition selectnt (n:nat) (lnt : list NTerm): NTerm :=
  nth n lnt (vterm nvarx).

Lemma deq_bterm : DeqSumbool BTerm.
Proof using deqnvar hdeq.
  intros btx bty. destruct btx as [lvx ntx].
  destruct bty as [lvy nty].
  destruct (deq_nterm ntx nty);
  destruct (decideP (lvx=lvy)); subst;sp;
  right; introv Heq;
  inverts Heq; cpx.
Qed.

Inductive nt_wf2 : NTerm -> [univ] :=
  | wfvt2 : forall nv : NVar, nt_wf2 (vterm nv)
  | wfot2 : forall (o : Opid) (lnt : list BTerm),
            length lnt = length (OpBindings o)
           -> (forall n, n < (length lnt) ->
                num_bvars (selectbt lnt n) = nth n (OpBindings o) 0
                # bt_wf2 (selectbt lnt n))
           -> nt_wf2 (oterm o lnt)
  with bt_wf2 : BTerm -> [univ] :=
    wfbt2 : forall (lnv : list NVar) (nt : NTerm),
           nt_wf2 nt -> bt_wf2 (bterm lnv nt).

(** mainly for convenience in proofs *)
Theorem  selectbt_in2:  forall (n : nat) (bts : list BTerm),
  n < length bts -> { bt : BTerm & (LIn bt bts # (selectbt bts n)=bt) }.
Proof using.
  intros. exists (selectbt bts n).
  split;auto. apply selectbt_in; trivial.
Defined.

Lemma nt_wf_nt_wf2 : forall t, (nt_wf t) <=> (nt_wf2 t).
Proof using.
    assert (0= num_bvars (bterm [] (vterm nvarx))) as XX by auto.
  nterm_ind1 t as [?| o lbt Hind] Case; split; introv Hyp; sp.
  - inverts Hyp as Hl Hyp. constructor. apply_length Hyp;sp.
    introv hlt. unfold selectbt. rw <- Hyp.
    rw XX. rw  map_nth; sp;[].
    fold (selectbt lbt n).
    pose proof (selectbt_in2 n lbt hlt) as Hbt.
    exrepnd. destruct bt as [lv nt].
    applydup Hind in Hbt1.
    rw Hbt0. constructor.
    apply Hl in Hbt1. inverts Hbt1.
    sp3.
  - inverts Hyp as Hl Hyp. constructor.
    + introv Hin. apply in_selectbt in Hin; auto;[].
      exrepnd. applydup Hyp in Hin1.
      rw Hin0 in Hin2. destruct l as [lv nt].
      constructor. exrepnd. invertsn Hin2.
      applysym selectbt_in in Hin1. rw Hin0 in Hin1.
      apply Hind in Hin1. sp3.
    + eapply (tiff_snd (eq_list2 _ 0 _ _)). rw map_length.
      split; auto;[]. introv Hlt. apply Hyp in Hlt.
      repnd. rw <- Hlt0.
      rw XX. rw  map_nth. sp.
Qed.

Definition bin_rel_nterm :=
  binrel_list  (vterm nvarx).

Theorem isprogram_ot_implies_eauto2 :
  forall o bts,
    isprogram (oterm o bts)
    -> (forall n, n< length bts -> isprogram_bt (selectbt bts n)).
Proof using.
  introv Hp Hlt. apply isprogram_ot_iff in Hp.
  apply selectbt_in in Hlt. exrepnd.
  eauto with slow.
Qed.

Lemma isprogram_bt_nobnd :
  forall t ,
    isprogram_bt (bterm [] t)
    -> isprogram (t).
Proof using.
  unfold isprogram_bt, closed_bt, isprogram, closed; intros ?  Hxx;  spc; allsimpl.
  match goal with
  [H: (bt_wf _) |- _ ] => inverts H
  end.
  assumption.
Qed.

Lemma free_vars_list_app :
  forall (ts1 ts2 : list NTerm),
    free_vars_list (ts1 ++ ts2)
    = free_vars_list ts1 ++ free_vars_list ts2.
Proof using.
  induction ts1; simpl; sp.
  rw IHts1; simpl.
  rw app_assoc; sp.
Qed.

Lemma isprog_ntwf_eauto : forall t, isprogram t -> nt_wf t.
Proof using. unfold isprogram. spc.
Qed.

Theorem isprogram_ot_if_eauto :
  forall o bts,
    map num_bvars bts = OpBindings o
    -> (forall bt, LIn bt bts -> isprogram_bt bt)
    -> isprogram (oterm o bts).
Proof using.
 intros. apply isprogram_ot_iff;spc.
Qed.

Definition getOpidBTerms (t: NTerm) : option (Opid * list BTerm):=
match t with
| terms.vterm _ => None
| terms.oterm o lb => Some (o, lb)
end.

Lemma isprogramd :
  forall v, isprogram v
  -> {o : Opid $ {lbt : list BTerm $ v = oterm o lbt}}.
Proof using.
  introv Hpr.
  invertsn Hpr.
  destruct v; inverts Hpr.
  eexists; eexists ; eauto.
Qed.

(* Move *)
Lemma fold_combine : forall {A B} (v:A) (t:B),
  [(v,t)] = (combine [v] [t]).
Proof using.
  intros. simpl. auto.
Qed.

(* Lemma noncan_not_value : forall e,
  isnoncan e
  -> isvalue e
  -> False.
Proof using.
  introv Hisnc Hisv.
  destruct e as [?| o lbt]; allsimpl; cpx.
  destruct o; cpx.
  inverts Hisv.
Qed. *)

Theorem isprogram_ot_if_eauto2 :
  forall o bts,
    map num_bvars bts = OpBindings o
    -> (forall n, n< length bts -> isprogram_bt (selectbt bts n))
    -> isprogram (oterm o bts).
Proof using.
  introv Hn Hp. apply isprogram_ot_iff; dands; spcf.
  introv Hin. apply in_selectbt in Hin. exrepnd.
  eauto with slow.
  rw <- Hin0.
  eauto with slow.
Qed.

Lemma closed_implies:
  forall (t : NTerm),
    closed t -> (forall x, !LIn x (free_vars t)).
Proof using.
  introv cl.
  unfold closed in cl.
  allrw; simpl; try (complete sp).
Qed.

Lemma list_nil_btwf: forall es,
(forall l : BTerm, LIn l (map (bterm []) es) -> bt_wf l)
<->
(forall l : NTerm, LIn l es -> nt_wf l).
Proof using.
  intros ?.
  split; intros H  ? Hin.
- apply (bt_wf_iff []).
  apply H. apply in_map; auto.
- apply in_map_iff in Hin. exrepnd. subst.
  constructor; auto.
Qed.

Require Import Coq.Program.Basics.

Open Scope program_scope.

Lemma flat_map_bterm_nil : forall gts lnt,
flat_map free_vars_bterm
  (map ((@terms.bterm NVar gts) []) lnt) =
flat_map free_vars lnt.
Proof.
  induction lnt; auto.
  simpl. f_equal; auto.
Qed.

Lemma flat_map_vterm : forall gts (lv: list NVar),
flat_map free_vars_bterm
  (map ((@terms.bterm NVar gts) [] ∘ terms.vterm) lv) = lv.
Proof using.
  induction lv; auto.
  simpl. f_equal; auto.
Qed.

Lemma subset_flat_map_lbt:
forall lbt (l lv : list NVar) (n : NTerm),
LIn (bterm l n) lbt ->
subsetv (flat_map free_vars_bterm lbt) lv
-> subsetv (free_vars n) (l ++ lv).
Proof using.
  intros ? ? ? ? Hin Hs.
  rewrite subset_flat_map in Hs.
  rewrite subsetv_prop.
  apply_clear Hs in Hin.
  simpl in Hin.
  rewrite subsetv_prop in Hin.
  intros x Hn. specialize (Hin x).
  rewrite in_remove_nvars in Hin.
  rewrite in_app_iff; destruct (dmemvar x l); cpx.
Qed.

Lemma select_selectbt : forall n lbt (b:BTerm),
select n lbt = Some b
<-> (selectbt lbt n = b /\ n < length lbt).
Proof using.
  intros ? ? ?.
  split; intros Hin.
- pose proof Hin.
  apply select_lt in Hin. split;[|assumption].
  apply nth_select1 with (def:= bterm [] (vterm nvarx))in Hin.
  unfold selectbt.
  congruence.
- repnd. eapply nth_select3; auto.
  apply Hin0.
Qed.

Lemma size_pos : forall (t:NTerm),
  0<(size t).
Proof.
  intros. destruct t; simpl; omega.
Qed.

Definition preservesVarclass (ta tb : NTerm) :Prop :=
forall vc,
varsOfClass (all_vars ta) vc
-> varsOfClass (all_vars tb) vc.

Definition preservesVarclassBT (ta tb : BTerm) :Prop :=
forall vc,
varsOfClass (all_vars_bt ta) vc
-> varsOfClass (all_vars_bt tb) vc.

Lemma subsetAllVarsLbt : forall o lbt bt,
  LIn bt lbt -> subset (all_vars_bt bt) (all_vars (oterm o lbt)).
Proof.
  intros ? ? ? Hin.
  rewrite all_vars_ot.
  unfold all_vars_bt.
  eapply subset_trans;
    [|apply subset_flat_map_r; apply Hin].
  apply subset_refl.
Qed.

Lemma varsOfClassOT : forall o lbt c,
  varsOfClass (all_vars (oterm o lbt)) c
  -> forall bt, LIn bt lbt -> varsOfClass (all_vars_bt bt) c.
Proof using.
  intros ? ? ? Hv ? Hin ? Hinn.
  apply Hv. revert Hinn.
  apply subsetAllVarsLbt.
  assumption.
Qed.

Lemma map0lbt : forall (lbt: list BTerm),
map num_bvars lbt = repeat 0 (Datatypes.length lbt)
->  lbt = map (bterm []) (map get_nt lbt).
Proof using.
  induction lbt; simpl; auto.
  intro Hn.
  destruct a. inverts Hn as Hn Hnn. unfold num_bvars in Hn.
  simpl in Hn. dlist_len_name l Hh.
  simpl. f_equal. eauto.
Qed.

Definition allvars_bterm : forall lv nt,
  eq_set
    (all_vars_bt (bterm lv nt))
    (lv ++ all_vars nt).
Proof using.
  clear.
  intros ? ?. apply eqsetv_prop.
  intro. unfold all_vars, all_vars_bt.
  simpl.
  repeat rewrite in_app_iff.
  repeat rewrite in_remove_nvars.
  destruct (decideP (LIn x lv)); (* firstorder does not know about decidability *)
  firstorder.
Qed.

Lemma flat_map_free_var_vterm: forall lv:list NVar, flat_map free_vars (map vterm lv)=lv.
Proof using.
  induction lv;sp;simpl;f_equal;sp.
Qed.

Lemma flat_map_bound_var_vterm: forall lv:list NVar, flat_map bound_vars (map vterm lv)=[].
Proof using.
  induction lv;sp;simpl;f_equal;sp.
Qed.

Lemma size_subterm4 :
     forall  (lb : list (BTerm)) (nt : NTerm) (lv : list NVar),
       LIn (bterm lv nt) lb -> size nt < S (addl (map size_bterm lb)).
Proof using.
  induction lb; auto; simpl; try tauto;[].
  intros ? ? Hin. dorn Hin.
- subst. simpl. omega.
- apply IHlb in Hin. omega.
Qed.

Lemma subsetAllVarsLbt2 : forall lbt lv (nt : NTerm),
  LIn (bterm lv nt) lbt -> subset (all_vars nt) (flat_map all_vars_bt lbt).
Proof using.
  clear.
  intros.
  eapply subset_trans;
    [|eapply subset_flat_map_r; eauto].
  rewrite allvars_bterm.
  apply subset_app_l.
  refl.
Qed.

Lemma subsetBoundVarsLbt3 : forall (lbt : list BTerm) (lv : list NVar) (nt : NTerm),
  LIn (bterm lv nt) lbt -> subset lv (flat_map bound_vars_bterm lbt).
Proof using.
  intros.
  eapply subset_trans;
    [|eapply subset_flat_map_r; eauto].
  apply subset_app_r.
  refl.
Qed.

Lemma flat_map_bterm_nil_allvars:
  forall  (lnt : list NTerm),
   flat_map all_vars_bt (map (terms.bterm []) lnt) = flat_map all_vars lnt.
Proof using.
  intros. rewrite flat_map_map.
  apply eq_flat_maps.
  intros ? Hin.
  unfold compose, all_vars_bt.
  simpl.
  refl.
Qed.

Lemma subsetAllVarsLbt3
     : forall (lbt : list BTerm) (lv : list NVar) (nt : terms.NTerm),
       LIn (bterm lv nt) lbt -> subset lv (flat_map all_vars_bt lbt).
Proof.
  introv Hin.
   eapply transitivity;
    [|apply subset_flat_map_r; eauto].
  rewrite allvars_bterm.
  apply subset_app_r. refl.
Qed.

End terms4Generic.

Ltac  varsOfClassSimpl :=
repeat match goal with
[ H: varsOfClass (all_vars (oterm ?o ?lbt)) true |- _ ] =>
  specialize (varsOfClassOT _ _ _ H); clear H; intro H;
  repeat match goal with
  | [HH : LIn _ lbt |- _] => apply (fun lin => (conj lin (H _ lin))) in HH
  end; repnd;
repeat match goal with
[H:context [varsOfClass (all_vars_bt (bterm _ _)) true] |- _]
  => setoid_rewrite allvars_bterm in H (* if it fails, continuing may cause a loop *)
end;
repeat rewrite @varsOfClassApp in *
end.

(* Move *)
Hint Rewrite @flat_map_bterm_nil @flat_map_free_var_vterm
  remove_nvars_eq : SquiggleEq.

Hint Rewrite @all_vars_ot @allvars_bterm : allvarsSimpl.

Hint Rewrite @all_vars_ot @allvars_bterm @varsOfClassApp : SquiggleEq.

Hint Resolve isprogram_ot_if_eauto : slow.
Hint Immediate isprogram_get_cterm.
Hint Resolve isprog_implies : isprog.
Hint Extern 100 (LIn _ _) => complete (simpl; sp) : isprog.
Hint Resolve nt_wf_implies : slow.
Hint Resolve nt_wf_eq: slow.
Hint Resolve is_program_ot_nth_nobnd : slow.
Hint Resolve deq_bterm.
Hint Immediate deq_nterm.
Hint Immediate isprogram_get_cterm.
Hint Resolve isprog_ntwf_eauto : slow.
Tactic Notation "disjoint_reasoningv" :=
  (allunfold all_vars); repeat( progress disjoint_reasoning).
Ltac destruct_bterms:=
repeat match goal with
[bt : BTerm |- _] =>
  let btlv := fresh bt "lv" in
  let btnt := fresh bt "nt" in
  destruct bt as [btlv btnt]
end.

Ltac noRepDis :=
(repeat match goal with
[H: no_repeats [] |- _] => clear H
|[H: no_repeats (_::_) |- _] =>
  let Hnrd := fresh "Hnrd" in
  apply no_repeats_as_disjoint in H;
  destruct H as [Hnrd H]
end); disjoint_reasoningv;
rewrite in_single_iff in *; subst; tauto; try tauto.

(* try to move to list.v  . disjoint_reasoningv performs
  some non-list-based unfolding which may
  be done using a database *)
Ltac inauto:=
(repeat match goal with
[H: no_repeats [] |- _] => clear H
|[H: no_repeats (_::_) |- _] =>
  let Hnrd := fresh "Hnrd" in
  apply no_repeats_as_disjoint in H;
  destruct H as [Hnrd H]
end); disjoint_reasoningv;
unfold subset in *;
unfold disjoint in *;
repeat match goal with
| [H:context[LIn _ (_::_) ] |- _] => simpl in H; try setoid_rewrite or_false_r in H
| [|- context[LIn _ (_::_)]] => simpl; try setoid_rewrite or_false_r
| [H:context[LIn _ (flat_map _ _) ] |- _] => setoid_rewrite in_flat_map in H
| [|- context[LIn _ (flat_map _ _)]] => setoid_rewrite in_flat_map
| [H:context[LIn  _ (map _ _)]|- _] => setoid_rewrite in_map_iff in H
| [|- context[LIn  _ (map _ _)]] => setoid_rewrite in_map_iff
| [H:context[LIn  _ (remove_nvars _ _)]|- _] => setoid_rewrite in_remove_nvars in H; simpl in H
| [|- context[LIn  _ (remove_nvars _ _)]] => setoid_rewrite in_remove_nvars; simpl
| [H: _ = []|- _] => apply null_iff_nil in H; unfold null in H; simpl in H
| [|- _ = []] => apply null_iff_nil; unfold null; simpl
| [|- context[LIn  _ (map _ _)]] => setoid_rewrite in_map_iff
end;
subst.

Local Ltac
illFormedCase :=
 (try reflexivity; try (simpl;rewrite flat_map_vterm; reflexivity)).

(* Move *)
Ltac destructbtdeep2 bt tac :=
  let btlv := fresh bt "lv" in
  let btnt := fresh bt "nt" in
  let btlv1 := fresh btlv "1" in
  let btlv2 := fresh btlv "2" in
  let btlv3 := fresh btlv "3" in
  destruct bt as [btlv btnt];
  destruct btlv as [| btlv1]; tac;
  try(destruct btlv as [| btlv2]; tac);
  try(destruct btlv as [| btlv3]; tac).

Ltac destructlbt lbt tac :=
  repeat (
  let b := fresh "b" in
  destruct lbt as [| b lbt];tac; []).

Hint Rewrite memvar_singleton : SquiggleEq.

Hint Rewrite remove_nvars_cons_r : SquiggleEq2.

Hint Rewrite
  <- beq_var_refl : SquiggleEq.

Ltac disjoint_flat_allv :=
repeat match goal with
[ Hdis : disjoint ?lv (flat_map all_vars_bt ?lbt) ,
  Hin : LIn _ ?lbt |- _]
  => rewrite disjoint_flat_map_r in Hdis; specialize (Hdis _ Hin); unfold all_vars_bt in Hdis;
  simpl in Hdis
end.

Ltac disjoint_reasoning2 :=
match goal with
| [  |- disjoint _ (_ ++ _) ] => apply disjoint_app_r;split
| [  |- disjoint (_ ++ _) _ ] => apply disjoint_app_l;split
| [  |- disjoint _ (_ :: (_ :: _)) ] => apply disjoint_cons_r;split
| [  |- disjoint (_ :: (_ :: _)) _ ] => apply disjoint_cons_l;split
| [  |- disjoint _ (_ :: ?v) ] => notNil v;apply disjoint_cons_r;split
| [  |- disjoint (_ :: ?v) _ ] => notNil v;apply disjoint_cons_l;split
| [  |- disjoint _ _ ] => (sp;fail  || apply disjoint_sym; sp;fail)
| [  |- _ <> _] => apply disjoint_neq_iff
| [  |- ! (LIn _ _)] => apply disjoint_singleton_l
(** important to leave it the way it was .. so that repeat progress won't loop*)
| [ H: disjoint _ (_ ++ _) |- _ ] => apply disjoint_app_r in H;sp
| [ H: disjoint (_ ++ _) _ |- _ ] => apply disjoint_app_l in H;sp
| [ H: disjoint _ (_ :: (_ :: _)) |- _ ] => apply disjoint_cons_r in H;sp
| [ H: disjoint (_ :: (_ :: _)) _ |- _ ] => apply disjoint_cons_l in H;sp
| [ H: disjoint _ (_ :: ?v) |- _ ] => notNil v;apply disjoint_cons_r in H;sp
| [ H: disjoint (_ :: ?v) _ |- _ ] => notNil v;apply disjoint_cons_l in H;sp
| [ H: !(disjoint  _ []) |- _ ] => provefalse; apply H; apply disjoint_nil_r
| [ H: !(disjoint  [] _) |- _ ] => provefalse; apply H; apply disjoint_nil_l
| [ H: (disjoint  _ []) |- _ ] => clear H
| [ H: (disjoint  [] _) |- _ ] => clear H
| [ H: ! (LIn _ _) |- _] => apply disjoint_singleton_l in H
| [ H: _ <> _  |- _] => apply disjoint_neq_iff in H
end.

Tactic Notation "disjoint_reasoningv2" :=
  (unfold all_vars in *); repeat( progress disjoint_reasoning2).

Ltac disjoint_flat2 :=
disjoint_reasoning2; disjoint_flat_allv;disjoint_reasoningv2.

Hint Resolve subsetAllVarsLbt2 : subset.

Hint Rewrite remove_var_nil remove_nvars_nil_r:  SquiggleEq.

    Ltac rwHyps :=
    unfold closed, closed_bt in *;
    repeat match goal with
    [ H: _ = _ |- _] =>  repeat rewrite H; hide_hyp H
    end; show_hyps.

    Hint Resolve @subsetAllVarsLbt3 @subsetBoundVarsLbt3 : subset.

Lemma isProgramLNoBnd {O V} {deqv: Deq V} {gtso : GenericTermSig O}
      (lbt: list (@BTerm V O)) m:
  map num_bvars lbt = repeat 0 m
  -> lforall isprogram_bt lbt
  -> lforall isprogram (map get_nt lbt).
Proof using.
  revert m.
  induction lbt; unfold lforall; simpl in *;[ firstorder; fail | ].
  intros ? Hm.
  simpl in *.
  simpl.
  destruct m; [invertsn Hm | ].
  simpl in *. inverts Hm as Hma Hm.
  rewrite Hma in Hm.
  specialize (IHlbt _ Hm).
  destruct a as [lv nt].
  destruct lv; [ |  inverts Hma].
  revert IHlbt. revert Hm. unfold lforall. clear.
  intros.
  pose proof (H _ ltac:(left; refl)).
  apply isprogram_bt_nobnd in H1.
  firstorder; subst; simpl; firstorder.
Qed.

Lemma map0lbt2 {V O}: forall (lbt: list (@BTerm V O)) m,
map num_bvars lbt = repeat 0 m
->  lbt = map (bterm []) (map get_nt lbt).
Proof using.
  induction lbt; simpl; auto.
  intros ? Hn.
  destruct a. inverts Hn as Hn Hnn. unfold num_bvars in Hn.
  simpl in Hn. dlist_len_name l Hh.
  destruct m; invertsn Hn.
  destruct l; invertsn Hn.
  simpl. f_equal. eauto.
Qed.

Hint Rewrite @noDupApp @all_vars_ot @allvars_bterm @varsOfClassConsIff @noDupConsIff: SquiggleEq.

Lemma  wft_ntwf {Opid V} {gts : GenericTermSig Opid}: forall t: @NTerm V Opid,  wft t =true -> nt_wf t.
Proof using.
  induction t as [x | o lbt Hind] using NTerm_better_ind; intros Hwf; try (constructor; fail).
  simpl in Hwf.
  apply andb_eq_true in Hwf. repnd.
  setoid_rewrite assert_beq_list in Hwf0.
  constructor; auto.
  rewrite ball_map_true in Hwf.
  intros l. destruct l. intros. constructor.
  eapply Hind; eauto.
  specialize (Hwf _ H).
  simpl in Hwf. assumption.
  Qed.

Hint Rewrite @flat_map_bterm_nil_allvars: SquiggleEq.


(** * Induction: Proof by Induction *)

(** Before getting started, we need to import all of our
    definitions from the previous chapter: *)

From LF Require Export Basics.

(** For the [Require Export] to work, Coq needs to be able to
    find a compiled version of [Basics.v], called [Basics.vo], in a directory
    associated with the prefix [LF].  This file is analogous to the [.class]
    files compiled from [.java] source files and the [.o] files compiled from
    [.c] files.

    First create a file named [_CoqProject] containing the following line
    (if you obtained the whole volume "Logical Foundations" as a single
    archive, a [_CoqProject] should already exist and you can skip this step):

      [-Q . LF]

    This maps the current directory ("[.]", which contains [Basics.v],
    [Induction.v], etc.) to the prefix (or "logical directory") "[LF]".
    PG and CoqIDE read [_CoqProject] automatically, so they know to where to
    look for the file [Basics.vo] corresponding to the library [LF.Basics].

    Once [_CoqProject] is thus created, there are various ways to build
    [Basics.vo]:

     - In Proof General: The compilation can be made to happen automatically
       when you submit the [Require] line above to PG, by setting the emacs
       variable [coq-compile-before-require] to [t]. You can also use the
       menu option "Coq -> Auto Compilation -> Compile Before Require".

     - In CoqIDE: Open [Basics.v]; then, in the "Compile" menu, click
       on "Compile Buffer".

     - From the command line: Generate a [Makefile] using the [coq_makefile]
       utility, that comes installed with Coq (if you obtained the whole
       volume as a single archive, a [Makefile] should already exist
       and you can skip this step):

         [coq_makefile -f _CoqProject *.v -o Makefile]

       Note: You should rerun that command whenever you add or remove Coq files
       to the directory.

       Then you can compile [Basics.v] by running [make] with the corresponding
       [.vo] file as a target:

         [make Basics.vo]

       All files in the directory can be compiled by giving no arguments:

         [make]

       Under the hood, [make] uses the Coq compiler, [coqc].  You can also
       run [coqc] directly:

         [coqc -Q . LF Basics.v]

       But [make] also calculates dependencies between source files to compile
       them in the right order, so [make] should generally be prefered over
       explicit [coqc].

    If you have trouble (e.g., if you get complaints about missing
    identifiers later in the file), it may be because the "load path"
    for Coq is not set up correctly.  The [Print LoadPath.] command
    may be helpful in sorting out such issues.

    In particular, if you see a message like

        [Compiled library Foo makes inconsistent assumptions over
        library Bar]

    check whether you have multiple installations of Coq on your machine.
    It may be that commands (like [coqc]) that you execute in a terminal
    window are getting a different version of Coq than commands executed by
    Proof General or CoqIDE.

    - Another common reason is that the library [Bar] was modified and
      recompiled without also recompiling [Foo] which depends on it.  Recompile
      [Foo], or everything if too many files are affected.  (Using the third
      solution above: [make clean; make].)

    One more tip for CoqIDE users: If you see messages like [Error:
    Unable to locate library Basics], a likely reason is
    inconsistencies between compiling things _within CoqIDE_ vs _using
    [coqc] from the command line_.  This typically happens when there
    are two incompatible versions of [coqc] installed on your
    system (one associated with CoqIDE, and one associated with [coqc]
    from the terminal).  The workaround for this situation is
    compiling using CoqIDE only (i.e. choosing "make" from the menu),
    and avoiding using [coqc] directly at all. *)

(* ################################################################# *)
(** * Proof by Induction *)

(** We proved in the last chapter that [0] is a neutral element
    for [+] on the left, using an easy argument based on
    simplification.  We also observed that proving the fact that it is
    also a neutral element on the _right_... *)

Theorem plus_n_O_firsttry : forall n:nat,
  n = n + 0.

(** ... can't be done in the same simple way.  Just applying
  [reflexivity] doesn't work, since the [n] in [n + 0] is an arbitrary
  unknown number, so the [match] in the definition of [+] can't be
  simplified.  *)

Proof.
  intros n.
  simpl. (* Does nothing! *)
Abort.

(** And reasoning by cases using [destruct n] doesn't get us much
    further: the branch of the case analysis where we assume [n = 0]
    goes through fine, but in the branch where [n = S n'] for some [n'] we
    get stuck in exactly the same way. *)

Theorem plus_n_O_secondtry : forall n:nat,
  n = n + 0.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - (* n = 0 *)
    reflexivity. (* so far so good... *)
  - (* n = S n' *)
    simpl.       (* ...but here we are stuck again *)
Abort.

(** We could use [destruct n'] to get one step further, but,
    since [n] can be arbitrarily large, if we just go on like this
    we'll never finish. *)

(** To prove interesting facts about numbers, lists, and other
    inductively defined sets, we usually need a more powerful
    reasoning principle: _induction_.

    Recall (from high school, a discrete math course, etc.) the
    _principle of induction over natural numbers_: If [P(n)] is some
    proposition involving a natural number [n] and we want to show
    that [P] holds for all numbers [n], we can reason like this:
         - show that [P(O)] holds;
         - show that, for any [n'], if [P(n')] holds, then so does
           [P(S n')];
         - conclude that [P(n)] holds for all [n].

    In Coq, the steps are the same: we begin with the goal of proving
    [P(n)] for all [n] and break it down (by applying the [induction]
    tactic) into two separate subgoals: one where we must show [P(O)]
    and another where we must show [P(n') -> P(S n')].  Here's how
    this works for the theorem at hand: *)

Theorem plus_n_O : forall n:nat, n = n + 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)    reflexivity.
  - (* n = S n' *) simpl. rewrite <- IHn'. reflexivity.  Qed.

(** Like [destruct], the [induction] tactic takes an [as...]
    clause that specifies the names of the variables to be introduced
    in the subgoals.  Since there are two subgoals, the [as...] clause
    has two parts, separated by [|].  (Strictly speaking, we can omit
    the [as...] clause and Coq will choose names for us.  In practice,
    this is a bad idea, as Coq's automatic choices tend to be
    confusing.)

    In the first subgoal, [n] is replaced by [0].  No new variables
    are introduced (so the first part of the [as...] is empty), and
    the goal becomes [0 = 0 + 0], which follows by simplification.

    In the second subgoal, [n] is replaced by [S n'], and the
    assumption [n' + 0 = n'] is added to the context with the name
    [IHn'] (i.e., the Induction Hypothesis for [n']).  These two names
    are specified in the second part of the [as...] clause.  The goal
    in this case becomes [S n' = (S n') + 0], which simplifies to
    [S n' = S (n' + 0)], which in turn follows from [IHn']. *)

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  (* WORKED IN CLASS *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** (The use of the [intros] tactic in these proofs is actually
    redundant.  When applied to a goal that contains quantified
    variables, the [induction] tactic will automatically move them
    into the context as needed.) *)

(** **** Exercise: 2 stars, standard, recommended (basic_induction)

    Prove the following using induction. You might need previously
    proven results. *)

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  (* SOLUTION: *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  (* SOLUTION: *)
  intros n m. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  (* SOLUTION: *)
  intros n m. induction m as [| m' IHm'].
  - (* m = 0 *)
    simpl. rewrite <- plus_n_O. reflexivity.
  - (* m = S m' *)
    simpl. rewrite <- IHm'. rewrite <- plus_n_Sm.
    reflexivity.  Qed.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* SOLUTION: *)
  intros n m p. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.   Qed.
(** [] *)

(** **** Exercise: 2 stars, standard (double_plus)

    Consider the following function, which doubles its argument: *)

Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.

(** Use induction to prove this simple fact about [double]: *)

Lemma double_plus : forall n, double n = n + n .
Proof.
  (* SOLUTION: *)
  intros n.  induction n as [|n' IHn'].
  - (* n = 0 *)
   reflexivity.
  - (* n = S n' *)
   simpl. rewrite plus_comm. simpl. rewrite IHn'. reflexivity. Qed.
  (** [] *)

(** **** Exercise: 2 stars, standard, optional (evenb_S)

    One inconvenient aspect of our definition of [evenb n] is the
    recursive call on [n - 2]. This makes proofs about [evenb n]
    harder when done by induction on [n], since we may need an
    induction hypothesis about [n - 2]. The following lemma gives an
    alternative characterization of [evenb (S n)] that works better
    with induction: *)

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  (* SOLUTION: *)
  intros n.
  induction n as [| n' IHn'].
  - (* n = 0 *) simpl. reflexivity.
  - (* n = S n' *)
    rewrite IHn'. rewrite negb_involutive. simpl. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 1 star, standard, optional (destruct_induction)

    Briefly explain the difference between the tactics [destruct]
    and [induction].

(* SOLUTION: *)
   Both are used to perform case analysis on an element of an
   inductively defined type; [induction] also generates an induction
   hypothesis, while [destruct] does not.
*)

(* Do not modify the following line: *)
Definition manual_grade_for_destruct_induction : option (nat*string) := None.
(** [] *)

(* ################################################################# *)
(** * Proofs Within Proofs *)

(** In Coq, as in informal mathematics, large proofs are often
    broken into a sequence of theorems, with later proofs referring to
    earlier theorems.  But sometimes a proof will require some
    miscellaneous fact that is too trivial and of too little general
    interest to bother giving it its own top-level name.  In such
    cases, it is convenient to be able to simply state and prove the
    needed "sub-theorem" right at the point where it is used.  The
    [assert] tactic allows us to do this. *)

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  assert (H: 0 + n = n). { reflexivity. }
  rewrite -> H.
  reflexivity.  Qed.

(** The [assert] tactic introduces two sub-goals.  The first is
    the assertion itself; by prefixing it with [H:] we name the
    assertion [H].  (We can also name the assertion with [as] just as
    we did above with [destruct] and [induction], i.e., [assert (0 + n
    = n) as H].)  Note that we surround the proof of this assertion
    with curly braces [{ ... }], both for readability and so that,
    when using Coq interactively, we can see more easily when we have
    finished this sub-proof.  The second goal is the same as the one
    at the point where we invoke [assert] except that, in the context,
    we now have the assumption [H] that [0 + n = n].  That is,
    [assert] generates one subgoal where we must prove the asserted
    fact and a second subgoal where we can use the asserted fact to
    make progress on whatever we were trying to prove in the first
    place. *)

(** Another example of [assert]... *)

(** For example, suppose we want to prove that [(n + m) + (p + q)
    = (m + n) + (p + q)]. The only difference between the two sides of
    the [=] is that the arguments [m] and [n] to the first inner [+]
    are swapped, so it seems we should be able to use the
    commutativity of addition ([plus_comm]) to rewrite one into the
    other.  However, the [rewrite] tactic is not very smart about
    _where_ it applies the rewrite.  There are three uses of [+] here,
    and it turns out that doing [rewrite -> plus_comm] will affect
    only the _outer_ one... *)

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* We just need to swap (n + m) for (m + n)... seems
     like plus_comm should do the trick! *)
  rewrite -> plus_comm.
  (* Doesn't work... Coq rewrites the wrong plus! :-( *)
Abort.

(** To use [plus_comm] at the point where we need it, we can introduce
    a local lemma stating that [n + m = m + n] (for the particular [m]
    and [n] that we are talking about here), prove this lemma using
    [plus_comm], and then use it to do the desired rewrite. *)

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
  { rewrite -> plus_comm. reflexivity. }
  rewrite -> H. reflexivity.  Qed.

(* ################################################################# *)
(** * Formal vs. Informal Proof *)

(** "_Informal proofs are algorithms; formal proofs are code_." *)

(** What constitutes a successful proof of a mathematical claim?
    The question has challenged philosophers for millennia, but a
    rough and ready definition could be this: A proof of a
    mathematical proposition [P] is a written (or spoken) text that
    instills in the reader or hearer the certainty that [P] is true --
    an unassailable argument for the truth of [P].  That is, a proof
    is an act of communication.

    Acts of communication may involve different sorts of readers.  On
    one hand, the "reader" can be a program like Coq, in which case
    the "belief" that is instilled is that [P] can be mechanically
    derived from a certain set of formal logical rules, and the proof
    is a recipe that guides the program in checking this fact.  Such
    recipes are _formal_ proofs.

    Alternatively, the reader can be a human being, in which case the
    proof will be written in English or some other natural language,
    and will thus necessarily be _informal_.  Here, the criteria for
    success are less clearly specified.  A "valid" proof is one that
    makes the reader believe [P].  But the same proof may be read by
    many different readers, some of whom may be convinced by a
    particular way of phrasing the argument, while others may not be.
    Some readers may be particularly pedantic, inexperienced, or just
    plain thick-headed; the only way to convince them will be to make
    the argument in painstaking detail.  But other readers, more
    familiar in the area, may find all this detail so overwhelming
    that they lose the overall thread; all they want is to be told the
    main ideas, since it is easier for them to fill in the details for
    themselves than to wade through a written presentation of them.
    Ultimately, there is no universal standard, because there is no
    single way of writing an informal proof that is guaranteed to
    convince every conceivable reader.

    In practice, however, mathematicians have developed a rich set of
    conventions and idioms for writing about complex mathematical
    objects that -- at least within a certain community -- make
    communication fairly reliable.  The conventions of this stylized
    form of communication give a fairly clear standard for judging
    proofs good or bad.

    Because we are using Coq in this course, we will be working
    heavily with formal proofs.  But this doesn't mean we can
    completely forget about informal ones!  Formal proofs are useful
    in many ways, but they are _not_ very efficient ways of
    communicating ideas between human beings. *)

(** For example, here is a proof that addition is associative: *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof. intros n m p. induction n as [| n' IHn']. reflexivity.
  simpl. rewrite -> IHn'. reflexivity.  Qed.

(** Coq is perfectly happy with this.  For a human, however, it
    is difficult to make much sense of it.  We can use comments and
    bullets to show the structure a little more clearly... *)

Theorem plus_assoc'' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.   Qed.

(** ... and if you're used to Coq you may be able to step
    through the tactics one after the other in your mind and imagine
    the state of the context and goal stack at each point, but if the
    proof were even a little bit more complicated this would be next
    to impossible.

    A (pedantic) mathematician might write the proof something like
    this: *)

(** - _Theorem_: For any [n], [m] and [p],

      n + (m + p) = (n + m) + p.

    _Proof_: By induction on [n].

    - First, suppose [n = 0].  We must show

        0 + (m + p) = (0 + m) + p.

      This follows directly from the definition of [+].

    - Next, suppose [n = S n'], where

        n' + (m + p) = (n' + m) + p.

      We must show

        (S n') + (m + p) = ((S n') + m) + p.

      By the definition of [+], this follows from

        S (n' + (m + p)) = S ((n' + m) + p),

      which is immediate from the induction hypothesis.  _Qed_. *)

(** The overall form of the proof is basically similar, and of
    course this is no accident: Coq has been designed so that its
    [induction] tactic generates the same sub-goals, in the same
    order, as the bullet points that a mathematician would write.  But
    there are significant differences of detail: the formal proof is
    much more explicit in some ways (e.g., the use of [reflexivity])
    but much less explicit in others (in particular, the "proof state"
    at any given point in the Coq proof is completely implicit,
    whereas the informal proof reminds the reader several times where
    things stand). *)

(** **** Exercise: 2 stars, advanced, recommended (plus_comm_informal)

    Translate your solution for [plus_comm] into an informal proof:

    Theorem: Addition is commutative.

    Proof: (* SOLUTION: *)
       Let natural numbers [n] and [m] be given.  We show [n + m = m +
       n] by induction on [m].

       - First, suppose [m = 0].  We must show [n + 0 = 0 + n].  By
         the definition of [+], we know [0 + n = n], and we have
         already shown (lemma [plus_n_O]) that [n + 0 = n].  Thus,
         showing [n + 0 = 0 + n] is equivalent to showing [n = n],
         which is true by reflexivity.

       - Next, suppose [m = S m'] for some [m'], where [n + m'] = [m'
         + n].  We must show that [n + (S m') = (S m') + n].  By the
         definition of [+] and the induction hypothesis, [(S m') + n =
         S (m' + n) = S (n + m')].  It remains to show [n + (S m') = S
         (n + m')], which is precisely lemma [plus_n_Sm].
*)

(* Do not modify the following line: *)
Definition manual_grade_for_plus_comm_informal : option (nat*string) := None.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (eqb_refl_informal)

    Write an informal proof of the following theorem, using the
    informal proof of [plus_assoc] as a model.  Don't just
    paraphrase the Coq tactics into English!

    Theorem: [true = n =? n] for any [n].

    Proof: (* SOLUTION: *)
       By induction on [n].

       - First, suppose [n = 0].  We must show [true = 0 =? 0].  This
         follows directly from the definition of [eqb].

       - Next, suppose [n = S n'], where [true = n' =? n'].  We
         must show [true = (S n') =? (S n')]. This
         follows directly from the induction hypothesis and the
         definition of [eqb].
*)
(** [] *)

(* ################################################################# *)
(** * More Exercises *)

(** **** Exercise: 3 stars, standard, recommended (mult_comm)

    Use [assert] to help prove [plus_swap].  You don't need to
    use induction yet. *)

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* SOLUTION: *)
  intros n m p.
  rewrite -> plus_assoc.
  assert (H: n + m = m + n).
  { rewrite <- plus_comm. reflexivity. }
  rewrite -> H. rewrite -> plus_assoc. reflexivity.  Qed.

Theorem mult_m_Sn : forall m n : nat,
 m * (S n) = m + (m * n).
Proof.
  induction m as [| m' IHm'].
  - (* m = 0 *)
    intros n. simpl. reflexivity.
  - (* m = S m' *)
    intros n.
    simpl.
    rewrite -> IHm'.
    rewrite -> plus_swap.
    reflexivity.  Qed.

(** Now prove commutativity of multiplication.  You will probably
    want to define and prove a "helper" theorem to be used
    in the proof of this one. Hint: what is [n * (1 + k)]? *)

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  (* SOLUTION: *)
  intros m n.
  induction m as [| m' IHm'].
  - (* m = 0 *)
    simpl. rewrite mult_0_r. reflexivity.
  - (* m = S m' *)
    simpl.
    rewrite -> IHm'.
    rewrite -> mult_m_Sn.
    reflexivity.  Qed.
(** [] *)

(** **** Exercise: 3 stars, standard, optional (more_exercises)

    Take a piece of paper.  For each of the following theorems, first
    _think_ about whether (a) it can be proved using only
    simplification and rewriting, (b) it also requires case
    analysis ([destruct]), or (c) it also requires induction.  Write
    down your prediction.  Then fill in the proof.  (There is no need
    to turn in your piece of paper; this is just to encourage you to
    reflect before you hack!) *)

Check leb.

Theorem leb_refl : forall n:nat,
  true = (n <=? n).
Proof.
  (* SOLUTION: *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

Theorem zero_nbeq_S : forall n:nat,
  0 =? (S n) = false.
Proof.
  (* SOLUTION: *)
  reflexivity.  Qed.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  (* SOLUTION: *)
  intros b. destruct b eqn:E.
  - reflexivity.
  - reflexivity.  Qed.

Theorem plus_ble_compat_l : forall n m p : nat,
  n <=? m = true -> (p + n) <=? (p + m) = true.
Proof.
  (* SOLUTION: *)
  intros n m p. induction p as [| p' IHp'].
  - (* p = 0 *)
    intros H.
    simpl. rewrite -> H. reflexivity.
  - (* p = S p' *)
    intros H.
    simpl. rewrite -> IHp'.
    + reflexivity.
    + rewrite -> H. reflexivity.  Qed.

Theorem S_nbeq_0 : forall n:nat,
  (S n) =? 0 = false.
Proof.
  (* SOLUTION: *)
  reflexivity.  Qed.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  (* SOLUTION: *)
  intros n. simpl. rewrite <- plus_n_O.
  reflexivity.  Qed.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  (* SOLUTION: *)
  intros b c. destruct b eqn:Eb.
  - destruct c eqn:Ec.
    + reflexivity.
    + reflexivity.
  - destruct c eqn:Ec.
    + reflexivity.
    + reflexivity.  Qed.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  (* SOLUTION: *)
  intros n m p. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite IHn'.
    rewrite -> plus_assoc.
    reflexivity.  Qed.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  (* SOLUTION: *)
  intros n m p.  induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> mult_plus_distr_r.  rewrite IHn'.  reflexivity.  Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (eqb_refl)  *)

Theorem eqb_refl : forall n : nat,
  true = (n =? n).
Proof.
  (* SOLUTION: *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (plus_swap')

    The [replace] tactic allows you to specify a particular subterm to
   rewrite and what you want it rewritten to: [replace (t) with (u)]
   replaces (all copies of) expression [t] in the goal by expression
   [u], and generates [t = u] as an additional subgoal. This is often
   useful when a plain [rewrite] acts on the wrong part of the goal.

   Use the [replace] tactic to do a proof of [plus_swap'], just like
   [plus_swap] but without needing [assert]. *)

Theorem plus_swap' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* SOLUTION: *)
  intros n m p.
  rewrite -> plus_assoc.
  replace (n+m) with (m+n).
  { rewrite plus_assoc.
    reflexivity. }
  rewrite -> plus_comm.
  reflexivity. Qed.
(** [] *)

(** **** Exercise: 3 stars, standard, recommended (binary_commute)

    Recall the [incr] and [bin_to_nat] functions that you
    wrote for the [binary] exercise in the [Basics] chapter.  Prove
    that the following diagram commutes:

                            incr
              bin ----------------------> bin
               |                           |
    bin_to_nat |                           |  bin_to_nat
               |                           |
               v                           v
              nat ----------------------> nat
                             S

    That is, incrementing a binary number and then converting it to
    a (unary) natural number yields the same result as first converting
    it to a natural number and then incrementing.
    Name your theorem [bin_to_nat_pres_incr] ("pres" for "preserves").

    Before you start working on this exercise, copy the definitions of
    [incr] and [bin_to_nat] from your solution to the [binary]
    exercise here so that this file can be graded on its own.  If you
    want to change your original definitions to make the property
    easier to prove, feel free to do so! *)

(* SOLUTION: *)
Inductive bin : Type :=
  | Z
  | B0 (n : bin)
  | B1 (n : bin).

Fixpoint incr (m:bin) : bin :=
  match m with
  | Z     => B1 Z
  | B0 m' => B1 m'
  | B1 m' => B0 (incr m')
  end.

Fixpoint bin_to_nat (m:bin) : nat :=
  match m with
  | Z     => O
  | B0 m' => 2 * bin_to_nat m'
  | B1 m' => 1 + 2 * bin_to_nat m'
  end.

Theorem bin_to_nat_pres_incr : forall b : bin,
  bin_to_nat (incr b) = 1 + bin_to_nat b.
Proof.
  intros b.
  induction b as [| b' IHb' | b' IHb'].
  - (* b = 0 *)
    reflexivity.
  - (* b = 2*b' *)
    reflexivity.
  - (* b = 1 + 2*b' *)
    simpl. rewrite -> IHb'.
    simpl. rewrite <- plus_n_Sm.
    reflexivity.
Qed.

(* Do not modify the following line: *)
Definition manual_grade_for_binary_commute : option (nat*string) := None.
(** [] *)

(** **** Exercise: 5 stars, advanced (binary_inverse)

    This is a further continuation of the previous exercises about
    binary numbers.  You may find you need to go back and change your
    earlier definitions to get things to work here.

    (a) First, write a function to convert natural numbers to binary
        numbers. *)

Fixpoint nat_to_bin (n:nat) : bin
  (* SOLUTION: *) :=
  match n with
  | O    => Z
  | S n' => incr (nat_to_bin n')
  end.

(** Prove that, if we start with any [nat], convert it to binary, and
    convert it back, we get the same [nat] we started with.  (Hint: If
    your definition of [nat_to_bin] involved any extra functions, you
    may need to prove a subsidiary lemma showing how such functions
    relate to [nat_to_bin].) *)

Theorem nat_bin_nat : forall n, bin_to_nat (nat_to_bin n) = n.
Proof.
  (* SOLUTION: *)
  induction n as [|n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl.
    rewrite bin_to_nat_pres_incr.
    rewrite IHn'.
    reflexivity.
Qed.

(* Do not modify the following line: *)
Definition manual_grade_for_binary_inverse_a : option (nat*string) := None.

(** (b) One might naturally expect that we should also prove the
        opposite direction -- that starting with a binary number,
        converting to a natural, and then back to binary should yield
        the same number we started with.  However, this is not the
        case!  Explain (in a comment) what the problem is. *)

(* SOLUTION: *)
(* Answer to (b): [0] has many representations: it can be written [Z],
    [B0 Z], [Bo (B0 Z)], and so on.  For these alternate representations,
    if you do [bin_to_nat] then [nat_to_bin], you don't get back what
    you started with.  (Any other number also has many
    representations, after applying constructors to the multiple
    representations of zero.) *)

(* Do not modify the following line: *)
Definition manual_grade_for_binary_inverse_b : option (nat*string) := None.

(** (c) Define a normalization function -- i.e., a function
        [normalize] going directly from [bin] to [bin] (i.e., _not_ by
        converting to [nat] and back) such that, for any binary number
        [b], converting [b] to a natural and then back to binary yields
        [(normalize b)].  Prove it.  (Warning: This part is a bit
        tricky -- you may end up defining several auxiliary lemmas.
        One good way to find out what you need is to start by trying
        to prove the main statement, see where you get stuck, and see
        if you can find a lemma -- perhaps requiring its own inductive
        proof -- that will allow the main proof to make progress.) Don't
        define this using [nat_to_bin] and [bin_to_nat]! *)

(* SOLUTION: *)
Fixpoint double_bin (b:bin) : bin :=
  match b with
  | Z => Z
  | _ => B0 b
  end.

Fixpoint normalize (b:bin) : bin :=
  match b with
  | Z    => Z
  | B0 b' => double_bin (normalize b')
  | B1 b' => B1 (normalize b')
  end.

Lemma double_incr : forall b, double_bin (incr b) = incr (incr (double_bin b)).
Proof.
  destruct b eqn:E.
  - (* Z *) reflexivity.
  - (* B0 *) reflexivity.
  - (* B1 *) reflexivity.
Qed.

Lemma incr_double : forall b, incr (double_bin b) = B1 b.
Proof.
  destruct b eqn:E.
  - (* Z *) reflexivity.
  - (* B0 *) reflexivity.
  - (* B1 *) reflexivity.
Qed.

Lemma nat_to_bin_double : forall n, nat_to_bin (double n) = double_bin (nat_to_bin n).
Proof.
  induction n as [|n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl. rewrite IHn'. rewrite <- double_incr. reflexivity.
Qed.

Theorem bin_nat_bin : forall b, nat_to_bin (bin_to_nat b) = normalize b.
Proof.
  induction b as [|b' IHb'|b' IHb'].
  - (* Z *) reflexivity.
  - (* B0 *) simpl.
    rewrite <- plus_n_O.
    rewrite <- double_plus.
    rewrite -> nat_to_bin_double.
    rewrite IHb'.
    reflexivity.
  - (* B1 *) simpl.
    rewrite <- plus_n_O.
    rewrite <- double_plus.
    rewrite -> nat_to_bin_double.
    rewrite IHb'.
    rewrite incr_double.
    reflexivity.
Qed.

(* Do not modify the following line: *)
Definition manual_grade_for_binary_inverse_c : option (nat*string) := None.
(** [] *)

(* 04 Mar 2020 *)


(** * Postscript *)

(** Congratulations: We've made it to the end! *)

(* ################################################################# *)
(** * Looking Back *)

(** We've covered quite a bit of ground so far.  Here's a quick review...

   - _Functional programming_:
          - "declarative" programming style (recursion over immutable
            data structures, rather than looping over mutable arrays
            or pointer structures)
          - higher-order functions
          - polymorphism *)

(**
     - _Logic_, the mathematical basis for software engineering:

               logic                        calculus
        --------------------   ~   ----------------------------
        software engineering       mechanical/civil engineering

          - inductively defined sets and relations
          - inductive proofs
          - proof objects *)

(**
     - _Coq_, an industrial-strength proof assistant
          - functional core language
          - core tactics
          - automation
*)

(* ################################################################# *)
(** * Looking Forward *)

(** If what you've seen so far has whetted your interest, you have two
    choices for further reading in the _Software Foundations_ series:

           - _Programming Language Foundations_ (volume 2, by a set of
             authors similar to this book's) covers material that
             might be found in a graduate course on the theory of
             programming languages, including Hoare logic, operational
             semantics, and type systems.

           - _Verified Functional Algorithms_ (volume 3, by Andrew
             Appel) builds on the themes of functional programming and
             program verification in Coq, addressing a range of topics
             that might be found in a standard data structures course,
             with an eye to formal verification. *)

(* ################################################################# *)
(** * Other sources *)

(** Here are some other good places to learn more...

       - This book includes some optional chapters covering topics
         that you may find useful.  Take a look at the table of contents and the chapter dependency diagram to find
         them.

       - For questions about Coq, the [#coq] area of Stack
         Overflow (https://stackoverflow.com/questions/tagged/coq)
         is an excellent community resource.

       - Here are some great books on functional programming
            - Learn You a Haskell for Great Good, by Miran Lipovaca
              [Lipovaca 2011] (in Bib.v).
            - Real World Haskell, by Bryan O'Sullivan, John Goerzen,
              and Don Stewart [O'Sullivan 2008] (in Bib.v)
            - ...and many other excellent books on Haskell, OCaml,
              Scheme, Racket, Scala, F sharp, etc., etc.

       - And some further resources for Coq:
           - Certified Programming with Dependent Types, by Adam
             Chlipala [Chlipala 2013] (in Bib.v).
           - Interactive Theorem Proving and Program Development:
             Coq'Art: The Calculus of Inductive Constructions, by Yves
             Bertot and Pierre Casteran [Bertot 2004] (in Bib.v).

       - If you're interested in real-world applications of formal
         verification to critical software, see the Postscript chapter
         of _Programming Language Foundations_.

       - For applications of Coq in building verified systems, the
         lectures and course materials for the 2017 DeepSpec Summer
         School are a great resource.
         https://deepspec.org/event/dsss17/index.html
*)

(* Wed Jan 9 12:02:47 EST 2019 *)


(** * PostScript *)

(* ################################################################# *)
(** * Future Directions *)

(** We have lots of plans for future directions:
       - Mutation testing tool
       - Automatic derivation of generators and shrinkers for data
         satisfying Inductive relations
       - Vellum2 testing
       - DeepSpec Web Server
       - Testing-only variant of _Software Foundations_?
*)

(* ################################################################# *)
(** * Recommended Reading *)
(** The material presented in this short course serves as an
    introduction to property based random testing using
    QuickChick. For the interested reader, we provide a few more
    references for additional reading:

    - The original QuickCheck paper by Koen Claessen and John Hughes
      from ICFP 2000.
      http://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/quick.pdf

    - The original QuickChick paper that focuses on a framework for
      proving the correctness of QuickChick generators.
      http://www.cis.upenn.edu/~llamp/pdf/Foundational.pdf

    - A case study that uses QuickCheck to test non-interference for
      information-flow-control abstract machines.
      http://www.cis.upenn.edu/~llamp/pdf/TestingNonInterferenceQuickly.pdf

    - Code for that case study exists under the QuickChick
      organization of github (https://github.com/QuickChick) for
      both Haskell ("Testing Noninterference") and Coq ("IFC").

    - A paper on deriving QuickChick generators for a large class of
      inductive relations.
      http://www.cis.upenn.edu/~llamp/pdf/GeneratingGoodGenerators.pdf
*)


(* It is forbidden to erase a variable (or a local def) that is used in
   the current goal. *)
Section S.
Let a := 0.
Definition b := a.
Goal b = b.
clear a.


(** * Postscript *)

(** Congratulations: You've made it to the end! *)

(** * Looking Back... *)

(** We've covered a lot of ground.  The topics might be summarized like this:

   - _Functional programming_:
          - "declarative" programming style (recursion over persistent
            data structures, rather than looping over mutable arrays
            or pointer structures)
          - higher-order functions
          - polymorphism *)

(**
     - _Logic_, the mathematical basis for software engineering:

               logic                        calculus
        --------------------   =   ----------------------------
        software engineering       mechanical/civil engineering

          - inductively defined sets and relations
          - inductive proofs
          - proof objects *)

(**
     - _Coq_, an industrial-strength proof assistant
          - functional core language
          - core tactics
          - automation
*)

(**
     - _Foundations of programming languages_

           - notations and definitional techniques for precisely specifying
                - abstract syntax
                - operational semantics
                    - big-step style
                    - small-step style
                - type systems

           - program equivalence

           - Hoare logic

           - fundamental metatheory of type systems

              - progress and preservation

           - theory of subtyping
*)

(* ###################################################################### *)
(** * Looking Forward... *)

(** Some good places to go for more...

       - This book includes several optional chapters covering topics
         that you may find useful.  If you've been using it in the
         context of a course, take a look at the table of contents
         and the chapter dependency diagram.

       - Cutting-edge conferences on programming languages and formal
         verification:
            - POPL
            - PLDI
            - OOPSLA
            - ICFP
            - CAV
            - (and many others)

       - More on functional programming
            - Learn You a Haskell for Great Good, by Miran
              Lipovaca [Lipovaca 2011].
            - and many other texts on Haskell, OCaml, Scheme, Scala,
              ...

       - More on Hoare logic and program verification
            - The Formal Semantics of Programming Languages: An
              Introduction, by Glynn Winskel [Winskel 1993].
            - Many practical verification tools, e.g. Microsoft's
              Boogie system, Java Extended Static Checking, etc.

       - More on the foundations of programming languages:
            - Types and Programming Languages, by Benjamin
              C. Pierce [Pierce 2002].
            - Practical Foundations for Programming Languages, by
              Robert Harper [Harper 2016].
            - Foundations for Programming Languages, by John
              C. Mitchell [Mitchell 1996].

       - More on Coq:
           - Certified Programming with Dependent Types, by Adam
             Chlipala [Chlipala 2013].
           - Interactive Theorem Proving and Program Development:
             Coq'Art: The Calculus of Inductive Constructions, by Yves
             Bertot and Pierre Casteran [Bertot 2004].
           - Iron Lambda (http://iron.ouroborus.net/) is a collection
             of Coq formalisations for functional languages of
             increasing complexity. It fills part of the gap between
             the end of the Software Foundations course and what
             appears in current research papers.  The collection has
             at least Progress and Preservation theorems for a number
             of variants of STLC and the polymorphic
             lambda-calculus (System F). *)

(* $Date: 2016-05-26 17:51:14 -0400 (Thu, 26 May 2016) $ *)