(*
    File:        dLambda.thy
    Time-stamp:  <2020-06-22T04:19:58Z>
    Author:      JRF
    Web:         http://jrf.cocolog-nifty.com/software/2016/01/post.html
    Logic Image: Logics_ZF (of Isabelle2020)
*)

theory dLambda imports dTermDef OCons FinCard ZF.Arith begin

definition dAbst :: "[i, i, i]=>i" where
"dAbst(M, x, n) == dTerm_rec(
       %y. lam i: nat. if(x=y, dBound(i), dVar(y)),
       %j. lam i: nat. dBound(j),
       %N r. lam i: nat. dLam(r`succ(i)),
       %A B ra rb. lam i: nat. dApp(ra`i, rb`i), M) ` n"

definition dLift :: "[i, i]=>i" where
"dLift(M, n) == dTerm_rec(
       %x. lam i: nat. dVar(x),
       %j. lam i: nat. if (j < i, dBound(j), dBound(succ(j))),
       %N r. lam i: nat. dLam(r`succ(i)),
       %A B ra rb. lam i: nat. dApp(ra`i, rb`i), M) ` n"

definition dSubst :: "[i, i, i]=>i" where
"dSubst(M, n, N) == dTerm_rec(
       %x. lam i: nat. lam m: dTerm. dVar(x),
       %j. lam i: nat. lam m: dTerm. if (i < j, dBound(j #- 1),
                                      if (i=j, m, dBound(j))),
       %N r. lam i: nat. lam m: dTerm. dLam(r`succ(i)`dLift(m, 0)),
       %A B ra rb. lam i: nat. lam m: dTerm. dApp(ra`i`m, rb`i`m), M)`n`N"

definition dDeg :: "i=>i" where
"dDeg(M) == dTerm_rec(%x. 0, %n. succ(n), %N r. r #- 1,
                      %A B rm rn. rm Un rn, M)"

definition dFV :: "i=>i" where
"dFV(M) == {x: LVariable. EX l.  <l, TdVar(x)>: dOcc(M)}"

definition dProp :: i where
"dProp == {M: dTerm. dDeg(M) = 0}"

definition dLamDegBase :: "[i, i]=>i" where
"dLamDegBase(l, M) == {v: dOcc(M). EX m. v = <m, TdLam> & m ~= l &
                                   initseg(nat, m, l)}"

definition dLamDeg :: "[i, i]=>i" where
"dLamDeg(l, M) == |dLamDegBase(l, M)|"

definition dBoundBy :: "[i, i, i]=>o" where
"dBoundBy(u, v, M) == M: dTerm & u: dOcc(M) & v: dOcc(M) &
   (EX n l m x. u = <m, TdBound(n)> & v = <l, TdLam> &
     m = l @ x & dLamDeg(x, dsubterm(M, l)) = succ(n))"

lemmas dOcc_domain = Occ_ind_cond_Occ_domain [OF
  dTerm_Occ_ind_cond]

lemmas dOcc_in_Occ_range = Occ_ind_cond_Occ_in_Occ_range [OF
  dTerm_Occ_ind_cond]

lemma dOcc_typeD1:
  assumes major: "<l, T>: dOcc(M)"
  and prem: "M: dTerm"
  shows "l: list(nat)"
apply (rule major [THEN prem [THEN dOcc_domain, THEN subsetD, THEN SigmaD1]])
done

lemma dOcc_typeD2:
  assumes major: "<l, T>: dOcc(M)"
  and prem: "M: dTerm"
  shows "T: dTag"
apply (rule major [THEN prem [THEN dOcc_domain, THEN subsetD, THEN SigmaD2]])
done

lemma dTerm_typeEs:
  "[| dVar(x): dTerm; x: LVariable ==> R |] ==> R"
  "[| dBound(n): dTerm; n: nat ==> R |] ==> R"
  "[| dLam(M): dTerm; M: dTerm ==> R |] ==> R"
  "[| dApp(M, N): dTerm; [| M: dTerm; N: dTerm |] ==> R |] ==> R"
apply (erule dTerm.cases, (blast elim!: dTerm.free_elims)+)+
done

lemma dTag_typeEs:
  "[| TdVar(x): dTag; x: LVariable ==> R |] ==> R"
  "[| TdBound(n): dTag; n: nat ==> R |] ==> R"
apply (erule dTag.cases, (blast elim!: dTag.free_elims)+)+
done

lemma dOcc_dVarE:
  assumes major: "u: dOcc(dVar(x))"
  and prem: "u = <[], TdVar(x)> ==> R"
  shows "R"
apply (insert major)
apply (simp add: dOcc_eqns)
apply (erule Occ_consE)
apply (erule prem)
apply simp
done

lemma dOcc_dBoundE:
  assumes major: "u: dOcc(dBound(n))"
  and prem: "u = <[], TdBound(n)> ==> R"
  shows "R"
apply (insert major)
apply (simp only: dOcc_eqns)
apply (erule Occ_consE)
apply (erule prem)
apply simp
done

lemma dOcc_dLamE:
  assumes major: "u: dOcc(dLam(M))"
  and prem1: "u = <[], TdLam> ==> R"
  and prem2:
     "!! l T. [| u = <Cons(0, l), T>; <l, T>: dOcc(M) |] ==> R"
  shows "R"
apply (insert major)
apply (simp only: dOcc_eqns)
apply (erule Occ_consE)
apply (erule prem1)
apply simp
apply (erule succE)
apply (erule_tac [2] emptyE)
apply hypsubst
apply (rule prem2)
prefer 2 apply simp
apply assumption
done

lemma dOcc_dAppE:
  assumes major: "u: dOcc(dApp(M, N))"
  and prem1: "u = <[], TdApp> ==> R"
  and prem2:
     "!! l T. [| u = <Cons(0, l), T>; <l, T>: dOcc(M) |] ==> R"
  and prem3:
     "!! l T. [| u = <Cons(1, l), T>; <l, T>: dOcc(N) |] ==> R"
  shows "R"
apply (insert major)
apply (simp only: dOcc_eqns)
apply (erule Occ_consE)
apply (erule prem1)
apply simp
apply (erule succE)
apply (erule_tac [2] succE)
apply (erule_tac [3] emptyE)
apply hypsubst
apply (rule prem3)
prefer 2 apply simp
apply assumption
apply hypsubst
apply (rule prem2)
prefer 2 apply simp
apply assumption
done

lemmas dOcc_dTermEs = dOcc_dVarE dOcc_dBoundE dOcc_dLamE dOcc_dAppE

lemma dOcc_dTermIs:
  "<[], TdVar(x)>: dOcc(dVar(x))"
  "<[], TdBound(n)>: dOcc(dBound(n))"
  "<[], TdLam>: dOcc(dLam(M))"
  "<l, T>: dOcc(M) ==> <Cons(0, l), T>: dOcc(dLam(M))"
  "<[], TdApp>: dOcc(dApp(M, N))"
  "<l, T>: dOcc(M) ==> <Cons(0, l), T>: dOcc(dApp(M, N))"
  "<l, T>: dOcc(N) ==> <Cons(1, l), T>: dOcc(dApp(M, N))"
apply (simp_all add: dOcc_eqns)
apply (rule Occ_consI2 Occ_consI1 | simp
       | (assumption | rule succI1 succI2)+)+
done

lemmas dTerm_def_subterm_Nil = def_subterm_Nil [OF
  dTerm_Occ_cons_cond dTerm_Occ_ind_cond dOccinv_def
  dSub_def dTerm_Term_cons_inj_cond dsubterm_def]

lemmas dTerm_def_subterm_Cons = def_subterm_Cons [OF
  dTerm_Occ_cons_cond dTerm_Occ_ind_cond dOccinv_def
  dSub_def dTerm_Term_cons_inj_cond dsubterm_def]

lemma dsubterm_eqns_0:
  "[| M: dTerm; l: list(nat) |] ==>
      dsubterm(dLam(M), Cons(0, l)) = dsubterm(M, l)"
  "[| A: dTerm; B: dTerm; l: list(nat) |] ==>
      dsubterm(dApp(A, B), Cons(0, l)) = dsubterm(A, l)"
  "[| A: dTerm; B: dTerm; l: list(nat) |] ==>
      dsubterm(dApp(A, B), Cons(1, l)) = dsubterm(B, l)"
apply (simp_all add: dTerm_cons_eqns_sym dTerm_def_subterm_Cons)
done

lemmas dsubterm_eqns = dTerm_def_subterm_Nil dsubterm_eqns_0

lemma dAbst_eqns:
  "n: nat ==> dAbst(dVar(y), x, n) = if(x = y, dBound(n), dVar(y))"
  "n: nat ==> dAbst(dBound(i), x, n) = dBound(i)"
  "n: nat ==> dAbst(dLam(M), x, n) = dLam(dAbst(M, x, succ(n)))"
  "n: nat ==> dAbst(dApp(A, B), x, n) =
                  dApp(dAbst(A, x, n), dAbst(B, x, n))"
apply (unfold dAbst_def)
apply simp_all
done

lemma dAbst_type:
  assumes major: "M: dTerm"
  and sub: "n: nat"
  shows "dAbst(M, x, n): dTerm"
apply (rule sub [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply (simp_all add: dAbst_eqns)
apply (rule_tac [3] ballI)
apply (drule_tac [3] bspec)
apply (erule_tac [3] nat_succI)
apply blast+
done

lemma dLift_eqns:
  "n: nat ==> dLift(dVar(x), n) = dVar(x)"
  "n: nat ==> dLift(dBound(i), n) = if (i < n, dBound(i), dBound(succ(i)))"
  "n: nat ==> dLift(dLam(M), n) = dLam(dLift(M, succ(n)))"
  "n: nat ==> dLift(dApp(A, B), n) =
                  dApp(dLift(A, n), dLift(B, n))"
apply (unfold dLift_def)
apply simp_all
done

lemma dLift_type:
  assumes major: "M: dTerm"
  and sub: "n: nat"
  shows "dLift(M, n): dTerm"
apply (rule sub [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply (simp_all add: dLift_eqns)
apply (rule_tac [3] ballI)
apply (drule_tac [3] bspec)
apply (erule_tac [3] nat_succI)
apply blast+
done

lemma dSubst_eqns:
  "[| n: nat; N: dTerm |] ==> dSubst(dVar(x), n, N) = dVar(x)"
  "[| n: nat; N: dTerm |] ==> dSubst(dBound(i), n, N) =
              if (n < i, dBound(i #- 1), if (n = i, N, dBound(i)))"
  "[| n: nat; N: dTerm |] ==> dSubst(dLam(M), n, N)
                        = dLam(dSubst(M, succ(n), dLift(N, 0)))"
  "[| n: nat; N: dTerm |] ==> dSubst(dApp(A, B), n, N) =
                  dApp(dSubst(A, n, N), dSubst(B, n, N))"
apply (unfold dSubst_def)
apply simp_all
done

lemma dSubst_type:
  assumes major: "M: dTerm"
  and sub: "n: nat"
  and prem: "N: dTerm"
  shows "dSubst(M, n, N): dTerm"
apply (rule sub [THEN [2] bspec])
apply (rule prem [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply (simp_all add: dSubst_eqns)
apply safe
apply (erule_tac [3] bspec [THEN bspec])
apply (erule_tac [2] bspec [THEN bspec])
apply (erule_tac [1] bspec [THEN bspec])
apply (assumption | rule dLift_type nat_succI nat_0I)+
done

lemma dDeg_eqns:
  "dDeg(dVar(x)) = 0"
  "dDeg(dBound(i)) = succ(i)"
  "dDeg(dLam(M)) = dDeg(M) #- 1"
  "dDeg(dApp(A, B)) = dDeg(A) Un dDeg(B)"
apply (unfold dDeg_def)
apply simp_all
done

lemma dDeg_type:
  "M: dTerm ==> dDeg(M): nat"
apply (unfold dDeg_def)
apply (rule dTerm_rec_type)
apply (assumption | rule diff_type nat_UnI nat_succI nat_0I)+
done

(** dLamDeg **)
lemma dLamDegBase_Nil:
  "M: dTerm ==> dLamDegBase([], M) = 0"
apply (unfold dLamDegBase_def)
apply (rule equalityI)
apply (safe elim!: initseg_NilE)
done

lemma dLamDegBase_Cons_dLam:
  "l: list(nat) ==> dLamDegBase(Cons(0, l), dLam(M))
                 = cons(<[], TdLam>, Occ_shift(0, dLamDegBase(l, M)))"
apply (unfold dLamDegBase_def)
apply (rule equalityI)
apply (safe elim!: list.free_elims Occ_shiftE initseg_ConsE dOcc_dTermEs)
apply (erule swap, rule Occ_shiftI)
apply blast
apply (rule dOcc_dTermIs)
apply (erule_tac [2] dOcc_dTermIs)
apply (erule_tac [2] asm_rl | rule_tac [2] conjI refl exI)+
apply (assumption | rule conjI refl exI)+
apply (blast elim!: list.free_elims)
prefer 2 apply (blast elim!: list.free_elims)
apply (assumption | rule list.intros initseg_NilI initseg_ConsI
         nat_0I)+
done

lemma dLamDegBase_Cons_dApp1:
  "l: list(nat) ==> dLamDegBase(Cons(0, l), dApp(M, N))
                 = Occ_shift(0, dLamDegBase(l, M))"
apply (unfold dLamDegBase_def)
apply (rule equalityI)
apply (safe elim!: list.free_elims dTag.free_elims Occ_shiftE
         initseg_ConsE dOcc_dTermEs)
apply (rule Occ_shiftI)
apply blast
apply (erule dOcc_dTermIs)
apply (assumption | rule conjI refl exI)+
apply (blast elim!: list.free_elims)
apply (assumption | rule list.intros initseg_ConsI nat_0I)+
done

lemma dLamDegBase_Cons_dApp2:
  "l: list(nat) ==> dLamDegBase(Cons(1, l), dApp(M, N))
                 = Occ_shift(1, dLamDegBase(l, N))"
apply (unfold dLamDegBase_def)
apply (rule equalityI)
apply (safe elim!: list.free_elims dTag.free_elims Occ_shiftE
         initseg_ConsE dOcc_dTermEs)
apply (rule Occ_shiftI)
apply blast
apply (erule dOcc_dTermIs)
apply (assumption | rule conjI refl exI)+
apply (blast elim!: list.free_elims)
apply (assumption | rule list.intros initseg_ConsI nat_1I)+
done

lemmas dTerm_Occ_ind_cond_Occ_FinI = Occ_ind_cond_Occ_FinI [OF
  dTerm_Occ_ind_cond]

lemma dLamDeg_type:
  "M: dTerm ==> dLamDeg(l, M): nat"
apply (unfold dLamDeg_def dLamDegBase_def)
apply (assumption | rule Finite_imp_card_nat Fin_into_Finite
         dTerm_Occ_ind_cond_Occ_FinI Collect_subset Fin_subset)+
done

lemma dLamDeg_Nil:
  "M: dTerm ==> dLamDeg([], M) = 0"
apply (unfold dLamDeg_def)
apply (simp only: dLamDegBase_Nil)
apply (rule Card_0 [THEN Card_cardinal_eq])
done

lemma dLamDeg_Cons_dLam:
  assumes major: "M: dTerm"
  and prem: "l: list(nat)"
  shows "dLamDeg(Cons(0, l), dLam(M)) = succ(dLamDeg(l, M))"
apply (unfold dLamDeg_def)
apply (simp only: prem [THEN dLamDegBase_Cons_dLam])
apply (rule trans)
apply (rule Finite_cardinal_cons)
apply (rule_tac [3] f="succ" in function_apply_eq)
apply (rule_tac [3] Occ_shift_cardinal)
apply (unfold dLamDegBase_def)
apply (assumption | rule Fin_into_Finite Occ_shift_FinI
         Collect_subset major nat_0I
         dTerm_Occ_ind_cond_Occ_FinI Fin_subset)+
apply (blast elim!: list.free_elims Occ_shiftE)
apply (rule subset_trans)
apply (assumption | rule major dOcc_domain Collect_subset)+
done

lemma dLamDeg_Cons_dApp1:
  "[| M: dTerm; l: list(nat) |]  ==>
         dLamDeg(Cons(0, l), dApp(M, N)) = dLamDeg(l, M)"
apply (unfold dLamDeg_def)
apply (simp only: dLamDegBase_Cons_dApp1)
apply (rule Occ_shift_cardinal)
apply (unfold dLamDegBase_def)
apply (rule subset_trans)
apply (assumption | rule dOcc_domain Collect_subset)+
done

lemma dLamDeg_Cons_dApp2:
  "[| N: dTerm; l: list(nat) |]  ==>
         dLamDeg(Cons(1, l), dApp(M, N)) = dLamDeg(l, N)"
apply (unfold dLamDeg_def)
apply (simp only: dLamDegBase_Cons_dApp2)
apply (rule Occ_shift_cardinal)
apply (unfold dLamDegBase_def)
apply (rule subset_trans)
apply (assumption | rule dOcc_domain Collect_subset)+
done

lemmas dLamDeg_eqns = dLamDeg_Nil dLamDeg_Cons_dLam dLamDeg_Cons_dApp1
                    dLamDeg_Cons_dApp2

(** dFV **)
lemma dFV_I:
  "[| <l, TdVar(x)>: dOcc(M); M: dTerm |] ==> x: dFV(M)"
apply (unfold dFV_def)
apply (frule dOcc_typeD2)
apply assumption
apply (erule dTag_typeEs)
apply (assumption | rule exI CollectI)+
done

lemma dFV_I2:
  "[| <l, TdVar(x)>: dOcc(M); x: LVariable |] ==> x: dFV(M)"
apply (unfold dFV_def)
apply (assumption | rule exI CollectI)+
done

lemma dFV_E:
  "[| x: dFV(M); !!l. [| x: LVariable; <l, TdVar(x)>: dOcc(M) |] ==> R |]
    ==> R"
apply (unfold dFV_def)
apply blast
done

lemma dFV_Fin:
  "M: dTerm ==> dFV(M): Fin(LVariable)"
apply (unfold dFV_def)
apply (erule dTerm_Occ_ind_cond_Occ_FinI [THEN Fin_induct])
apply simp
apply (erule SigmaE)
apply (erule dTag.cases)
apply safe
apply (rule_tac P="%x. x: Fin(LVariable)" in ssubst)
apply (erule_tac [2] Fin.intros)
prefer 2 apply assumption
apply (rule_tac [2] P="%x. x: Fin(LVariable)" in ssubst)
prefer 3 apply assumption
apply (rule_tac [3] P="%x. x: Fin(LVariable)" in ssubst)
prefer 4 apply assumption
apply (rule_tac [4] P="%x. x: Fin(LVariable)" in ssubst)
prefer 5 apply assumption
apply (rule equalityI, blast elim!: dTag.free_elims,
       blast elim!: dTag.free_elims)+
done

lemma dFV_not_in_lemma:
  "[| x ~: dFV(M); M: dTerm |] ==> ~(EX l. <l, TdVar(x)>: dOcc(M))"
apply (blast intro!: dFV_I)
done

lemma dFV_dVar:
  "x: LVariable ==> dFV(dVar(x)) = {x}"
apply (rule equalityI)
apply (safe elim!: dOcc_dTermEs dFV_E dTag.free_elims)
apply (assumption | rule dFV_I dTerm.intros dOcc_dTermIs)+
done

lemma dFV_dBound:
  "dFV(dBound(x)) = 0"
apply (rule equalityI)
apply (safe elim!: dOcc_dTermEs dFV_E dTag.free_elims)
done

lemma dFV_dLam:
  "M: dTerm ==> dFV(dLam(M)) = dFV(M)"
apply (rule equalityI)
apply (safe elim!: dOcc_dTermEs dFV_E dTag.free_elims)
apply (assumption | rule dFV_I dTerm.intros dOcc_dTermIs)+
done

lemma dFV_dApp:
  "[| M: dTerm; N: dTerm |] ==> dFV(dApp(M, N)) = dFV(M) Un dFV(N)"
apply (rule equalityI)
apply (safe elim!: dOcc_dTermEs dFV_E dTag.free_elims)
apply (erule_tac [2] swap)
apply (assumption | rule dFV_I dTerm.intros
       | erule dOcc_dTermIs)+
done

lemmas dFV_eqns = dFV_dVar dFV_dBound dFV_dApp dFV_dLam

declare nat_ltI [simp del]
lemmas dTerm_ss_simps = nat_succ_Un Un_diff (* dArity_eqns *)
    (* add_0_right add_succ_right *) gt_not_eq lt_asym_if
    le_asym_if not_lt_iff_le lt_irrefl_if
    diff_le_iff lt_diff_iff diff_diff_eq_diff_add
    Un_least_lt_iff [OF nat_into_Ord nat_into_Ord]
    dLift_eqns dSubst_eqns dsubterm_eqns dDeg_eqns
    dAbst_eqns dLamDeg_eqns dFV_eqns
lemmas dTerm_ss_typechecks = dDeg_type dAbst_type
    dSubst_type dLift_type dLamDeg_type dTerm.intros
    nat_UnI

declare dTerm_ss_simps [simp]
declare dTerm_ss_typechecks [TC]
(* declare split_if [split del] *)

(** dProp **)
lemma dPropI:
  "[| M: dTerm; dDeg(M) = 0 |] ==> M: dProp"
apply (unfold dProp_def)
apply blast
done

lemma dPropE:
  "[| M: dProp; [| M: dTerm; dDeg(M) = 0 |] ==> R |] ==> R"
apply (unfold dProp_def)
apply blast
done

lemma dPropD1:
  "M: dProp ==> M: dTerm"
apply (unfold dProp_def)
apply (erule CollectD1)
done

lemma dPropD2:
  "M: dProp ==> dDeg(M) = 0"
apply (unfold dProp_def)
apply (erule CollectD2)
done

lemma dProp_dVarI:
  "x: LVariable ==> dVar(x): dProp"
apply (blast intro: dPropI dDeg_eqns)
done

lemma dProp_dLamI1:
  "M: dProp ==> dLam(M): dProp"
apply (erule dPropE)
apply (rule dPropI)
prefer 2 apply simp
apply (assumption | rule dTerm.intros)+
done

lemma dProp_dLamI2:
  "[| M: dTerm; dDeg(M) = 1 |] ==> dLam(M): dProp"
apply (rule dPropI)
prefer 2 apply simp
apply (assumption | rule dTerm.intros)+
done

lemma dProp_dAppI:
  "[| A: dProp; B: dProp |] ==> dApp(A, B): dProp"
apply (erule dPropE)+
apply (rule dPropI)
prefer 2 apply simp
apply (assumption | rule dTerm.intros)+
done

lemmas dProp_dTermIs = dProp_dVarI dProp_dLamI1 dProp_dLamI2 dProp_dAppI

lemma dProp_dVarE:
  "[| dVar(x): dProp; x: LVariable ==> R |] ==> R"
apply (blast elim!: dPropE dTerm_typeEs)
done

lemma dProp_dBoundE:
  "dBound(n): dProp ==> R"
apply (erule dPropE)
apply (simp only: dDeg_eqns)
apply (erule succ_neq_0)
done

lemma dProp_dLamE:
  assumes major: "dLam(M): dProp"
  and "M: dProp ==> R"
  and "[| M: dTerm; dDeg(M) = 1 |] ==> R"
  shows "R"
apply (rule major [THEN dPropE])
apply (simp only: dDeg_eqns)
apply (erule dTerm_typeEs)
apply (rule dDeg_type [THEN natE])
apply assumption
apply (rotate_tac [2] 1)
prefer 2 apply simp
apply (blast intro: dPropI assms)+
done

lemma dProp_dAppE:
  assumes major: "dApp(A, B): dProp"
  and prem: "[| A: dProp; B: dProp |] ==> R"
  shows "R"
apply (rule major [THEN dPropE])
apply (simp only: dDeg_eqns)
apply (erule dTerm_typeEs)
apply (rule prem)
apply (rule_tac [2] dPropI)
apply (rule dPropI)
prefer 3
apply assumption+
apply (rule_tac [2] equals0I, drule_tac [2] equals0D)
apply (rule_tac [1] equals0I, drule_tac [1] equals0D)
apply (erule notE, erule UnI1)
apply (erule notE, erule UnI2)
done

lemmas dProp_dTermEs = dProp_dVarE dProp_dBoundE dProp_dLamE dProp_dAppE

lemma dProp_induct:
  assumes major: "M: dProp"
  and prem1:
     "!! x. x: LVariable ==> P(dVar(x))"
  and prem2:
     "!! M. [| M: dProp; P(M) |] ==> P(dLam(M))"
  and prem3:
     "!! M. [| M: dTerm; dDeg(M) = 1 |] ==> P(dLam(M))"
  and prem4:
     "!! A B. [| A: dProp; P(A); B: dProp; P(B) |] ==> P(dApp(A, B))"
  shows "P(M)"
apply (rule major [THEN dPropD2, THEN rev_mp])
apply (rule major [THEN dPropD1, THEN dTerm.induct])
prefer 4
apply (rule impI)
apply simp
apply (erule conjE)
prefer 4
apply (rule impI)
apply simp
prefer 4
apply (rule impI)
apply simp
prefer 3
apply (rule impI)
apply simp
apply (erule prem1)
apply (drule diff_eq_0D)
apply (assumption | rule dDeg_type nat_1I)+
apply (drule le_succ_iff [THEN iffD1])
apply (erule disjE)
apply (drule le0_iff [THEN iffD1])
apply (rule_tac [3] prem4)
apply (rule_tac [2] prem3)
apply (rule prem2)
apply (safe intro!: dPropI)
done

(** dBoundBy **)
lemma dBoundByI:
  "[| M: dTerm; <m, TdBound(n)>: dOcc(M); <l, TdLam>: dOcc(M);
      m = l @ x; dLamDeg(x, dsubterm(M, l)) = succ(n)
   |] ==> dBoundBy(<m, TdBound(n)>, <l, TdLam>, M)"
apply (unfold dBoundBy_def)
apply blast
done

lemma dBoundByE:
  assumes major: "dBoundBy(u, v, M)"
  and prem:
     "!! l n x. [| u = <l @ x, TdBound(n)>; v = <l, TdLam>;
        M: dTerm; l: list(nat); x: list(nat);
        <l @ x, TdBound(n)>: dOcc(M); <l, TdLam>: dOcc(M);
        dLamDeg(x, dsubterm(M, l)) = succ(n)
      |] ==> R"
  shows "R"
apply (rule major [unfolded dBoundBy_def, THEN conjE])
apply (erule conjE exE)+
apply (rule prem)
apply safe
apply (assumption | rule refl)+
apply (drule_tac [2] dOcc_typeD1, erule_tac [3] app_typeD)
apply (assumption | rule refl | erule dOcc_typeD1)+
done

lemma dBoundByD1:
  "dBoundBy(u, v, M) ==> M: dTerm"
apply (unfold dBoundBy_def)
apply (erule conjunct1)
done

lemma dBoundBy_dLamI1:
  "[| M: dTerm; dLamDeg(m, M) = n; <m, TdBound(n)>: dOcc(M) |]  ==>
    dBoundBy(<Cons(0, m), TdBound(n)>, <[], TdLam>, dLam(M))"
apply (rule dBoundByI)
apply (rule_tac [4] app_Nil [THEN sym])
apply (drule_tac [4] dOcc_typeD1)
prefer 5 apply simp
apply (assumption | rule nat_succI nat_0I dOcc_dTermIs
         dTerm.intros list.intros)+
done

lemma dBoundBy_dLamI2:
  "dBoundBy(<m, T>, <l, U>, M) ==>
    dBoundBy(<Cons(0, m), T>, <Cons(0, l), U>, dLam(M))"
apply (erule dBoundByE)
apply safe
apply (rule dBoundByI)
apply (rule_tac [4] app_Cons [THEN sym])
prefer 4 apply simp
apply (assumption | rule nat_succI nat_0I initseg_ConsI
         dOcc_dTermIs dTerm.intros)+
done

lemma dBoundBy_dAppI1:
  "[| dBoundBy(<m, T>, <l, U>, A); B: dTerm |] ==>
    dBoundBy(<Cons(0, m), T>, <Cons(0, l), U>, dApp(A, B))"
apply (erule dBoundByE)
apply safe
apply (rule dBoundByI)
apply (rule_tac [4] app_Cons [THEN sym])
prefer 4 apply simp
apply (assumption | rule nat_succI nat_0I initseg_ConsI
         dOcc_dTermIs dTerm.intros)+
done

lemma dBoundBy_dAppI2:
  "[| dBoundBy(<m, T>, <l, U>, B); A: dTerm |] ==>
    dBoundBy(<Cons(1, m), T>, <Cons(1, l), U>, dApp(A, B))"
apply (erule dBoundByE)
apply safe
apply (rule dBoundByI)
apply (rule_tac [4] app_Cons [THEN sym])
prefer 4 apply simp
apply (assumption | rule nat_succI nat_0I initseg_ConsI
         dOcc_dTermIs dTerm.intros)+
done

lemmas dBoundBy_dTermIs = dBoundBy_dLamI1 dBoundBy_dLamI2
                          dBoundBy_dAppI1 dBoundBy_dAppI2

lemma dBoundBy_dBoundE:
  "dBoundBy(u, v, dBound(n)) ==> R"
apply (erule dBoundByE)
apply (erule dOcc_dTermEs)+
apply (blast elim!: dTag.free_elims)
done

lemma dBoundBy_dVarE:
  "dBoundBy(u, v, dVar(x)) ==> R"
apply (erule dBoundByE)
apply (erule dOcc_dTermEs)+
apply (blast elim!: dTag.free_elims)
done

lemma dBoundBy_dLamE:
  assumes major: "dBoundBy(u, v, dLam(M))"
  and prem1:
     "!! m. [| u = <Cons(0, m), TdBound(dLamDeg(m, M))>; v = <[], TdLam>;
         M: dTerm; <m, TdBound(dLamDeg(m, M))>: dOcc(M)
      |] ==> R"
  and prem2:
     "!! l m n. [| u = <Cons(0, m), TdBound(n)>; v = <Cons(0, l), TdLam>;
         dBoundBy(<m, TdBound(n)>,  <l, TdLam>, M)
      |] ==> R"
  shows "R"
apply (rule major [THEN dBoundByE])
apply (erule dTerm_typeEs)
apply (rotate_tac 7)
apply (erule dOcc_dTermEs)
apply (erule_tac [2] dOcc_dTermEs)
apply (rule_tac [3] prem2)
apply (rule_tac [2] prem1)
apply (safe elim!: dTag.free_elims dTerm_typeEs list.free_elims)
apply (rotate_tac [1] 3)
apply (rotate_tac [2] 3)
apply (rotate_tac [3] 3)
apply simp_all
apply hypsubst
prefer 2 apply hypsubst
prefer 3 apply hypsubst
apply (assumption | rule refl dBoundByI conjI)+
done

lemma dBoundBy_dAppE:
  assumes major:  "dBoundBy(u, v, dApp(A, B))"
  and prem1:
     "!! l m n. [| u = <Cons(0, m), TdBound(n)>; v = <Cons(0, l), TdLam>;
         dBoundBy(<m, TdBound(n)>,  <l, TdLam>, A); B: dTerm
      |] ==> R"
  and prem2:
     "!! l m n. [| u = <Cons(1, m), TdBound(n)>; v = <Cons(1, l), TdLam>;
         dBoundBy(<m, TdBound(n)>,  <l, TdLam>, B); A: dTerm
      |] ==> R"
  shows "R"
apply (rule major [THEN dBoundByE])
apply (erule dTerm_typeEs)
apply (erule dOcc_dTermEs)
apply (erule_tac [3] dOcc_dTermEs)
apply (erule_tac [2] dOcc_dTermEs)
apply (rule_tac [7] prem2)
apply (rule_tac [3] prem1)
apply (safe elim!: ConsE dTag.free_elims dOcc_dTermEs
         dTerm_typeEs list.free_elims)
apply (simp_all only: app_Nil app_Cons)
apply (safe elim!: list.free_elims)
apply (rotate_tac [2] 2)
apply (rotate_tac [1] 2)
apply simp_all
apply (assumption | rule dBoundByI refl)+
done

lemmas dBoundBy_dTermEs = dBoundBy_dVarE dBoundBy_dBoundE
                          dBoundBy_dLamE dBoundBy_dAppE

(** Some Lemmas **)
lemma dDeg_dAbst_lemma1:
  assumes major: "M: dTerm"
  and prem1: "x ~: dFV(M)"
  and prem2: "n: nat"
  shows "dAbst(M, x, n) = M"
apply (rule prem1 [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply simp_all
done

lemma dDeg_dAbst_lemma2:
  assumes major: "M: dTerm"
  and prem1: "x: dFV(M)"
  and prem2: "n: nat"
  shows "dDeg(dAbst(M, x, n)) = succ(n) Un dDeg(M)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply (safe elim!: dProp_dTermEs dOcc_dTermEs dTag.free_elims)
apply simp_all
apply (erule disjE)
apply (case_tac [2] "x: dFV(M)")
apply (case_tac [1] "x: dFV(N)")
apply (simp_all add: dDeg_dAbst_lemma1)
apply blast+
done

lemma dDeg_dLift_lemma1:
  assumes major: "dDeg(M) \<le> n"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  shows "dLift(M, n) = M"
apply (rule major [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply simp_all
done

lemma dDeg_dLift_lemma2:
  assumes major: "n < dDeg(M)"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  shows "dDeg(dLift(M, n)) = succ(dDeg(M))"
apply (rule major [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply safe
apply simp_all
apply (rule dDeg_type [THEN natE])
apply assumption
apply (rotate_tac [2] 4)
apply (rotate_tac [1] 4)
apply simp_all
apply (rule_tac i="dDeg(N)" and j="dDeg(M)" in Ord_linear_lt)
apply (rule_tac [5] i="x" and j="dDeg(M)" in Ord_linear2)
apply (rule_tac [3] i="x" and j="dDeg(N)" in Ord_linear2)
prefer 8
prefer 9
apply (assumption | rule nat_into_Ord dDeg_type)+
apply (simp_all add: dDeg_dLift_lemma1 lt_Un_eq_lemma
         trans [OF Un_commute lt_Un_eq_lemma])
apply (rule_tac [2] lt_Un_eq_lemma)
apply (erule_tac [2] leI)
apply (rule trans [OF Un_commute lt_Un_eq_lemma])
apply (erule leI)
done

lemma dDeg_dSubst_lemma1:
  assumes major: "M: dTerm"
  and prem1: "dDeg(M) \<le> n"
  and prem2: "n: nat"
  and prem3: "N: dTerm"
  shows "dSubst(M, n, N) = M"
apply (rule prem1 [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule prem3 [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply safe
apply simp_all
done

lemma dDeg_dSubst_lemma2:
  assumes major: "M: dTerm"
  and prem1: "n < dDeg(M)"
  and prem2: "n: nat"
  and prem3: "N: dTerm"
  shows "dDeg(dSubst(M, n, N)) \<le> (dDeg(M) #- 1) Un dDeg(N)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem2 [THEN [2] bspec])
apply (rule major [THEN dTerm.induct])
apply safe
apply (case_tac [2] "x = n")
apply (simp_all split del: split_if)
apply (rule Un_upper2_le)
apply (assumption | rule nat_into_Ord dDeg_type)+
apply (subgoal_tac "x < n")
apply (erule_tac [2] swap, rule_tac [2] le_anti_sym)
apply (simp_all add: not_lt_imp_le
            [OF asm_rl nat_into_Ord nat_into_Ord]
            split del: split_if)
apply (rule_tac lt_trans2)
apply (rule_tac [2] Un_upper1_le)
apply (rule gt_pred)
apply (assumption | rule le_refl nat_into_Ord dDeg_type)+

apply (rule_tac M1="M" in dDeg_type [THEN natE])
apply assumption
apply (rotate_tac [1] 5)
apply (rotate_tac [2] 5)
apply (rule_tac [3] i="dDeg(M)" and j="dDeg(N)" in Ord_linear_lt)
apply (erule_tac [3] asm_rl | rule_tac [3] nat_into_Ord dDeg_type)+
apply (frule_tac [5] c="dDeg(M)" in trans [OF Un_commute lt_Un_eq_lemma])
apply (frule_tac [3] B="dDeg(N)" in lt_Un_eq_lemma)
apply (rotate_tac [3] 8)
apply (rotate_tac [4] 7)
apply (rotate_tac [5] 8)
apply simp_all
apply (rule nat_succ_Un [THEN subst])
apply (rule_tac [3] succ_pred [THEN mp, THEN ssubst])
prefer 5 apply assumption
apply (assumption | rule diff_type nat_succI nat_0I dDeg_type)+

apply (rule_tac i="0" and j="dDeg(dSubst(M, succ(x), dLift(xa, 0)))"
        in Ord_linear2)
apply (assumption | rule nat_into_Ord nat_0I nat_succI dDeg_type
        dSubst_type dLift_type)+
prefer 2
apply simp
apply (rule lt_imp_0_lt)
apply (erule Un_upper1_lt)
apply (assumption | rule nat_into_Ord dDeg_type nat_succI)+
apply (rule gt_pred)
prefer 2 apply assumption
apply (drule_tac x2="succ(x)" and x="dLift(xa, 0)" in bspec [THEN mp, THEN bspec])
prefer 4
apply (erule le_trans)
apply (rule_tac M1="xa" in dDeg_type [THEN natE])
apply assumption
apply (simp add: dDeg_dLift_lemma1)
apply (rule Un_upper1_le)
prefer 3
apply (rule dDeg_dLift_lemma2 [THEN ssubst])
apply simp
apply (assumption | rule nat_succI nat_into_Ord dDeg_type
        nat_0I dLift_type le_refl nat_UnI succ_leI dSubst_type)+

apply (rule_tac [2] i="x" and j="dDeg(N)" in Ord_linear2)
apply (rule_tac [1] i="x" and j="dDeg(M)" in Ord_linear2)
prefer 5
prefer 6
apply (assumption | rule nat_into_Ord dDeg_type)+
apply (simp_all add: dDeg_dSubst_lemma1)
apply (drule_tac [1] x="xa" in bspec [THEN mp, THEN bspec],
       erule_tac [1] asm_rl, erule_tac [1] asm_rl,
       erule_tac [1] asm_rl)+
apply (drule_tac [2] x="xa" in bspec [THEN mp, THEN bspec],
       erule_tac [2] asm_rl, erule_tac [2] asm_rl,
       erule_tac [2] asm_rl)+
apply (drule_tac [3] x="xa" in bspec [THEN mp, THEN bspec],
       erule_tac [3] asm_rl, erule_tac [3] asm_rl,
       erule_tac [3] asm_rl)+
apply (drule_tac [4] x="xa" in bspec [THEN mp, THEN bspec],
       erule_tac [4] asm_rl, erule_tac [4] asm_rl,
       erule_tac [4] asm_rl)+
apply safe
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
prefer 8 apply (erule le_trans)
apply simp_all
prefer 4
prefer 5
prefer 6
prefer 7
apply (rule conjI)
apply (rule_tac [2] Un_upper2_le)
apply (rule Un_upper1_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule conjI)
apply (rule_tac [2] Un_upper2_le)
apply (rule Un_upper2_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule conjI)
apply (rule_tac [2] Un_upper2_le)
apply (rule Un_upper1_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule conjI)
apply (rule_tac [2] Un_upper2_le)
apply (rule Un_upper2_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule conjI)
apply (rule_tac [2] Un_upper2_le)
apply (rule Un_upper1_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule conjI)
apply (rule_tac [2] Un_upper2_le)
apply (rule Un_upper2_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule_tac j="dDeg(N) #- 1" in le_trans)
apply (erule lt_imp_le_pred)
prefer 2
apply (rule Un_upper2_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

apply (rule_tac j="dDeg(M) #- 1" in le_trans)
apply (erule lt_imp_le_pred)
prefer 2
apply (rule Un_upper1_le [THEN le_trans])
apply (rule_tac [3] Un_upper1_le)
apply (assumption | rule nat_into_Ord dDeg_type diff_type
         nat_0I nat_succI nat_UnI)+

done

lemma dDeg_dSubst_lemma3:
  assumes prem1: "M: dTerm"
  and prem2: "dDeg(M) = 1"
  and prem3: "N: dProp"
  shows "dSubst(M, 0, N): dProp"
apply (insert prem1 prem2 prem3 [THEN dPropD1] prem3 [THEN dPropD2])
apply (rule_tac M1="M" and n1="0" and N1="N" in
         dDeg_dSubst_lemma2 [THEN revcut_rl])
apply (rule_tac [2] prem2 [THEN ssubst])
apply (assumption | rule le_refl nat_0I nat_into_Ord)+
apply simp
apply (assumption | rule dPropI dSubst_type nat_0I)+
done

lemma dSubst_dAbst_lemma:
  assumes prem1: "M: dTerm"
  and prem2: "x: LVariable"
  and prem3: "n: nat"
  and prem4: "dDeg(M) \<le> n"
  shows "dSubst(dAbst(M, x, n), n, dVar(x)) = M"
apply (insert prem2)
apply (rule prem4 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply safe
apply (case_tac "x = xa")
apply simp_all
done

lemma dSubst_dAbst_lemma2:
  assumes major: "M: dProp"
  and prem: "x: LVariable"
  shows "dSubst(dAbst(M, x, 0), 0, dVar(x)) = M"
apply (rule dSubst_dAbst_lemma)
apply (rule_tac [4] major [THEN dPropD2, THEN ssubst])
apply (assumption | rule major [THEN dPropD1] prem nat_0I
         Ord_0 le_refl)+
done

lemma dSubst_dAbst_lemma3:
  assumes prem1: "dDeg(M) \<le> n"
  and prem2: "M: dTerm"
  and prem3: "N: dTerm"
  and prem4: "n: nat"
  shows "dSubst(dAbst(M, x, succ(n)), succ(n), N) =
              dSubst(dAbst(M, x, n), n, N)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply (rule_tac [2] ballI)
apply (case_tac [2] "xa = n")
apply (case_tac "x = xa")
apply simp_all
apply safe
apply (subgoal_tac "succ(x) ~= n" "~ succ(x) < n")
apply simp
apply safe
apply (drule_tac [2] leI [THEN succ_le_iff [THEN iffD1]])
apply (erule_tac [2] lt_irrefl)
apply (drule lt_trans, assumption)
apply (drule leI [THEN succ_le_iff [THEN iffD1]],
       erule lt_irrefl)
done

lemma dAbst_dSubst_lemma:
  assumes prem1: "M: dTerm"
  and prem2: "x: LVariable"
  and prem3: "x ~: dFV(M)"
  and prem4: "n: nat"
  and prem5: "dDeg(M) \<le> succ(n)"
  shows "dAbst(dSubst(M, n, dVar(x)), x, n) = M"
apply (insert prem2)
apply (rule prem3 [THEN rev_mp])
apply (rule prem5 [THEN rev_mp])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply safe
apply (case_tac [2] "xa = n")
apply (case_tac [3] "xa < n")
apply simp_all
apply (drule lt_trans2, assumption)
apply (erule lt_irrefl)
done

lemma dAbst_dLift_lemma:
  assumes prem1: "m \<le> n"
  and prem2: "M: dTerm"
  and prem3: "n: nat"
  and prem4: "m: nat"
  shows "dAbst(dLift(M, m), x, succ(n))
            = dLift(dAbst(M, x, n), m)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply safe
apply (case_tac [2] "xa = n")
apply (case_tac [3] "n < xa")
apply (case_tac [1] "x = xa")
apply simp_all
done

lemma dAbst_dSubst_lemma2:
  assumes prem1: "m \<le> n"
  and prem3: "M: dTerm"
  and prem4: "N: dTerm"
  and prem5: "n: nat"
  and prem6: "m: nat"
  shows "dAbst(dSubst(M, m, N), x, n)
            = dSubst(dAbst(M, x, succ(n)), m, dAbst(N, x, n))"
apply (rule prem1 [THEN rev_mp])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem5 [THEN [2] bspec])
apply (rule prem6 [THEN [2] bspec])
apply (rule prem3 [THEN dTerm.induct])
apply safe
apply (case_tac [2] "xa = n")
apply (case_tac [3] "xa < n")
apply (case_tac "x = xa")
apply (simp_all add: dAbst_dLift_lemma)
done

lemma dLift_dLift_lemma:
  assumes prem1: "m \<le> n"
  and prem2: "M: dTerm"
  and prem4: "n: nat"
  and prem5: "m: nat"
  shows "dLift(dLift(M, m), succ(n)) = dLift(dLift(M, n), m)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem5 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply simp_all
apply safe
apply (frule le_anti_sym, assumption)
apply hypsubst
apply assumption
apply (erule lt_trans, assumption)
apply (erule lt_trans1, assumption)
apply (erule lt_trans, assumption)
done

lemma dLift_dSubst_lemma:
  assumes prem1: "m \<le> n"
  and prem2: "M: dTerm"
  and prem3: "N: dTerm"
  and prem4: "n: nat"
  and prem5: "m: nat"
  shows "dLift(dSubst(M, n, N), m) = dSubst(dLift(M, m), succ(n),
                                        dLift(N, m))"
apply (rule prem1 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem5 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply (simp_all add: dLift_dLift_lemma)
apply safe
apply (drule_tac i="n" in lt_trans2, assumption)
apply (erule lt_irrefl)
apply (drule_tac i="succ(xa)" in lt_trans2, assumption)
apply simp
apply (drule_tac i="n" in lt_trans2, assumption)
apply (drule_tac i="xa" and j="n" and k="xa" in lt_trans, assumption)
apply (erule lt_irrefl)
apply (drule_tac i="succ(xa)" in lt_trans2, assumption)
apply simp
apply (drule_tac i="x" and k="n" in lt_trans1, assumption)
apply (erule_tac n="n" in natE)
apply hypsubst
apply (erule lt0E)
apply hypsubst
apply simp
apply (drule_tac i="xb" and k="xb" in lt_trans2, assumption)
apply (erule lt_irrefl)
apply (drule_tac i="n" and k="n" in lt_trans2, assumption)
apply (erule lt_irrefl)
apply (drule_tac i="succ(xa)" and k="xa" in lt_trans2, assumption)
apply simp
apply (drule_tac i="n" and k="xa" in lt_trans2, assumption)
apply (drule_tac i="n" and k="n" in lt_trans, assumption)
apply (erule lt_irrefl)
apply (drule_tac i="n" and k="xa" in lt_trans2, assumption)
apply (drule_tac i="n" and k="n" in lt_trans, assumption)
apply (erule lt_irrefl)
apply (drule_tac i="n" and k="n #- 1" in lt_trans2, assumption)
apply simp
apply (erule_tac n="n" in natE)
apply hypsubst
apply simp
apply hypsubst
apply simp
done

lemma dSubst_dSubst_lemma1:
  assumes prema: "dDeg(M) \<le> succ(m)"
  and prem0: "dDeg(A) = 0"
  and prem1: "m \<le> n"
  and prem2: "M: dTerm"
  and prem3: "A: dTerm"
  and prem4: "B: dTerm"
  and prem5: "n: nat"
  and prem6: "m: nat"
  shows "dSubst(dSubst(M, m, A), n, B) =
              dSubst(dSubst(M, succ(n), dLift(B, 0)), m, A)"
apply (rule prema [THEN rev_mp])
apply (rule prem0 [THEN rev_mp])
apply (rule prem1 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem5 [THEN [2] bspec])
apply (rule prem6 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply (simp_all add: dDeg_dLift_lemma1 split del: split_if)
apply safe
apply (case_tac "x = n")
apply (subgoal_tac [2] "n < x" "n < xa")
apply (erule_tac [4] swap, rule_tac [4] le_anti_sym)
apply (erule_tac [3] lt_trans2, erule_tac [3] asm_rl)
apply hypsubst
apply (simp_all split del: split_if add: leI dDeg_dSubst_lemma1)
done

lemma dSubst_dSubst_lemma2:
  assumes prem0: "dDeg(B) = 0"
  and prem1: "m \<le> n"
  and prem2: "M: dTerm"
  and prem3: "A: dTerm"
  and prem4: "B: dTerm"
  and prem5: "n: nat"
  and prem6: "m: nat"
  shows "dSubst(dSubst(M, m, A), n, B) =
              dSubst(dSubst(M, succ(n), B), m, dSubst(A, n, B))"
apply (rule prem0 [THEN rev_mp])
apply (rule prem1 [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem4 [THEN [2] bspec])
apply (rule prem5 [THEN [2] bspec])
apply (rule prem6 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply (simp_all split del: split_if
         add: dDeg_dLift_lemma1 dLift_dSubst_lemma)
apply safe
apply (rule_tac i="n" and j="x" in Ord_linear_lt)
apply (assumption | rule nat_into_Ord)+
apply (subgoal_tac "n < xa")
apply (erule_tac [2] lt_trans2, erule_tac [2] asm_rl)
apply (rule_tac [3] i="n" and j="succ(xa)" in Ord_linear_lt)
apply (erule_tac [3] asm_rl | rule_tac [3] nat_into_Ord nat_succI)+
apply (subgoal_tac [5] "succ(x) < n")
apply (subgoal_tac [3] "xa ~= n #- 1")
apply (simp_all split del: split_if
        add: leI dDeg_dSubst_lemma1 not_lt_iff_le [OF nat_into_Ord nat_into_Ord])
apply (rule_tac [2] j="succ(xa)" in lt_trans1)
prefer 3 apply assumption
apply (erule_tac n="n" in natE)
apply safe
apply simp
apply (erule lt_irrefl)
done

lemma dFV_dAbst:
  assumes major: "M: dTerm"
  and prem: "n:nat"
  shows "dFV(dAbst(M, x, n)) = dFV(M) - {x}"
apply (rule prem [THEN rev_bspec])
apply (rule major [THEN dTerm.induct])
apply (case_tac "x = xa")
apply simp_all
apply blast+
done

lemma dDeg_dLamDeg_lemma1:
  assumes prem1: "M: dTerm"
  and prem2: "<l, TdBound(n)>: dOcc(M)"
  shows "n < dDeg(M) #+ dLamDeg(l, M)"
apply (rule prem2 [THEN rev_mp])
apply (rule_tac x="l" in spec)
apply (rule prem1 [THEN dTerm.induct])
apply (safe elim!: dOcc_dTermEs dTag.free_elims)
apply (frule_tac [4] dOcc_typeD1, erule_tac [4] asm_rl)
apply (frule_tac [3] dOcc_typeD1, erule_tac [3] asm_rl)
apply (frule_tac [2] dOcc_typeD1, erule_tac [2] asm_rl)
apply (simp_all split del: split_if)
apply (rule dDeg_type [THEN natE])
apply assumption
apply (rotate_tac [1] 4)
apply (rotate_tac [2] 4)
apply simp
prefer 2
apply simp
apply (drule_tac [3] spec [THEN mp], erule_tac [3] asm_rl)
apply (drule_tac [2] spec [THEN mp], erule_tac [2] asm_rl)
apply (drule_tac [1] spec [THEN mp], erule_tac [1] asm_rl)
apply (erule leI)
apply (erule_tac [2] lt_trans2)
apply (rule_tac [2] add_le_mono1)
apply (erule_tac [1] lt_trans2)
apply (rule_tac [1] add_le_mono1)
apply (assumption | rule dLamDeg_type dDeg_type nat_UnI
         Un_upper1_le Un_upper2_le nat_into_Ord)+
done

lemma dDeg_0_lemma:
  assumes prem1: "M: dTerm"
  and prem2: "~(EX l n. <l, TdBound(n)>: dOcc(M))"
  shows "dDeg(M) = 0"
apply (rule prem2 [THEN rev_mp])
apply (rule prem1 [THEN dTerm.induct])
apply (simp_all split del: split_if)
apply (assumption | rule exI dOcc_dTermIs)+
apply (safe elim!: dOcc_dTermEs dTag.free_elims)
prefer 2 apply simp
prefer 5 apply simp
apply (blast intro: dOcc_dTermIs)+
done

lemma dDeg_dLamDeg_lemma2:
  assumes prem1: "M: dTerm"
  and prem2: "EX l n. <l, TdBound(n)>: dOcc(M)"
  shows "EX l n. <l, TdBound(n)>: dOcc(M) &
               dDeg(M) = succ(n) #- dLamDeg(l, M)"
apply (rule prem2 [THEN rev_mp])
apply (rule prem1 [THEN dTerm.induct])
apply (safe elim!: dOcc_dTermEs dTag.free_elims)
prefer 2 apply (erule swap, rule exI [THEN exI], assumption)
prefer 3 apply (erule swap, rule exI [THEN exI], assumption)
prefer 3 apply (erule swap, rule exI [THEN exI], assumption)
prefer 3 apply (erule swap, rule exI [THEN exI], assumption)
prefer 5 apply (erule swap, rule exI [THEN exI], assumption)
apply (rule exI [THEN exI])
apply (rule conjI)
apply (rule dOcc_dTermIs)
apply simp
apply (rule_tac x="Cons(0, lb)" in exI)
apply (frule_tac l="lb" in dOcc_typeD1, assumption)
apply (frule_tac T="TdBound(na)" in dOcc_typeD2, assumption)
apply (erule dTag_typeEs)
apply (rule_tac [2] x="Cons(1, la)" in exI)
apply (frule_tac [2] l="la" in dOcc_typeD1, erule_tac [2] asm_rl)
apply (rule_tac [3] x="Cons(0, la)" in exI)
apply (frule_tac [3] l="la" in dOcc_typeD1, erule_tac [3] asm_rl)
apply (rule_tac [5] i="dDeg(M)" and j="dDeg(N)" in Ord_linear2)
apply (erule_tac [5] asm_rl | rule_tac [5] nat_into_Ord dDeg_type)+
apply (rule_tac [4] i="dDeg(M)" and j="dDeg(N)" in Ord_linear2)
apply (erule_tac [4] asm_rl | rule_tac [4] nat_into_Ord dDeg_type)+
apply (rule_tac [4] x="Cons(1, lb)" in exI)
apply (frule_tac [4] l="lb" in dOcc_typeD1, erule_tac [4] asm_rl)
apply (rule_tac [5] x="Cons(0, la)" in exI)
apply (frule_tac [5] l="la" in dOcc_typeD1, erule_tac [5] asm_rl)
apply (rule_tac [6] x="Cons(1, lb)" in exI)
apply (frule_tac [6] l="lb" in dOcc_typeD1, erule_tac [6] asm_rl)
apply (rule_tac [7] x="Cons(0, la)" in exI)
apply (frule_tac [7] l="la" in dOcc_typeD1, erule_tac [7] asm_rl)
apply (rule_tac [1] exI, rule_tac [1] conjI, erule_tac [1] dOcc_dTermIs)
apply (rule_tac [2] exI, rule_tac [2] conjI, erule_tac [2] dOcc_dTermIs)
apply (rule_tac [3] exI, rule_tac [3] conjI, erule_tac [3] dOcc_dTermIs)
apply (rule_tac [4] exI, rule_tac [4] conjI, erule_tac [4] dOcc_dTermIs)
apply (rule_tac [5] exI, rule_tac [5] conjI, erule_tac [5] dOcc_dTermIs)
apply (rule_tac [6] exI, rule_tac [6] conjI, erule_tac [6] dOcc_dTermIs)
apply (rule_tac [7] exI, rule_tac [7] conjI, erule_tac [7] dOcc_dTermIs)
apply (simp_all add: dDeg_0_lemma le_Un_eq_lemma lt_Un_eq_lemma del: not_ex)
apply (rule_tac [1] Un_commute [THEN subst])
apply (rule_tac [2] Un_commute [THEN subst])
apply (simp_all add: le_Un_eq_lemma)
done

lemma dBoundBy_dLamDeg_lemma1:
  assumes major: "dBoundBy(<l, TdBound(n)>, v, M)"
  shows "succ(n) #- dLamDeg(l, M) = 0"
apply (rule major [THEN rev_mp])
apply (rule_tac x="v" in spec)
apply (rule_tac x="l" and A="list(nat)" in bspec)
apply (rule_tac x="n" and A="nat" in bspec)
apply (rule_tac [2] major [THEN dBoundByE])
apply (rule_tac [3] major [THEN dBoundByE])
apply (rule major [THEN dBoundByD1, THEN dTerm.induct])
apply (safe elim!: dBoundBy_dTermEs dTag.free_elims ConsE)
apply (erule_tac [6] asm_rl | rule_tac [6] app_type)+
apply (drule_tac [5] dOcc_typeD2)
apply (erule_tac [6] dTag_typeEs)
apply (erule_tac [5] asm_rl)+
apply (simp_all del: all_simps)
apply (drule bspec [THEN bspec, THEN spec, THEN mp])
prefer 3 apply assumption
prefer 3
apply (simp only: le0_iff [THEN iff_sym])
apply (rule le_trans)
prefer 2 apply assumption
apply (assumption | rule diff_le_mono1 dLamDeg_type le_refl
         nat_into_Ord nat_succI leI)+
done

lemma dBoundBy_dLamDeg_lemma2:
  assumes major: "M: dTerm"
  and prem1: "<l, TdBound(n)>: dOcc(M)"
  and prem2: "n < dLamDeg(l, M)"
  shows "EX m. dBoundBy(<l, TdBound(n)>, <m, TdLam>, M)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem2 [THEN rev_mp])
apply (rule_tac x="l" and A="list(nat)" in bspec)
apply (rule_tac x="n" and A="nat" in bspec)
apply (rule_tac [2] dOcc_typeD2 [OF prem1 major, THEN revcut_rl])
apply (rule_tac [3] dOcc_typeD1 [OF prem1 major])
apply (rule major [THEN dTerm.induct])
apply (safe elim!: dTag_typeEs dOcc_dTermEs ConsE dTag.free_elims)
apply (rotate_tac [2] 4)
apply (rotate_tac [3] 6)
apply (rotate_tac [4] 6)
apply simp_all
apply (erule leE)
prefer 2
apply hypsubst
apply (rule exI)
apply (assumption | rule refl dBoundBy_dLamI1)+
apply (drule_tac [3] bspec [THEN bspec, THEN mp, THEN mp],
       erule_tac [5] asm_rl)
apply (drule_tac [2] bspec [THEN bspec, THEN mp, THEN mp],
       erule_tac [4] asm_rl)
apply (drule_tac [1] bspec [THEN bspec, THEN mp, THEN mp],
       erule_tac [3] asm_rl)
apply safe
apply (assumption | rule exI dBoundBy_dLamI2 dBoundBy_dAppI1
         dBoundBy_dAppI2)+
done

lemma dProp_dBoundBy_lemma1:
  assumes major: "M: dProp"
  and prem: "<m, TdBound(n)>: dOcc(M)"
  shows "EX l. dBoundBy(<m, TdBound(n)>, <l, TdLam>, M)"
apply (rule major [THEN dPropE])
apply (insert dDeg_dLamDeg_lemma1 [OF major [THEN dPropD1] prem])
apply (rule dBoundBy_dLamDeg_lemma2)
prefer 3 apply simp
apply (assumption | rule prem)+
done

lemma dProp_dBoundBy_lemma2:
  assumes major: "M: dTerm"
  and prem:
     "ALL m n. <m, TdBound(n)>: dOcc(M) -->
          (EX l. dBoundBy(<m, TdBound(n)>, <l, TdLam>, M))"
  shows "M: dProp"
apply (case_tac "EX l n. <l, TdBound(n)>: dOcc(M)")
prefer 2
apply (drule major [THEN dDeg_0_lemma])
apply (drule_tac [2] major [THEN dDeg_dLamDeg_lemma2])
apply (erule_tac [2] exE conjE)+
apply (rule_tac [2] prem [THEN spec, THEN spec, THEN mp, THEN exE])
prefer 2 apply assumption
apply (drule_tac [2] dBoundBy_dLamDeg_lemma1)
apply (rotate_tac [2] 2)
prefer 2 apply simp
apply (assumption | rule dPropI major)+
done

lemma dOcc_dAbstI1:
  assumes prem1: "<l, TdVar(x)>: dOcc(M)"
  and prem2: "M: dTerm"
  and prem3: "n: nat"
  shows "<l, TdBound(n #+ dLamDeg(l, M))>: dOcc(dAbst(M, x, n))"
apply (rule prem1 [THEN rev_mp])
apply (rule_tac x="l" and A="list(nat)" in bspec)
apply (rule_tac [2] dOcc_typeD1 [OF prem1 prem2])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply (safe elim!: dOcc_dTermEs dTag.free_elims ConsE)
apply simp_all
apply (rule_tac [4] dOcc_dTermIs)
apply (rule_tac [3] dOcc_dTermIs)
apply (rule_tac [2] dOcc_dTermIs)
apply (rule_tac [1] dOcc_dTermIs)
apply (drule bspec [THEN bspec, THEN mp])
prefer 3 apply assumption
apply (erule nat_succI)
prefer 2 apply simp
apply assumption
apply (erule_tac [2] bspec [THEN bspec, THEN mp])
apply (erule_tac [1] bspec [THEN bspec, THEN mp])
apply assumption+
done

lemma dOcc_dAbstI2:
  assumes prem1: "<l, T>: dOcc(M)"
  and major: "T ~= TdVar(x)"
  and prem2: "M: dTerm"
  and prem3: "n: nat"
  shows "<l, T>: dOcc(dAbst(M, x, n))"
apply (insert major)
apply (rule prem1 [THEN rev_mp])
apply (rule_tac x="l" and A="list(nat)" in bspec)
apply (rule_tac [2] dOcc_typeD1 [OF prem1 prem2])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem2 [THEN dTerm.induct])
apply (safe elim!: dOcc_dTermEs dTag.free_elims ConsE)
apply (subgoal_tac "x ~= xa")
prefer 2 apply blast
apply simp_all
apply (safe intro!: dOcc_dTermIs)
apply (erule_tac [3] bspec [THEN bspec, THEN mp])
apply (erule_tac [2] bspec [THEN bspec, THEN mp])
apply (erule_tac [1] bspec [THEN bspec, THEN mp])
apply (assumption | rule nat_succI)+
done

lemma dOcc_dAbstE_lemma:
  assumes major: "<l, T>: dOcc(dAbst(M, x, n))"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  and prem3:
   "T = TdBound(n #+ dLamDeg(l, M)) & <l, TdVar(x)>: dOcc(M) --> R"
  and prem4: "<l, T>: dOcc(M) --> R"
  shows "R"
apply (rule prem4 [THEN rev_mp])
apply (rule prem3 [THEN rev_mp])
apply (rule major [THEN rev_mp])
apply (rule_tac x="l" and A="list(nat)" in bspec)
prefer 2
apply (rule major [THEN dOcc_typeD1])
apply (assumption | rule dAbst_type prem1 prem2)+
apply (rule prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply (case_tac "x = xa")
apply simp_all
apply (safe elim!: dOcc_dTermEs dTag.free_elims ConsE
         intro!: dOcc_dTermIs)
apply simp_all
apply (drule_tac [2] bspec [THEN bspec])
apply (erule_tac [2] nat_succI)
apply (drule_tac [1] bspec [THEN bspec])
apply (erule_tac [1] nat_succI)
apply assumption
prefer 2 apply assumption
apply simp
apply simp
apply blast
apply blast
done

lemma dOcc_dAbstE:
  assumes major: "<l, T>: dOcc(dAbst(M, x, n))"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  and prem3:
   "[| T = TdBound(n #+ dLamDeg(l, M)); <l, TdVar(x)>: dOcc(M) |] ==> R"
  and prem4: "<l, T>: dOcc(M) ==> R"
  shows "R"
apply (rule dOcc_dAbstE_lemma [OF major prem1 prem2])
apply (rule_tac [2] impI)
apply (rule impI)
apply (erule conjE)
apply (erule_tac [2] prem4)
apply (erule prem3)
apply assumption
done

lemma dOcc_dAbst_lemma1:
  assumes major: "<l, T>: dOcc(dAbst(M, x, n))"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  shows "T ~= TdVar(x)"
apply (rule major [THEN rev_mp])
apply (rule_tac x="l" in spec)
apply (rule_tac prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply (case_tac "x = xa")
prefer 2
apply (simp_all del: all_simps)
apply (safe elim!: dOcc_dTermEs dTag.free_elims)
apply (drule_tac [3] bspec [THEN spec, THEN mp],
       erule_tac [4] asm_rl)
apply (drule_tac [2] bspec [THEN spec, THEN mp],
       erule_tac [3] asm_rl)
apply (drule_tac [1] bspec [THEN spec, THEN mp],
       erule_tac [2] asm_rl)
prefer 3
prefer 5
apply (assumption | rule nat_succI)+
apply (erule notE, rule refl)+
done

lemma dOcc_dAbst_lemma2:
  assumes major: "<l, TdBound(n #+ dLamDeg(l, M))>: dOcc(dAbst(M, x, n))"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  and prem3: "dDeg(M) \<le> n"
  shows "<l, TdVar(x)>: dOcc(M)"
apply (rule major [THEN rev_mp])
apply (rule prem3 [THEN rev_mp])
apply (rule_tac x="l" and A="list(nat)" in bspec)
prefer 2
apply (rule major [THEN dOcc_typeD1])
apply (assumption | rule dAbst_type prem1 prem2)+
apply (rule prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply (case_tac "x = xa")
prefer 2
apply simp_all
apply (safe elim!: dOcc_dTermEs dTag.free_elims ConsE
            intro!: dOcc_dTermIs)
apply simp_all
apply (erule bspec [THEN mp, THEN bspec, THEN mp])
apply (erule nat_succI)
prefer 3 apply simp
apply assumption+
done

lemma dOcc_dAbst_lemma3:
  assumes major: "<l, TdBound(dLamDeg(l, M))>: dOcc(dAbst(M, x, 0))"
  and prem: "M: dProp"
  shows "<l, TdVar(x)>: dOcc(M)"
apply (rule prem [THEN dPropE])
apply (rule dOcc_dAbst_lemma2)
prefer 4
apply simp
apply (rule le_refl)
prefer 2
apply simp
apply (assumption | rule major nat_0I Ord_0)+
done

lemma dLamDeg_dAbst_lemma:
  assumes major: "M: dTerm"
  and prem1: "<l, T>: dOcc(M)"
  and prem2: "n: nat"
  shows "dLamDeg(l, dAbst(M, x, n)) = dLamDeg(l, M)"
apply (rule prem1 [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule_tac x="l" and A="list(nat)" in bspec)
prefer 2
apply (rule dOcc_typeD1 [OF prem1 major])
apply (rule major [THEN dTerm.induct])
apply (safe elim!: dOcc_dTermEs ConsE dTag.free_elims)
apply (case_tac "x = xa")
apply simp_all
done

lemma dBoundBy_dAbstI:
  assumes major: "dBoundBy(u, v, M)"
  and prem: "n: nat"
  shows "dBoundBy(u, v, dAbst(M, x, n))"
apply (rule major [THEN rev_mp])
apply (rule prem [THEN [2] bspec])
apply (rule_tac x="v" in spec)
apply (rule_tac x="u" in spec)
apply (rule major [THEN dBoundByD1, THEN dTerm.induct])
apply (safe elim!: dBoundBy_dTermEs dTag.free_elims)
apply simp_all
apply (safe intro!: dBoundBy_dTermIs dAbst_type)
apply (rule dLamDeg_dAbst_lemma)
apply (assumption | rule nat_succI)+
apply (erule dOcc_dAbstI2)
apply (blast elim!: dTag.free_elims)
apply (assumption | rule nat_succI)+
apply (erule_tac [3] spec [THEN spec, THEN mp, THEN bspec])
apply (erule_tac [2] spec [THEN spec, THEN mp, THEN bspec])
apply (erule_tac [1] spec [THEN spec, THEN mp, THEN bspec])
apply (assumption | rule nat_succI)+
done

lemma dBoundBy_dAbstD:
  assumes major: "dBoundBy(u, v, dAbst(M, x, n))"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  shows "dBoundBy(u, v, M)"
apply (rule major [THEN rev_mp])
apply (rule prem2 [THEN [2] bspec])
apply (rule_tac x="v" in spec)
apply (rule_tac x="u" in spec)
apply (rule prem1 [THEN dTerm.induct])
apply (case_tac "x = xa")
prefer 2
apply (simp_all del: all_simps ball_simps)
apply (safe elim!: dBoundBy_dTermEs dOcc_dAbstE dTag.free_elims
            intro!: dBoundBy_dTermIs)
apply (assumption | rule dLamDeg_dAbst_lemma [THEN sym] nat_succI)+
apply (drule_tac f="%x. x #- dLamDeg(m, M)" in function_apply_eq)
apply (simp del: all_simps ball_simps add: dLamDeg_dAbst_lemma)
apply (erule_tac [3] spec [THEN spec, THEN bspec, THEN mp],
       erule_tac [4] asm_rl)
apply (erule_tac [2] spec [THEN spec, THEN bspec, THEN mp],
       erule_tac [3] asm_rl)
apply (erule_tac [1] spec [THEN spec, THEN bspec, THEN mp],
       erule_tac [2] asm_rl)
apply (assumption | rule nat_succI)+
done

lemma dFV_dLift_iff:
  assumes prem1: "M: dTerm"
  and prem2: "n: nat"
  shows "x : dFV(dLift(M, n)) <-> x: dFV(M)"
apply (rule prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply (rule_tac [2] ballI)
apply (case_tac [2] "n < xa")
apply simp_all
done

lemma dFV_dSubst_lemma:
  assumes major: "x: dFV(dSubst(M, n, N))"
  and prem1: "M: dTerm"
  and prem2: "n: nat"
  and prem3: "N: dTerm"
  shows "x: dFV(M) | x: dFV(N)"
apply (rule major [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule prem2 [THEN [2] bspec])
apply (rule prem1 [THEN dTerm.induct])
apply (rule_tac [2] ballI)
apply (case_tac [2] "xa = n")
apply (case_tac [3] "xa < n")
apply (simp_all del: ball_simps all_simps)
apply safe
apply (drule_tac [3] bspec [THEN bspec, THEN mp],
       erule_tac [5] asm_rl)
apply (drule_tac [2] bspec [THEN bspec, THEN mp],
       erule_tac [4] asm_rl)
apply (drule_tac [1] bspec [THEN bspec, THEN mp],
       erule_tac [3] asm_rl)
prefer 4
prefer 5
prefer 7
prefer 8
apply (assumption | rule dLift_type nat_succI nat_0I)+
apply (simp add: dFV_dLift_iff)
apply safe
done

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_rotate_snoc_self
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
"x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun snoc :: "'a => 'a list => 'a list" where
"snoc y (nil2) = cons2 y (nil2)"
| "snoc y (cons2 z2 ys) = cons2 z2 (snoc y ys)"

fun rotate :: "Nat => 'a list => 'a list" where
"rotate (Z) z = z"
| "rotate (S z2) (nil2) = nil2"
| "rotate (S z2) (cons2 z22 xs1) = rotate z2 (snoc z22 xs1)"

theorem property0 :
  "((rotate n (x xs xs)) = (x (rotate n xs) (rotate n xs)))"
  oops

end


theory sort_TSortPermutes
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"

datatype 'a Tree = TNode "'a Tree" "'a" "'a Tree" | TNil

datatype Nat = Z | S "Nat"

fun flatten :: "'a Tree => 'a list => 'a list" where
"flatten (TNode q z q2) y = flatten q (Cons2 z (flatten q2 y))"
| "flatten (TNil) y = y"

fun dot :: "('b => 'c) => ('a => 'b) => 'a => 'c" where
"dot x y z = x (y z)"

fun count :: "int => int list => Nat" where
"count x (Nil2) = Z"
| "count x (Cons2 z xs) =
     (if x = z then S (count x xs) else count x xs)"

fun add :: "int => int Tree => int Tree" where
"add x (TNode q z q2) =
   (if x <= z then TNode (add x q) z q2 else TNode q z (add x q2))"
| "add x (TNil) = TNode (TNil) x (TNil)"

fun toTree :: "int list => int Tree" where
"toTree (Nil2) = TNil"
| "toTree (Cons2 y xs) = add y (toTree xs)"

fun tsort :: "int list => int list" where
"tsort x =
   dot
     (% (y :: (int list => int list)) => y (Nil2))
     (% (z :: int list) =>
        dot
          (% (x2 :: int Tree) => % (x3 :: int list) => flatten x2 x3)
          (% (x4 :: int list) => toTree x4) z)
     x"

(*hipster flatten dot count add toTree tsort *)

theorem x0 :
  "!! (x :: int) (y :: int list) . (count x (tsort y)) = (count x y)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


theory Prelude_Bool_1
imports "$HETS_LIB/Isabelle/MainHC"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize [\"Ax4\", \"Not_False\", \"Not_True\"]"

typedecl Bool

consts
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X_False :: "Bool" ("False''")
X_True :: "Bool" ("True''")

instance Bool:: type ..

axioms
Not_False [rule_format] : "Not' False' = True'"

Not_True [rule_format] : "Not' True' = False'"

declare Not_False [simp]
declare Not_True [simp]

theorem Ax4 : "~ True' = False'"
by auto

ML "Header.record \"Ax4\""

end


theory Launchbury
imports Terms Substitution
begin

subsubsection {* The natural semantics *}

text {* This is the semantics as in \cite{launchbury}, with two differences:
\begin{itemize}
\item Explicit freshness requirements for bound variables in the application and the Let rule.
\item An additional parameter that stores variables that have to be avoided, but do not occur
in the judgement otherwise, follwing \cite{sestoft}.
\end{itemize}
*}

inductive
  reds :: "heap \<Rightarrow> exp \<Rightarrow> var list \<Rightarrow> heap \<Rightarrow> exp \<Rightarrow> bool"
  ("_ : _ \<Down>\<^bsub>_\<^esub> _ : _" [50,50,50,50] 50)
where
  Lambda:
    "\<Gamma> : (Lam [x]. e) \<Down>\<^bsub>L\<^esub> \<Gamma> : (Lam [x]. e)"
 | Application: "\<lbrakk>
    atom y \<sharp> (\<Gamma>,e,x,L,\<Delta>,\<Theta>,z) ;
    \<Gamma> : e \<Down>\<^bsub>x#L\<^esub> \<Delta> : (Lam [y]. e');
    \<Delta> : e'[y ::= x] \<Down>\<^bsub>L\<^esub> \<Theta> : z
  \<rbrakk>  \<Longrightarrow>
    \<Gamma> : App e x \<Down>\<^bsub>L\<^esub> \<Theta> : z"
 | Variable: "\<lbrakk>
    map_of \<Gamma> x = Some e; delete x \<Gamma> : e \<Down>\<^bsub>x#L\<^esub> \<Delta> : z
  \<rbrakk> \<Longrightarrow>
    \<Gamma> : Var x \<Down>\<^bsub>L\<^esub> (x, z) # \<Delta> : z"
 | Let: "\<lbrakk>
    atom ` domA as \<sharp>* (\<Gamma>, L);
    as @ \<Gamma> : body \<Down>\<^bsub>L\<^esub> \<Delta> : z
  \<rbrakk> \<Longrightarrow>
    \<Gamma> : Let as body \<Down>\<^bsub>L\<^esub> \<Delta> : z"

equivariance reds

nominal_inductive reds
  avoids Application: "y"
  by (auto simp add: fresh_star_def fresh_Pair)

subsubsection {* Example evaluations *}

lemma eval_test:
  "[] : (Let [(x, Lam [y]. Var y)] (Var x)) \<Down>\<^bsub>[]\<^esub> [(x, Lam [y]. Var y)] : (Lam [y]. Var y)"
apply(auto intro!: Lambda Application Variable Let
 simp add: fresh_Pair fresh_Cons fresh_Nil fresh_star_def)
done

lemma eval_test2:
  "y \<noteq> x \<Longrightarrow> n \<noteq> y \<Longrightarrow> n \<noteq> x \<Longrightarrow>[] : (Let [(x, Lam [y]. Var y)] (App (Var x) x)) \<Down>\<^bsub>[]\<^esub> [(x, Lam [y]. Var y)] : (Lam [y]. Var y)"
  by (auto intro!: Lambda Application Variable Let simp add: fresh_Pair fresh_at_base fresh_Cons fresh_Nil fresh_star_def)

subsubsection {* Better introduction rule *}

text {*
This variant do not require freshness.
*}

lemma reds_ApplicationI:
  assumes "\<Gamma> : e \<Down>\<^bsub>x # L\<^esub> \<Delta> : Lam [y]. e'"
  assumes "\<Delta> : e'[y::=x] \<Down>\<^bsub>L\<^esub> \<Theta> : z"
  shows "\<Gamma> : App e x \<Down>\<^bsub>L\<^esub> \<Theta> : z"
proof-
  obtain y' :: var where "atom y' \<sharp> (\<Gamma>, e, x, L, \<Delta>, \<Theta>, z, e')" by (rule obtain_fresh)

  have a: "Lam [y']. ((y' \<leftrightarrow> y) \<bullet> e') = Lam [y]. e'"
    using `atom y' \<sharp> _`
    by (auto simp add: Abs1_eq_iff fresh_Pair fresh_at_base)

  have b: "((y' \<leftrightarrow> y) \<bullet> e')[y'::=x] = e'[y::=x]"
  proof(cases "x = y")
    case True
    have "atom y' \<sharp> e'" using `atom y' \<sharp> _` by simp
    thus ?thesis
      by (simp add: True subst_swap_same  subst_subst_back)
  next
    case False
    hence "atom y \<sharp> x" by simp

    have [simp]: "(y' \<leftrightarrow> y) \<bullet> x = x" using `atom y \<sharp> _`  `atom y' \<sharp> _`
        by (simp add: flip_fresh_fresh fresh_Pair fresh_at_base)

    have "((y' \<leftrightarrow> y) \<bullet> e')[y'::=x] = (y' \<leftrightarrow> y) \<bullet> (e'[y::=x])" by simp
    also have "\<dots> = e'[y::=x]"
      using `atom y \<sharp> _`  `atom y' \<sharp> _`
      by (simp add: flip_fresh_fresh fresh_Pair fresh_at_base subst_pres_fresh)
    finally
    show ?thesis.
  qed
  have "atom y' \<sharp> (\<Gamma>, e, x, L, \<Delta>, \<Theta>, z)" using  `atom y' \<sharp> _` by (simp add: fresh_Pair)
  from this assms[folded a b]
  show ?thesis ..
qed

subsubsection {* Properties of the semantics *}

text {*
Heap entries are never removed.
*}

lemma reds_doesnt_forget:
  "\<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z \<Longrightarrow> domA \<Gamma> \<subseteq> domA \<Delta>"
proof(induct rule: reds.induct)
case(Variable \<Gamma> v e L \<Delta> z)
  show ?case
  proof
    fix x
    assume "x \<in> domA \<Gamma>"
    show "x \<in> domA ((v, z) # \<Delta>)"
    proof(cases "x = v")
    case True
      thus ?thesis by simp
    next
    case False
      with `x \<in> domA \<Gamma>`
      have "x \<in> domA (delete v \<Gamma>)" by simp
      hence "x \<in> domA \<Delta>" using Variable.hyps(3) by auto
      thus ?thesis by simp
    qed
  qed
qed (auto)

text {*
Live variables are not added to the heap.
*}

lemma reds_avoids_live:
  "\<lbrakk> \<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z;
   x \<in> set L;
   x \<notin> domA \<Gamma>
  \<rbrakk> \<Longrightarrow> x \<notin> domA \<Delta>"
proof(induct rule:reds.induct)
case (Lambda \<Gamma> x e L) thus ?case by auto
next
case (Application y \<Gamma> e x L \<Delta> \<Theta> z e') thus ?case by auto
next
case (Variable \<Gamma> x e L \<Delta> z)
   from Variable(1) have "x \<in> domA \<Gamma>" by (metis domA_from_set map_of_is_SomeD)
   with Variable
   show ?case by auto
next
case (Let as \<Gamma> L body \<Delta> z)
  have "x \<notin> domA \<Gamma>" by fact moreover
  have "atom ` domA as \<sharp>* L" using `atom \` domA as \<sharp>* (\<Gamma>, L)` by (simp add: fresh_star_Pair)
  hence "x \<notin> domA as"
    using `x \<in> set L`
    by (metis fresh_star_def imageI set_not_fresh)
  ultimately
  have "x \<notin> domA (as @ \<Gamma>)" by auto
  thus ?case
    by (rule Let.hyps(3)[OF `x \<in> set L`])
qed

lemma reds_avoids_live':
 assumes "\<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z"
 shows "set L \<subseteq> - (domA \<Delta> - domA \<Gamma>)"
using reds_avoids_live[OF assms] by auto

text {*
Fresh variables either stay fresh or are added to the heap.
*}

lemma reds_fresh:" \<lbrakk> \<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z;
   atom (x::var) \<sharp> (\<Gamma>, e)
  \<rbrakk> \<Longrightarrow> atom x \<sharp> (\<Delta>, z) \<or> x \<in> (domA \<Delta> - set L)"
proof(induct rule: reds.induct)
case (Lambda \<Gamma> x e) thus ?case by auto
next
case (Application y \<Gamma> e x' L \<Delta> \<Theta> z e')
  hence "atom x \<sharp> (\<Delta>, Lam [y]. e') \<or> x \<in> domA \<Delta> - set (x' # L)" by (auto simp add: fresh_Pair)

  thus ?case
  proof
    assume  "atom x \<sharp> (\<Delta>, Lam [y]. e')"
    show ?thesis
    proof(cases "x = y")
    case False
      hence "atom x \<sharp> e'" using `atom x \<sharp> (\<Delta>, Lam [y]. e')`
        by (auto simp add:fresh_Pair)
      hence "atom x \<sharp> e'[y ::= x']" using Application.prems
        by (auto intro: subst_pres_fresh[rule_format] simp add: fresh_Pair)
      thus ?thesis using Application.hyps(5) `atom x \<sharp> (\<Delta>, Lam [y]. e')` by auto
    next
    case True
      hence "atom x \<sharp> e'[y ::= x']" using `atom x \<sharp> (\<Delta>, Lam [y]. e')` Application.prems
        by (auto intro:subst_is_fresh simp add: fresh_Pair)
      thus ?thesis using Application.hyps(5) `atom x \<sharp> (\<Delta>, Lam [y]. e')` by auto
    qed
  next
    assume "x \<in> domA \<Delta>  - set (x' # L)"
    thus ?thesis using reds_doesnt_forget[OF Application.hyps(4)] by auto
  qed
next

case(Variable \<Gamma> v e L \<Delta> z)
  have "atom x \<sharp> \<Gamma>" and "atom x \<sharp> v" using Variable.prems(1) by (auto simp add: fresh_Pair)
  from fresh_delete[OF this(1)]
  have "atom x \<sharp> delete v \<Gamma>".
  moreover
  have "v \<in> domA \<Gamma>" using Variable.hyps(1) by (metis domA_from_set map_of_is_SomeD)
  from fresh_map_of[OF this  `atom x \<sharp> \<Gamma>`]
  have "atom x \<sharp> the (map_of \<Gamma> v)".
  hence "atom x \<sharp> e" using `map_of \<Gamma> v = Some e` by simp
  ultimately
  have "atom x \<sharp> (\<Delta>, z) \<or> x \<in> domA \<Delta> - set (v # L)"  using Variable.hyps(3) by (auto simp add: fresh_Pair)
  thus ?case using `atom x \<sharp> v` by (auto simp add: fresh_Pair fresh_Cons fresh_at_base)
next

case (Let as \<Gamma> L body \<Delta> z)
  show ?case
    proof (cases "x \<in> domA as")
    case False
      hence "atom x \<sharp> as" using Let.prems by(auto simp add: fresh_Pair)
      show ?thesis
        apply(rule Let.hyps(3))
        using Let.prems `atom x \<sharp> as` False
        by (auto simp add: fresh_Pair fresh_append)
    next
    case True
      hence "x \<notin> set L"
        using Let(1)
        by (metis fresh_PairD(2) fresh_star_def image_eqI set_not_fresh)
      with True
      show ?thesis
      using reds_doesnt_forget[OF Let.hyps(2)] by auto
    qed
qed

lemma reds_fresh_fv: "\<lbrakk> \<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z;
   x \<in> fv (\<Delta>, z) \<and> (x \<notin> domA \<Delta> \<or>  x \<in> set L)
  \<rbrakk> \<Longrightarrow> x \<in> fv (\<Gamma>, e)"
using reds_fresh
unfolding fv_def fresh_def
by blast

lemma new_vars_not_free:
  assumes "\<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z"
  assumes "x \<in> domA \<Delta>"
  assumes "x \<in> set L"
  shows "x \<in> fv (\<Gamma>, e)"
  apply (rule reds_fresh_fv[OF assms(1)])
  using assms(2,3)
  apply (auto dest: set_mp[OF domA_fv_subset])
  done

lemma new_free_vars_on_heap:
  assumes "\<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z"
  shows "fv (\<Delta>, z) - domA \<Delta> \<subseteq> fv (\<Gamma>, e) - domA \<Gamma>"
using reds_fresh_fv[OF assms(1)] reds_doesnt_forget[OF assms(1)] by auto

text {*
Reducing the set of variables to avoid is always possible.
*}

lemma reds_smaller_L: "\<lbrakk> \<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z;
   set L' \<subseteq> set L
  \<rbrakk> \<Longrightarrow> \<Gamma> : e \<Down>\<^bsub>L'\<^esub> \<Delta> : z"
proof(nominal_induct avoiding : L' rule: reds.strong_induct)
case (Lambda \<Gamma> x e L L')
  show ?case
    by (rule reds.Lambda)
next
case (Application y \<Gamma> e xa L \<Delta> \<Theta> z e' L')
  show ?case
  proof(rule reds.Application)
    show "atom y \<sharp> (\<Gamma>, e, xa, L', \<Delta>, \<Theta>, z)"
      using Application
      by (auto simp add: fresh_Pair)

    have "set (xa # L') \<subseteq> set (xa # L)"
      using `set L' \<subseteq> set L` by auto
    thus "\<Gamma> : e \<Down>\<^bsub>xa # L'\<^esub> \<Delta> : Lam [y]. e'"
      by (rule Application.hyps(10))

    show "\<Delta> : e'[y::=xa] \<Down>\<^bsub>L'\<^esub> \<Theta> : z "
      by (rule Application.hyps(12)[OF Application.prems])
  qed
next
case (Variable \<Gamma> xa e L \<Delta> z L')
  have "set (xa # L') \<subseteq> set (xa # L)"
    using Variable.prems by auto
  thus ?case
    by (rule reds.Variable[OF Variable(1) Variable.hyps(3)])
next
case (Let as \<Gamma>  L body \<Delta> z L')
  have "atom ` domA as \<sharp>* (\<Gamma>, L')"
    using Let(1-3) Let.prems
    by (auto simp add: fresh_star_Pair  fresh_star_set_subset)
  thus ?case
    by (rule reds.Let[OF _ Let.hyps(4)[OF Let.prems]])
qed

text {* Things are evaluated to a lambda expression, and the variable can be freely chose. *}

lemma result_evaluated_fresh:
  assumes "\<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z"
  obtains y e'
  where "z = (Lam [y]. e')" and "atom y \<sharp> (c::'a::fs)"
proof-
  from assms
  have "\<exists> x e'. z = Lam [x]. e'"
    by (induct \<Gamma> e L \<Delta> z rule:reds.induct) (auto dest: reds_doesnt_forget)
  hence "\<exists> y e'. z = Lam [y]. e' \<and> atom y \<sharp> c"
    by (nominal_induct z avoiding: c rule:exp_assn.strong_induct(1)) auto
  thus thesis using that by blast
qed

end


(* Title:      Preconditions
   Author:     Walter Guttmann
   Maintainer: Walter Guttmann <walter.guttmann at canterbury.ac.nz>
*)

section \<open>Preconditions\<close>

theory Preconditions

imports Tests

begin

class pre =
  fixes pre :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixr "\<guillemotleft>" 55)

class precondition = tests + pre +
  assumes pre_closed: "x\<guillemotleft>-q = --(x\<guillemotleft>-q)"
  assumes pre_seq: "x*y\<guillemotleft>-q = x\<guillemotleft>y\<guillemotleft>-q"
  assumes pre_lower_bound_right: "x\<guillemotleft>-p*-q \<le> x\<guillemotleft>-q"
  assumes pre_one_increasing: "-q \<le> 1\<guillemotleft>-q"
begin

text \<open>Theorem 39.2\<close>

lemma pre_sub_distr:
  "x\<guillemotleft>-p*-q \<le> (x\<guillemotleft>-p)*(x\<guillemotleft>-q)"
  by (smt (z3) pre_closed pre_lower_bound_right tests_dual.sub_commutative tests_dual.sub_sup_closed tests_dual.least_upper_bound)

text \<open>Theorem 39.5\<close>

lemma pre_below_one:
  "x\<guillemotleft>-p \<le> 1"
  by (metis pre_closed tests_dual.sub_bot_least)

lemma pre_lower_bound_left:
  "x\<guillemotleft>-p*-q \<le> x\<guillemotleft>-p"
  using pre_lower_bound_right tests_dual.sub_commutative by fastforce

text \<open>Theorem 39.1\<close>

lemma pre_iso:
  "-p \<le> -q \<Longrightarrow> x\<guillemotleft>-p \<le> x\<guillemotleft>-q"
  by (metis leq_def pre_lower_bound_right)

text \<open>Theorem 39.4 and Theorem 40.9\<close>

lemma pre_below_pre_one:
  "x\<guillemotleft>-p \<le> x\<guillemotleft>1"
  using tests_dual.sba_dual.one_def pre_iso tests_dual.sub_bot_least by blast

text \<open>Theorem 39.3\<close>

lemma pre_seq_below_pre_one:
  "x*y\<guillemotleft>1 \<le> x\<guillemotleft>1"
  by (metis one_def pre_below_pre_one pre_closed pre_seq)

text \<open>Theorem 39.6\<close>

lemma pre_compose:
  "-p \<le> x\<guillemotleft>-q \<Longrightarrow> -q \<le> y\<guillemotleft>-r \<Longrightarrow> -p \<le> x*y\<guillemotleft>-r"
  by (metis pre_closed pre_iso tests_dual.transitive pre_seq)

proposition pre_test_test: "-p*(-p\<guillemotleft>-q) = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test_promote: "-p\<guillemotleft>-q = -p\<guillemotleft>-p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=4] oops
proposition pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=2] oops

end

class precondition_test_test = precondition +
  assumes pre_test_test: "-p*(-p\<guillemotleft>-q) = -p*-q"
begin

lemma pre_one:
  "1\<guillemotleft>-p = -p"
  by (metis pre_closed pre_test_test tests_dual.sba_dual.one_def tests_dual.sup_left_unit)

lemma pre_import:
  "-p*(x\<guillemotleft>-q) = -p*(-p*x\<guillemotleft>-q)"
  by (metis pre_closed pre_seq pre_test_test)

lemma pre_import_composition:
  "-p*(-p*x*y\<guillemotleft>-q) = -p*(x\<guillemotleft>y\<guillemotleft>-q)"
  by (metis pre_closed pre_seq pre_import)

lemma pre_import_equiv:
  "-p \<le> x\<guillemotleft>-q \<longleftrightarrow> -p \<le> -p*x\<guillemotleft>-q"
  by (metis leq_def pre_closed pre_import)

lemma pre_import_equiv_mult:
  "-p*-q \<le> x\<guillemotleft>-s \<longleftrightarrow> -p*-q \<le> -q*x\<guillemotleft>-s"
  by (smt leq_def pre_closed sub_assoc sub_mult_closed pre_import)

proposition pre_test_promote: "-p\<guillemotleft>-q = -p\<guillemotleft>-p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=4] oops
proposition pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=2] oops

end

class precondition_promote = precondition +
  assumes pre_test_promote: "-p\<guillemotleft>-q = -p\<guillemotleft>-p*-q"
begin

lemma pre_mult_test_promote:
  "x*-p\<guillemotleft>-q = x*-p\<guillemotleft>-p*-q"
  by (metis pre_seq pre_test_promote sub_mult_closed)

proposition pre_test_test: "-p*(-p\<guillemotleft>-q) = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=4] oops
proposition pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=2] oops

end

class precondition_test_box = precondition +
  assumes pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q"
begin

lemma pre_test_neg:
  "--p*(-p\<guillemotleft>-q) = --p"
  by (simp add: pre_test)

lemma pre_bot:
  "bot\<guillemotleft>-q = 1"
  by (metis pre_test tests_dual.sba_dual.one_def tests_dual.sba_dual.sup_left_zero tests_dual.top_double_complement)

lemma pre_export:
  "-p*x\<guillemotleft>-q = --p\<squnion>(x\<guillemotleft>-q)"
  by (metis pre_closed pre_seq pre_test)

lemma pre_neg_mult:
  "--p \<le> -p*x\<guillemotleft>-q"
  by (metis leq_def pre_closed pre_seq pre_test_neg)

lemma pre_test_test_same:
  "-p\<guillemotleft>-p = 1"
  using pre_test tests_dual.sba_dual.less_eq_sup_top tests_dual.sba_dual.reflexive by auto

lemma test_below_pre_test_mult:
  "-q \<le> -p\<guillemotleft>-p*-q"
  by (metis pre_test tests_dual.sba_dual.reflexive tests_dual.sba_dual.shunting tests_dual.sub_sup_closed)

lemma test_below_pre_test:
  "-q \<le> -p\<guillemotleft>-q"
  by (simp add: pre_test tests_dual.sba_dual.upper_bound_right)

lemma test_below_pre_test_2:
  "--p \<le> -p\<guillemotleft>-q"
  by (simp add: pre_test tests_dual.sba_dual.upper_bound_left)

lemma pre_test_bot:
  "-p\<guillemotleft>bot = --p"
  by (metis pre_test tests_dual.sba_dual.sup_right_unit tests_dual.top_double_complement)

lemma pre_test_one:
  "-p\<guillemotleft>1 = 1"
  by (metis pre_seq pre_bot tests_dual.sup_right_zero)

subclass precondition_test_test
  apply unfold_locales
  by (simp add: pre_test tests_dual.sup_complement_intro)

subclass precondition_promote
  apply unfold_locales
  by (metis pre_test tests_dual.sba_dual.sub_commutative tests_dual.sub_sup_closed tests_dual.inf_complement_intro)

proposition pre_test: "-p\<guillemotleft>-q = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" oops
proposition pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=2] oops

end

class precondition_test_diamond = precondition +
  assumes pre_test: "-p\<guillemotleft>-q = -p*-q"
begin

lemma pre_test_neg:
  "--p*(-p\<guillemotleft>-q) = bot"
  by (simp add: pre_test tests_dual.sub_associative tests_dual.sub_commutative)

lemma pre_bot:
  "bot\<guillemotleft>-q = bot"
  by (metis pre_test tests_dual.sup_left_zero tests_dual.top_double_complement)

lemma pre_export:
  "-p*x\<guillemotleft>-q = -p*(x\<guillemotleft>-q)"
  by (metis pre_closed pre_seq pre_test)

lemma pre_neg_mult:
  "-p*x\<guillemotleft>-q \<le> -p"
  by (metis pre_closed pre_export tests_dual.upper_bound_left)

lemma pre_test_test_same:
  "-p\<guillemotleft>-p = -p"
  by (simp add: pre_test)

lemma test_above_pre_test_plus:
  "--p\<guillemotleft>-p\<squnion>-q \<le> -q"
  using pre_test tests_dual.sba_dual.inf_complement_intro tests_dual.sub_commutative tests_dual.sub_inf_def tests_dual.upper_bound_left by auto

lemma test_above_pre_test:
  "-p\<guillemotleft>-q \<le> -q"
  by (simp add: pre_test tests_dual.upper_bound_right)

lemma test_above_pre_test_2:
  "-p\<guillemotleft>-q \<le> -p"
  by (simp add: pre_test tests_dual.upper_bound_left)

lemma pre_test_bot:
  "-p\<guillemotleft>bot = bot"
  by (metis pre_test tests_dual.sup_right_zero tests_dual.top_double_complement)

lemma pre_test_one:
  "-p\<guillemotleft>1 = -p"
  by (metis pre_test tests_dual.complement_top tests_dual.sup_right_unit)

subclass precondition_test_test
  apply unfold_locales
  by (simp add: pre_test tests_dual.sub_associative)

subclass precondition_promote
  apply unfold_locales
  by (metis pre_seq pre_test tests_dual.sup_idempotent)

proposition pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=6] oops
proposition pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=2] oops

end

class precondition_distr_mult = precondition +
  assumes pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)"
begin

proposition pre_test_test: "-p*(-p\<guillemotleft>-q) = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test_promote: "-p\<guillemotleft>-q = -p\<guillemotleft>-p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=2] oops

end

class precondition_distr_plus = precondition +
  assumes pre_distr_plus: "x\<guillemotleft>-p\<squnion>-q = (x\<guillemotleft>-p)\<squnion>(x\<guillemotleft>-q)"
begin

proposition pre_test_test: "-p*(-p\<guillemotleft>-q) = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test_promote: "-p\<guillemotleft>-q = -p\<guillemotleft>-p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = --p\<squnion>-q" nitpick [expect=genuine,card=2] oops
proposition pre_test: "-p\<guillemotleft>-q = -p*-q" nitpick [expect=genuine,card=2] oops
proposition pre_distr_mult: "x\<guillemotleft>-p*-q = (x\<guillemotleft>-p)*(x\<guillemotleft>-q)" nitpick [expect=genuine,card=4] oops

end

end


(*  Title       : CStar.thy
    Author      : Jacques D. Fleuriot
    Copyright   : 2001 University of Edinburgh
*)

section{*Star-transforms in NSA, Extending Sets of Complex Numbers
      and Complex Functions*}

theory CStar
imports NSCA
begin

subsection{*Properties of the *-Transform Applied to Sets of Reals*}

lemma STARC_hcomplex_of_complex_Int:
     "*s* X Int SComplex = hcomplex_of_complex ` X"
by (auto simp add: Standard_def)

lemma lemma_not_hcomplexA:
     "x \<notin> hcomplex_of_complex ` A ==> \<forall>y \<in> A. x \<noteq> hcomplex_of_complex y"
by auto

subsection{*Theorems about Nonstandard Extensions of Functions*}

lemma starfunC_hcpow: "!!Z. ( *f* (%z. z ^ n)) Z = Z pow hypnat_of_nat n"
by transfer (rule refl)

lemma starfunCR_cmod: "*f* cmod = hcmod"
by transfer (rule refl)

subsection{*Internal Functions - Some Redundancy With *f* Now*}

(** subtraction: ( *fn) - ( *gn) = *(fn - gn) **)
(*
lemma starfun_n_diff:
   "( *fn* f) z - ( *fn* g) z = ( *fn* (%i x. f i x - g i x)) z"
apply (cases z)
apply (simp add: starfun_n star_n_diff)
done
*)
(** composition: ( *fn) o ( *gn) = *(fn o gn) **)

lemma starfun_Re: "( *f* (\<lambda>x. Re (f x))) = (\<lambda>x. hRe (( *f* f) x))"
by transfer (rule refl)

lemma starfun_Im: "( *f* (\<lambda>x. Im (f x))) = (\<lambda>x. hIm (( *f* f) x))"
by transfer (rule refl)

lemma starfunC_eq_Re_Im_iff:
    "(( *f* f) x = z) = ((( *f* (%x. Re(f x))) x = hRe (z)) &
                          (( *f* (%x. Im(f x))) x = hIm (z)))"
by (simp add: hcomplex_hRe_hIm_cancel_iff starfun_Re starfun_Im)

lemma starfunC_approx_Re_Im_iff:
    "(( *f* f) x @= z) = ((( *f* (%x. Re(f x))) x @= hRe (z)) &
                            (( *f* (%x. Im(f x))) x @= hIm (z)))"
by (simp add: hcomplex_approx_iff starfun_Re starfun_Im)

end


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_prop_32
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun rotate :: "Nat => 'a list => 'a list" where
  "rotate (Z) z = z"
| "rotate (S z2) (nil2) = nil2"
| "rotate (S z2) (cons2 x2 x3) =
     rotate z2 (x x3 (cons2 x2 (nil2)))"

fun length :: "'a list => Nat" where
  "length (nil2) = Z"
| "length (cons2 z xs) = S (length xs)"

theorem property0 :
  "((rotate (length y) y) = y)"
  oops

end


theory Simdpll
imports Main

begin
datatype 'a Option      =  None | Some 'a
type_synonym    Literal =  int
type_synonym  Clause    =  "Literal list"
type_synonym Formula    =  "Clause list"
type_synonym Model      =  "int list"

fun negateLiteral :: "(Literal) \<Rightarrow>  Literal "
where
"negateLiteral  a =   (-1*a)"

fun deOption::"(Formula) Option \<Rightarrow> Formula"
where
"deOption None = undefined"
|
"deOption (Some f) =  f"

fun findUnit :: "Formula \<Rightarrow> (Literal) Option "
where
"findUnit [] = None"
|
"findUnit (c#cs) = (if length c = 1 then Some (hd c) else findUnit cs)"

fun notElem :: "(Literal) \<Rightarrow> Clause \<Rightarrow> bool"
where
"notElem _ [] = True"
|
"notElem p (x#xs) = (if p=x then False else notElem p xs)"

fun elem :: "Clause \<Rightarrow> Formula \<Rightarrow>bool"
where
"elem _ [] = False"
|
"elem p (x#xs) = (if p=x then True else elem p xs)"

(*should work on termination of this function *)
fun resolve ::"Formula \<Rightarrow> Literal \<Rightarrow> Formula"
where
"resolve f literal =  (let  q = filter (notElem literal) f in map (removeAll (negateLiteral literal)) q)"

(*second section of case has problem*)
function  unitPropagate:: "Formula \<Rightarrow> Formula "
where
"unitPropagate f = (case (findUnit f) of None \<Rightarrow>  f  | Some a \<Rightarrow> unitPropagate (resolve f a))"
by pat_completeness auto

lemma ter: "findUnit f = Some x \<Longrightarrow> length (filter (notElem x) f) < length f"
proof (induction f)
  case Nil
  then show ?case by simp
next
  case Cons
  fix f a
  assume
    prems: "findUnit (a # f) = Some x" and
    IH: "findUnit f = Some x \<Longrightarrow> length (filter (notElem x) f) < length f"
  then show "length (filter (notElem x) (a # f)) < length (a # f)"
  proof (cases "notElem x a")
    case
      H1: True
    then show ?thesis
    proof (cases "findUnit f = Some x")
      case True
      with IH show ?thesis by simp
    next
      case False
      then have "Some (hd a) = Some x" "length a = 1"
        using findUnit.simps prems by presburger+
      then have "\<not> notElem x a" by (induction a) simp_all
      with H1 show ?thesis by simp
    qed
  next
    case False
    then show ?thesis by (simp add: le_imp_less_Suc)
  qed
qed

termination
apply (relation "measure (\<lambda>x. size x)")
apply (auto)
apply (simp add: ter)
done

lemma [fundef_cong]:"(\<not>Q' \<Longrightarrow>  P=P') \<Longrightarrow> (Q=Q') \<Longrightarrow> (P \<or> Q)=(P'\<or> Q')"
by blast

function dpll:: "Formula \<Rightarrow> bool"
where
"dpll f = (if f = [] then True else if (elem [] f) then False else (let ff = unitPropagate f in(let nextLiteral = hd( hd f) in  dpll (resolve f (negateLiteral nextLiteral)) \<or>  dpll (resolve f nextLiteral))))"
by pat_completeness auto

lemma ter2: "f \<noteq> [] \<Longrightarrow> \<not> elem [] f \<Longrightarrow> length (filter (notElem (hd (hd f))) f) < length f"
proof (induction f)
case Nil
then show ?case by simp
next
  case Cons
  fix f a
 assume
    prems: "(a#f) \<noteq> []" and
    premss: " \<not> elem [] (a#f)" and
    IM: "f \<noteq> [] \<Longrightarrow> \<not> elem [] f \<Longrightarrow> length (filter (notElem (hd (hd f))) f) < length f"
    then show "length (filter (notElem (hd (hd (a#f)))) (a#f)) < length (a#f)"
    proof (cases "notElem (hd (hd (a#f))) a")
    case
    H1: True
    then show ?thesis
    proof (cases "(a#f) \<noteq> []")
    case True
    then show ?thesis
    proof (cases"\<not> elem [] (a#f)" )
    case True
    then show ?thesis by (metis H1 elem.simps(2) list.sel(1) notElem.elims(2))
      next
    case False
    then show ?thesis using premss by blast
qed
  next
    case False
        then show ?thesis by simp
        qed
next
case False
then show ?thesis by (simp add: filter.simps(2) le_imp_less_Suc length_Cons length_filter_le)
qed
qed

lemma elim:"dpll_dom (map (removeAll (- hd (hd (a # f)))) (filter (notElem (hd (hd (a # f)))) (a # f))) \<Longrightarrow> length (filter (notElem (- hd (hd (a # f)))) (a # f)) < length (a # f)"
apply (induction  rule: "dpll.pinduct")
sorry
lemma ter3: "f \<noteq> [] \<Longrightarrow>
         \<not> elem [] f \<Longrightarrow>
          \<not> dpll (map (removeAll (- hd (hd f))) (filter (notElem (hd (hd f))) f)) \<Longrightarrow>
         dpll_dom (map (removeAll (- hd (hd f))) (filter (notElem (hd (hd f))) f)) \<Longrightarrow>
         length (filter (notElem (- hd (hd f))) f) < length f"
proof(induction f)
case Nil
then show ?case by simp
next
case Cons
fix
f a
assume
prems: "(a#f) \<noteq> []" and
premss : "\<not> elem [] (a#f)"and
premsss : "\<not> dpll (map (removeAll (- hd (hd (a#f)))) (filter (notElem (hd (hd (a#f)))) (a#f)))"and
premssss: "dpll_dom (map (removeAll (- hd (hd (a#f)))) (filter (notElem (hd (hd (a#f)))) (a#f)))"and
IM: "f \<noteq> [] \<Longrightarrow>
         \<not> elem [] f \<Longrightarrow>
         \<not> dpll (map (removeAll (- hd (hd f))) (filter (notElem (hd (hd f))) f)) \<Longrightarrow>
         dpll_dom (map (removeAll (- hd (hd f))) (filter (notElem (hd (hd f))) f)) \<Longrightarrow>
         length (filter (notElem (- hd (hd f))) f) < length f"

then show " length (filter (notElem (- hd (hd (a#f)))) (a#f)) < length (a#f)"
proof (cases "notElem (- hd (hd (a#f))) a")
case
H1: True
then show ?thesis
proof(cases "(a#f) \<noteq> []")
case
True
then show ?thesis
proof (cases "\<not> elem [] (a#f)")
case True
then show ?thesis
proof (cases "\<not> dpll (map (removeAll (- hd (hd (a#f)))) (filter (notElem (hd (hd (a#f)))) (a#f)))")
case True
then show ?thesis
proof (cases "dpll_dom (map (removeAll (- hd (hd (a#f)))) (filter (notElem (hd (hd (a#f)))) (a#f)))")
case True
then show ?thesis using elim  by simp
next
case False
then show ?thesis using premssss by blast
qed
next
case False
then show ?thesis using premsss by linarith
qed
next
case False
then show ?thesis using premss by linarith
qed
next case False
then show ?thesis by simp
qed
next case False
then show ?thesis by (simp add: filter.simps(2) le_imp_less_Suc length_Cons length_filter_le)
qed
qed

termination
apply (relation "(measure (length))")
apply auto
apply (simp add:ter2)
apply (simp add:ter3)
done

value "dpll [[1],[2],[(-1),(-2)]]"
value "dpll [[-1]]"
value "dpll []"

(*============================================================================================*)
fun validModel::"Model \<Rightarrow> bool"
where
"validModel [] = True"
|
"validModel (m#rest) =(if m > 0 then True \<and> validModel rest else False  \<and> validModel rest)"

fun evalLiteral::"Literal \<Rightarrow> Model \<Rightarrow> bool"
where
"evalLiteral l [] = (if l>0 then False else True)"
|
"evalLiteral l (m#ms) = (if (l > 0 ) \<and> (l = m) then True else if ((l < 0) \<and> ((-1*l) = m)) then False else evalLiteral l ms)"

fun evalClause::"Clause \<Rightarrow> Model \<Rightarrow> bool"
where
"evalClause [] m = False"
|
"evalClause (l#ls) m = ((evalLiteral l m) \<or> evalClause ls m)"

fun eval'::"Formula \<Rightarrow>Model \<Rightarrow>bool"
where
"eval' [] m = True"
|
"eval' (c#cs) m = (((evalClause c m) \<and> (eval' cs m)))"

end


theory Prelude_Bool
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"NotFalse\", \"NotTrue\", \"AndFalse\", \"AndTrue\", \"AndSym\",
     \"OrDef\", \"OtherwiseDef\", \"NotFalse1\", \"NotTrue1\",
     \"notNot1\", \"notNot2\"]"

typedecl Bool

consts
Not__X :: "bool => bool" ("(Not''/ _)" [56] 56)
X__XAmpXAmp__X :: "bool => bool => bool" ("(_/ &&/ _)" [54,54] 52)
X__XVBarXVBar__X :: "bool => bool => bool" ("(_/ ||/ _)" [54,54] 52)
otherwiseH :: "bool"

axioms
NotFalse [rule_format] : "Not' False"

NotTrue [rule_format] : "~ Not' True"

AndFalse [rule_format] : "ALL x. ~ False && x"

AndTrue [rule_format] : "ALL x. True && x = x"

AndSym [rule_format] : "ALL x. ALL y. x && y = y && x"

OrDef [rule_format] :
"ALL x. ALL y. x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH"

declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare OtherwiseDef [simp]

theorem NotFalse1 : "ALL x. Not' x = (~ x)"
by (auto)

ML "Header.record \"NotFalse1\""

theorem NotTrue1 : "ALL x. ~ Not' x = x"
by (auto)

ML "Header.record \"NotTrue1\""

theorem notNot1 : "ALL x. (~ x) = Not' x"
by (auto)

ML "Header.record \"notNot1\""

theorem notNot2 : "ALL x. (~ ~ x) = (~ Not' x)"
apply(auto)
apply(case_tac x)
apply(auto)
done

ML "Header.record \"notNot2\""

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_10
  imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun t2 :: "Nat => Nat => Nat" where
  "t2 (Z) y = Z"
| "t2 (S z) (Z) = S z"
| "t2 (S z) (S x2) = t2 z x2"

theorem property0 :
  "((t2 m m) = Z)"
  oops

end


theory Old_Untyped_Set
imports Main
begin

section {* Untyped Set Theory as in TLA+ *}

subsection {* Basic Setup *}

definition unique_unsafe :: "('a \<Rightarrow> bool) \<Rightarrow> 'a" where
  "unique_unsafe P = (if \<exists>x. P x then The P else Nitpick.unknown)"

typedecl u

nitpick_params [user_axioms, dont_box, show_all, atoms u = a b c d e f g h i j k l]

subsection {* Set Membership *}

axiomatization
  emptyset :: u and
  mem :: "u \<Rightarrow> u \<Rightarrow> bool" (infix "\<in>#" 50)
where
  emptyset: "\<And>x. \<not> x \<in># emptyset" and
  mem_ext: "\<And>A B. A = B \<or> (\<exists>x. \<not> (x \<in># A \<longleftrightarrow> x \<in># B))" and
  mem_acyclic: "\<And>A. \<not> tranclp (op \<in>#) A A"

nitpick_params [card = 1-8, eval = "\<lambda>x. {y. y \<in># x}", format mem = 2]

lemma "x \<in># A"
  nitpick [expect = genuine]
  oops

lemma "\<not> x \<in># A"
  nitpick [expect = genuine]
  oops

lemma "x \<in># x"
  nitpick [expect = genuine]
  oops

lemma "\<not> x \<in># x"
  nitpick [expect = none]
  sorry

lemma "x \<in># y \<Longrightarrow> \<not> y \<in># x"
  nitpick [expect = none]
  sorry

lemma "x \<in># y \<Longrightarrow> y \<in># z \<Longrightarrow> \<not> z \<in># x"
  nitpick [expect = none]
  sorry

subsection {* Quantifiers *}

text \<open>
Nunchaku will look for finite models of @{type u}. Universal quantification
@{prop "\<forall>x :: u. P x"} in the original problem must be translated to
@{text "false asserting exists x : u. ~ P x"} to account for the incompleteness
of @{type u} w.r.t. the ZF universe it approximates, unless there is a guard
@{text "x \<in># \<dots>"} in @{prop "P x"}, in which case @{prop "\<forall>x :: u. P x"} can be
left alone.
\<close>

definition All_u :: "(u \<Rightarrow> bool) \<Rightarrow> bool" where
  "All_u P = (\<forall>x. P x \<and> Nitpick.unknown)"

(* use All_u? *)
lemma "\<forall>x. \<not> x \<in># emptyset"
  nitpick [satisfy, expect = genuine]
  nitpick [expect = none]
  sorry

lemma "\<exists>u. All_u (\<lambda>x. x \<in># u)"
  nitpick [satisfy, expect = none]
  nitpick [expect = genuine]
  sorry

lemma "(SOME x. \<not> x \<in># A) \<in># A"
  nitpick [expect = genuine]
  nitpick [satisfy, expect = none]
  oops

lemma "\<not> (SOME x. \<not> x \<in># A) \<in># A"
  nitpick [expect = none]
  sorry

subsection {* Subset *}

definition
  subseteq :: "u \<Rightarrow> u \<Rightarrow> bool" (infix "\<subseteq>#" 50)
where
  "subseteq A B \<longleftrightarrow> (\<forall>x. x \<in># A \<longrightarrow> x \<in># B)"

subsection {* Functions *}

axiomatization
  dom :: "u \<Rightarrow> u" and
  app :: "u \<Rightarrow> u \<Rightarrow> u" (infixl "\<cdot>" 70)
where
  app_ext: "\<And>f g. dom f = dom g \<and> (\<forall>x. x \<in># dom f \<longrightarrow> f \<cdot> x = g \<cdot> x) \<longrightarrow> f = g"

abbreviation mapsto :: "u \<Rightarrow> (u \<Rightarrow> u) \<Rightarrow> u" where
  "mapsto A f \<equiv> unique_unsafe (\<lambda>g. dom g = A \<and> (\<forall>x. x \<in># A \<longrightarrow> g \<cdot> x = f x))"

lemma "f = mapsto (dom f) (op \<cdot> f)"
  nitpick [expect = none]
  sorry

subsection {* Powerset *}

definition
  Pow :: "u \<Rightarrow> u"
where
  "Pow B = unique_unsafe (\<lambda>C. \<forall>A. A \<in># C \<longleftrightarrow> A \<subseteq># B)"

lemma "A \<in># Pow B"
  nitpick [expect = genuine]
  oops

lemma "\<not> A \<in># Pow B"
  nitpick [expect = genuine]
  oops

lemma "A \<in># Pow A"
  nitpick [expect = none]
  sorry

lemma "A \<subseteq># Pow A"
  nitpick [expect = genuine]
  oops

subsection {* Big Union *}

definition
  Union :: "u \<Rightarrow> u"
where
  "Union B = unique_unsafe (\<lambda>C. \<forall>x. x \<in># C \<longleftrightarrow> (\<exists>A. x \<in># A \<and> A \<in># B))"

lemma "A \<in># Union A"
  nitpick [expect = genuine]
  oops

lemma "\<not> A \<in># Union A"
  nitpick [expect = none]
  sorry

lemma "A = Union (Pow A)"
  nitpick [expect = none]
  sorry

end


(* Author: Andreas Lochbihler, ETH Zurich *)

section \<open>Examples of applicative lifting\<close>

subsection \<open>Algebraic operations for the environment functor\<close>

theory Applicative_Environment_Algebra imports
  Applicative_Environment
  "~~/src/HOL/Library/Function_Division"
begin

text \<open> Link between applicative instance of the environment functor with the pointwise operations
  for the algebraic type classes \<close>

context begin interpretation applicative_syntax .

lemma plus_fun_af [applicative_unfold]: "f + g = pure op + \<diamondop> f \<diamondop> g"
unfolding plus_fun_def const_def apf_def ..

lemma zero_fun_af [applicative_unfold]: "0 = pure 0"
unfolding zero_fun_def const_def ..

lemma times_fun_af [applicative_unfold]: "f * g = pure op * \<diamondop> f \<diamondop> g"
unfolding times_fun_def const_def apf_def ..

lemma one_fun_af [applicative_unfold]: "1 = pure 1"
unfolding one_fun_def const_def ..

lemma of_nat_fun_af [applicative_unfold]: "of_nat n = pure (of_nat n)"
unfolding of_nat_fun const_def ..

lemma inverse_fun_af [applicative_unfold]: "inverse f = pure inverse \<diamondop> f"
unfolding inverse_fun_def o_def const_def apf_def ..

lemma divide_fun_af [applicative_unfold]: "divide f g = pure divide \<diamondop> f \<diamondop> g"
unfolding divide_fun_def const_def apf_def ..

end

end


theory Heap
imports Terms "DistinctVars-Nominal" "Nominal-Utils"
begin

subsubsection {* Conversion from assignments to heaps *}

text {* The type @{typ assn} is the data type used in the let expression. It
is isomorphic to @{typ "(var \<times> exp) list"}, but since Nominal does not
support nested data type, this redundancy was introduced. The following
function converts between them. Once Nominal supports nested data types, this
could be simplified. *}

nominal_function asToHeap :: "assn \<Rightarrow> heap"
 where ANilToHeap: "asToHeap ANil = []"
 | AConsToHeap: "asToHeap (ACons v e as) = (v, e) # asToHeap as"
unfolding eqvt_def asToHeap_graph_aux_def
apply rule
apply simp
apply rule
apply(case_tac x rule: exp_assn.exhaust(2))
apply auto
done

nominal_termination (eqvt) by lexicographic_order

lemma asToHeap_eqvt: "eqvt asToHeap"
  unfolding eqvt_def
  by (auto simp add: permute_fun_def asToHeap.eqvt)

lemma set_bn_to_atom_heapVars:
  "set (bn as) = atom ` heapVars (asToHeap as)"
   apply (induct as rule: asToHeap.induct)
   apply (auto simp add: exp_assn.bn_defs)
   done

lemma fresh_assn_distinct:
 assumes "set (bn as) \<sharp>* \<Gamma>"
 shows "heapVars (asToHeap as) \<inter> heapVars \<Gamma> = {}"
 using assms
by (metis set_bn_to_atom_heapVars fresh_heapVars_distinct)

lemma distinctVars_append_asToHeap:
  assumes "distinctVars (asToHeap as)"
  assumes "distinctVars \<Gamma>"
  assumes "set (bn as) \<sharp>* \<Gamma>"
  shows "distinctVars (asToHeap as @ \<Gamma>)"
by(rule distinctVars_appendI[OF assms(1,2) fresh_assn_distinct[OF assms(3)]])

end