header {* \isaheader{Definition of the CFG} *}

theory PCFG imports ProcState begin

definition Main :: "pname"
  where "Main = ''Main''"

datatype label = Label nat | Entry | Exit

subsection{* The CFG for every procedure *}

subsubsection {* Definition of @{text "\<oplus>"} *}

fun label_incr :: "label \<Rightarrow> nat \<Rightarrow> label" ("_ \<oplus> _" 60)
where "(Label l) \<oplus> i = Label (l + i)"
  | "Entry \<oplus> i       = Entry"
  | "Exit \<oplus> i        = Exit"

lemma Exit_label_incr [dest]: "Exit = n \<oplus> i \<Longrightarrow> n = Exit"
  by(cases n,auto)

lemma label_incr_Exit [dest]: "n \<oplus> i = Exit \<Longrightarrow> n = Exit"
  by(cases n,auto)

lemma Entry_label_incr [dest]: "Entry = n \<oplus> i \<Longrightarrow> n = Entry"
  by(cases n,auto)

lemma label_incr_Entry [dest]: "n \<oplus> i = Entry \<Longrightarrow> n = Entry"
  by(cases n,auto)

lemma label_incr_inj:
  "n \<oplus> c = n' \<oplus> c \<Longrightarrow> n = n'"
by(cases n)(cases n',auto)+

lemma label_incr_simp:"n \<oplus> i = m \<oplus> (i + j) \<Longrightarrow> n = m \<oplus> j"
by(cases n,auto,cases m,auto)

lemma label_incr_start_Node_smaller:
  "Label l = n \<oplus> i \<Longrightarrow> n = Label (l - i)"
by(cases n,auto)

lemma label_incr_start_Node_smaller_rev:
  "n \<oplus> i = Label l \<Longrightarrow> n = Label (l - i)"
by(cases n,auto)

lemma label_incr_ge:"Label l = n \<oplus> i \<Longrightarrow> l \<ge> i"
by(cases n) auto

lemma label_incr_0 [dest]:
  "\<lbrakk>Label 0 = n \<oplus> i; i > 0\<rbrakk> \<Longrightarrow> False"
by(cases n) auto

lemma label_incr_0_rev [dest]:
  "\<lbrakk>n \<oplus> i = Label 0; i > 0\<rbrakk> \<Longrightarrow> False"
by(cases n) auto

subsubsection {* The edges of the procedure CFG *}

text {* Control flow information in this language is the node, to which we return
  after the calles procedure is finished. *}

datatype p_edge_kind =
  IEdge "(vname,val,pname \<times> label,pname) edge_kind"
| CEdge "pname \<times> expr list \<times> vname list"

type_synonym p_edge = "(label \<times> p_edge_kind \<times> label)"

inductive Proc_CFG :: "cmd \<Rightarrow> label \<Rightarrow> p_edge_kind \<Rightarrow> label \<Rightarrow> bool"
("_ \<turnstile> _ -_\<rightarrow>\<^sub>p _")
where

  Proc_CFG_Entry_Exit:
  "prog \<turnstile> Entry -IEdge (\<lambda>s. False)\<^sub>\<surd>\<rightarrow>\<^sub>p Exit"

| Proc_CFG_Entry:
  "prog \<turnstile> Entry -IEdge (\<lambda>s. True)\<^sub>\<surd>\<rightarrow>\<^sub>p Label 0"

| Proc_CFG_Skip:
  "Skip \<turnstile> Label 0 -IEdge \<Up>id\<rightarrow>\<^sub>p Exit"

| Proc_CFG_LAss:
  "V:=e \<turnstile> Label 0 -IEdge \<Up>(\<lambda>cf. update cf V e)\<rightarrow>\<^sub>p Label 1"

| Proc_CFG_LAssSkip:
  "V:=e \<turnstile> Label 1 -IEdge \<Up>id\<rightarrow>\<^sub>p Exit"

| Proc_CFG_SeqFirst:
  "\<lbrakk>c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p n'; n' \<noteq> Exit\<rbrakk> \<Longrightarrow> c\<^sub>1;;c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'"

| Proc_CFG_SeqConnect:
  "\<lbrakk>c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p Exit; n \<noteq> Entry\<rbrakk> \<Longrightarrow> c\<^sub>1;;c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p Label #:c\<^sub>1"

| Proc_CFG_SeqSecond:
  "\<lbrakk>c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'; n \<noteq> Entry\<rbrakk> \<Longrightarrow> c\<^sub>1;;c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 -et\<rightarrow>\<^sub>p n' \<oplus> #:c\<^sub>1"

| Proc_CFG_CondTrue:
    "if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> Label 0
  -IEdge (\<lambda>cf. state_check cf b (Some true))\<^sub>\<surd>\<rightarrow>\<^sub>p Label 1"

| Proc_CFG_CondFalse:
    "if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> Label 0 -IEdge (\<lambda>cf. state_check cf b (Some false))\<^sub>\<surd>\<rightarrow>\<^sub>p
                        Label (#:c\<^sub>1 + 1)"

| Proc_CFG_CondThen:
  "\<lbrakk>c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p n'; n \<noteq> Entry\<rbrakk> \<Longrightarrow> if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> 1 -et\<rightarrow>\<^sub>p n' \<oplus> 1"

| Proc_CFG_CondElse:
  "\<lbrakk>c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'; n \<noteq> Entry\<rbrakk>
  \<Longrightarrow> if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> (#:c\<^sub>1 + 1) -et\<rightarrow>\<^sub>p n' \<oplus> (#:c\<^sub>1 + 1)"

| Proc_CFG_WhileTrue:
    "while (b) c' \<turnstile> Label 0 -IEdge (\<lambda>cf. state_check cf b (Some true))\<^sub>\<surd>\<rightarrow>\<^sub>p Label 2"

| Proc_CFG_WhileFalse:
    "while (b) c' \<turnstile> Label 0 -IEdge (\<lambda>cf. state_check cf b (Some false))\<^sub>\<surd>\<rightarrow>\<^sub>p Label 1"

| Proc_CFG_WhileFalseSkip:
  "while (b) c' \<turnstile> Label 1 -IEdge \<Up>id\<rightarrow>\<^sub>p Exit"

| Proc_CFG_WhileBody:
  "\<lbrakk>c' \<turnstile> n -et\<rightarrow>\<^sub>p n'; n \<noteq> Entry; n' \<noteq> Exit\<rbrakk>
  \<Longrightarrow> while (b) c' \<turnstile> n \<oplus> 2 -et\<rightarrow>\<^sub>p n' \<oplus> 2"

| Proc_CFG_WhileBodyExit:
  "\<lbrakk>c' \<turnstile> n -et\<rightarrow>\<^sub>p Exit; n \<noteq> Entry\<rbrakk> \<Longrightarrow> while (b) c' \<turnstile> n \<oplus> 2 -et\<rightarrow>\<^sub>p Label 0"

| Proc_CFG_Call:
  "Call p es rets \<turnstile> Label 0 -CEdge (p,es,rets)\<rightarrow>\<^sub>p Label 1"

| Proc_CFG_CallSkip:
  "Call p es rets \<turnstile> Label 1 -IEdge \<Up>id\<rightarrow>\<^sub>p Exit"

subsubsection{* Some lemmas about the procedure CFG *}

lemma Proc_CFG_Exit_no_sourcenode [dest]:
  "prog \<turnstile> Exit -et\<rightarrow>\<^sub>p n' \<Longrightarrow> False"
by(induct prog n\<equiv>"Exit" et n' rule:Proc_CFG.induct,auto)

lemma Proc_CFG_Entry_no_targetnode [dest]:
  "prog \<turnstile> n -et\<rightarrow>\<^sub>p Entry \<Longrightarrow> False"
by(induct prog n et n'\<equiv>"Entry" rule:Proc_CFG.induct,auto)

lemma Proc_CFG_IEdge_intra_kind:
  "prog \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> intra_kind et"
by(induct prog n x\<equiv>"IEdge et" n' rule:Proc_CFG.induct,auto simp:intra_kind_def)

lemma [dest]:"prog \<turnstile> n -IEdge (Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs)\<rightarrow>\<^sub>p n' \<Longrightarrow> False"
by(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)

lemma [dest]:"prog \<turnstile> n -IEdge (Q\<hookleftarrow>\<^bsub>p\<^esub>f)\<rightarrow>\<^sub>p n' \<Longrightarrow> False"
by(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)

lemma Proc_CFG_sourcelabel_less_num_nodes:
  "prog \<turnstile> Label l -et\<rightarrow>\<^sub>p n' \<Longrightarrow> l < #:prog"
proof(induct prog "Label l" et n' arbitrary:l rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 et n' c\<^sub>2 l)
  thus ?case by simp
next
  case (Proc_CFG_SeqConnect c\<^sub>1 et c\<^sub>2 l)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1 l)
  note n = `n \<oplus> #:c\<^sub>1 = Label l`
  note IH = `\<And>l. n = Label l \<Longrightarrow> l < #:c\<^sub>2`
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c\<^sub>2" .
  with n l' show ?case by simp
next
  case (Proc_CFG_CondThen c\<^sub>1 n et n' b c\<^sub>2 l)
  note n = `n \<oplus> 1 = Label l`
  note IH = `\<And>l. n = Label l \<Longrightarrow> l < #:c\<^sub>1`
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c\<^sub>1" .
  with n l' show ?case by simp
next
  case (Proc_CFG_CondElse c\<^sub>2 n et n' b c\<^sub>1 l)
  note n = `n \<oplus> (#:c\<^sub>1 + 1) = Label l`
  note IH = `\<And>l. n = Label l \<Longrightarrow> l < #:c\<^sub>2`
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c\<^sub>2" .
  with n l' show ?case by simp
next
  case (Proc_CFG_WhileBody c' n et n' b l)
  note n = `n \<oplus> 2 = Label l`
  note IH = `\<And>l. n = Label l \<Longrightarrow> l < #:c'`
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c'" .
  with n l' show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n et b l)
  note n = `n \<oplus> 2 = Label l`
  note IH = `\<And>l. n = Label l \<Longrightarrow> l < #:c'`
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c'" .
  with n l' show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)

lemma Proc_CFG_targetlabel_less_num_nodes:
  "prog \<turnstile> n -et\<rightarrow>\<^sub>p Label l \<Longrightarrow> l < #:prog"
proof(induct prog n et "Label l" arbitrary:l rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n et c\<^sub>2 l)
 thus ?case by simp
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1 l)
  note n' = `n' \<oplus> #:c\<^sub>1 = Label l`
  note IH = `\<And>l. n' = Label l \<Longrightarrow> l < #:c\<^sub>2`
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c\<^sub>2" .
  with n' l' show ?case by simp
next
  case (Proc_CFG_CondThen c\<^sub>1 n et n' b c\<^sub>2 l)
  note n' = `n' \<oplus> 1 = Label l`
  note IH = `\<And>l. n' = Label l \<Longrightarrow> l < #:c\<^sub>1`
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c\<^sub>1" .
  with n' l' show ?case by simp
next
  case (Proc_CFG_CondElse c\<^sub>2 n et n' b c\<^sub>1 l)
  note n' = `n' \<oplus> (#:c\<^sub>1 + 1) = Label l`
  note IH = `\<And>l. n' = Label l \<Longrightarrow> l < #:c\<^sub>2`
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c\<^sub>2" .
  with n' l' show ?case by simp
next
  case (Proc_CFG_WhileBody c' n et n' b l)
  note n' = `n' \<oplus> 2 = Label l`
note IH = `\<And>l. n' = Label l \<Longrightarrow> l < #:c'`
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c'" .
  with n' l' show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)

lemma Proc_CFG_EntryD:
  "prog \<turnstile> Entry -et\<rightarrow>\<^sub>p n'
  \<Longrightarrow> (n' = Exit \<and> et = IEdge(\<lambda>s. False)\<^sub>\<surd>) \<or> (n' = Label 0 \<and> et = IEdge (\<lambda>s. True)\<^sub>\<surd>)"
by(induct prog n\<equiv>"Entry" et n' rule:Proc_CFG.induct,auto)

text {* Lots of lemmas for call edges @{text "\<dots>"} *}

lemma Proc_CFG_Call_Labels:
  "prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n' \<Longrightarrow> \<exists>l. n = Label l \<and> n' = Label (Suc l)"
by(induct prog n et\<equiv>"CEdge (p,es,rets)" n' rule:Proc_CFG.induct,auto)

lemma Proc_CFG_Call_target_0:
  "prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p Label 0 \<Longrightarrow> n = Entry"
by(induct prog n et\<equiv>"CEdge (p,es,rets)" n'\<equiv>"Label 0" rule:Proc_CFG.induct)
  (auto dest:Proc_CFG_Call_Labels)

lemma Proc_CFG_Call_Intra_edge_not_same_source:
  "\<lbrakk>prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; prog \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n''\<rbrakk> \<Longrightarrow> False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n n' c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n' \<noteq> Exit`
  obtain nx where "c\<^sub>1 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG_Entry_Exit Proc_CFG_Entry)
    by(case_tac n)(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n c\<^sub>2)
  from `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n n' c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>2 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>2 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(cases n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n,auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c\<^sub>1 n n' b c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> 1 -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>1 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n) apply auto apply(case_tac n) apply auto
    apply(cases n) apply auto
    by(case_tac n)(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c\<^sub>2 n n' b c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 + 1 -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>2 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>2 \<turnstile> n -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n) apply auto
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n,auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = `\<And>n''. c' \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `while (b) c' \<turnstile> n \<oplus> 2 -IEdge et\<rightarrow>\<^sub>p n''` `c' \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry` `n' \<noteq> Exit`
  obtain nx where "c' \<turnstile> n -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(drule label_incr_ge[OF sym]) apply simp
     apply(cases n) apply auto apply(case_tac n) apply auto
    by(cases n,auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from `c' \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from `Call p es rets \<turnstile> Label 0 -IEdge et\<rightarrow>\<^sub>p n''`
  show ?case by(fastforce elim:Proc_CFG.cases)
qed

lemma Proc_CFG_Call_Intra_edge_not_same_target:
  "\<lbrakk>prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; prog \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n'\<rbrakk> \<Longrightarrow> False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n n' c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> False`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n'` `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n' \<noteq> Exit`
  have "c\<^sub>1 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n'"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG_Entry dest:Proc_CFG_targetlabel_less_num_nodes)
    by(case_tac n')(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n c\<^sub>2)
  from `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n n' c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> False`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<oplus> #:c\<^sub>1` `c\<^sub>2 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>2 \<turnstile> nx -IEdge et\<rightarrow>\<^sub>p n'"
    apply - apply(erule Proc_CFG.cases,auto)
       apply(fastforce intro:Proc_CFG_Entry_Exit)
      apply(cases n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
     apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
    apply(cases n') apply(auto dest:Proc_CFG_Call_Labels)
    by(case_tac n') auto
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c\<^sub>1 n n' b c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> False`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<oplus> 1` `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>1 \<turnstile> nx -IEdge et\<rightarrow>\<^sub>p n'"
    apply - apply(erule Proc_CFG.cases,auto)
        apply(cases n') apply(auto intro:Proc_CFG_Entry_Exit)
       apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
      apply(cases n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
     apply(cases n') apply auto apply(case_tac n') apply auto
    apply(cases n') apply auto
    apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
    by(case_tac n')(auto dest:Proc_CFG_Call_Labels)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c\<^sub>2 n n' b c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> False`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<oplus> #:c\<^sub>1 + 1` `c\<^sub>2 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>2 \<turnstile> nx -IEdge et\<rightarrow>\<^sub>p n'"
    apply - apply(erule Proc_CFG.cases,auto)
        apply(cases n') apply(auto intro:Proc_CFG_Entry_Exit)
       apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
      apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
     apply(cases n') apply auto
      apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
     apply(case_tac n') apply(auto dest:Proc_CFG_Call_Labels)
    by(cases n',auto,case_tac n',auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = `\<And>n''. c' \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> False`
  from `while (b) c' \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p n' \<oplus> 2` `c' \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry` `n' \<noteq> Exit`
  obtain nx where "c' \<turnstile> nx -IEdge et\<rightarrow>\<^sub>p n'"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
     apply(cases n') apply auto
    by(cases n',auto,case_tac n',auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from `c' \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from `Call p es rets \<turnstile> n'' -IEdge et\<rightarrow>\<^sub>p Label 1`
  show ?case by(fastforce elim:Proc_CFG.cases)
qed

lemma Proc_CFG_Call_nodes_eq:
  "\<lbrakk>prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; prog \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''\<rbrakk>
  \<Longrightarrow> n' = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n n' c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''
    \<Longrightarrow> n' = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `c\<^sub>1;; c\<^sub>2 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  have "c\<^sub>1 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(case_tac n,(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)+)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n c\<^sub>2)
  from `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p Exit` have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n n' c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''
    \<Longrightarrow> n' = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''` `n \<noteq> Entry`
  obtain nx where edge:"c\<^sub>2 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx" and nx:"nx \<oplus> #:c\<^sub>1 = n''"
    apply - apply(erule Proc_CFG.cases,auto)
    by(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes label_incr_inj)+
  from edge have "n' = nx \<and> p = p' \<and> es = es' \<and> rets = rets'" by (rule IH)
  with nx show ?case by auto
next
  case (Proc_CFG_CondThen c\<^sub>1 n n' b c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''
    \<Longrightarrow> n' = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> 1 -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''`
  obtain nx where "c\<^sub>1 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx \<and> nx \<oplus> 1 = n''"
  proof(rule Proc_CFG.cases)
    fix c\<^sub>2' nx etx nx' bx c\<^sub>1'
    assume "if (b) c\<^sub>1 else c\<^sub>2 = if (bx) c\<^sub>1' else c\<^sub>2'"
      and "n \<oplus> 1 = nx \<oplus> #:c\<^sub>1' + 1" and "nx \<noteq> Entry"
    with `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'` obtain l where "n = Label l" and "l \<ge> #:c\<^sub>1"
      by(cases n,auto,cases nx,auto)
    with `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'` have False
      by(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c\<^sub>1 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    and nx:"nx \<oplus> 1 = n''" by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_CondElse c\<^sub>2 n n' b c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''
    \<Longrightarrow> n' = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 + 1 -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''`
  obtain nx where "c\<^sub>2 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx \<and> nx \<oplus> #:c\<^sub>1 + 1 = n''"
  proof(rule Proc_CFG.cases)
    fix c\<^sub>1' nx etx nx' bx c\<^sub>2'
    assume ifs:"if (b) c\<^sub>1 else c\<^sub>2 = if (bx) c\<^sub>1' else c\<^sub>2'"
      and "n \<oplus> #:c\<^sub>1 + 1 = nx \<oplus> 1" and "nx \<noteq> Entry"
      and edge:"c\<^sub>1' \<turnstile> nx -etx\<rightarrow>\<^sub>p nx'"
    then obtain l where "nx = Label l" and "l \<ge> #:c\<^sub>1"
      by(cases n,auto,cases nx,auto)
    with edge ifs have False
      by(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c\<^sub>2 \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    and nx:"nx \<oplus> #:c\<^sub>1 + 1 = n''"
    by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = `\<And>n''. c' \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''
    \<Longrightarrow> n' = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `while (b) c' \<turnstile> n \<oplus> 2 -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''`
  obtain nx where "c' \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx \<and> nx \<oplus> 2 = n''"
    by(rule Proc_CFG.cases,auto dest:label_incr_inj Proc_CFG_Call_Labels)
  then obtain nx where edge:"c' \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    and nx:"nx \<oplus> 2 = n''" by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from `c' \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p Exit` have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case Proc_CFG_Call
  from `Call p es rets \<turnstile> Label 0 -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''`
  have "p = p' \<and> es = es' \<and> rets = rets' \<and> n'' = Label 1"
    by(auto elim:Proc_CFG.cases)
  then show ?case by simp
qed

lemma Proc_CFG_Call_nodes_eq':
  "\<lbrakk>prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; prog \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'\<rbrakk>
  \<Longrightarrow> n = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n n' c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'
    \<Longrightarrow> n = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'` `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  have "c\<^sub>1 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(case_tac n',auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n c\<^sub>2)
  from `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p Exit` have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n n' c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'
    \<Longrightarrow> n = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n' \<oplus> #:c\<^sub>1`
  obtain nx where edge:"c\<^sub>2 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'" and nx:"nx \<oplus> #:c\<^sub>1 = n''"
    apply - apply(erule Proc_CFG.cases,auto)
    by(cases n',
       auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels
                 label_incr_inj)
  from edge have "n = nx \<and> p = p' \<and> es = es' \<and> rets = rets'" by (rule IH)
  with nx show ?case by auto
next
  case (Proc_CFG_CondThen c\<^sub>1 n n' b c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'
    \<Longrightarrow> n = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n' \<oplus> 1`
  obtain nx where "c\<^sub>1 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p n' \<and> nx \<oplus> 1 = n''"
  proof(cases)
    case (Proc_CFG_CondElse nx nx')
    from `n' \<oplus> 1 = nx' \<oplus> #:c\<^sub>1 + 1`
      `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
    obtain l where "n' = Label l" and "l \<ge> #:c\<^sub>1"
      by(cases n', auto dest:Proc_CFG_Call_Labels,cases nx',auto)
    with `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'` have False
      by(fastforce dest:Proc_CFG_targetlabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c\<^sub>1 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'"
    and nx:"nx \<oplus> 1 = n''"
    by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_CondElse c\<^sub>2 n n' b c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'
    \<Longrightarrow> n = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n' \<oplus> #:c\<^sub>1 + 1`
  obtain nx where "c\<^sub>2 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p n' \<and> nx \<oplus> #:c\<^sub>1 + 1 = n''"
  proof(cases)
    case (Proc_CFG_CondThen nx nx')
    from `n' \<oplus> #:c\<^sub>1 + 1 = nx' \<oplus> 1`
      `c\<^sub>1 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx'`
    obtain l where "nx' = Label l" and "l \<ge> #:c\<^sub>1"
      by(cases n',auto,cases nx',auto dest:Proc_CFG_Call_Labels)
    with `c\<^sub>1 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx'`
    have False by(fastforce dest:Proc_CFG_targetlabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c\<^sub>2 \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'"
    and nx:"nx \<oplus> #:c\<^sub>1 + 1 = n''"
    by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = `\<And>n''. c' \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'
    \<Longrightarrow> n = n'' \<and> p = p' \<and> es = es' \<and> rets = rets'`
  from `while (b) c' \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n' \<oplus> 2`
  obtain nx where edge:"c' \<turnstile> nx -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'" and nx:"nx \<oplus> 2 = n''"
    by(rule Proc_CFG.cases,auto dest:label_incr_inj)
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from `c' \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p Exit`
  have False by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case Proc_CFG_Call
  from `Call p es rets \<turnstile> n'' -CEdge (p',es',rets')\<rightarrow>\<^sub>p Label 1`
  have "p = p' \<and> es = es' \<and> rets = rets' \<and> n'' = Label 0"
    by(auto elim:Proc_CFG.cases)
  then show ?case by simp
qed

lemma Proc_CFG_Call_targetnode_no_Call_sourcenode:
  "\<lbrakk>prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; prog \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''\<rbrakk>
  \<Longrightarrow> False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n n' c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n' -CEdge (p', es', rets')\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `c\<^sub>1;; c\<^sub>2 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  have "c\<^sub>1 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n''"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n c\<^sub>2)
  from `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p Exit` have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n n' c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n' -CEdge (p', es', rets')\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `c\<^sub>1;; c\<^sub>2 \<turnstile> n' \<oplus> #:c\<^sub>1 -CEdge (p', es', rets')\<rightarrow>\<^sub>p n''` `c\<^sub>2 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c\<^sub>2 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c\<^sub>1 n n' b c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n' \<oplus> 1 -CEdge (p', es', rets')\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c\<^sub>1 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto apply(case_tac n) apply auto
    apply(cases n') apply auto
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c\<^sub>2 n n' b c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n' \<oplus> #:c\<^sub>1 + 1 -CEdge (p', es', rets')\<rightarrow>\<^sub>p n''`
    `c\<^sub>2 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c\<^sub>2 \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = `\<And>n''. c' \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p n'' \<Longrightarrow> False`
  from `while (b) c' \<turnstile> n' \<oplus> 2 -CEdge (p', es', rets')\<rightarrow>\<^sub>p n''` `c' \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c' \<turnstile> n' -CEdge (p',es',rets')\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
    by(cases n',auto,case_tac n,auto)+
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from `c' \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from `Call p es rets \<turnstile> Label 1 -CEdge (p', es', rets')\<rightarrow>\<^sub>p n''`
  show ?case by(fastforce elim:Proc_CFG.cases)
qed

lemma Proc_CFG_Call_follows_id_edge:
  "\<lbrakk>prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; prog \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n''\<rbrakk> \<Longrightarrow> et = \<Up>id"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c\<^sub>1 n n' c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> et = \<Up>id`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'` `n' \<noteq> Exit`
  obtain nx where "c\<^sub>1 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n c\<^sub>2)
  from `c\<^sub>1 \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n n' c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> et = \<Up>id`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n' \<oplus> #:c\<^sub>1 -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>2 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c\<^sub>2 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c\<^sub>1 n n' b c\<^sub>2)
  note IH = `\<And>n''. c\<^sub>1 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> et = \<Up>id`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n' \<oplus> 1 -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>1 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
    `n \<noteq> Entry`
  obtain nx where "c\<^sub>1 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto apply(case_tac n) apply auto
    apply(cases n') apply auto
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c\<^sub>2 n n' b c\<^sub>1)
  note IH = `\<And>n''. c\<^sub>2 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> et = \<Up>id`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n' \<oplus> #:c\<^sub>1 + 1 -IEdge et\<rightarrow>\<^sub>p n''` `c\<^sub>2 \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c\<^sub>2 \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = `\<And>n''. c' \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p n'' \<Longrightarrow> et = \<Up>id`
  from `while (b) c' \<turnstile> n' \<oplus> 2 -IEdge et\<rightarrow>\<^sub>p n''` `c' \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'`
  obtain nx where "c' \<turnstile> n' -IEdge et\<rightarrow>\<^sub>p nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply auto
     apply(cases n') apply auto apply(case_tac n) apply auto
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n et' b)
  from `c' \<turnstile> n -CEdge (p, es, rets)\<rightarrow>\<^sub>p Exit`
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from `Call p es rets \<turnstile> Label 1 -IEdge et\<rightarrow>\<^sub>p n''` show ?case
    by(fastforce elim:Proc_CFG.cases)
qed

lemma Proc_CFG_edge_det:
  "\<lbrakk>prog \<turnstile> n -et\<rightarrow>\<^sub>p n'; prog \<turnstile> n -et'\<rightarrow>\<^sub>p n'\<rbrakk> \<Longrightarrow> et = et'"
proof(induct rule:Proc_CFG.induct)
  case Proc_CFG_Entry_Exit thus ?case by(fastforce dest:Proc_CFG_EntryD)
next
  case Proc_CFG_Entry thus ?case by(fastforce dest:Proc_CFG_EntryD)
next
  case Proc_CFG_Skip thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_LAss thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_LAssSkip thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case (Proc_CFG_SeqFirst c\<^sub>1 n et n' c\<^sub>2)
  note edge = `c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p n'`
  note IH = `c\<^sub>1 \<turnstile> n -et'\<rightarrow>\<^sub>p n' \<Longrightarrow> et = et'`
  from edge `n' \<noteq> Exit` obtain l where l:"n' = Label l" by (cases n') auto
  with edge have "l < #:c\<^sub>1" by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with `c\<^sub>1;;c\<^sub>2 \<turnstile> n -et'\<rightarrow>\<^sub>p n'` l have "c\<^sub>1 \<turnstile> n -et'\<rightarrow>\<^sub>p n'"
    by(fastforce elim:Proc_CFG.cases intro:Proc_CFG.intros dest:label_incr_ge)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n et c\<^sub>2)
  note edge = `c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p Exit`
  note IH = `c\<^sub>1 \<turnstile> n -et'\<rightarrow>\<^sub>p Exit \<Longrightarrow> et = et'`
  from edge `n \<noteq> Entry` obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c\<^sub>1" by(fastforce intro: Proc_CFG_sourcelabel_less_num_nodes)
  with `c\<^sub>1;;c\<^sub>2 \<turnstile> n -et'\<rightarrow>\<^sub>p Label #:c\<^sub>1` l have "c\<^sub>1 \<turnstile> n -et'\<rightarrow>\<^sub>p Exit"
    by(fastforce elim:Proc_CFG.cases
                dest:Proc_CFG_targetlabel_less_num_nodes label_incr_ge)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1)
  note edge = `c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'`
  note IH = `c\<^sub>2 \<turnstile> n -et'\<rightarrow>\<^sub>p n' \<Longrightarrow> et = et'`
  from edge `n \<noteq> Entry` obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c\<^sub>2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with `c\<^sub>1;;c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 -et'\<rightarrow>\<^sub>p n' \<oplus> #:c\<^sub>1` l have "c\<^sub>2 \<turnstile> n -et'\<rightarrow>\<^sub>p n'"
    by -(erule Proc_CFG.cases,
    (fastforce dest:Proc_CFG_sourcelabel_less_num_nodes label_incr_ge
              dest!:label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case Proc_CFG_CondTrue thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_CondFalse thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case (Proc_CFG_CondThen c\<^sub>1 n et n' b c\<^sub>2)
  note edge = `c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p n'`
  note IH = `c\<^sub>1 \<turnstile> n -et'\<rightarrow>\<^sub>p n' \<Longrightarrow> et = et'`
  from edge `n \<noteq> Entry` obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c\<^sub>1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> 1 -et'\<rightarrow>\<^sub>p n' \<oplus> 1` l have "c\<^sub>1 \<turnstile> n -et'\<rightarrow>\<^sub>p n'"
    by -(erule Proc_CFG.cases,(fastforce dest:label_incr_ge label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_CondElse c\<^sub>2 n et n' b c\<^sub>1)
  note edge = `c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'`
  note IH = `c\<^sub>2 \<turnstile> n -et'\<rightarrow>\<^sub>p n' \<Longrightarrow> et = et'`
  from edge `n \<noteq> Entry` obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c\<^sub>2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> (#:c\<^sub>1 + 1) -et'\<rightarrow>\<^sub>p n' \<oplus> (#:c\<^sub>1 + 1)` l
  have "c\<^sub>2 \<turnstile> n -et'\<rightarrow>\<^sub>p n'"
    by -(erule Proc_CFG.cases,(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes
                             label_incr_inj label_incr_ge label_incr_simp_rev)+)
  from IH[OF this] show ?case .
next
  case Proc_CFG_WhileTrue thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_WhileFalse thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_WhileFalseSkip thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case (Proc_CFG_WhileBody c' n et n' b)
  note edge = `c' \<turnstile> n -et\<rightarrow>\<^sub>p n'`
  note IH = `c' \<turnstile> n -et'\<rightarrow>\<^sub>p n' \<Longrightarrow> et = et'`
  from edge `n \<noteq> Entry` obtain l where l:"n = Label l" by (cases n) auto
  with edge have less:"l < #:c'"
    by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  from edge `n' \<noteq> Exit` obtain l' where l':"n' = Label l'" by (cases n') auto
  with edge have "l' < #:c'" by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with `while (b) c' \<turnstile> n \<oplus> 2 -et'\<rightarrow>\<^sub>p n' \<oplus> 2` l less l' have "c' \<turnstile> n -et'\<rightarrow>\<^sub>p n'"
    by(fastforce elim:Proc_CFG.cases dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_WhileBodyExit c' n et b)
  note edge = `c' \<turnstile> n -et\<rightarrow>\<^sub>p Exit`
  note IH = `c' \<turnstile> n -et'\<rightarrow>\<^sub>p Exit \<Longrightarrow> et = et'`
  from edge `n \<noteq> Entry` obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with `while (b) c' \<turnstile> n \<oplus> 2 -et'\<rightarrow>\<^sub>p Label 0` l have "c' \<turnstile> n -et'\<rightarrow>\<^sub>p Exit"
    by -(erule Proc_CFG.cases,auto dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
next
  case Proc_CFG_Call thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_CallSkip thus ?case by(fastforce elim:Proc_CFG.cases)
qed

lemma WCFG_deterministic:
  "\<lbrakk>prog \<turnstile> n\<^sub>1 -et\<^sub>1\<rightarrow>\<^sub>p n\<^sub>1'; prog \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n\<^sub>1 = n\<^sub>2; n\<^sub>1' \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et\<^sub>1 = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
            (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))"
proof(induct arbitrary:n\<^sub>2 n\<^sub>2' rule:Proc_CFG.induct)
  case (Proc_CFG_Entry_Exit prog)
  from `prog \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Entry = n\<^sub>2` `Exit \<noteq> n\<^sub>2'`
  have "et\<^sub>2 = IEdge (\<lambda>s. True)\<^sub>\<surd>" by(fastforce dest:Proc_CFG_EntryD)
  thus ?case by simp
next
  case (Proc_CFG_Entry prog)
  from `prog \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Entry = n\<^sub>2` `Label 0 \<noteq> n\<^sub>2'`
  have "et\<^sub>2 = IEdge (\<lambda>s. False)\<^sub>\<surd>" by(fastforce dest:Proc_CFG_EntryD)
  thus ?case by simp
next
  case Proc_CFG_Skip
  from `Skip \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 0 = n\<^sub>2` `Exit \<noteq> n\<^sub>2'`
  have False by(fastforce elim:Proc_CFG.cases)
  thus ?case by simp
next
  case (Proc_CFG_LAss V e)
  from `V:=e \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 0 = n\<^sub>2` `Label 1 \<noteq> n\<^sub>2'`
  have False by -(erule Proc_CFG.cases,auto)
  thus ?case by simp
next
  case (Proc_CFG_LAssSkip V e)
  from `V:=e \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 1 = n\<^sub>2` `Exit \<noteq> n\<^sub>2'`
  have False by -(erule Proc_CFG.cases,auto)
  thus ?case by simp
next
  case (Proc_CFG_SeqFirst c\<^sub>1 n et n' c\<^sub>2)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
            (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p n'` `n = n\<^sub>2` `n' \<noteq> n\<^sub>2'`
  have "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2' \<or> (c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p Exit \<and> n\<^sub>2' = Label #:c\<^sub>1)"
    apply hypsubst_thin apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
    by(case_tac n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)+
  thus ?case
  proof
    assume "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'"
    from IH[OF this `n = n\<^sub>2` `n' \<noteq> n\<^sub>2'`] show ?case .
  next
    assume "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p Exit \<and> n\<^sub>2' = Label #:c\<^sub>1"
    hence edge:"c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p Exit" and n2':"n\<^sub>2' = Label #:c\<^sub>1" by simp_all
    from IH[OF edge `n = n\<^sub>2` `n' \<noteq> Exit`] show ?case .
  qed
next
  case (Proc_CFG_SeqConnect c\<^sub>1 n et c\<^sub>2)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; Exit \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
            (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p Exit` `n = n\<^sub>2` `n \<noteq> Entry`
    `Label #:c\<^sub>1 \<noteq> n\<^sub>2'` have "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2' \<and> Exit \<noteq> n\<^sub>2'"
    apply hypsubst_thin apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
    by(case_tac n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)+
  from IH[OF this[THEN conjunct1] `n = n\<^sub>2` this[THEN conjunct2]]
  show ?case .
next
  case (Proc_CFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
            (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `c\<^sub>1;;c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'` `n \<oplus> #:c\<^sub>1 = n\<^sub>2`
    `n' \<oplus> #:c\<^sub>1 \<noteq> n\<^sub>2'` `n \<noteq> Entry`
  obtain nx where "c\<^sub>2 \<turnstile> n -et\<^sub>2\<rightarrow>\<^sub>p nx \<and> nx \<oplus> #:c\<^sub>1 = n\<^sub>2'"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
      apply(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  with `n' \<oplus> #:c\<^sub>1 \<noteq> n\<^sub>2'` have edge:"c\<^sub>2 \<turnstile> n -et\<^sub>2\<rightarrow>\<^sub>p nx" and neq:"n' \<noteq> nx"
    by auto
  from IH[OF edge _ neq] show ?case by simp
next
  case (Proc_CFG_CondTrue b c\<^sub>1 c\<^sub>2)
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 0 = n\<^sub>2` `Label 1 \<noteq> n\<^sub>2'`
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_CondFalse b c\<^sub>1 c\<^sub>2)
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 0 = n\<^sub>2` `Label (#:c\<^sub>1 + 1) \<noteq> n\<^sub>2'`
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_CondThen c\<^sub>1 n et n' b c\<^sub>2)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
              (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c\<^sub>1 \<turnstile> n -et\<rightarrow>\<^sub>p n'` `n \<noteq> Entry`
    `n \<oplus> 1 = n\<^sub>2` `n' \<oplus> 1 \<noteq> n\<^sub>2'`
  obtain nx where "c\<^sub>1 \<turnstile> n -et\<^sub>2\<rightarrow>\<^sub>p nx \<and> n' \<noteq> nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros simp del:One_nat_def)
     apply(drule label_incr_inj) apply(auto simp del:One_nat_def)
    apply(drule label_incr_simp_rev[OF sym])
    by(case_tac na,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (Proc_CFG_CondElse c\<^sub>2 n et n' b c\<^sub>1)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
              (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c\<^sub>2 \<turnstile> n -et\<rightarrow>\<^sub>p n'` `n \<noteq> Entry`
    `n \<oplus> #:c\<^sub>1 + 1 = n\<^sub>2` `n' \<oplus> #:c\<^sub>1 + 1 \<noteq> n\<^sub>2'`
  obtain nx where "c\<^sub>2 \<turnstile> n -et\<^sub>2\<rightarrow>\<^sub>p nx \<and> n' \<noteq> nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros simp del:One_nat_def)
     apply(drule label_incr_simp_rev)
     apply(case_tac na,auto,cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (Proc_CFG_WhileTrue b c')
  from `while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 0 = n\<^sub>2` `Label 2 \<noteq> n\<^sub>2'`
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_WhileFalse b c')
  from `while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 0 = n\<^sub>2` `Label 1 \<noteq> n\<^sub>2'`
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_WhileFalseSkip b c')
  from `while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `Label 1 = n\<^sub>2` `Exit \<noteq> n\<^sub>2'`
  show ?case by -(erule Proc_CFG.cases,auto dest:label_incr_ge)
next
  case (Proc_CFG_WhileBody c' n et n' b)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
              (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c' \<turnstile> n -et\<rightarrow>\<^sub>p n'` `n \<noteq> Entry`
    `n' \<noteq> Exit` `n \<oplus> 2 = n\<^sub>2` `n' \<oplus> 2 \<noteq> n\<^sub>2'`
  obtain nx where "c' \<turnstile> n -et\<^sub>2\<rightarrow>\<^sub>p nx \<and> n' \<noteq> nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
      apply(fastforce dest:label_incr_ge[OF sym])
     apply(fastforce dest:label_incr_inj)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n et b)
  note IH = `\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'; n = n\<^sub>2; Exit \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = IEdge (Q)\<^sub>\<surd> \<and> et\<^sub>2 = IEdge (Q')\<^sub>\<surd> \<and>
              (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))`
  from `while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow>\<^sub>p n\<^sub>2'` `c' \<turnstile> n -et\<rightarrow>\<^sub>p Exit` `n \<noteq> Entry`
    `n \<oplus> 2 = n\<^sub>2` `Label 0 \<noteq> n\<^sub>2'`
  obtain nx where "c' \<turnstile> n -et\<^sub>2\<rightarrow>\<^sub>p nx \<and> Exit \<noteq> nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
     apply(fastforce dest:label_incr_ge[OF sym])
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case Proc_CFG_Call thus ?case by -(erule Proc_CFG.cases,auto)
next
  case Proc_CFG_CallSkip thus ?case by -(erule Proc_CFG.cases,auto)
qed

subsection {* And now: the interprocedural CFG *}

subsubsection {* Statements containing calls *}

text {* A procedure is a tuple composed of its name, its input and output variables
  and its method body *}

type_synonym proc = "(pname \<times> vname list \<times> vname list \<times> cmd)"
type_synonym procs = "proc list"

text {* @{text "containsCall"} guarantees that a call to procedure p is in
  a certain statement. *}

declare conj_cong[fundef_cong]

function containsCall ::
  "procs \<Rightarrow> cmd \<Rightarrow> pname list \<Rightarrow> pname \<Rightarrow> bool"
where "containsCall procs Skip ps p \<longleftrightarrow> False"
  | "containsCall procs (V:=e) ps p \<longleftrightarrow> False"
  | "containsCall procs (c\<^sub>1;;c\<^sub>2) ps p \<longleftrightarrow>
       containsCall procs c\<^sub>1 ps p \<or> containsCall procs c\<^sub>2 ps p"
  | "containsCall procs (if (b) c\<^sub>1 else c\<^sub>2) ps p \<longleftrightarrow>
       containsCall procs c\<^sub>1 ps p \<or> containsCall procs c\<^sub>2 ps p"
  | "containsCall procs (while (b) c) ps p \<longleftrightarrow>
       containsCall procs c ps p"
  | "containsCall procs (Call q es' rets') ps p \<longleftrightarrow> p = q \<and> ps = [] \<or>
       (\<exists>ins outs c ps'. ps = q#ps' \<and> (q,ins,outs,c) \<in> set procs \<and>
                     containsCall procs c ps' p)"
by pat_completeness auto
termination containsCall
by(relation "measures [\<lambda>(procs,c,ps,p). length ps,
  \<lambda>(procs,c,ps,p). size c]") auto

lemmas containsCall_induct[case_names Skip LAss Seq Cond While Call] =
  containsCall.induct

lemma containsCallcases:
  "containsCall procs prog ps p
  \<Longrightarrow> ps = [] \<and> containsCall procs prog ps p \<or>
  (\<exists>q ins outs c ps'. ps = ps'@[q] \<and> (q,ins,outs,c) \<in> set procs \<and>
  containsCall procs c [] p \<and> containsCall procs prog ps' q)"
proof(induct procs prog ps p rule:containsCall_induct)
  case (Call procs q es' rets' ps p)
  note IH = `\<And>x y z ps'. \<lbrakk>ps = q#ps'; (q,x,y,z) \<in> set procs;
    containsCall procs z ps' p\<rbrakk>
    \<Longrightarrow> ps' = [] \<and> containsCall procs z ps' p \<or>
    (\<exists>qx ins outs c psx. ps' = psx@[qx] \<and> (qx,ins,outs,c) \<in> set procs \<and>
    containsCall procs c [] p \<and>
    containsCall procs z psx qx)`
  from `containsCall procs (Call q es' rets') ps p`
  have "p = q \<and> ps = [] \<or>
    (\<exists>ins outs c ps'. ps = q#ps' \<and> (q,ins,outs,c) \<in> set procs \<and>
                  containsCall procs c ps' p)" by simp
  thus ?case
  proof
    assume assms:"p = q \<and> ps = []"
    hence "containsCall procs (Call q es' rets') ps p" by simp
    with assms show ?thesis by simp
  next
    assume "\<exists>ins outs c ps'. ps = q#ps' \<and> (q,ins,outs,c) \<in> set procs \<and>
      containsCall procs c ps' p"
    then obtain ins outs c ps' where "ps = q#ps'" and "(q,ins,outs,c) \<in> set procs"
      and "containsCall procs c ps' p" by blast
    from IH[OF this] have "ps' = [] \<and> containsCall procs c ps' p \<or>
      (\<exists>qx insx outsx cx psx.
         ps' = psx @ [qx] \<and> (qx,insx,outsx,cx) \<in> set procs \<and>
         containsCall procs cx [] p \<and> containsCall procs c psx qx)" .
    thus ?thesis
    proof
      assume assms:"ps' = [] \<and> containsCall procs c ps' p"
      have "containsCall procs (Call q es' rets') [] q" by simp
      with assms `ps = q#ps'` `(q,ins,outs,c) \<in> set procs` show ?thesis by fastforce
    next
      assume "\<exists>qx insx outsx cx psx.
        ps' = psx@[qx] \<and> (qx,insx,outsx,cx) \<in> set procs \<and>
        containsCall procs cx [] p \<and> containsCall procs c psx qx"
      then obtain qx insx outsx cx psx
        where "ps' = psx@[qx]" and "(qx,insx,outsx,cx) \<in> set procs"
        and "containsCall procs cx [] p"
        and "containsCall procs c psx qx" by blast
      from `(q,ins,outs,c) \<in> set procs` `containsCall procs c psx qx`
      have "containsCall procs (Call q es' rets') (q#psx) qx" by fastforce
      with `ps' = psx@[qx]` `ps = q#ps'` `(qx,insx,outsx,cx) \<in> set procs`
        `containsCall procs cx [] p` show ?thesis by fastforce
    qed
  qed
qed auto

lemma containsCallE:
  "\<lbrakk>containsCall procs prog ps p;
    \<lbrakk>ps = []; containsCall procs prog ps p\<rbrakk> \<Longrightarrow> P procs prog ps p;
    \<And>q ins outs c es' rets' ps'. \<lbrakk>ps = ps'@[q]; (q,ins,outs,c) \<in> set procs;
      containsCall procs c [] p; containsCall procs prog ps' q\<rbrakk>
     \<Longrightarrow> P procs prog ps p\<rbrakk> \<Longrightarrow> P procs prog ps p"
  by(auto dest:containsCallcases)

lemma containsCall_in_proc:
  "\<lbrakk>containsCall procs prog qs q; (q,ins,outs,c) \<in> set procs;
  containsCall procs c [] p\<rbrakk>
  \<Longrightarrow> containsCall procs prog (qs@[q]) p"
proof(induct procs prog qs q rule:containsCall_induct)
  case (Call procs qx esx retsx ps p')
  note IH = `\<And>x y z psx. \<lbrakk>ps = qx#psx; (qx,x,y,z) \<in> set procs;
    containsCall procs z psx p'; (p',ins,outs,c) \<in> set procs;
    containsCall procs c [] p\<rbrakk> \<Longrightarrow> containsCall procs z (psx@[p']) p`
  from `containsCall procs (Call qx esx retsx) ps p'`
  have "p' = qx \<and> ps = [] \<or>
    (\<exists>insx outsx cx psx. ps = qx#psx \<and> (qx,insx,outsx,cx) \<in> set procs \<and>
    containsCall procs cx psx p')" by simp
  thus ?case
  proof
    assume assms:"p' = qx \<and> ps = []"
    with `(p', ins, outs, c) \<in> set procs` `containsCall procs c [] p`
    have "containsCall procs (Call qx esx retsx) [p'] p" by fastforce
    with assms show ?thesis by simp
  next
    assume "\<exists>insx outsx cx psx. ps = qx#psx \<and> (qx,insx,outsx,cx) \<in> set procs \<and>
      containsCall procs cx psx p'"
    then obtain insx outsx cx psx where "ps = qx#psx"
      and "(qx,insx,outsx,cx) \<in> set procs"
      and "containsCall procs cx psx p'" by blast
    from IH[OF this `(p', ins, outs, c) \<in> set procs`
      `containsCall procs c [] p`]
    have "containsCall procs cx (psx @ [p']) p" .
    with `ps = qx#psx` `(qx,insx,outsx,cx) \<in> set procs`
    show ?thesis by fastforce
  qed
qed auto

lemma containsCall_indirection:
  "\<lbrakk>containsCall procs prog qs q; containsCall procs c ps p;
  (q,ins,outs,c) \<in> set procs\<rbrakk>
  \<Longrightarrow> containsCall procs prog (qs@q#ps) p"
proof(induct procs prog qs q rule:containsCall_induct)
  case (Call procs px esx retsx ps' p')
  note IH = `\<And>x y z psx. \<lbrakk>ps' = px # psx; (px, x, y, z) \<in> set procs;
    containsCall procs z psx p'; containsCall procs c ps p;
    (p', ins, outs, c) \<in> set procs\<rbrakk>
    \<Longrightarrow> containsCall procs z (psx @ p' # ps) p`
  from `containsCall procs (Call px esx retsx) ps' p'`
  have "p' = px \<and> ps' = [] \<or>
    (\<exists>insx outsx cx psx. ps' = px#psx \<and> (px,insx,outsx,cx) \<in> set procs \<and>
    containsCall procs cx psx p')" by simp
  thus ?case
  proof
    assume "p' = px \<and> ps' = []"
    with `containsCall procs c ps p` `(p', ins, outs, c) \<in> set procs`
    show ?thesis by fastforce
  next
    assume "\<exists>insx outsx cx psx. ps' = px#psx \<and> (px,insx,outsx,cx) \<in> set procs \<and>
      containsCall procs cx psx p'"
    then obtain insx outsx cx psx where "ps' = px#psx"
      and "(px,insx,outsx,cx) \<in> set procs"
      and "containsCall procs cx psx p'" by blast
    from IH[OF this `containsCall procs c ps p`
      `(p', ins, outs, c) \<in> set procs`]
    have "containsCall procs cx (psx @ p' # ps) p" .
    with `ps' = px#psx` `(px,insx,outsx,cx) \<in> set procs`
    show ?thesis by fastforce
  qed
qed auto

lemma Proc_CFG_Call_containsCall:
  "prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n' \<Longrightarrow> containsCall procs prog [] p"
by(induct prog n et\<equiv>"CEdge (p,es,rets)" n' rule:Proc_CFG.induct,auto)

lemma containsCall_empty_Proc_CFG_Call_edge:
  assumes "containsCall procs prog [] p"
  obtains l es rets l' where "prog \<turnstile> Label l -CEdge (p,es,rets)\<rightarrow>\<^sub>p Label l'"
proof(atomize_elim)
  from `containsCall procs prog [] p`
  show "\<exists>l es rets l'. prog \<turnstile> Label l -CEdge (p,es,rets)\<rightarrow>\<^sub>p Label l'"
  proof(induct procs prog ps\<equiv>"[]::pname list" p rule:containsCall_induct)
    case Seq thus ?case
      by auto(fastforce dest:Proc_CFG_SeqFirst,fastforce dest:Proc_CFG_SeqSecond)
  next
    case Cond thus ?case
      by auto(fastforce dest:Proc_CFG_CondThen,fastforce dest:Proc_CFG_CondElse)
  next
    case While thus ?case by(fastforce dest:Proc_CFG_WhileBody)
  next
    case Call thus ?case by(fastforce intro:Proc_CFG_Call)
  qed auto
qed

subsubsection{* The edges of the combined CFG *}

type_synonym node = "(pname \<times> label)"
type_synonym edge = "(node \<times> (vname,val,node,pname) edge_kind \<times> node)"

fun get_proc :: "node \<Rightarrow> pname"
  where "get_proc (p,l) = p"

inductive PCFG ::
  "cmd \<Rightarrow> procs \<Rightarrow> node \<Rightarrow> (vname,val,node,pname) edge_kind \<Rightarrow> node \<Rightarrow> bool"
("_,_ \<turnstile> _ -_\<rightarrow> _" [51,51,0,0,0] 81)
for prog::cmd and procs::procs
where

  Main:
  "prog \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n' \<Longrightarrow> prog,procs \<turnstile> (Main,n) -et\<rightarrow> (Main,n')"

| Proc:
  "\<lbrakk>(p,ins,outs,c) \<in> set procs; c \<turnstile> n -IEdge et\<rightarrow>\<^sub>p n';
    containsCall procs prog ps p\<rbrakk>
  \<Longrightarrow> prog,procs \<turnstile> (p,n) -et\<rightarrow> (p,n')"

| MainCall:
  "\<lbrakk>prog \<turnstile> Label l -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'; (p,ins,outs,c) \<in> set procs\<rbrakk>
  \<Longrightarrow> prog,procs \<turnstile> (Main,Label l)
                  -(\<lambda>s. True):(Main,n')\<hookrightarrow>\<^bsub>p\<^esub>map (\<lambda>e cf. interpret e cf) es\<rightarrow> (p,Entry)"

| ProcCall:
  "\<lbrakk>(p,ins,outs,c) \<in> set procs; c \<turnstile> Label l -CEdge (p',es',rets')\<rightarrow>\<^sub>p Label l';
    (p',ins',outs',c') \<in> set procs; containsCall procs prog ps p\<rbrakk>
  \<Longrightarrow> prog,procs \<turnstile> (p,Label l)
               -(\<lambda>s. True):(p,Label l')\<hookrightarrow>\<^bsub>p'\<^esub>map (\<lambda>e cf. interpret e cf) es'\<rightarrow> (p',Entry)"

| MainReturn:
  "\<lbrakk>prog \<turnstile> Label l -CEdge (p,es,rets)\<rightarrow>\<^sub>p Label l'; (p,ins,outs,c) \<in> set procs\<rbrakk>
  \<Longrightarrow> prog,procs \<turnstile> (p,Exit) -(\<lambda>cf. snd cf = (Main,Label l'))\<hookleftarrow>\<^bsub>p\<^esub>
       (\<lambda>cf cf'. cf'(rets [:=] map cf outs))\<rightarrow> (Main,Label l')"

| ProcReturn:
  "\<lbrakk>(p,ins,outs,c) \<in> set procs; c \<turnstile> Label l -CEdge (p',es',rets')\<rightarrow>\<^sub>p Label l';
   (p',ins',outs',c') \<in> set procs; containsCall procs prog ps p\<rbrakk>
  \<Longrightarrow> prog,procs \<turnstile> (p',Exit) -(\<lambda>cf. snd cf = (p,Label l'))\<hookleftarrow>\<^bsub>p'\<^esub>
       (\<lambda>cf cf'. cf'(rets' [:=] map cf outs'))\<rightarrow> (p,Label l')"

| MainCallReturn:
  "prog \<turnstile> n -CEdge (p,es,rets)\<rightarrow>\<^sub>p n'
  \<Longrightarrow> prog,procs \<turnstile> (Main,n) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (Main,n')"

| ProcCallReturn:
  "\<lbrakk>(p,ins,outs,c) \<in> set procs; c \<turnstile> n -CEdge (p',es',rets')\<rightarrow>\<^sub>p n';
    containsCall procs prog ps p\<rbrakk>
  \<Longrightarrow> prog,procs \<turnstile> (p,n) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (p,n')"

end


theory RecComb
imports SimpComb
begin

syntax
  "pow" :: "[i,i,i] \<Rightarrow> i" ("(pow'(_,/ _,/ _'))" [75] 75)
  "col" :: "[i,i,i] \<Rightarrow> i" ("(col'(_,/ _,/ _'))" [75] 75)
  "row" :: "[i,i,i] \<Rightarrow> i" ("(row'(_,/ _,/ _'))" [75] 75)
  "Map" :: "[i,i] \<Rightarrow> i" ("(Map'(_,/ _'))" [75] 75)

  "powf" :: "[i,i,i] \<Rightarrow> i"
  "colf" :: "[i,i,i] \<Rightarrow> i"
  "rowf" :: "[i,i,i] \<Rightarrow> i"
  "mapf" :: "[i,i] \<Rightarrow> i"

  "Lambda" :: "[i,i] \<Rightarrow> i"
  "nat" :: "i"
translations
  "pow(A,n,R)" => "powf(A, n, Lambda(nat, %_. R))"
  "col(A,n,R)" => "colf(A, n, Lambda(nat, %_. R))"
  "row(A,n,R)" => "rowf(A, n, Lambda(nat, %_. R))"
  "Map(n,R)" => "mapf(n, Lambda(nat, %_. R))"

definition powf :: "[i,i,i] \<Rightarrow> i" where
  "powf(A,n,R) == rec(n, Id(A), %x y. y ;; R`x)"

definition mapf' :: "[i,i,i,i] \<Rightarrow> i" where
  "mapf'(A,B,n,R) == rec(n, NNIL, %x y.(apr(A,x)~);;[[y,R`x]];;apr(B,x))"

definition mapf :: "[i,i] \<Rightarrow> i" where
  "mapf(n,R) == mapf'(dtyp(Union(range(R))), rtyp(Union(range(R))), n, R)"

definition tri :: "[i,i,i] \<Rightarrow> i" where
  "tri(A,n,R) == mapf(n, lam i:nat. pow(A,i,R))"

definition colf' :: "[i,i,i,i,i] \<Rightarrow> i" where
  "colf'(A,B,C,n,R) ==
    rec(n, Fst(B,NNIL) ;; cross(nlist[0]C, B),
    %x y. Fst(B,apr(A,x)~) ;; (y || (R`x)) ;; Snd(B,apr(C,x)))"

definition colf :: "[i,i,i] \<Rightarrow> i" where
  "colf(B,n,R) == colf'(ddtyp(Union(range(R))), B, rrtyp(Union(range(R))), n, R)"

definition rowf :: "[i,i,i] \<Rightarrow> i" where
  "rowf(B,n,R) == (colf(B,n,lam m:nat. ((R`m)~)))~"

theorem dtypUR: "\<lbrakk> x:sig(dtyp(Union(range(R)))); R:nat\<rightarrow>A<~>B \<rbrakk> \<Longrightarrow> x:sig(A)"
apply(rule dtyp_rel[of "Union(range(R))"], simp_all)
apply(auto, drule range_type, blast+)
done

theorem rtypUR: "\<lbrakk> x:sig(rtyp(Union(range(R)))); R:nat\<rightarrow>B<~>A \<rbrakk> \<Longrightarrow> x:sig(A)"
apply(rule rtyp_rel[of "Union(range(R))"], simp_all)
apply(auto, drule range_type, blast+)
done

theorem dtyp_sigUR:
  "\<lbrakk> <x,y>:R`n; R:nat\<rightarrow>A<~>B; n:nat; x:sig(A) \<rbrakk>
    \<Longrightarrow> x:sig(dtyp(Union(range(R))))"
apply(rule dtyp_sig)
apply(frule apply_rangeI, simp, blast+)
done

theorem rtyp_sigUR:
  "\<lbrakk> <x,y>:R`n; R:nat\<rightarrow>A<~>B; n:nat; y:sig(B) \<rbrakk>
    \<Longrightarrow> y:sig(rtyp(Union(range(R))))"
apply(rule rtyp_sig)
apply(frule apply_rangeI, simp, blast+)
done

theorem dtyp_rtyp_fun:
  "\<lbrakk> R:nat\<rightarrow>A<~>B; m:nat \<rbrakk>
    \<Longrightarrow> R`m:(dtyp(Union(range(R))))<~>(rtyp(Union(range(R))))"
apply(auto)
apply(frule apply_funtype, auto)
apply(drule subsetD, auto)
apply(rule dtyp_sigUR, simp_all)
apply(rule rtyp_sigUR, simp_all)
done

theorem nlist_dtypUR:
  "\<lbrakk> x:sig(nlist[n]dtyp(Union(range(R)))); R:nat\<rightarrow>A<~>B \<rbrakk>
    \<Longrightarrow> x:sig(nlist[n]A)"
apply(rule sig_sub_func, simp)
apply(drule apply_funtype, simp)
apply(subgoal_tac "dtyp(Union(range(R))) \<subseteq> A", drule nlist_mono[of _ _n], blast)
apply(auto simp add: dtyp_def)
apply(drule range_type, simp)
apply(drule PowD, drule subsetD, simp)
apply(auto, drule range_type, simp+)
done

theorem nlist_rtypUR:
  "\<lbrakk> x:sig(nlist[n]rtyp(Union(range(R)))); R:nat\<rightarrow>A<~>B \<rbrakk>
    \<Longrightarrow> x:sig(nlist[n]B)"
apply(rule sig_sub_func, simp)
apply(drule apply_funtype, simp)
apply(subgoal_tac "rtyp(Union(range(R))) \<subseteq> B", drule nlist_mono[of _ _n], blast)
apply(auto simp add: rtyp_def)
apply(drule range_type, simp)
apply(drule PowD, drule subsetD, simp)
apply(auto, drule range_type, simp+)
done

theorem nlist_ddtypUR:
  "\<lbrakk> a:sig(nlist[n]ddtyp(Union(range(Rf)))); Rf:nat \<rightarrow> A*B<~>B1*C \<rbrakk>
    \<Longrightarrow> a:sig(nlist[n]A)"
apply(rule sig_sub_func, simp)
apply(drule apply_funtype, simp)
apply(subgoal_tac "ddtyp(Union(range(Rf))) \<subseteq> A", drule nlist_mono[of _ _n], blast)
apply(auto simp add: dtyp_def ddtyp_def)
apply(drule range_type[of _ _ Rf], simp)
apply(drule PowD, drule subsetD, simp, auto)
apply(drule range_type, simp, blast)
done

theorem nlist_rrtypUR:
  "\<lbrakk> a:sig(nlist[n]rrtyp(Union(range(Rf)))); Rf:nat \<rightarrow> A*B<~>B1*C \<rbrakk>
    \<Longrightarrow> a:sig(nlist[n]C)"
apply(rule sig_sub_func, simp)
apply(drule apply_funtype, simp)
apply(subgoal_tac "rrtyp(Union(range(Rf))) \<subseteq> C", drule nlist_mono[of _ _n], blast)
apply(auto simp add: rtyp_def rrtyp_def)
apply(drule range_type[of _ _ Rf], simp)
apply(drule PowD, drule subsetD, simp, auto)
apply(drule range_type, simp, blast)
done

theorem rdtypUR:
  "\<lbrakk> b:sig(rdtyp(Union(range(Rf)))); Rf:nat\<rightarrow>A*B<~>B1*C \<rbrakk>
    \<Longrightarrow> b:sig(B)"
apply(rule sig_sub_func, simp)
apply(drule apply_funtype, simp)
apply(subgoal_tac "rdtyp(Union(range(Rf))) \<subseteq> B", blast)
apply(auto simp add: dtyp_def rdtyp_def)
apply(drule range_type[of _ _ Rf], simp) back
apply(drule PowD, drule subsetD, simp, auto)
apply(drule range_type, simp) back
apply(blast)
done

theorem powf_type: "\<lbrakk> n:nat; R:nat\<rightarrow>A<~>A \<rbrakk> \<Longrightarrow> powf(A,n,R):A<~>A"
apply(unfold powf_def)
apply(induct_tac n)
apply(simp, rule PowD, typecheck)
apply(subst rec_succ, typecheck)
done

theorem powfR: "\<lbrakk> A:ChTy; n:nat; R:nat\<rightarrow>A<R>A \<rbrakk> \<Longrightarrow> powf(A,n,R):A<R>A"
apply(unfold powf_def)
apply(induct_tac n)
apply(simp, rule IdR, simp)
apply(simp, intro RubyR, simp+)
done

theorem powf_zero: "a:sig(A) \<Longrightarrow> <a,a>:powf(A,0,R)"
apply(unfold powf_def)
apply(simp)
apply(rule IdI, simp)
done

theorem powf_zero_iff: "powf(A,0,R) = Id(A)"
apply(unfold powf_def, simp)
done

theorem powf_succ: "powf(A, succ(n), R) = powf(A,n,R) ;; R`n"
apply(unfold powf_def, simp)
done

theorem powfI: "x:powf(A,n,R) ;; R`n \<Longrightarrow> x:powf(A,succ(n),R)"
apply(unfold powf_def, simp)
done

theorem powfE: "\<lbrakk> x:powf(A,succ(n),R); \<lbrakk> x:powf(A,n,R) ;; R`n \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
apply(subst (asm) powf_succ, simp)
done

theorem mapf'_type: "\<lbrakk> n:nat; Rf:nat\<rightarrow>A<~>B \<rbrakk> \<Longrightarrow> mapf'(A,B,n,Rf):nlist[n]A<~>nlist[n]B"
apply(unfold mapf'_def)
apply(induct_tac n)
apply(simp, rule PowD, typecheck)
apply(simp, rule PowD, typecheck)
apply(simp)
done

lemma nat_dtyp_rtyp_fun: "R:nat\<rightarrow>A<~>B \<Longrightarrow> R:nat\<rightarrow>dtyp(Union(range(R)))<~>rtyp(Union(range(R)))"
apply(rule Pi_type, simp)
apply(rule dtyp_rtyp_fun, simp_all)
done

theorem mapf_type: "\<lbrakk> n:nat; Rf:nat\<rightarrow>A<~>B \<rbrakk> \<Longrightarrow> mapf(n,Rf):nlist[n]A<~>nlist[n]B"
apply(unfold mapf_def)
apply(frule nat_dtyp_rtyp_fun)
apply(frule mapf'_type, simp) back
apply(subgoal_tac "nlist[n]dtyp(\<Union>range(Rf))<~>nlist[n]rtyp(\<Union>range(Rf)) \<subseteq> nlist[n]A<~>nlist[n]B")
apply(blast)
apply(auto, drule subsetD, simp,  auto)
apply(rule nlist_dtypUR, auto)
apply(rule nlist_rtypUR, auto)
done

theorem mapf_rtyp_sigUR:
  "\<lbrakk> <la, lb>:mapf(n,R); R:nat\<rightarrow>A<~>B; n:nat \<rbrakk>
    \<Longrightarrow> lb:sig(nlist[n]rtyp(Union(range(R))))"
apply(frule nat_dtyp_rtyp_fun)
apply(frule mapf_type[of n R "dtyp(Union(range(R)))" "rtyp(Union(range(R)))"], simp)
apply(blast)
done

theorem mapf_dtyp_sigUR:
  "\<lbrakk> <la, lb>:mapf(n,R); R:nat\<rightarrow>A<~>B; n:nat \<rbrakk>
    \<Longrightarrow> la:sig(nlist[n]dtyp(Union(range(R))))"
apply(frule nat_dtyp_rtyp_fun)
apply(frule mapf_type[of n R "dtyp(Union(range(R)))" "rtyp(Union(range(R)))"], simp)
apply(blast)
done

theorem mapf_zero: "<snil, snil>:mapf(0, Rf)"
apply(unfold mapf_def mapf'_def)
apply(simp)
apply(rule NNILI)
done

theorem mapf_zero_ifft: "mapf(0, Rf) = NNIL"
apply(unfold mapf_def mapf'_def)
apply(simp)
done

theorem mapf'_zero_ifft: "mapf'(A,B,0, Rf) = NNIL"
apply(unfold mapf'_def)
apply(simp)
done

theorem mapf_succ_ifft:
  "mapf(succ(n), Rf) =
    (apr(dtyp(Union(range(Rf))), n)~);;[[mapf(n,Rf), Rf`n]];;
    apr(rtyp(Union(range(Rf))), n)"
apply(unfold mapf_def mapf'_def)
apply(simp)
done

theorem mapf_succ:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>A<~>B; a:sig(A); b:sig(B);
    la:sig(nlist[n]A); lb:sig(nlist[n]B) \<rbrakk>
    \<Longrightarrow> <[la<@a|n], [lb<@b|n]>:mapf(succ(n), Rf)
        \<longleftrightarrow> (<a,b>:Rf`n & <la, lb>:mapf(n, Rf))"
apply(subst mapf_succ_ifft)
apply(auto)
apply((drule nat_dtyp_rtyp_fun,
      elim compE, typecheck add: mapf_type,
      elim sig_pairE, simp,
      elim invE, typecheck,
      elim RubyE, simp_all)+)
apply(intro RubyI)
apply(subgoal_tac "<<la#a>, [la<@a|n]>:apr(dtyp(\<Union>range(Rf)), n)", simp)
apply(rule aprI)
apply(rule dtyp_sigUR, simp_all)
apply(rule mapf_dtyp_sigUR, simp_all)
apply(subgoal_tac "<<la#a>, <lb#b>>:[[mapf(n, Rf),Rf ` n]]", simp)
apply(intro RubyI, simp_all)
apply(intro RubyI)
apply(rule rtyp_sigUR, simp_all)
apply(rule mapf_rtyp_sigUR, simp_all)
done

lemma mapf'_succ_ifft:
  "mapf'(A,B,succ(n), Rf) =
    (apr(A, n)~);;[[mapf'(A,B,n,Rf), Rf`n]];;apr(B, n)"
apply(unfold mapf'_def, simp)
done

theorem mapf'_succ:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>A<~>B; a:sig(A); b:sig(B);
    la:sig(nlist[n]A); lb:sig(nlist[n]B) \<rbrakk>
    \<Longrightarrow> <[la<@a|n], [lb<@b|n]>:mapf'(A,B,succ(n),Rf)
        \<longleftrightarrow> (<a,b>:Rf`n & <la, lb>:mapf'(A,B,n,Rf))"
apply(subst mapf'_succ_ifft)
apply(auto)
apply((elim compE, typecheck add: mapf'_type,
      elim sig_pairE, simp,
      elim invE, typecheck,
      elim RubyE, simp_all)+)
apply(intro RubyI)
apply(subgoal_tac "<<la#a>, [la<@a|n]>:apr(A, n)", simp)
apply(rule aprI, simp_all)
apply(subgoal_tac "<<la#a>, <lb#b>>:[[mapf'(A,B,n, Rf),Rf ` n]]", simp)
apply(intro RubyI, simp_all)
apply(intro RubyI, simp_all)
done

theorem mapf_mapf'_iff:
  "\<lbrakk> n:nat; R:nat\<rightarrow>A<~>B \<rbrakk> \<Longrightarrow> mapf(n,R) = mapf'(A,B,n,R)"
apply(induct_tac n)
apply(subst mapf'_zero_ifft, subst mapf_zero_ifft, simp)
apply(rule, auto)
apply(frule mapf_type[of "succ(_)", OF nat_succI], simp+)
apply(drule subsetD, simp, safe)
apply(elim sig_ssnocE, simp)
apply(subst (asm) mapf_succ, simp_all)
apply(erule conjE)
apply(subst mapf'_succ, simp_all)
apply(frule mapf'_type[of "succ(_)", OF nat_succI], simp+)
apply(drule subsetD, simp, safe)
apply(elim sig_ssnocE, simp)
apply(subst (asm) mapf'_succ, simp_all)
apply(erule conjE)
apply(subst mapf_succ, simp_all)
done

theorem mapf_zero_iff: "mapf(0,R) = NNIL"
apply(rule mapf_zero_ifft)
done

theorem mapf_zero_iff2: "R:nat\<rightarrow>A<~>B \<Longrightarrow> mapf(0,R) = NNIL"
apply(rule mapf_zero_ifft)
done

theorem mapf_succ_iff:
  "\<lbrakk> n:nat; R:nat\<rightarrow>A<~>B \<rbrakk>
  \<Longrightarrow> mapf(succ(n),R) = (apr(A,n)~);;[[mapf(n,R), R`n]];;apr(B,n)"
apply((subst mapf_mapf'_iff, simp_all)+)
apply(unfold mapf'_def, simp)
done

theorem mapf_succE:
  "\<lbrakk> <[la<@a|n], [lb<@b|n]>:mapf(succ(n), Rf);
    \<lbrakk> <a,b>:Rf`n; <la,lb>:mapf(n,Rf) \<rbrakk> \<Longrightarrow> P;
    n:nat; Rf:nat\<rightarrow>A<~>B; a:sig(A); b:sig(B);
    la:sig(nlist[n]A); lb:sig(nlist[n]B) \<rbrakk> \<Longrightarrow> P"
apply(subst (asm) mapf_succ, simp_all)
done

theorem mapfR:
  "\<lbrakk> A:ChTy; B:ChTy; n:nat; Rf:nat\<rightarrow>A<R>B \<rbrakk>
    \<Longrightarrow> mapf(n,Rf):nlist[n]A<R>nlist[n]B"
apply(induct_tac n)
apply(subst mapf_zero_iff)
apply(intro RubyR, simp+)
apply(subst mapf_succ_iff, simp)
apply(rule fun_weaken_type[OF _ ruby_sub_sig], simp)
apply(intro RubyR)
apply(rule aprR, simp)
apply(rule parR, simp, simp)
apply(rule aprR, simp)
done

theorem tri_type: "\<lbrakk> n:nat; R:A<~>A \<rbrakk> \<Longrightarrow> tri(A,n,R):nlist[n]A<~>nlist[n]A"
apply(unfold tri_def)
apply(typecheck add: mapf_type powf_type)
done

theorem tri_zero: "<snil, snil>: tri(A,0,R)"
apply(unfold tri_def)
apply(rule mapf_zero)
done

theorem tri_zero_iff: "tri(A,0,Rf) = NNIL"
apply(unfold tri_def)
apply(rule mapf_zero_iff)
done

theorem tri_succ_iff:
  "\<lbrakk> n:nat; R:A<~>A \<rbrakk>
    \<Longrightarrow> tri(A, succ(n), R) =
    (apr(A,n)~);;[[tri(A,n,R), pow(A,n,R)]];;apr(A,n)"
apply(unfold tri_def)
apply(subst mapf_succ_iff, simp)
apply(typecheck add: powf_type)
apply(simp)
done

theorem tri_succ:
  "\<lbrakk> n:nat; R:A<~>A; a:sig(A); b:sig(A);
    la:sig(nlist[n]A); lb:sig(nlist[n]A) \<rbrakk> \<Longrightarrow>
    <[la<@a|n], [lb<@b|n]>:tri(A, succ(n), R) \<longleftrightarrow>
    (<a,b>:pow(A,n,R) & <la,lb>:tri(A,n,R))"
apply(unfold tri_def)
apply(subst mapf_succ, typecheck add: powf_type, simp_all)
done

theorem tri_succE:
  "\<lbrakk> <[la<@a|n], [lb<@b|n]>:tri(A, succ(n), R);
    \<lbrakk> <a,b>:pow(A,n,R); <la,lb>:tri(A,n,R) \<rbrakk> \<Longrightarrow> P;
    n:nat; R:A<~>A; a:sig(A); b:sig(A);
    la:sig(nlist[n]A); lb:sig(nlist[n]A) \<rbrakk> \<Longrightarrow> P"
apply(subst (asm) tri_succ, simp_all)
done

theorem colf'_type:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>A*B<~>B*C \<rbrakk>
    \<Longrightarrow> colf'(A,B,C,n,Rf):nlist[n]A*B<~>B*nlist[n]C"
apply(unfold colf'_def)
apply(induct_tac n)
apply(simp, rule PowD, typecheck)
apply(simp, rule PowD)
apply(typecheck, simp)
done

lemma nat_ddtyp_rrtyp_fun:
  "Rf:nat\<rightarrow>A*B<~>B*C \<Longrightarrow> Rf \<in> nat \<rightarrow> ddtyp(\<Union>range(Rf))\<times> B<~>B \<times> rrtyp(\<Union>range(Rf))"
apply(rule Pi_type, simp)
apply(frule apply_funtype, simp)
apply(auto, drule subsetD, simp, safe)
apply(elim sig_pairE, simp, typecheck)
apply(rule ddtyp_sig, simp)
apply(subgoal_tac "\<langle><a#b>, <aa#ba>\<rangle>\<in> \<Union>range(Rf)", simp)
apply(rule, rule apply_rangeI, simp+)
apply(elim sig_pairE, simp, typecheck)
apply(rule rrtyp_sig, simp)
apply(subgoal_tac "\<langle><a#b>, <aa#ba>\<rangle>\<in> \<Union>range(Rf)", simp)
apply(rule, rule apply_rangeI, simp+)
done

theorem colf_type:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>A*B<~>B*C \<rbrakk> \<Longrightarrow>
    colf(B,n,Rf):nlist[n]A*B<~>B*nlist[n]C"
apply(unfold colf_def)
apply(frule nat_ddtyp_rrtyp_fun)
apply(frule colf'_type, simp) back
apply(subgoal_tac "nlist[n]ddtyp(\<Union>range(Rf))\<times> B<~>B \<times> nlist[n]rrtyp(\<Union>range(Rf))
                    \<subseteq> nlist[n]A \<times> B<~>B \<times> nlist[n]C")
apply(blast)
apply(subgoal_tac "sig(nlist[n]ddtyp(\<Union>range(Rf)) \<times> B) \<subseteq> sig(nlist[n]A \<times> B)")
apply(subgoal_tac "sig(B \<times> nlist[n]rrtyp(\<Union>range(Rf))) \<subseteq> sig(B \<times> nlist[n]C)")
apply(auto)
apply(elim sig_pairE, simp, typecheck)
apply(rule nlist_rrtypUR, simp+)
apply(elim sig_pairE, simp, typecheck)
apply(rule nlist_ddtypUR, simp+)
done

theorem colf_basetype:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>A*B<~>B*C \<rbrakk>
    \<Longrightarrow> colf(B,n,Rf): nlist[n]ddtyp(\<Union>range(Rf))\<times> B<~>B \<times> nlist[n]rrtyp(\<Union>range(Rf))"
apply(unfold colf_def)
apply(rule colf'_type, simp)
apply(rule nat_ddtyp_rrtyp_fun, simp)
done

theorem ddtyp_sigUR:
  "\<lbrakk> <<a#bs>,<x#c>>:Rf`n; n:nat; Rf:nat\<rightarrow>A*B<~>B*C;
    a:sig(A'); c:sig(C'); x:sig(B'); bs:sig(E') \<rbrakk>
    \<Longrightarrow> a:sig(ddtyp(Union(range(Rf))))"
apply(drule nat_ddtyp_rrtyp_fun)
apply(drule apply_funtype, simp)
apply(simp, drule subsetD, simp)
apply(safe, drule spair_type_rev, simp+)
done

theorem rrtyp_sigUR:
  "\<lbrakk> <<a#bs>,<x#c>>:Rf`n; n:nat; Rf:nat\<rightarrow>A*B<~>B*C;
    a:sig(A'); c:sig(C'); x:sig(B'); bs:sig(E') \<rbrakk>
    \<Longrightarrow> c:sig(rrtyp(Union(range(Rf))))"
apply(drule nat_ddtyp_rrtyp_fun)
apply(drule apply_funtype, simp)
apply(simp, drule subsetD, simp)
apply(safe, drule spair_type_rev, simp+) back
done

theorem colf_sigUR:
  "\<lbrakk> <<la#x>,<b0#lc>>:colf(B,n,Rf); n:nat; Rf:nat\<rightarrow>A*B<~>B*C;
    la:sig(A'); x:sig(B'); b0:sig(C'); lc:sig(E') \<rbrakk> \<Longrightarrow>
    la:sig(nlist[n]ddtyp(Union(range(Rf)))) &
    lc:sig(nlist[n]rrtyp(Union(range(Rf))))"
apply(frule colf_basetype, simp)
apply(simp, drule subsetD, simp)
apply(safe, drule spair_type_rev, simp+)
apply(drule spair_type_rev, simp+) back
done

theorem colf_zero_ifft:
  "colf(B,0,Rf) =
    Fst(B,NNIL) ;; cross(nlist[0]rrtyp(Union(range(Rf))), B)"
apply(unfold colf_def colf'_def)
apply(simp)
done

theorem colf'_zero_ifft:
  "colf'(A,B,C,0,Rf) =
    Fst(B,NNIL) ;; cross(nlist[0]C, B)"
apply(unfold colf_def colf'_def)
apply(simp)
done

theorem colf_zero: "\<lbrakk> a:sig(A) \<rbrakk> \<Longrightarrow> <<snil#a>,<a#snil>>:colf(A,0,Rf)"
apply(subst colf_zero_ifft)
apply(intro RubyI)
apply(subgoal_tac "<<snil#a>, <snil#a>>:[[NNIL, Id(A)]]", simp)
apply(intro RubyI, simp_all)
apply(intro RubyI, simp_all)
done

theorem colf'_zero: "\<lbrakk> a:sig(B) \<rbrakk> \<Longrightarrow> <<snil#a>,<a#snil>>:colf'(A,B,C,0,Rf)"
apply(subst colf'_zero_ifft)
apply(intro RubyI)
apply(subgoal_tac "<<snil#a>, <snil#a>>:[[NNIL, Id(B)]]", simp)
apply(intro RubyI, simp_all)
apply(intro RubyI, simp_all)
done

theorem colf_succ_ifft:
  "colf(B, succ(n), Rf) =
    Fst(B, apr(ddtyp(Union(range(Rf))), n)~) ;;
    (colf(B,n,Rf) || (Rf`n)) ;;
    Snd(B,apr(rrtyp(Union(range(Rf))), n))"
apply(unfold colf_def colf'_def)
apply(simp)
done

theorem colf'_succ_ifft:
  "colf'(A,B,C,succ(n), Rf) =
    Fst(B, apr(A, n)~) ;;
    (colf'(A,B,C,n,Rf) || (Rf`n)) ;;
    Snd(B,apr(C, n))"
apply(unfold colf_def colf'_def)
apply(simp)
done

theorem colf_succ:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>A*B<~>B*C; a:sig(A'); c:sig(C'); bs:sig(B);
    b0:sig(B); la:sig(nlist[n]A'); lc:sig(nlist[n]C') \<rbrakk>
    \<Longrightarrow> <<[la<@a|n]#bs>,<b0#[lc<@c|n]>>: colf(B,succ(n), Rf) \<longleftrightarrow>
    (EX bn:sig(B). (<<a#bs>,<bn#c>>:Rf`n & <<la#bn>,<b0#lc>>:colf(B,n,Rf)))"
apply(subst colf_succ_ifft)
apply(rule)
apply(drule nat_ddtyp_rrtyp_fun)
apply(elim compE, typecheck add: colf_type)
apply(elim sig_pairE, simp)
apply(elim belowE, typecheck add: colf_type)
apply(elim RubyE, typecheck, simp)
apply(blast)
apply(erule bexE, erule conjE)
apply(intro RubyI)
apply(subgoal_tac "\<langle><[la<@a|n]#bs>, <<la#a>#bs>\<rangle> \<in> [[apr(ddtyp(\<Union>range(Rf)), n)~,Id(B)]]")
apply(simp)
apply(intro RubyI, typecheck)
apply(rule ddtyp_sigUR, simp+)
apply(drule colf_sigUR, simp+)
apply(subgoal_tac "\<langle><<la#a>#bs>, <b0#<lc#c>>\<rangle> \<in> colf(B, n, Rf) || Rf ` n")
apply(simp)
apply(rule belowI[of _ _ _ B], simp, thin_tac "bs:sig(B)", thin_tac "b0:sig(B)", simp+)
apply(intro RubyI, simp+)
apply(rule rrtyp_sigUR, simp+)
apply(drule colf_sigUR, simp+)
done

theorem colf'_succ:
   "\<lbrakk> n:nat; Rf:nat\<rightarrow>A*B<~>B*C; a:sig(A); c:sig(C); bs:sig(B);
    b0:sig(B); la:sig(nlist[n]A); lc:sig(nlist[n]C) \<rbrakk>
    \<Longrightarrow> <<[la<@a|n]#bs>,<b0#[lc<@c|n]>>: colf'(A,B,C,succ(n), Rf) \<longleftrightarrow>
    (EX bn:sig(B). (<<a#bs>,<bn#c>>:Rf`n & <<la#bn>,<b0#lc>>:colf'(A,B,C,n,Rf)))"
apply(subst colf'_succ_ifft)
apply(rule)
apply(elim compE, typecheck add: colf'_type)
apply(elim sig_pairE, simp)
apply(elim belowE, typecheck add: colf'_type)
apply(elim RubyE, typecheck, simp)
apply(blast)
apply(erule bexE, erule conjE)
apply(intro RubyI)
apply(subgoal_tac "\<langle><[la<@a|n]#bs>, <<la#a>#bs>\<rangle> \<in> [[apr(A, n)~,Id(B)]]", simp)
apply(intro RubyI, typecheck)
apply(subgoal_tac "\<langle><<la#a>#bs>, <b0#<lc#c>>\<rangle> \<in> colf'(A,B,C,n,Rf) || Rf ` n", simp)
apply(rule belowI[of _ _ _ B], simp, thin_tac "bs:sig(B)", thin_tac "b0:sig(B)", simp+)
apply(intro RubyI, simp+)
done

lemma colf_colf'_iff_zero:
    "R \<in> nat \<rightarrow> A \<times> B<~>B \<times> C
      \<Longrightarrow> colf(B, 0, R) = colf'(A, B, C, 0, R)"
apply(rule, safe)
apply(frule colf_type[OF nat_0I], simp)
apply(drule subsetD, simp, auto)
apply(elim sig_pairE, simp)
apply(subst (asm) colf_zero_ifft)
apply(erule compE, typecheck, elim sig_pairE, simp)
apply(erule FstE, erule parE, simp+)
apply(elim NNILE IdE, simp+)
apply(erule crossE, simp)
apply(rule colf'_zero, simp+)
apply(frule colf'_type[OF nat_0I], simp)
apply(drule subsetD, simp, auto)
apply(elim sig_pairE, simp)
apply(subst (asm) colf'_zero_ifft)
apply(erule compE, typecheck, elim sig_pairE, simp)
apply(erule FstE, erule parE, simp+)
apply(elim NNILE IdE, simp+)
apply(erule crossE, simp)
apply(rule colf_zero, simp+)
done

theorem colf_colf'_iff: "\<lbrakk> n:nat; R:nat\<rightarrow>A*B<~>B*C \<rbrakk> \<Longrightarrow> colf(B,n,R) = colf'(A,B,C,n,R)"
apply(induct_tac n)
apply(rule colf_colf'_iff_zero, simp)
apply(rule, safe)
apply(frule colf_type[of "succ(_)", OF nat_succI], simp+)
apply(drule subsetD, simp, safe)
apply(elim sig_pairE sig_ssnocE, simp)
apply(subst (asm) colf_succ, simp+)
apply(subst colf'_succ, simp+)
apply(frule colf'_type[of "succ(_)", OF nat_succI], simp+)
apply(drule subsetD, simp, safe)
apply(elim sig_pairE sig_ssnocE, simp)
apply(subst (asm) colf'_succ, simp+)
apply(subst colf_succ, simp+)
done

theorem colf_zero_iff:
  "colf(B,0,R) = (Fst(B,NNIL) ;; cross(nlist[0]rrtyp(\<Union>range(R)),B))"
apply(rule colf_zero_ifft)
done

theorem colf_zero_iff2:
  "R:nat\<rightarrow>A*B<~>B*C \<Longrightarrow> colf(B,0,R) = (Fst(B,NNIL) ;; cross(nlist[0]C,B))"
apply(subst colf_colf'_iff, simp+)
apply(subst colf'_zero_ifft, simp)
done

theorem colf_succ_iff:
  "\<lbrakk> n:nat; R:nat\<rightarrow>A*B<~>B*C \<rbrakk> \<Longrightarrow> colf(B, succ(n), R) =
    Fst(B, apr(A,n)~) ;; (colf(B,n,R) || (R`n)) ;; Snd(B, apr(C,n))"
apply((subst colf_colf'_iff, simp+)+)
apply(subst colf'_succ_ifft, simp)
done

theorem colfR:
  "\<lbrakk> A:ChTy; B:ChTy; C:ChTy; n:nat; R:nat\<rightarrow>A*B<R>B*C \<rbrakk>
    \<Longrightarrow> colf(B,n,R):nlist[n]A*B<R>B*nlist[n]C"
apply(induct_tac n)
apply(subst colf_zero_iff2)
apply(rule fun_weaken_type[OF _ ruby_sub_sig], simp)
apply(intro RubyR, rule FstR, rule NNILR)
apply(simp, rotate_tac 2, simp+)
apply(rule crossR, rule nlist_in_chty, simp+)
apply(subst colf_succ_iff, simp)
apply(rule fun_weaken_type[OF _ ruby_sub_sig], simp)
apply(intro RubyR)
apply(rule FstR, rule invR, rule aprR, simp+)
apply(rule belowR[of "nlist[_]A" B B "nlist[_]C" A B C])
apply((simp add: nlist_in_chty)+)
apply(rule SndR, rule aprR, simp+)
done

theorem colf_succE:
  "\<lbrakk> <<[la<@a|n]#bs>,<b0#[lc<@c|n]>>:colf(B,succ(n), Rf);
    \<And>bn. \<lbrakk> bn:sig(B); <<a#bs>,<bn#c>>:Rf`n;
          <<la#bn>,<b0#lc>>:colf(B,n,Rf) \<rbrakk> \<Longrightarrow> P;
    n:nat; Rf:nat\<rightarrow>A*B<~>B*C; a:sig(A'); c:sig(C');
    bs:sig(B); b0:sig(B); la:sig(nlist[n]A'); lc:sig(nlist[n]C') \<rbrakk> \<Longrightarrow> P"
apply(subst (asm) colf_succ, simp+, blast)
done

theorem colf_zeroE:
  "\<lbrakk> <<snil#a>,<b#snil>>:colf(B,0,Rf);
    \<lbrakk> a = b \<rbrakk> \<Longrightarrow> P; a:sig(B); b:sig(B) \<rbrakk> \<Longrightarrow> P"
apply(subst (asm) colf_zero_ifft)
apply(erule compE, typecheck, elim sig_pairE, simp)
apply(erule FstE, erule parE, simp+)
apply(elim NNILE IdE, simp+)
apply(erule crossE, simp, typecheck)
done

theorem rowf_type:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>B*A<~>C*B \<rbrakk>
    \<Longrightarrow> rowf(B,n,Rf):B*nlist[n]A<~>nlist[n]C*B"
apply(unfold rowf_def)
apply(typecheck add: colf_type)
done

theorem rowfR:
  "\<lbrakk> A:ChTy; B:ChTy; C:ChTy; n:nat; R:nat\<rightarrow>B*A<R>C*B \<rbrakk>
    \<Longrightarrow> rowf(B,n,R):B*nlist[n]A<R>nlist[n]C*B"
apply(unfold rowf_def)
apply(intro RubyR colfR, simp+)
apply(rule lam_type)
apply(intro RubyR, simp)
done

theorem rowf_zero_iff:
  "rowf(B,0,Rf) = (Fst(B,NNIL) ;; cross(nlist[0]rrtyp(\<Union>range(\<lambda>m\<in>nat. Rf ` m~)),B))~"
apply(unfold rowf_def)
apply(subst colf_zero_iff, simp)
done

theorem rowf_zero_iff2:
  "Rf:nat\<rightarrow>B*A<~>C*B \<Longrightarrow>
    rowf(B,0,Rf) =
    (Fst(B,NNIL) ;; cross(nlist[0]A,B))~"
apply(unfold rowf_def)
apply(subst colf_zero_iff2, simp+)
done

theorem row_zero_iff2:
  "R:B*A<~>C*B \<Longrightarrow>
    row(B,0,R) = (Fst(B,NNIL) ;; cross(nlist[0]A,B))~"
apply(subst rowf_zero_iff2)
apply(rule lam_type, simp+)
done

theorem rowf_zero: "a:sig(B) \<Longrightarrow> <<a#snil>,<snil#a>>:rowf(B,0,R)"
apply(unfold rowf_def)
apply(intro RubyI, typecheck)
apply(erule colf_zero)
done

theorem rowf_succ:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>B*A<~>C*B; a:sig(A); c:sig(C); bs:sig(B);
    b0:sig(B); la:sig(nlist[n]A); lc:sig(nlist[n]C) \<rbrakk>
    \<Longrightarrow> <<b0#[la<@a|n]>,<[lc<@c|n]#bs>>:rowf(B,succ(n),Rf) \<longleftrightarrow>
        (EX bn:sig(B). (<<bn#a>,<c#bs>>:Rf`n & <<b0#la>,<lc#bn>>:rowf(B,n,Rf)))"
apply(rule)
apply(unfold rowf_def)
apply(erule invE, typecheck add: colf_type)
apply(subst (asm) colf_succ, simp+)
apply(erule bexE, erule conjE)
apply(drule invI[of "<lc#_>"], simp+)
apply(erule invE, typecheck, blast)
apply(rule invI, typecheck)
apply(subst colf_succ, simp+)
apply(elim bexE conjE invE, typecheck add: colf_type)
apply(drule invI[of "<_#a>"], simp+, blast)
done

theorem rowf_succ_iff:
  "\<lbrakk> n:nat; Rf:nat\<rightarrow>B*A<~>C*B \<rbrakk> \<Longrightarrow>
    rowf(B,succ(n), Rf) =
    Snd(B,apr(A,n)~) ;; (rowf(B,n,Rf) <~~> Rf`n) ;; Fst(B,apr(C,n))"
apply(rule, auto)
apply(frule rowf_type[of "succ(_)", OF nat_succI], simp+)
apply(drule subsetD, simp, safe)
apply(elim sig_pairE sig_ssnocE, simp)
apply(subst (asm) rowf_succ, simp+)
apply(erule bexE, erule conjE)
apply(intro RubyI)
apply(subgoal_tac "\<langle><a#[l<@ab|n]>,<a#<l#ab>>\<rangle> \<in>[[Id(B),apr(A, n)~]]", simp)
apply(intro RubyI, simp+)
apply(subgoal_tac "\<langle><a#<l#ab>>,<<la#ac>#ba>\<rangle> \<in>rowf(B, n, Rf) <~~> Rf ` n", simp)
apply(rule besideI[of _ B], rotate_tac 12, simp+)
apply(intro RubyI, simp+)
apply(subgoal_tac "
    Snd(B, apr(A, n)~) ;; rowf(B, n, Rf) <~~> Rf ` n ;;
    Fst(B, apr(C, n)):B \<times> nlist[succ(n)]A<~>nlist[succ(n)]C \<times> B")
apply(typecheck add: rowf_type, simp)
apply(drule subsetD, simp, safe)
apply(elim sig_pairE sig_ssnocE, simp)
apply(erule compE, typecheck add: rowf_type)
apply(elim sig_pairE, simp)
apply(erule FstE, erule parE, typecheck, erule aprE, erule IdE, simp+)
apply(erule compE, typecheck add: rowf_type)
apply(elim sig_pairE, simp)
apply(erule besideE, typecheck add: rowf_type)
apply(erule SndE, erule parE, simp+, erule IdE, simp)
apply(erule invE, typecheck, erule aprE, simp+)
apply(erule IdE, simp)
apply(subst rowf_succ, simp+, blast)
done

theorem rowf_succE:
  "\<lbrakk> <<b0#[la<@a|n]>,<[lc<@c|n]#bs>>:rowf(B,succ(n),Rf);
    \<And>bn. \<lbrakk> bn:sig(B); <<bn#a>,<c#bs>>:Rf`n;
    <<b0#la>,<lc#bn>>:rowf(B,n,Rf)  \<rbrakk> \<Longrightarrow> P;
    n:nat; Rf:nat\<rightarrow>B*A<~>C*B; a:sig(A); c:sig(C);
    bs:sig(B); b0:sig(B);
    la:sig(nlist[n]A); lc:sig(nlist[n]C) \<rbrakk> \<Longrightarrow> P"
apply(subst (asm) rowf_succ, simp+)
apply(blast)
done

theorem rowf_zeroE:
  "\<lbrakk> <<b0#snil>,<snil#bs>>:rowf(B,0,Rf);
    \<lbrakk> b0 = bs \<rbrakk> \<Longrightarrow> P;
    Rf:nat\<rightarrow>B*A<~>C*B; bs:sig(B); b0:sig(B) \<rbrakk> \<Longrightarrow> P"
apply(unfold rowf_def)
apply(erule invE, typecheck add: colf_type)
apply(erule colf_zeroE, simp+)
done

lemmas RecComb_type =
  powf_type mapf_type tri_type
  colf_type rowf_type

declare RecComb_type [TC]

end