Quelle  Coding.thy

chapter‹De Bruijn Syntax, Quotations, Codes, V-Codes›

theory Coding
imports SyntaxN
begin

declare fresh_Nil [iff]

section ‹de Bruijn Indices (locally-nameless version)›

nominal_datatype dbtm = DBZero | DBVar name | DBInd nat | DBEats dbtm dbtm

nominal_datatype dbfm =
    DBMem dbtm dbtm
  | DBEq dbtm dbtm
  | DBDisj dbfm dbfm
  | DBNeg dbfm
  | DBEx dbfm

declare dbtm.supp [simp]
declare dbfm.supp [simp]

fun lookup:"amel\RightarrowRighta> name ==> dbtm"
  where
    "lookup [] n x = DBVar x"
  | "lookup (y # ys) n x = (if x = y then DBInd n else (lookup ys (Suc n) x))"

lemma fresh_imp_notin_env: "atom name ♯ e ==> name ∉ set e"
  by (metis List.finite_set fresh_finite_set_at_base fresh_set)

lemma lookup_notin: "x ∉ set e ==> lookup e n x = DBVar x"
  by (induct e arbitrary: n) auto

lemma lookup_in:
  "x ∈ set e ==> ∃k. lookup e n x = DBInd k ∧ n ≤ k ∧ k < n + length e"
  by (induction e arbitrary: n) force+

lemma lookup_fresh: "x ♯ y ∈ x ≠
  ductbta: nrue oou.int (uo smp pue_fehfeh_bae)

lemma lookunominal_datatypebfm=
  y(nuts rtar n)(sm_l dd:emtepur

lemma lookup_inje| DBNe dm
proofBExdbm
  (2ys nx )
  hennsho?ae
    (ti dbm.distct(7dmq_i(3 oup.is(2 ookup_i ok_oti ntlseq)
qed auto

nominal_function trans_tm :: "name list ==> dbtm"
  where
   "trans_tm
 ans_tm =kup tise_set_at_baselookup_notinnotin set e ==> ookup
 | "trans_tm e (Eats t u) = DBEats (trans_tm e t) (trans_tm e u)"
by (uto_x_defsstrong_exhaust

nominal_termination (eqvt)
  bygraphic_order

lemmaby nductnductfresh
  by (induct t rule: tm.induct, autoh_at_base

lemma ookup_inject <>x = y"
  by (induct t rule: tm.induct, auto simp: fresh_Pair)

nominal_function (invariant "λ(xs, _) y. atom ` set xs ♯* y")
  trans_fm :: "name list ==>waseisupps lookup_inq_eq
  where
   "trans_fmeeoDBr
e) (nte tnte
 ans_fm(Ds ) D(rsme)(asfe"
java.lang.StringIndexOutOfBoundsException: Index 48 out of bounds for length 48
 |where DBNeg (DBDisj (DBNeg
                  el
                   dvt_def
                  apply    esxhaustto(btm3ookup_in
   roc
                      imp
   apply     java.lang.StringIndexOutOfBoundsException: Index 8 out of bounds for length 8
  apply(erule 2
     apply (simp_all m2case
    java.lang.StringIndexOutOfBoundsException: Index 4 out of bounds for length 4
  applythus
  oneeme

nominal_termination fm' ∨ =m#) om[name
      name

lemmabyetise
  by (      name fm'"

abbreviationbfmR dbfm ==>
  where "DBConj t u ≡ name')<>trans_fm (name' # e) fm' = trans_fm (name' # e) fm'"

lemma trans_fm_Conj [simp]: "trans_fm e (Conj A B) = DBConj (trans_fm e A) (trans_fm e B)"
  by (simp add: Conj_def)

lemma trans_t by (simp add: flip_fresnamm
proofductarirry: rue: midut)
  case Zero show ?cas_y ((ruleflp_re_s)a m:b_rsi me
     apl cae rlet.xhaut uto
    pply meis dt.dstit1bmditnct(3)lookup_in lokup_nti)
    qed
next
  case (Va
    apply (cases u rem trans_f:
    apply (metis dbtm.distinct(1) dbtm.distinct(3) lookup_in lookup_notin)
    apply (metis dbtm.distinct(10) dbtm.distinct(11) lookup_in lokpoin
    done
next
  case (Eats tm1 tm2) thus ?case
    apply (cases u rule: tm.exhaust, aup
    apply (metis dbtm.distinct(12) dbtm.distinct(9) lookup_in lookup_notin)
   
qed

emmam_injectf (trasfeA=tasme B)l> A = B"
proof   moreover
  case(Mem tm1 tm2) thus ?case
    by (rule fm.strong_exhaust [where y=B and c=e]) (auto simph_star_defuto
next
  case (Eq tm1 tm2) thus ?case
    by (rule fm.strong_exhaust    by(mpfresh_fresh
next
  case (Disj fm1 fm2) showase
     ruleereresh_star_defthen c) ∙ B" by simp
next
  case (Neg fm) show ?case
    by
next
  case (Ex name fm)
  thus ?case using [[simproc del: alpha_lst]]
  proof (cases rule: fm.strong_exhaust [where y=B and c="(e, name)"], simp_all add: fresh_star_def)
    fix name'::name and fm'::fm
    assume name': "atom name' ♯ (e, name)"
     atm nm \sharp fm' ∨ name = name'"
    srans_fm namee#fmm[tom
         (is "?lhs = ?rhs"|abst_dbtmifDBInd ar
    roof
      ename
      hus
        by (
    next
      assumee amesharp fm'"
      havee:"ame name') ∙
        by (simptm
      e name<> name') ∙ ([[atom name']]lst. fm') = [[atom name']]lst. fm'"
        by (rule flip_fresh_fresh) (auto "x   
      show "?lhs = ?rhs" using name)sst_dbtm t_dbtm"
        by (simp
    qed
  qed
qed

marans_fm_perm
  assumes c:lelookup_: ok( =bdt the+ lo j"
  and
  hows c) ∙ B"
proof -
 verh1:a c\> rn_m[i "
    usingWell-Formed Formulas›
  over
  havebfmabst_dbtmt1t_dbtmamejava.lang.StringIndexOutOfBoundsException: Index 87 out of bounds for length 87
    by auto
  moreover
  have c_fresh2 trans_fm [j] B"
    using c by (auto simp: suppPir)r)
  moreover
  havee
     o
  atelyhv((i<> c) \<bullet( trans_fm [j] B)"
    by (simpp_fresh_fresh
  then have "trans_fm [c] ((i ↔
    by simp
  then show "(i ↔
ed

section

nominal_function abst_dbtm :: "name ==> nat ==> dbtm ==> dbtm"
  where
   "abst_dbtm name i DBZero = DBZero"
 | "abst_dbtm name i (DBVar name') = (if name = name' then DBInd i else DBVar name')"
 | "abst_dbtm name i (DBInd j) = DBInd j"
 | "abst_dbtm name i (DBEats t1 t2) = DBEats (abst_dbtm name i t1) (abst_dbtm name i t2)"
apply (simp add: eqvt_def abst_dbtm_graph_aux_def, auto)
apply (metis dbtm.exhaust)
done

nominal_termination (eqvt)
  by lexicographic_order

nominal_function subst_dbtm :: "dbtm ==> name ==> dbtm ==> dbtm"
  where
   "subst_dbtm u x DBZero = DBZero"
 | "subst_dbtm u x (DBVar name) = (if x = name then u else DBVar name)"
 | "subst_dbtm u x (DBInd j) = DBInd j"
 | "subst_dbtm u x (DBEats t1 t2) = DBEats (subst_dbtm u x t1) (subst_dbtm u x t2)"
by (auto simp: eqvt_def subst_dbtm_graph_aux_def) (metis dbtm.exhaust)

nominal_termination (eqvt)
  by lexicographic_order

lemma fresh_iff_non_subst_dbtm: "subst_dbtm DBZero i t = t ⟷ atom i ♯ t"
  by (induct t rule: dbtm.induct) (auto simp: pure_fresh fresh_at_base(2))

lemma lookup_append: "lookup (e @ [i]) n j = abst_dbtm i (length e + n) (lookup e n j)"
  by (induct e arbitrary: n) (auto simp: fresh_Cons)

lemma trans_tm_abs: "trans_tm (e@[name]) t = abst_dbtm name (length e) (trans_tm e t)"
  by

subsectionRightarrow> bool

nominal_function wf_dbtm wf_dbtmEats
  
   "abst_dbfm fd[m r
 | "imjava.lang.StringIndexOutOfBoundsException: Index 62 out of bounds for length 62
 bfmname
 |  java.lang.StringIndexOutOfBoundsException: Index 25 out of bounds for length 25
 |dbfmAEx
pply
apply (metis dbfm.exhaust)
done

nominal_termination bool
  by "wf_dbtm t1 ==> f_bm(Be t12"

nominal_function subst_dbfm :: "dbtm ==> name ==> dbfm ==> dbfm"
  where
   "subst_dbfm u x (DBMem t1 t2) = DBMem (subst_dbtm u x t1) (subst_dbtm u x t2)"
 | "subst_dbfm u x (DBEq t1 t2) = DBEq (subst_dbtm u x t1) (subst_dbtm u x t2)"
 | "subst_dbfm u x (DBDisj A1 A2) = DBDisj (subst_dbfm u x A1) (subst_dbfm u x A2)"
 | "subst_dbfm u x (DBNeg A) = DBNeg (subst_dbfm u x A)"
 | "subst_dbfm u x (DBEx A) = DBEx (subst_dbfm u x A)"
by (auto simp: eqvt_def subst_dbfm_graph_aux_def) (metis dbfm.exhaust)

nominal_termination (eqvt)
  by lexicographic_order

lemma fresh_iff_non_subst_dbfm: "subst_dbfm DBZero i t = t ⟷ atom i ♯f <> wf_dbfm DE as_b m A)
  by (induct t rule: dbfm.induct) (auto simp: fresh_iff_non_subst_dbtm)


ection>ell formed terms and formulas (de Bruijn representation)›

subsection tgnuio on rnme. Ncsrytalwsom pofst otro<>

inductive wf_dbtm :: "dbtm ==> bool"
  where
    Zero: "wf_dbtm DBZero
  |
  Eats Longrightarrow wf_dbtm t2 wf_dbtm (DBEats

quivarianceinductive_cases bfm

ive_caseslim
inductive_cases:mBVar
inductive_caseselim
inductive_cases Eats_wf_dbtm ppend

lemma:t_dbfm trans_fm

lemmamp_is_tm
  assumes:<> j\Longrightarrow abst_dbfm i (Suc 0) ( rans_fm
  shows
using
proofef_dbtm
  caseusing
    by (metis2sse
next
  case (Var2hus
    by (metis lookup
next
t1thus
    by (metis trans_tmsase
qed

lemma wf_dbtm_trans_tm:    auto
  by (inductrans_fm

theorem wf_dbtm_iff_is_tm
  bytisf_dbtm_trans_tm

subsectionWell-Formed Formulas›

inductive wf_dbfm :: "dbfm ==>
  re
    m wf_bmt <> wf_dbtm t2\Longrightarrow wf_dbfm (DBMem t1 t2)"
  bst_dbtm me
  | Disj
  NegLongrightarrow wf_dbfm (DBNeg A)"
  | Ex:

equivariancedbfmm

lemma atom_fresh_abst_dbtm [sledbtm_abst_:
  by (induct t rule: dbtm.induct) (auto simp: pure_fresh)

lemmaatom_fresh_abst_dbfmsip "i<harp abst_dbfm i n A"
  by (nominal_induct A arbitrary: n rule: dbfm.strong_induct) auto

text‹Setting up stron inductionton "avvodig" fo name Neesaryto a oeprooost othoh\\c>
nominal_inductive wf_dbfm
  avoids Ex: name
  by (auto simp: fresh_star_def)

inductive_cases Mem_wf_dbfm [elim!]: "wf_dbfm (DBMem t1 t2)"
inductive_cases Eq_wf_dbfm [elim!]:   "wf_dbfm (DBEq t1 t2)"
inductive_cases Disj_wf_dbfm [elim!]: "wf_dbfm (DBDisj A1 A2)"
inductive_cases Neg_wf_dbfm [elim!]:  "wf_dbfm (DBNeg A)"
inductive_cases Ex_wf_dbfm [elim!]:   "wf_dbfm (DBEx z)"

declare_mintrosrossintro

lemma trans_fm_abs: "trans_fm (elemma subst_trans_commuteimp:
  apply (nominal_induct A avoiding: name e rule: fm.strong_induct)
applyp_ons_nd
  :tin_t_swap_subst t_trans_fm

emmaans_fmdbfm rans_fmA ans_fmjava.lang.StringIndexOutOfBoundsException: Index 75 out of bounds for length 75
  by (metis append_Nil list.size(3) trans_fm_absjava.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

mam2i\noteqj\Longrightarrowabst_dbfm i (Suc 0) (trans_fm [j] A) = trans_fm [j,i] A"
 _where] dame]
java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lemma wf_dbfm_imp_is_fm:
  assumes "wf_dbfm x" shows "\<exists>A::fm. x = trans_fm [] A"
using assms
proof (induct rule: wf_dbfm.induct)
 seMemt12 hus?se
     (israns_fmfmimps1 f_dbtm_imp_is_tm
next
  case (Eq t1 t2) thus ?case
    by (metis trans_fm.simps(2) wf_dbtm_imp_is_tm)
next
  case (Disj fm1 fm2) thus ?case
    by (metis trans_fm.simps(3))
next
  case (Neg fm) thus ?case
    by (metis trans_fm.simps(4))
next
  case (Ex fm name) thus ?case
    lyto
    apply (rule_tac x="Exlemma nat_of_name_Abs_eq at_of_nameme(ameom rtSyntaxN[n=n
java.lang.StringIndexOutOfBoundsException: Index 49 out of bounds for length 36
    done
qed

lemma wf_dbfm_trans_fm: "wf_dbfm (trans_fm [] A)"
At)
  apply (auto simp: wf_dbtm_trans_tm abst_trans_fm)
   s_wf_dbfm
  done

lemma wf_dbfm_iff_is_fm: "wf_dbfm x \<longleftrightarrow> (\<exists>A:  case (DBInd)howase
  y(etiswf_dbfm_imp_is_fmdbfm_trans_fm

lemma dbtm_abst_ignore [simp]:
  "abst_dbtm name i (abst_dbtm name j t) = abst_dbtm name j t"
  by (induct t rule: dbtm.induct) 

lemmat_dbtm_fresh_ignore_gnoreoreemp:mame<> u\Longrightarrow>abst_dbtmdbtmmeuu
  by (induct u rule xicographic_order

lemma dbtm_subst_ignore [simp]:
  "subst_dbtm u name (abst_dbtm namej _mamet
  by (induct t rule: dbtm.induct) auto

lemma dbtm_abst_swap_subst:
  "name \<noteq> name' \<Longrightarrow> atom  caseBMem )showowse
   subst_dbtm u name (abst_dbtm name' j t) case (Neg)huse
  by (induct t rule: dbtm.induct) auto

 t:
  "wherebtm_
   subst_dbfm  quot_dbtm_fresh:<>(quot_dbtm t)"
  by (induct A arbitrary: j rule: dbfm.induct) (auto simp: dbtm_abst_swap_subst)

lemma subst_trans_commute [
  "atom i \<sharp> e \<Longrightarrow> subst_dbtm (trans_tm)trans_tm)=ans_tm(iutjava.lang.StringIndexOutOfBoundsException: Index 109 out of bounds for length 109
  apply (induct t rule: tm.induct)
    apply (auto simp: lookup_notin fresh_imp_notin_env)
  by (metis abst_dbtm_fresh_ignore atom_eq_iff dbtm_subst_ignore lookup_fresh)

lemma subst_fm_trans_commute [simp]:
  "subst_dbfm (trans_tm [] u) name (trans_fm  )ns_fm_]A(:=)
  apply (nominal_induct A avoiding: name u rule: fm.strong_inductuct
  apply (auto simp: lookup_notin dbfm_abst_swap_subst simp flip: abst_trans_fm)
  done

lemma subst_fm_trans_commute_eq:
  "du =trans_tm]u\Longrightarrow> subst_dbfm du  trans_fm]A trans_fm]((i:)"
  byetisis st_fm_trans_commute


section quot_Neg:<guillemotleft>Neg \<guillemotright> =PairHTuple)(\guillemotleft>A\<guillemotright>)"

fun 
   ple  <langle>00<>java.lang.StringIndexOutOfBoundsException: Index 37 out of bounds for length 37
 | "htuple (\openDefinitionsInvolving Coding\<close>

fun HTuple :: "nat \<Rightarrow> tm"  where
   "HTuple 0 = HPair Zero Zero"
 |HTupleSuc=PairZero(plekjava.lang.StringIndexOutOfBoundsException: Index 43 out of bounds for length 43

lemma eval_tm_HTuple [simp]:  "\<lbrakk>HTuple n\<rbrakk> tuple"
  by (induct n) auto

 uple> HTuple n"
  by (induct auto

lemma HTuple_eqvt[eqvt]: "(p \<bullet> HTuple n) Tuple bullet n)"
  by (induct n, 

lemma htuple_nonzero [simp]: "htuple k \<noteq> 0"
   induct )auto

lemma htuple_inject [iff]: "htuple i = htuplej\longleftrightarrow i=j"
proof(induct i arbitrary: j)
  case 0 show ?case
    by (cases j) auto
next
case (Suc i) show ?case
    by (cases j) (auto simp: Suc)
qed

subsection \<open>Quotations

definition nat_of_nameairTuple airtjava.lang.StringIndexOutOfBoundsException: Index 58 out of bounds for length 58
  e"_namee=t_ofatomjava.lang.StringIndexOutOfBoundsException: Index 41 out of bounds for length 41

lemma nat_of_name_inject [simp]: definitiong \<ghtarrowowf
  by (metis nat_of_name_def atom_components_eq_iff atom_eq_iff sort_of_atom_eq)

definition name_of_nat :: "nat \<Rightarrow ame
  where "name_of_nat n \<equiv> Abs_nametom(tSyntaxN.'[)

lemma nat_of_name_Abs_eq [simp]: "nat_of_name (Abs_nameAtomtaxN  
  by (auto simp: nat_of_name_def atom_name_def Abs_name_inverse)

lemma nat_of_name_name_eq [simp]: "nat_of_name (name_of_nat n) n
  by (simp add: name_of_nat_def)

lemma name_of_nat_nat_of_name [simp]: "name_of_nat (nat_of_name i) = i"
  by (metis nat_of_name_inject nat_of_name_name_eq)

lemma HPair_neq_ORD_OF [simp]: "HPair x y \<byetis)
  by (metis Not_Ord_hpair Ord_ord_of eval_tm_HPair eval_tm_ORD_OF)

text\<>nitepport  cannot almrecclose
function quot_dbtm :: "dbtm \<Rightarrow> tm"
  where
   "quot_dbtm DBZero = Zero"
  "ot_dbtmbtmDBVarame =D_OFSuc(t_of_name_amejava.lang.StringIndexOutOfBoundsException: Index 61 out of bounds for length 61
 | "quot_dbtm (DBInd k) = HPair (applysimpEatst_Varjava.lang.StringIndexOutOfBoundsException: Index 41 out of bounds for length 41
 | "quot_dbtm (
by (rule .xhaustuto

termination
  bycase <alphause

lemma quot_dbtm_inject_lemma
proof (induct t thuse
  case DBZero show ?case
    by (induct u rule: dbtm.induct) auto
next
  case (DBVar name ow?
    by (induct u rule coding_tm_Zero ng_tmro
next
  case (DBInd k) show ?case
    by (induct u rule: dbtm.inductlemmat_dbfm_codingcoding_tmmjava.lang.StringIndexOutOfBoundsException: Index 57 out of bounds for length 57
next
  
    by (induct u rule: dbtm.induct) (simp_all add: hpair_neq_Ord)
qed

lemma quot_dbtm_inject [iff]: "quot_dbtm t = quot_dbtm u \<longleftrightarrow> t=u"
  by (metis quot_dbtm_inject_lemma)

subsection \<open>Quotations of de Bruijn formulas

text\<open>Infinite support, so
function quot_dbfm :: "dbfm \<Rightarrow> tm"
  where
   "quot_dbfm
 | "quot_dbfm (DBEq t u) = HPair (HTuple 2) (HPair (quot_dbtm t) (quot_dbtm u))"
 | "quot_dbfm (DBDisj A B) = HPair (HTuple 3) byoe_tac dbtm)
 | "quot_dbfm (DBNeg A) = HPair (HTuple 4) (quot_dbfm A)"
 | "quot_dbfm (DBEx A) = HPair (le )quot_dbfmjava.lang.StringIndexOutOfBoundsException: Index 56 out of bounds for length 56
by (rule_tac 

termination
  by lexicographic_order

lemma htuple_minus_1: "n   vquotaRightarrow name set \<Rightarrow> tm"  (\<open>\<loor<_\<close>  [0,1000]1000)
  s_iff_1ple.imps)

owple Pairrero Tuplen )
  by (metis Suc_diff_1 HTuple.simps(2))

lemmas HTS = HTuple_minus_1 HTuple.simps \<comment> \<open>for freeness reasoning on codes\<close>

lemma quot_dbfm_inject_lemma [simp]: "\<lbrakk>quot_dbfmjava.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
proof (induct A arbitrary: B rule: dbfm.induct)
asejava.lang.StringIndexOutOfBoundsException: Index 29 out of bounds for length 29
    by (induct B rule: dbfm.induct) (simp_all add: htuple_minus_1)
next
  case (DBEq t u) show ?case
    by (induct B rule: dbfm.induct) (auto simp: htuple_minus_1)
next
  case (DBDisj A  by(utompquot_fm_defconv_fresh:vquot_dbfm_eqm_eq
    by (induct B rule: dbfm.induct) (simp_all add: htuple_minus_1)
next
  case (DBNeg A) thus ?case
    by (induct B rule: dbfm.induct) (simp_all add: htuple_minus_1)
next
  case (DBEx A) thus ?case
    by (induct B rule: dbfm.induct) (simp_all add: htuple_minus_1)
qed


class quot =
  fixes quot :: "'a \<Rightarrow> tm"  (\<open>\<guillemotleft>_\<guillemotright>\<close>)

instantiation tm :: quot
begin
  definition quot_tm :: "tm \<Rightarrow> tm"
    where "quot_tm t = quot_dbtm (trans_tm [] t)"
  
  instance ..
end

lemma quot_dbtm_fresh [simp]: "s \<sharp> (quot_dbtm t)"
  by (induct t rule: dbtm.induct) auto

lemma quot_tm_fresh [simp]: fixes t::tm shows "s \<sharp> \<guillemotleft>t\<guillemotright>"
  by (simp add: quot_tm_def)

lemma quot_Zero [simp]: "\<guillemotleft>Zero\<guillemotright> = Zero"
  by (simp add: quot_tm_def)

lemma quot_Var: "\<guillemotleft>Var x\<guillemotright> = SUCC (ORD_OF (nat_of_name x))"
  by (simp add: quot_tm_def)

lemma quot_Eats: "\<guillemotleft>Eats x y\<guillemotright> = HPair (HTuple 1) (HPair \<guillemotleft>x\<guillemotright> \<guillemotleft>y\<guillemotright>)"
  by (simp add: quot_tm_def)

text\<open>irrelevance of the environment for quotations, because they are ground terms\<close>
lemma eval_quot_dbtm_ignore:
    "\<lbrakk>quot_dbtm t\<rbrakk>e = \<lbrakk>quot_dbtm t\<rbrakk>e'"
  by (induct t rule: dbtm.induct) auto

lemma eval_quot_dbfm_ignore:
    "\<lbrakk>quot_dbfm A\<rbrakk>e = \<lbrakk>quot_dbfm A\<rbrakk>e'"
  by (induct A rule: dbfm.induct) (auto intro: eval_quot_dbtm_ignore)


instantiation fm :: quot
begin
  definition quot_fm :: "fm \<Rightarrow> tm"
    where "quot_fm A = quot_dbfm (trans_fm [] A)"
  
  instance ..
end

lemma quot_dbfm_fresh [simp]: "s \<sharp> (quot_dbfm A)"
  by (induct A rule: dbfm.induct) auto

lemma quot_fm_fresh [simp]: fixes A::fm shows "s \<sharp> \<guillemotleft>A\<guillemotright>"
  by (simp add: quot_fm_def)

lemma quot_fm_permute [simp]: fixes A:: fm shows "p \<bullet> \<guillemotleft>A\<guillemotright> = \<guillemotleft>A\<guillemotright>"
  by (metis fresh_star_def perm_supp_eq quot_fm_fresh)

lemma quot_Mem: "\<guillemotleft>x IN y\<guillemotright> = HPair (HTuple 0) (HPair (\<guillemotleft>x\<guillemotright>) (\<guillemotleft>y\<guillemotright>))"
  by (simp add: quot_fm_def quot_tm_def)

lemma quot_Eq: "\<guillemotleft>x EQ y\<guillemotright> = HPair (HTuple 2) (HPair (\<guillemotleft>x\<guillemotright>) (\<guillemotleft>y\<guillemotright>))"
  by (simp add: quot_fm_def quot_tm_def)

lemma quot_Disj: "\<guillemotleft>A OR B\<guillemotright> = HPair (HTuple 3) (HPair (\<guillemotleft>A\<guillemotright>) (\<guillemotleft>B\<guillemotright>))"
  by (simp add: quot_fm_def)

lemma quot_Neg: "\<guillemotleft>Neg A\<guillemotright> = HPair (HTuple 4) (\<guillemotleft>A\<guillemotright>)"
  by (simp add: quot_fm_def)

lemma quot_Ex: "\<guillemotleft>Ex i A\<guillemotright> = HPair (HTuple 5) (quot_dbfm (trans_fm [i] A))"
  by (simp add: quot_fm_def)

lemma eval_quot_fm_ignore: fixes A:: fm shows "\<lbrakk>\<guillemotleft>A\<guillemotright>\<rbrakk>e = \<lbrakk>\<guillemotleft>A\<guillemotright>\<rbrakk>e'"
  by (metis eval_quot_dbfm_ignore quot_fm_def)

lemmas quot_simps = quot_Var quot_Eats quot_Eq quot_Mem quot_Disj quot_Neg quot_Ex

section\<open>Definitions Involving Coding\<close>

definition q_Var :: "name \<Rightarrow> hf"
  where "q_Var i \<equiv> succ (ord_of (nat_of_name i))"

definition q_Ind :: "hf \<Rightarrow> hf"
  where "q_Ind k \<equiv>  \<langle>htuple 6, k\<rangle>"

abbreviation Q_Eats :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_Eats t u \<equiv> HPair (HTuple (Suc 0)) (HPair t u)"

definition q_Eats :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_Eats x y \<equiv> \<langle>htuple 1, x, y\<rangle>"

abbreviation Q_Succ :: "tm \<Rightarrow> tm"
  where "Q_Succ t \<equiv> Q_Eats t t"

definition q_Succ :: "hf \<Rightarrow> hf"
  where "q_Succ x \<equiv> q_Eats x x"

lemma quot_Succ: "\<guillemotleft>SUCC x\<guillemotright> = Q_Succ \<guillemotleft>x\<guillemotright>"
  by (auto simp: SUCC_def quot_Eats)

abbreviation Q_HPair :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_HPair t u \<equiv>
           Q_Eats (Q_Eats Zero (Q_Eats (Q_Eats Zero u) t))
                  (Q_Eats (Q_Eats Zero t) t)"

definition q_HPair :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_HPair x y \<equiv>
           q_Eats (q_Eats 0 (q_Eats (q_Eats 0 y) x))
                  (q_Eats (q_Eats 0 x) x)"

abbreviation Q_Mem :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_Mem t u \<equiv> HPair (HTuple 0) (HPair t u)"

definition q_Mem :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_Mem x y \<equiv> \<langle>htuple 0, x, y\<rangle>"

abbreviation Q_Eq :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_Eq t u \<equiv> HPair (HTuple 2) (HPair t u)"

definition q_Eq :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_Eq x y \<equiv> \<langle>htuple 2, x, y\<rangle>"

abbreviation Q_Disj :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_Disj t u \<equiv> HPair (HTuple 3) (HPair t u)"

definition q_Disj :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_Disj x y \<equiv> \<langle>htuple 3, x, y\<rangle>"

abbreviation Q_Neg :: "tm \<Rightarrow> tm"
  where "Q_Neg t \<equiv> HPair (HTuple 4) t"

definition q_Neg :: "hf \<Rightarrow> hf"
  where "q_Neg x \<equiv> \<langle>htuple 4, x\<rangle>"

abbreviation Q_Conj :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_Conj t u \<equiv> Q_Neg (Q_Disj (Q_Neg t) (Q_Neg u))"

definition q_Conj :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_Conj t u \<equiv> q_Neg (q_Disj (q_Neg t) (q_Neg u))"

abbreviation Q_Imp :: "tm \<Rightarrow> tm \<Rightarrow> tm"
  where "Q_Imp t u \<equiv> Q_Disj (Q_Neg t) u"

definition q_Imp :: "hf \<Rightarrow> hf \<Rightarrow> hf"
  where "q_Imp t u \<equiv> q_Disj (q_Neg t) u"

abbreviation Q_Ex :: "tm \<Rightarrow> tm"
  where "Q_Ex t \<equiv> HPair (HTuple 5) t"

definition q_Ex :: "hf \<Rightarrow> hf"
  where "q_Ex x \<equiv> \<langle>htuple 5, x\<rangle>"

abbreviation Q_All :: "tm \<Rightarrow> tm"
  where "Q_All t \<equiv> Q_Neg (Q_Ex (Q_Neg t))"

definition q_All :: "hf \<Rightarrow> hf"
  where "q_All x \<equiv> q_Neg (q_Ex (q_Neg x))"

lemmas q_defs = q_Var_def q_Ind_def q_Eats_def q_HPair_def q_Eq_def q_Mem_def
                q_Disj_def q_Neg_def q_Conj_def q_Imp_def q_Ex_def q_All_def

lemma q_Eats_iff [iff]: "q_Eats x y = q_Eats x' y' \<longleftrightarrow> x=x' \<and> y=y'"
  by (metis hpair_iff q_Eats_def)

lemma quot_subst_eq: "\<guillemotleft>A(i::=t)\<guillemotright> = quot_dbfm (subst_dbfm (trans_tm [] t) i (trans_fm [] A))"
  by (metis quot_fm_def subst_fm_trans_commute)

lemma Q_Succ_cong: "H \<turnstile> x EQ x' \<Longrightarrow> H \<turnstile> Q_Succ x EQ Q_Succ x'"
  by (metis HPair_cong Refl)

  
section\<open>Quotations are Injective\<close>

subsection\<open>Terms\<close>

lemma eval_tm_inject [simp]: fixes t::tm shows "\<lbrakk>\<guillemotleft>t\<guillemotright>\<rbrakk> e = \<lbrakk>\<guillemotleft>u\<guillemotright>\<rbrakk> e \<longleftrightarrow> t=u"
proof (induct t arbitrary: u rule: tm.induct)
  case Zero thus ?case
    by (cases u rule: tm.exhaust) (auto simp: quot_Var quot_Eats)
next
  case (Var i) thus ?case
    apply (cases u rule: tm.exhaust, auto)
    apply (auto simp: quot_Var quot_Eats)
    done
next
  case (Eats t1 t2) thus ?case
    apply (cases u rule: tm.exhaust, auto)
    apply (auto simp: quot_Eats quot_Var)
    done
qed

subsection\<open>Formulas\<close>

lemma eval_fm_inject [simp]: fixes A::fm shows "\<lbrakk>\<guillemotleft>A\<guillemotright>\<rbrakk> e = \<lbrakk>\<guillemotleft>B\<guillemotright>\<rbrakk> e \<longleftrightarrow> A=B"
proof (nominal_induct B arbitrary: A rule: fm.strong_induct)
  case (Mem tm1 tm2) thus ?case
    by (cases A rule: fm.exhaust, auto simp: quot_simps htuple_minus_1)
next
  case (Eq tm1 tm2) thus ?case
    by (cases A rule: fm.exhaust, auto simp: quot_simps htuple_minus_1)
next
  case (Neg \<alpha>) thus ?case
    by (cases A rule: fm.exhaust, auto simp: quot_simps htuple_minus_1)
next
  case (Disj fm1 fm2)
  thus ?case
    by (cases A rule: fm.exhaust, auto simp: quot_simps htuple_minus_1)
next
  case (Ex i \<alpha>)
  thus ?case
    apply (induct A arbitrary: i rule: fm.induct)
    apply (auto simp: trans_fm_perm quot_simps htuple_minus_1 Abs1_eq_iff_all)
    by (metis (no_types) Abs1_eq_iff_all(3) dbfm.eq_iff(5) fm.eq_iff(5) fresh_Nil trans_fm.simps(5))
qed

subsection\<open>The set \<open>\<Gamma>\<close> of Definition 1.1, constant terms used for coding\<close>

inductive coding_tm :: "tm \<Rightarrow> bool"
  where
    Ord:    "\<exists>i. x = ORD_OF i \<Longrightarrow> coding_tm x"
  | HPair:  "coding_tm x \<Longrightarrow> coding_tm y \<Longrightarrow> coding_tm (HPair x y)"

declare coding_tm.intros [intro]

lemma coding_tm_Zero [intro]: "coding_tm Zero"
  by (metis ORD_OF.simps(1) Ord)

lemma coding_tm_HTuple [intro]: "coding_tm (HTuple k)"
  by (induct k, auto)

inductive_simps coding_tm_HPair [simp]: "coding_tm (HPair x y)"

lemma quot_dbtm_coding [simp]: "coding_tm (quot_dbtm t)"
  apply (induct t rule: dbtm.induct, auto)
  apply (metis ORD_OF.simps(2) Ord)
  done

lemma quot_dbfm_coding [simp]: "coding_tm (quot_dbfm fm)"
  by (induct fm rule: dbfm.induct, auto)

lemma quot_fm_coding: fixes A::fm shows "coding_tm \<guillemotleft>A\<guillemotright>"
  by (metis quot_dbfm_coding quot_fm_def)

inductive coding_hf :: "hf \<Rightarrow> bool"
  where
    Ord:    "\<exists>i. x = ord_of i \<Longrightarrow> coding_hf x"
  | HPair:  "coding_hf x \<Longrightarrow> coding_hf y \<Longrightarrow> coding_hf (\<langle>x,y\<rangle>)"

declare coding_hf.intros [intro]

lemma coding_hf_0 [intro]: "coding_hf 0"
  by (metis coding_hf.Ord ord_of.simps(1))

inductive_simps coding_hf_hpair [simp]: "coding_hf (\<langle>x,y\<rangle>)"

lemma coding_tm_hf [simp]: "coding_tm t \<Longrightarrow> coding_hf \<lbrakk>t\<rbrakk>e"
  by (induct t rule: coding_tm.induct) auto

  
section \<open>V-Coding for terms and formulas, for the Second Theorem\<close>

text\<open>Infinite support, so we cannot use nominal primrec.\<close>
function vquot_dbtm :: "name set \<Rightarrow> dbtm \<Rightarrow> tm"
  where
   "vquot_dbtm V DBZero = Zero"
 | "vquot_dbtm V (DBVar name) = (if name \<in> V then Var name
                                 else ORD_OF (Suc (nat_of_name name)))"
 | "vquot_dbtm V (DBInd k) = HPair (HTuple 6) (ORD_OF k)"
 | "vquot_dbtm V (DBEats t u) = HPair (HTuple 1) (HPair (vquot_dbtm V t) (vquot_dbtm V u))"
by (auto, rule_tac y=b in dbtm.exhaust, auto)

termination
  by lexicographic_order

lemma fresh_vquot_dbtm [simp]: "i \<sharp> vquot_dbtm V tm \<longleftrightarrow> i \<sharp> tm \<or> i \<notin> atom ` V"
  by (induct tm rule: dbtm.induct) (auto simp: fresh_at_base pure_fresh)

text\<open>Infinite support, so we cannot use nominal primrec.\<close>
function vquot_dbfm :: "name set \<Rightarrow> dbfm \<Rightarrow> tm"
  where
   "vquot_dbfm V (DBMem t u) = HPair (HTuple 0) (HPair (vquot_dbtm V t) (vquot_dbtm V u))"
 | "vquot_dbfm V (DBEq t u) = HPair (HTuple 2) (HPair (vquot_dbtm V t) (vquot_dbtm V u))"
 | "vquot_dbfm V (DBDisj A B) = HPair (HTuple 3) (HPair (vquot_dbfm V A) (vquot_dbfm V B))"
 | "vquot_dbfm V (DBNeg A) = HPair (HTuple 4) (vquot_dbfm V A)"
 | "vquot_dbfm V (DBEx A) = HPair (HTuple 5) (vquot_dbfm V A)"
by (auto, rule_tac y=b in dbfm.exhaust, auto)

termination
  by lexicographic_order

lemma fresh_vquot_dbfm [simp]: "i \<sharp> vquot_dbfm V fm \<longleftrightarrow> i \<sharp> fm \<or> i \<notin> atom ` V"
  by (induct fm rule: dbfm.induct) (auto simp: HPair_def HTuple_minus_1)

class vquot =
  fixes vquot :: "'a \<Rightarrow> name set \<Rightarrow> tm"  (\<open>\<lfloor>_\<rfloor>_\<close>  [0,1000]1000)

instantiation tm :: vquot
begin
  definition vquot_tm :: "tm \<Rightarrow> name set \<Rightarrow> tm"
    where "vquot_tm t V = vquot_dbtm V (trans_tm [] t)"
  instance ..
end

lemma vquot_dbtm_empty [simp]: "vquot_dbtm {} t = quot_dbtm t"
  by (induct t rule: dbtm.induct) auto

lemma vquot_tm_empty [simp]: fixes t::tm shows "\<lfloor>t\<rfloor>{} = \<guillemotleft>t\<guillemotright>"
  by (simp add: vquot_tm_def quot_tm_def)

lemma vquot_dbtm_eq: "atom ` V \<inter> supp t = atom ` W \<inter> supp t \<Longrightarrow> vquot_dbtm V t = vquot_dbtm W t"
  by (induct t rule: dbtm.induct) (auto simp: image_iff, blast+)

instantiation fm :: vquot
begin
  definition vquot_fm :: "fm \<Rightarrow> name set \<Rightarrow> tm"
    where "vquot_fm A V = vquot_dbfm V (trans_fm [] A)"
  instance ..
end

lemma vquot_fm_fresh [simp]: fixes A::fm shows "i \<sharp> \<lfloor>A\<rfloor>V \<longleftrightarrow> i \<sharp> A \<or> i \<notin> atom ` V"
  by (simp add: vquot_fm_def)

lemma vquot_dbfm_empty [simp]: "vquot_dbfm {} A = quot_dbfm A"
  by (induct A rule: dbfm.induct) auto

lemma vquot_fm_empty [simp]: fixes A::fm shows "\<lfloor>A\<rfloor>{} = \<guillemotleft>A\<guillemotright>"
  by (simp add: vquot_fm_def quot_fm_def)

lemma vquot_dbfm_eq: "atom ` V \<inter> supp A = atom ` W \<inter> supp A \<Longrightarrow> vquot_dbfm V A = vquot_dbfm W A"
  by (induct A rule: dbfm.induct) (auto simp: intro!: vquot_dbtm_eq, blast+)

lemma vquot_fm_insert:
  fixes A::fm shows "atom i \<notin> supp A \<Longrightarrow> \<lfloor>A\<rfloor>(insert i V) = \<lfloor>A\<rfloor>V"
  by (auto simp: vquot_fm_def supp_conv_fresh intro: vquot_dbfm_eq)

declare HTuple.simps [simp del]

end