merged
authorAndreas Lochbihler
Wed Feb 12 10:59:25 2014 +0100 (2014-02-12)
changeset 554280ab52bf7b5e6
parent 55427 ff54d22fe357
parent 55425 7a3e78ee813b
child 55440 721b4561007a
merged
src/HOL/Code_Numeral.thy
src/HOL/String.thy
     1.1 --- a/NEWS	Wed Feb 12 09:06:04 2014 +0100
     1.2 +++ b/NEWS	Wed Feb 12 10:59:25 2014 +0100
     1.3 @@ -122,6 +122,11 @@
     1.4      BNF/BNF.thy
     1.5      BNF/Equiv_Relations_More.thy
     1.6  
     1.7 +* Old datatype package:
     1.8 +  * Generated constants "xxx_case" and "xxx_rec" have been renamed "case_xxx"
     1.9 +    and "rec_xxx".
    1.10 +    INCOMPATIBILITY.
    1.11 +
    1.12  * New theory:
    1.13      Cardinals/Ordinal_Arithmetic.thy
    1.14  
     2.1 --- a/src/Doc/Codegen/Evaluation.thy	Wed Feb 12 09:06:04 2014 +0100
     2.2 +++ b/src/Doc/Codegen/Evaluation.thy	Wed Feb 12 10:59:25 2014 +0100
     2.3 @@ -296,7 +296,7 @@
     2.4  
     2.5  code_reflect %quote Sum_Type
     2.6    datatypes sum = Inl | Inr
     2.7 -  functions "Sum_Type.Projl" "Sum_Type.Projr"
     2.8 +  functions "Sum_Type.sum.projl" "Sum_Type.sum.projr"
     2.9  
    2.10  text {*
    2.11    \noindent @{command_def code_reflect} takes a structure name and
     3.1 --- a/src/Doc/Codegen/Refinement.thy	Wed Feb 12 09:06:04 2014 +0100
     3.2 +++ b/src/Doc/Codegen/Refinement.thy	Wed Feb 12 10:59:25 2014 +0100
     3.3 @@ -148,15 +148,15 @@
     3.4    \noindent It is good style, although no absolute requirement, to
     3.5    provide code equations for the original artefacts of the implemented
     3.6    type, if possible; in our case, these are the datatype constructor
     3.7 -  @{const Queue} and the case combinator @{const queue_case}:
     3.8 +  @{const Queue} and the case combinator @{const case_queue}:
     3.9  *}
    3.10  
    3.11  lemma %quote Queue_AQueue [code]:
    3.12    "Queue = AQueue []"
    3.13    by (simp add: AQueue_def fun_eq_iff)
    3.14  
    3.15 -lemma %quote queue_case_AQueue [code]:
    3.16 -  "queue_case f (AQueue xs ys) = f (ys @ rev xs)"
    3.17 +lemma %quote case_queue_AQueue [code]:
    3.18 +  "case_queue f (AQueue xs ys) = f (ys @ rev xs)"
    3.19    by (simp add: AQueue_def)
    3.20  
    3.21  text {*
    3.22 @@ -164,7 +164,7 @@
    3.23  *}
    3.24  
    3.25  text %quotetypewriter {*
    3.26 -  @{code_stmts empty enqueue dequeue Queue queue_case (SML)}
    3.27 +  @{code_stmts empty enqueue dequeue Queue case_queue (SML)}
    3.28  *}
    3.29  
    3.30  text {*
    3.31 @@ -274,4 +274,3 @@
    3.32  *}
    3.33  
    3.34  end
    3.35 -
     4.1 --- a/src/Doc/Datatypes/Datatypes.thy	Wed Feb 12 09:06:04 2014 +0100
     4.2 +++ b/src/Doc/Datatypes/Datatypes.thy	Wed Feb 12 10:59:25 2014 +0100
     4.3 @@ -470,7 +470,7 @@
     4.4    @@{command datatype_new} target? @{syntax dt_options}? \<newline>
     4.5      (@{syntax dt_name} '=' (@{syntax ctor} + '|') + @'and')
     4.6    ;
     4.7 -  @{syntax_def dt_options}: '(' (('no_discs_sels' | 'no_code' | 'rep_compat') + ',') ')'
     4.8 +  @{syntax_def dt_options}: '(' (('no_discs_sels' | 'no_code') + ',') ')'
     4.9  \<close>}
    4.10  
    4.11  \medskip
    4.12 @@ -492,12 +492,6 @@
    4.13  \item
    4.14  The @{text "no_code"} option indicates that the datatype should not be
    4.15  registered for code generation.
    4.16 -
    4.17 -\item
    4.18 -The @{text "rep_compat"} option indicates that the generated names should
    4.19 -contain optional (and normally not displayed) ``@{text "new."}'' components to
    4.20 -prevent clashes with a later call to \keyw{rep\_datatype}. See
    4.21 -Section~\ref{ssec:datatype-compatibility-issues} for details.
    4.22  \end{itemize}
    4.23  
    4.24  The left-hand sides of the datatype equations specify the name of the type to
    4.25 @@ -771,7 +765,7 @@
    4.26  @{thm list.case(1)[no_vars]} \\
    4.27  @{thm list.case(2)[no_vars]}
    4.28  
    4.29 -\item[@{text "t."}\hthm{case\_cong}\rm:] ~ \\
    4.30 +\item[@{text "t."}\hthm{case\_cong} @{text "[fundef_cong]"}\rm:] ~ \\
    4.31  @{thm list.case_cong[no_vars]}
    4.32  
    4.33  \item[@{text "t."}\hthm{weak\_case\_cong} @{text "[cong]"}\rm:] ~ \\
    4.34 @@ -2563,7 +2557,7 @@
    4.35  %    old \keyw{datatype}
    4.36  %
    4.37  %  * @{command wrap_free_constructors}
    4.38 -%    * @{text "no_discs_sels"}, @{text "no_code"}, @{text "rep_compat"}
    4.39 +%    * @{text "no_discs_sels"}, @{text "no_code"}
    4.40  %    * hack to have both co and nonco view via locale (cf. ext nats)
    4.41  %  * code generator
    4.42  %     * eq, refl, simps
    4.43 @@ -2601,10 +2595,13 @@
    4.44  
    4.45  \medskip
    4.46  
    4.47 -% options: no_discs_sels no_code rep_compat
    4.48 +% options: no_discs_sels no_code
    4.49  
    4.50  \noindent
    4.51  Section~\ref{ssec:datatype-generated-theorems} lists the generated theorems.
    4.52 +For technical reasons, the @{text "[fundef_cong]"} attribute is not set on the
    4.53 +generated @{text case_cong} theorem. It can be added manually using
    4.54 +\keyw{declare}.
    4.55  *}
    4.56  
    4.57  
     5.1 --- a/src/Doc/LaTeXsugar/Sugar.thy	Wed Feb 12 09:06:04 2014 +0100
     5.2 +++ b/src/Doc/LaTeXsugar/Sugar.thy	Wed Feb 12 10:59:25 2014 +0100
     5.3 @@ -166,9 +166,9 @@
     5.4  \end{quote}
     5.5  To support the ``\_''-notation for irrelevant variables
     5.6  the constant \texttt{DUMMY} has been introduced:
     5.7 -@{thm fst_conv[where b = DUMMY]} is produced by
     5.8 +@{thm fst_conv[of _ DUMMY]} is produced by
     5.9  \begin{quote}
    5.10 -\verb!@!\verb!{thm fst_conv[where b = DUMMY]}!
    5.11 +\verb!@!\verb!{thm fst_conv[of _ DUMMY]}!
    5.12  \end{quote}
    5.13  Variables that are bound by quantifiers or lambdas cannot be renamed
    5.14  like this. Instead, the attribute \texttt{rename\_abs} does the
     6.1 --- a/src/Doc/Logics/document/HOL.tex	Wed Feb 12 09:06:04 2014 +0100
     6.2 +++ b/src/Doc/Logics/document/HOL.tex	Wed Feb 12 10:59:25 2014 +0100
     6.3 @@ -1115,7 +1115,7 @@
     6.4    \it symbol    & \it meta-type &           & \it description \\ 
     6.5    \cdx{Inl}     & $\alpha \To \alpha+\beta$    & & first injection\\
     6.6    \cdx{Inr}     & $\beta \To \alpha+\beta$     & & second injection\\
     6.7 -  \cdx{sum_case} & $[\alpha\To\gamma, \beta\To\gamma, \alpha+\beta] \To\gamma$
     6.8 +  \cdx{case_sum} & $[\alpha\To\gamma, \beta\To\gamma, \alpha+\beta] \To\gamma$
     6.9          & & conditional
    6.10  \end{constants}
    6.11  \begin{ttbox}\makeatletter
    6.12 @@ -1126,11 +1126,11 @@
    6.13  
    6.14  \tdx{sumE}           [| !!x. P(Inl x);  !!y. P(Inr y) |] ==> P s
    6.15  
    6.16 -\tdx{sum_case_Inl}   sum_case f g (Inl x) = f x
    6.17 -\tdx{sum_case_Inr}   sum_case f g (Inr x) = g x
    6.18 +\tdx{case_sum_Inl}   case_sum f g (Inl x) = f x
    6.19 +\tdx{case_sum_Inr}   case_sum f g (Inr x) = g x
    6.20  
    6.21 -\tdx{surjective_sum} sum_case (\%x. f(Inl x)) (\%y. f(Inr y)) s = f s
    6.22 -\tdx{sum.split_case} R(sum_case f g s) = ((! x. s = Inl(x) --> R(f(x))) &
    6.23 +\tdx{surjective_sum} case_sum (\%x. f(Inl x)) (\%y. f(Inr y)) s = f s
    6.24 +\tdx{sum.split_case} R(case_sum f g s) = ((! x. s = Inl(x) --> R(f(x))) &
    6.25                                       (! y. s = Inr(y) --> R(g(y))))
    6.26  \end{ttbox}
    6.27  \caption{Type $\alpha+\beta$}\label{hol-sum}
    6.28 @@ -1231,7 +1231,7 @@
    6.29  Note that Isabelle insists on precisely this format; you may not even change
    6.30  the order of the two cases.
    6.31  Both \texttt{primrec} and \texttt{case} are realized by a recursion operator
    6.32 -\cdx{nat_rec}, which is available because \textit{nat} is represented as
    6.33 +\cdx{rec_nat}, which is available because \textit{nat} is represented as
    6.34  a datatype.
    6.35  
    6.36  %The predecessor relation, \cdx{pred_nat}, is shown to be well-founded.
    6.37 @@ -1435,7 +1435,7 @@
    6.38  case $e$ of [] => $a$  |  \(x\)\#\(xs\) => b
    6.39  \end{center}
    6.40  is defined by translation.  For details see~{\S}\ref{sec:HOL:datatype}. There
    6.41 -is also a case splitting rule \tdx{split_list_case}
    6.42 +is also a case splitting rule \tdx{list.split}
    6.43  \[
    6.44  \begin{array}{l}
    6.45  P(\mathtt{case}~e~\mathtt{of}~\texttt{[] =>}~a ~\texttt{|}~
     7.1 --- a/src/Doc/ProgProve/Isar.thy	Wed Feb 12 09:06:04 2014 +0100
     7.2 +++ b/src/Doc/ProgProve/Isar.thy	Wed Feb 12 10:59:25 2014 +0100
     7.3 @@ -636,8 +636,8 @@
     7.4    thus ?thesis by simp
     7.5  qed
     7.6  
     7.7 -text{*\index{cases@@{text"cases"}|(}Function @{text tl} (''tail'') is defined by @{thm tl.simps(1)} and
     7.8 -@{thm tl.simps(2)}. Note that the result type of @{const length} is @{typ nat}
     7.9 +text{*\index{cases@@{text"cases"}|(}Function @{text tl} (''tail'') is defined by @{thm list.sel(2)} and
    7.10 +@{thm list.sel(3)}. Note that the result type of @{const length} is @{typ nat}
    7.11  and @{prop"0 - 1 = (0::nat)"}.
    7.12  
    7.13  This proof pattern works for any term @{text t} whose type is a datatype.
     8.1 --- a/src/Doc/Tutorial/CTL/CTL.thy	Wed Feb 12 09:06:04 2014 +0100
     8.2 +++ b/src/Doc/Tutorial/CTL/CTL.thy	Wed Feb 12 10:59:25 2014 +0100
     8.3 @@ -258,9 +258,9 @@
     8.4  @{thm[source]infinity_lemma}. Aficionados of minimal proofs might like to know
     8.5  that we could have given the witness without having to define a new function:
     8.6  the term
     8.7 -@{term[display]"nat_rec s (\<lambda>n t. SOME u. (t,u)\<in>M \<and> Q u)"}
     8.8 +@{term[display]"rec_nat s (\<lambda>n t. SOME u. (t,u)\<in>M \<and> Q u)"}
     8.9  is extensionally equal to @{term"path s Q"},
    8.10 -where @{term nat_rec} is the predefined primitive recursor on @{typ nat}.
    8.11 +where @{term rec_nat} is the predefined primitive recursor on @{typ nat}.
    8.12  *};
    8.13  (*<*)
    8.14  lemma
    8.15 @@ -270,7 +270,7 @@
    8.16   "\<exists> p. s = p 0 \<and> (\<forall> i. (p i,p(Suc i))\<in>M \<and> Q(p i))");
    8.17   apply(simp add: Paths_def);
    8.18   apply(blast);
    8.19 -apply(rule_tac x = "nat_rec s (\<lambda>n t. SOME u. (t,u)\<in>M \<and> Q u)" in exI);
    8.20 +apply(rule_tac x = "rec_nat s (\<lambda>n t. SOME u. (t,u)\<in>M \<and> Q u)" in exI);
    8.21  apply(simp);
    8.22  apply(intro strip);
    8.23  apply(induct_tac i);
     9.1 --- a/src/HOL/Algebra/Group.thy	Wed Feb 12 09:06:04 2014 +0100
     9.2 +++ b/src/HOL/Algebra/Group.thy	Wed Feb 12 10:59:25 2014 +0100
     9.3 @@ -34,13 +34,13 @@
     9.4  
     9.5  overloading nat_pow == "pow :: [_, 'a, nat] => 'a"
     9.6  begin
     9.7 -  definition "nat_pow G a n = nat_rec \<one>\<^bsub>G\<^esub> (%u b. b \<otimes>\<^bsub>G\<^esub> a) n"
     9.8 +  definition "nat_pow G a n = rec_nat \<one>\<^bsub>G\<^esub> (%u b. b \<otimes>\<^bsub>G\<^esub> a) n"
     9.9  end
    9.10  
    9.11  overloading int_pow == "pow :: [_, 'a, int] => 'a"
    9.12  begin
    9.13    definition "int_pow G a z =
    9.14 -   (let p = nat_rec \<one>\<^bsub>G\<^esub> (%u b. b \<otimes>\<^bsub>G\<^esub> a)
    9.15 +   (let p = rec_nat \<one>\<^bsub>G\<^esub> (%u b. b \<otimes>\<^bsub>G\<^esub> a)
    9.16      in if z < 0 then inv\<^bsub>G\<^esub> (p (nat (-z))) else p (nat z))"
    9.17  end
    9.18  
    10.1 --- a/src/HOL/Auth/Guard/Extensions.thy	Wed Feb 12 09:06:04 2014 +0100
    10.2 +++ b/src/HOL/Auth/Guard/Extensions.thy	Wed Feb 12 10:59:25 2014 +0100
    10.3 @@ -410,6 +410,7 @@
    10.4  lemma knows_sub_app: "knows A evs <= knows A (evs @ evs')"
    10.5  apply (induct evs, auto)
    10.6  apply (simp add: knows_decomp)
    10.7 +apply (rename_tac a b c)
    10.8  by (case_tac a, auto simp: knows.simps)
    10.9  
   10.10  subsubsection{*maximum knowledge an agent can have
   10.11 @@ -504,7 +505,8 @@
   10.12  by (induct evs, auto split: event.split)
   10.13  
   10.14  lemma used'_parts [rule_format]: "X:used' evs ==> Y:parts {X} --> Y:used' evs"
   10.15 -apply (induct evs, simp) 
   10.16 +apply (induct evs, simp)
   10.17 +apply (rename_tac a b)
   10.18  apply (case_tac a, simp_all) 
   10.19  apply (blast dest: parts_trans)+; 
   10.20  done
   10.21 @@ -521,7 +523,7 @@
   10.22  by (auto dest: used_sub_Cons [THEN subsetD])
   10.23  
   10.24  lemma used_appD [dest]: "X:used (evs @ evs') ==> X:used evs | X:used evs'"
   10.25 -by (induct evs, auto, case_tac a, auto)
   10.26 +by (induct evs, auto, rename_tac a b, case_tac a, auto)
   10.27  
   10.28  lemma used_ConsD: "X:used (ev#evs) ==> X:used [ev] | X:used evs"
   10.29  by (case_tac ev, auto)
   10.30 @@ -572,6 +574,7 @@
   10.31  apply (case_tac "A=Spy", blast)
   10.32  apply (induct evs)
   10.33  apply (simp add: used.simps, blast)
   10.34 +apply (rename_tac a evs)
   10.35  apply (frule_tac ev=a and evs=evs in one_step_Cons, simp, clarify)
   10.36  apply (drule_tac P="%G. X:parts G" in knows_Cons_substD, safe)
   10.37  apply (erule initState_used)
   10.38 @@ -585,6 +588,7 @@
   10.39  apply force
   10.40  apply (induct evs)
   10.41  apply (simp add: knows_max_def used.simps, blast)
   10.42 +apply (rename_tac a evs)
   10.43  apply (frule_tac ev=a and evs=evs in one_step_Cons, simp, clarify)
   10.44  apply (drule_tac P="%G. X:parts G" in knows_max_Cons_substD, safe)
   10.45  apply (case_tac a, auto)
    11.1 --- a/src/HOL/Auth/Guard/Guard.thy	Wed Feb 12 09:06:04 2014 +0100
    11.2 +++ b/src/HOL/Auth/Guard/Guard.thy	Wed Feb 12 10:59:25 2014 +0100
    11.3 @@ -228,6 +228,7 @@
    11.4  lemma kparts_set: "EX l'. kparts (set l) = set l' & cnb l' = cnb l"
    11.5  apply (induct l)
    11.6  apply (rule_tac x="[]" in exI, simp, clarsimp)
    11.7 +apply (rename_tac a b l')
    11.8  apply (subgoal_tac "EX l''.  kparts {a} = set l'' & cnb l'' = crypt_nb a", clarify)
    11.9  apply (rule_tac x="l''@l'" in exI, simp)
   11.10  apply (rule kparts_insert_substI, simp)
    12.1 --- a/src/HOL/Auth/Guard/GuardK.thy	Wed Feb 12 09:06:04 2014 +0100
    12.2 +++ b/src/HOL/Auth/Guard/GuardK.thy	Wed Feb 12 10:59:25 2014 +0100
    12.3 @@ -222,6 +222,7 @@
    12.4  lemma kparts_set: "EX l'. kparts (set l) = set l' & cnb l' = cnb l"
    12.5  apply (induct l)
    12.6  apply (rule_tac x="[]" in exI, simp, clarsimp)
    12.7 +apply (rename_tac a b l')
    12.8  apply (subgoal_tac "EX l''.  kparts {a} = set l'' & cnb l'' = crypt_nb a", clarify)
    12.9  apply (rule_tac x="l''@l'" in exI, simp)
   12.10  apply (rule kparts_insert_substI, simp)
    13.1 --- a/src/HOL/Auth/KerberosIV.thy	Wed Feb 12 09:06:04 2014 +0100
    13.2 +++ b/src/HOL/Auth/KerberosIV.thy	Wed Feb 12 10:59:25 2014 +0100
    13.3 @@ -256,23 +256,27 @@
    13.4  
    13.5  lemma spies_Says_rev: "spies (evs @ [Says A B X]) = insert X (spies evs)"
    13.6  apply (induct_tac "evs")
    13.7 -apply (induct_tac [2] "a", auto)
    13.8 +apply (rename_tac [2] a b)
    13.9 +apply (induct_tac [2] a, auto)
   13.10  done
   13.11  
   13.12  lemma spies_Gets_rev: "spies (evs @ [Gets A X]) = spies evs"
   13.13  apply (induct_tac "evs")
   13.14 -apply (induct_tac [2] "a", auto)
   13.15 +apply (rename_tac [2] a b)
   13.16 +apply (induct_tac [2] a, auto)
   13.17  done
   13.18  
   13.19  lemma spies_Notes_rev: "spies (evs @ [Notes A X]) =
   13.20            (if A:bad then insert X (spies evs) else spies evs)"
   13.21  apply (induct_tac "evs")
   13.22 -apply (induct_tac [2] "a", auto)
   13.23 +apply (rename_tac [2] a b)
   13.24 +apply (induct_tac [2] a, auto)
   13.25  done
   13.26  
   13.27  lemma spies_evs_rev: "spies evs = spies (rev evs)"
   13.28  apply (induct_tac "evs")
   13.29 -apply (induct_tac [2] "a")
   13.30 +apply (rename_tac [2] a b)
   13.31 +apply (induct_tac [2] a)
   13.32  apply (simp_all (no_asm_simp) add: spies_Says_rev spies_Gets_rev spies_Notes_rev)
   13.33  done
   13.34  
   13.35 @@ -280,6 +284,7 @@
   13.36  
   13.37  lemma spies_takeWhile: "spies (takeWhile P evs) <=  spies evs"
   13.38  apply (induct_tac "evs")
   13.39 +apply (rename_tac [2] a b)
   13.40  apply (induct_tac [2] "a", auto)
   13.41  txt{* Resembles @{text"used_subset_append"} in theory Event.*}
   13.42  done
   13.43 @@ -407,6 +412,7 @@
   13.44  lemma used_Says_rev: "used (evs @ [Says A B X]) = parts {X} \<union> (used evs)"
   13.45  apply (induct_tac "evs")
   13.46  apply simp
   13.47 +apply (rename_tac a b)
   13.48  apply (induct_tac "a")
   13.49  apply auto
   13.50  done
   13.51 @@ -414,6 +420,7 @@
   13.52  lemma used_Notes_rev: "used (evs @ [Notes A X]) = parts {X} \<union> (used evs)"
   13.53  apply (induct_tac "evs")
   13.54  apply simp
   13.55 +apply (rename_tac a b)
   13.56  apply (induct_tac "a")
   13.57  apply auto
   13.58  done
   13.59 @@ -421,6 +428,7 @@
   13.60  lemma used_Gets_rev: "used (evs @ [Gets B X]) = used evs"
   13.61  apply (induct_tac "evs")
   13.62  apply simp
   13.63 +apply (rename_tac a b)
   13.64  apply (induct_tac "a")
   13.65  apply auto
   13.66  done
   13.67 @@ -428,6 +436,7 @@
   13.68  lemma used_evs_rev: "used evs = used (rev evs)"
   13.69  apply (induct_tac "evs")
   13.70  apply simp
   13.71 +apply (rename_tac a b)
   13.72  apply (induct_tac "a")
   13.73  apply (simp add: used_Says_rev)
   13.74  apply (simp add: used_Gets_rev)
   13.75 @@ -438,6 +447,7 @@
   13.76        "x : used (takeWhile P X) --> x : used X"
   13.77  apply (induct_tac "X")
   13.78  apply simp
   13.79 +apply (rename_tac a b)
   13.80  apply (induct_tac "a")
   13.81  apply (simp_all add: used_Nil)
   13.82  apply (blast dest!: initState_into_used)+
    14.1 --- a/src/HOL/Auth/KerberosV.thy	Wed Feb 12 09:06:04 2014 +0100
    14.2 +++ b/src/HOL/Auth/KerberosV.thy	Wed Feb 12 10:59:25 2014 +0100
    14.3 @@ -207,22 +207,26 @@
    14.4  
    14.5  lemma spies_Says_rev: "spies (evs @ [Says A B X]) = insert X (spies evs)"
    14.6  apply (induct_tac "evs")
    14.7 +apply (rename_tac [2] a b)
    14.8  apply (induct_tac [2] "a", auto)
    14.9  done
   14.10  
   14.11  lemma spies_Gets_rev: "spies (evs @ [Gets A X]) = spies evs"
   14.12  apply (induct_tac "evs")
   14.13 +apply (rename_tac [2] a b)
   14.14  apply (induct_tac [2] "a", auto)
   14.15  done
   14.16  
   14.17  lemma spies_Notes_rev: "spies (evs @ [Notes A X]) =
   14.18            (if A:bad then insert X (spies evs) else spies evs)"
   14.19  apply (induct_tac "evs")
   14.20 +apply (rename_tac [2] a b)
   14.21  apply (induct_tac [2] "a", auto)
   14.22  done
   14.23  
   14.24  lemma spies_evs_rev: "spies evs = spies (rev evs)"
   14.25  apply (induct_tac "evs")
   14.26 +apply (rename_tac [2] a b)
   14.27  apply (induct_tac [2] "a")
   14.28  apply (simp_all (no_asm_simp) add: spies_Says_rev spies_Gets_rev spies_Notes_rev)
   14.29  done
   14.30 @@ -231,6 +235,7 @@
   14.31  
   14.32  lemma spies_takeWhile: "spies (takeWhile P evs) <=  spies evs"
   14.33  apply (induct_tac "evs")
   14.34 +apply (rename_tac [2] a b)
   14.35  apply (induct_tac [2] "a", auto)
   14.36  txt{* Resembles @{text"used_subset_append"} in theory Event.*}
   14.37  done
    15.1 --- a/src/HOL/Auth/Kerberos_BAN.thy	Wed Feb 12 09:06:04 2014 +0100
    15.2 +++ b/src/HOL/Auth/Kerberos_BAN.thy	Wed Feb 12 10:59:25 2014 +0100
    15.3 @@ -139,22 +139,26 @@
    15.4  
    15.5  lemma spies_Says_rev: "spies (evs @ [Says A B X]) = insert X (spies evs)"
    15.6  apply (induct_tac "evs")
    15.7 +apply (rename_tac [2] a b)
    15.8  apply (induct_tac [2] "a", auto)
    15.9  done
   15.10  
   15.11  lemma spies_Gets_rev: "spies (evs @ [Gets A X]) = spies evs"
   15.12  apply (induct_tac "evs")
   15.13 +apply (rename_tac [2] a b)
   15.14  apply (induct_tac [2] "a", auto)
   15.15  done
   15.16  
   15.17  lemma spies_Notes_rev: "spies (evs @ [Notes A X]) =
   15.18            (if A:bad then insert X (spies evs) else spies evs)"
   15.19  apply (induct_tac "evs")
   15.20 +apply (rename_tac [2] a b)
   15.21  apply (induct_tac [2] "a", auto)
   15.22  done
   15.23  
   15.24  lemma spies_evs_rev: "spies evs = spies (rev evs)"
   15.25  apply (induct_tac "evs")
   15.26 +apply (rename_tac [2] a b)
   15.27  apply (induct_tac [2] "a")
   15.28  apply (simp_all (no_asm_simp) add: spies_Says_rev spies_Gets_rev spies_Notes_rev)
   15.29  done
   15.30 @@ -163,6 +167,7 @@
   15.31  
   15.32  lemma spies_takeWhile: "spies (takeWhile P evs) <=  spies evs"
   15.33  apply (induct_tac "evs")
   15.34 +apply (rename_tac [2] a b)
   15.35  apply (induct_tac [2] "a", auto)
   15.36  txt{* Resembles @{text"used_subset_append"} in theory Event.*}
   15.37  done
   15.38 @@ -174,6 +179,7 @@
   15.39  lemma used_Says_rev: "used (evs @ [Says A B X]) = parts {X} \<union> (used evs)"
   15.40  apply (induct_tac "evs")
   15.41  apply simp
   15.42 +apply (rename_tac a b)
   15.43  apply (induct_tac "a")
   15.44  apply auto
   15.45  done
   15.46 @@ -181,6 +187,7 @@
   15.47  lemma used_Notes_rev: "used (evs @ [Notes A X]) = parts {X} \<union> (used evs)"
   15.48  apply (induct_tac "evs")
   15.49  apply simp
   15.50 +apply (rename_tac a b)
   15.51  apply (induct_tac "a")
   15.52  apply auto
   15.53  done
   15.54 @@ -188,6 +195,7 @@
   15.55  lemma used_Gets_rev: "used (evs @ [Gets B X]) = used evs"
   15.56  apply (induct_tac "evs")
   15.57  apply simp
   15.58 +apply (rename_tac a b)
   15.59  apply (induct_tac "a")
   15.60  apply auto
   15.61  done
   15.62 @@ -195,6 +203,7 @@
   15.63  lemma used_evs_rev: "used evs = used (rev evs)"
   15.64  apply (induct_tac "evs")
   15.65  apply simp
   15.66 +apply (rename_tac a b)
   15.67  apply (induct_tac "a")
   15.68  apply (simp add: used_Says_rev)
   15.69  apply (simp add: used_Gets_rev)
   15.70 @@ -205,6 +214,7 @@
   15.71        "x : used (takeWhile P X) --> x : used X"
   15.72  apply (induct_tac "X")
   15.73  apply simp
   15.74 +apply (rename_tac a b)
   15.75  apply (induct_tac "a")
   15.76  apply (simp_all add: used_Nil)
   15.77  apply (blast dest!: initState_into_used)+
    16.1 --- a/src/HOL/Auth/Kerberos_BAN_Gets.thy	Wed Feb 12 09:06:04 2014 +0100
    16.2 +++ b/src/HOL/Auth/Kerberos_BAN_Gets.thy	Wed Feb 12 10:59:25 2014 +0100
    16.3 @@ -168,6 +168,7 @@
    16.4  lemma used_Says_rev: "used (evs @ [Says A B X]) = parts {X} \<union> (used evs)"
    16.5  apply (induct_tac "evs")
    16.6  apply simp
    16.7 +apply (rename_tac a b)
    16.8  apply (induct_tac "a")
    16.9  apply auto
   16.10  done
   16.11 @@ -175,6 +176,7 @@
   16.12  lemma used_Notes_rev: "used (evs @ [Notes A X]) = parts {X} \<union> (used evs)"
   16.13  apply (induct_tac "evs")
   16.14  apply simp
   16.15 +apply (rename_tac a b)
   16.16  apply (induct_tac "a")
   16.17  apply auto
   16.18  done
   16.19 @@ -182,6 +184,7 @@
   16.20  lemma used_Gets_rev: "used (evs @ [Gets B X]) = used evs"
   16.21  apply (induct_tac "evs")
   16.22  apply simp
   16.23 +apply (rename_tac a b)
   16.24  apply (induct_tac "a")
   16.25  apply auto
   16.26  done
   16.27 @@ -189,6 +192,7 @@
   16.28  lemma used_evs_rev: "used evs = used (rev evs)"
   16.29  apply (induct_tac "evs")
   16.30  apply simp
   16.31 +apply (rename_tac a b)
   16.32  apply (induct_tac "a")
   16.33  apply (simp add: used_Says_rev)
   16.34  apply (simp add: used_Gets_rev)
   16.35 @@ -199,6 +203,7 @@
   16.36        "x : used (takeWhile P X) --> x : used X"
   16.37  apply (induct_tac "X")
   16.38  apply simp
   16.39 +apply (rename_tac a b)
   16.40  apply (induct_tac "a")
   16.41  apply (simp_all add: used_Nil)
   16.42  apply (blast dest!: initState_into_used)+
    17.1 --- a/src/HOL/Auth/NS_Shared.thy	Wed Feb 12 09:06:04 2014 +0100
    17.2 +++ b/src/HOL/Auth/NS_Shared.thy	Wed Feb 12 10:59:25 2014 +0100
    17.3 @@ -385,22 +385,26 @@
    17.4  
    17.5  lemma spies_Says_rev: "spies (evs @ [Says A B X]) = insert X (spies evs)"
    17.6  apply (induct_tac "evs")
    17.7 +apply (rename_tac [2] a b)
    17.8  apply (induct_tac [2] "a", auto)
    17.9  done
   17.10  
   17.11  lemma spies_Gets_rev: "spies (evs @ [Gets A X]) = spies evs"
   17.12  apply (induct_tac "evs")
   17.13 +apply (rename_tac [2] a b)
   17.14  apply (induct_tac [2] "a", auto)
   17.15  done
   17.16  
   17.17  lemma spies_Notes_rev: "spies (evs @ [Notes A X]) =
   17.18            (if A:bad then insert X (spies evs) else spies evs)"
   17.19  apply (induct_tac "evs")
   17.20 +apply (rename_tac [2] a b)
   17.21  apply (induct_tac [2] "a", auto)
   17.22  done
   17.23  
   17.24  lemma spies_evs_rev: "spies evs = spies (rev evs)"
   17.25  apply (induct_tac "evs")
   17.26 +apply (rename_tac [2] a b)
   17.27  apply (induct_tac [2] "a")
   17.28  apply (simp_all (no_asm_simp) add: spies_Says_rev spies_Gets_rev spies_Notes_rev)
   17.29  done
   17.30 @@ -409,6 +413,7 @@
   17.31  
   17.32  lemma spies_takeWhile: "spies (takeWhile P evs) <=  spies evs"
   17.33  apply (induct_tac "evs")
   17.34 +apply (rename_tac [2] a b)
   17.35  apply (induct_tac [2] "a", auto)
   17.36  txt{* Resembles @{text"used_subset_append"} in theory Event.*}
   17.37  done
    18.1 --- a/src/HOL/Auth/Public.thy	Wed Feb 12 09:06:04 2014 +0100
    18.2 +++ b/src/HOL/Auth/Public.thy	Wed Feb 12 10:59:25 2014 +0100
    18.3 @@ -61,7 +61,7 @@
    18.4    injective_publicKey:
    18.5      "publicKey b A = publicKey c A' ==> b=c & A=A'"
    18.6     apply (rule exI [of _ 
    18.7 -       "%b A. 2 * agent_case 0 (\<lambda>n. n + 2) 1 A + keymode_case 0 1 b"])
    18.8 +       "%b A. 2 * case_agent 0 (\<lambda>n. n + 2) 1 A + case_keymode 0 1 b"])
    18.9     apply (auto simp add: inj_on_def split: agent.split keymode.split)
   18.10     apply presburger
   18.11     apply presburger
   18.12 @@ -137,7 +137,7 @@
   18.13  specification (shrK)
   18.14    inj_shrK: "inj shrK"
   18.15    --{*No two agents have the same long-term key*}
   18.16 -   apply (rule exI [of _ "agent_case 0 (\<lambda>n. n + 2) 1"]) 
   18.17 +   apply (rule exI [of _ "case_agent 0 (\<lambda>n. n + 2) 1"]) 
   18.18     apply (simp add: inj_on_def split: agent.split) 
   18.19     done
   18.20  
    19.1 --- a/src/HOL/Auth/Shared.thy	Wed Feb 12 09:06:04 2014 +0100
    19.2 +++ b/src/HOL/Auth/Shared.thy	Wed Feb 12 10:59:25 2014 +0100
    19.3 @@ -17,7 +17,7 @@
    19.4  specification (shrK)
    19.5    inj_shrK: "inj shrK"
    19.6    --{*No two agents have the same long-term key*}
    19.7 -   apply (rule exI [of _ "agent_case 0 (\<lambda>n. n + 2) 1"]) 
    19.8 +   apply (rule exI [of _ "case_agent 0 (\<lambda>n. n + 2) 1"]) 
    19.9     apply (simp add: inj_on_def split: agent.split) 
   19.10     done
   19.11  
    20.1 --- a/src/HOL/Auth/TLS.thy	Wed Feb 12 09:06:04 2014 +0100
    20.2 +++ b/src/HOL/Auth/TLS.thy	Wed Feb 12 10:59:25 2014 +0100
    20.3 @@ -81,7 +81,7 @@
    20.4    inj_sessionK: "inj sessionK"
    20.5    --{*sessionK is collision-free; also, no clientK clashes with any serverK.*}
    20.6     apply (rule exI [of _ 
    20.7 -         "%((x,y,z), r). prod_encode(role_case 0 1 r, 
    20.8 +         "%((x,y,z), r). prod_encode(case_role 0 1 r, 
    20.9                             prod_encode(x, prod_encode(y,z)))"])
   20.10     apply (simp add: inj_on_def prod_encode_eq split: role.split) 
   20.11     done
    21.1 --- a/src/HOL/BNF_Def.thy	Wed Feb 12 09:06:04 2014 +0100
    21.2 +++ b/src/HOL/BNF_Def.thy	Wed Feb 12 10:59:25 2014 +0100
    21.3 @@ -118,9 +118,9 @@
    21.4  lemma predicate2_eqD: "A = B \<Longrightarrow> A a b \<longleftrightarrow> B a b"
    21.5  by metis
    21.6  
    21.7 -lemma sum_case_o_inj:
    21.8 -"sum_case f g \<circ> Inl = f"
    21.9 -"sum_case f g \<circ> Inr = g"
   21.10 +lemma case_sum_o_inj:
   21.11 +"case_sum f g \<circ> Inl = f"
   21.12 +"case_sum f g \<circ> Inr = g"
   21.13  by auto
   21.14  
   21.15  lemma card_order_csum_cone_cexp_def:
    22.1 --- a/src/HOL/BNF_Examples/Derivation_Trees/Gram_Lang.thy	Wed Feb 12 09:06:04 2014 +0100
    22.2 +++ b/src/HOL/BNF_Examples/Derivation_Trees/Gram_Lang.thy	Wed Feb 12 10:59:25 2014 +0100
    22.3 @@ -860,7 +860,7 @@
    22.4    have "subtr (insert n ?ns1) (f (last (n1 # nl))) (f n)"
    22.5    using f subtr.Step[OF _ fn1_flast fn1] by auto
    22.6    thus ?case unfolding 1 by simp
    22.7 -qed (metis f hd.simps last_ConsL last_in_set not_Cons_self2 subtr.Refl)
    22.8 +qed (metis f list.sel(1) last_ConsL last_in_set not_Cons_self2 subtr.Refl)
    22.9  
   22.10  lemma reg_subtr_path_aux:
   22.11  assumes f: "reg f tr" and n: "subtr ns tr1 tr"
   22.12 @@ -878,7 +878,7 @@
   22.13    obtain nl where nl: "path f nl" and f_nl: "f (hd nl) = tr1"
   22.14    and last_nl: "f (last nl) = tr2" and set: "set nl \<subseteq> ns" using Step(3)[OF tr1] by auto
   22.15    have 0: "path f (root tr # nl)" apply (subst path.simps)
   22.16 -  using f_nl nl reg_root tr tr1_tr by (metis hd.simps neq_Nil_conv)
   22.17 +  using f_nl nl reg_root tr tr1_tr by (metis list.sel(1) neq_Nil_conv)
   22.18    show ?case apply(rule exI[of _ "(root tr) # nl"])
   22.19    using 0 reg_root tr last_nl nl path_NE rtr set by auto
   22.20  qed
    23.1 --- a/src/HOL/BNF_Examples/Derivation_Trees/Prelim.thy	Wed Feb 12 09:06:04 2014 +0100
    23.2 +++ b/src/HOL/BNF_Examples/Derivation_Trees/Prelim.thy	Wed Feb 12 10:59:25 2014 +0100
    23.3 @@ -27,8 +27,8 @@
    23.4  lemma sum_map_InrD: "(f \<oplus> g) z = Inr x \<Longrightarrow> \<exists>y. z = Inr y \<and> g y = x"
    23.5  by (cases z) auto
    23.6  
    23.7 -abbreviation sum_case_abbrev ("[[_,_]]" 800)
    23.8 -where "[[f,g]] \<equiv> Sum_Type.sum_case f g"
    23.9 +abbreviation case_sum_abbrev ("[[_,_]]" 800)
   23.10 +where "[[f,g]] \<equiv> Sum_Type.case_sum f g"
   23.11  
   23.12  lemma Inl_oplus_elim:
   23.13  assumes "Inl tr \<in> (id \<oplus> f) ` tns"
    24.1 --- a/src/HOL/BNF_FP_Base.thy	Wed Feb 12 09:06:04 2014 +0100
    24.2 +++ b/src/HOL/BNF_FP_Base.thy	Wed Feb 12 10:59:25 2014 +0100
    24.3 @@ -19,10 +19,10 @@
    24.4  lemma eq_sym_Unity_conv: "(x = (() = ())) = x"
    24.5  by blast
    24.6  
    24.7 -lemma unit_case_Unity: "(case u of () \<Rightarrow> f) = f"
    24.8 +lemma case_unit_Unity: "(case u of () \<Rightarrow> f) = f"
    24.9  by (cases u) (hypsubst, rule unit.cases)
   24.10  
   24.11 -lemma prod_case_Pair_iden: "(case p of (x, y) \<Rightarrow> (x, y)) = p"
   24.12 +lemma case_prod_Pair_iden: "(case p of (x, y) \<Rightarrow> (x, y)) = p"
   24.13  by simp
   24.14  
   24.15  lemma unit_all_impI: "(P () \<Longrightarrow> Q ()) \<Longrightarrow> \<forall>x. P x \<longrightarrow> Q x"
   24.16 @@ -53,9 +53,9 @@
   24.17  
   24.18  lemma ssubst_mem: "\<lbrakk>t = s; s \<in> X\<rbrakk> \<Longrightarrow> t \<in> X" by simp
   24.19  
   24.20 -lemma sum_case_step:
   24.21 -"sum_case (sum_case f' g') g (Inl p) = sum_case f' g' p"
   24.22 -"sum_case f (sum_case f' g') (Inr p) = sum_case f' g' p"
   24.23 +lemma case_sum_step:
   24.24 +"case_sum (case_sum f' g') g (Inl p) = case_sum f' g' p"
   24.25 +"case_sum f (case_sum f' g') (Inr p) = case_sum f' g' p"
   24.26  by auto
   24.27  
   24.28  lemma one_pointE: "\<lbrakk>\<And>x. s = x \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   24.29 @@ -71,8 +71,8 @@
   24.30  lemma obj_sumE: "\<lbrakk>\<forall>x. s = Inl x \<longrightarrow> P; \<forall>x. s = Inr x \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   24.31  by (cases s) auto
   24.32  
   24.33 -lemma sum_case_if:
   24.34 -"sum_case f g (if p then Inl x else Inr y) = (if p then f x else g y)"
   24.35 +lemma case_sum_if:
   24.36 +"case_sum f g (if p then Inl x else Inr y) = (if p then f x else g y)"
   24.37  by simp
   24.38  
   24.39  lemma mem_UN_compreh_eq: "(z : \<Union>{y. \<exists>x\<in>A. y = F x}) = (\<exists>x\<in>A. z : F x)"
   24.40 @@ -122,14 +122,14 @@
   24.41  lemma map_pair_o_convol_id: "(map_pair f id \<circ> <id , g>) x = <id \<circ> f , g> x"
   24.42    unfolding map_pair_o_convol id_comp comp_id ..
   24.43  
   24.44 -lemma o_sum_case: "h o sum_case f g = sum_case (h o f) (h o g)"
   24.45 +lemma o_case_sum: "h o case_sum f g = case_sum (h o f) (h o g)"
   24.46    unfolding comp_def by (auto split: sum.splits)
   24.47  
   24.48 -lemma sum_case_o_sum_map: "sum_case f g o sum_map h1 h2 = sum_case (f o h1) (g o h2)"
   24.49 +lemma case_sum_o_sum_map: "case_sum f g o sum_map h1 h2 = case_sum (f o h1) (g o h2)"
   24.50    unfolding comp_def by (auto split: sum.splits)
   24.51  
   24.52 -lemma sum_case_o_sum_map_id: "(sum_case id g o sum_map f id) x = sum_case (f o id) g x"
   24.53 -  unfolding sum_case_o_sum_map id_comp comp_id ..
   24.54 +lemma case_sum_o_sum_map_id: "(case_sum id g o sum_map f id) x = case_sum (f o id) g x"
   24.55 +  unfolding case_sum_o_sum_map id_comp comp_id ..
   24.56  
   24.57  lemma fun_rel_def_butlast:
   24.58    "(fun_rel R (fun_rel S T)) f g = (\<forall>x y. R x y \<longrightarrow> (fun_rel S T) (f x) (g y))"
    25.1 --- a/src/HOL/BNF_GFP.thy	Wed Feb 12 09:06:04 2014 +0100
    25.2 +++ b/src/HOL/BNF_GFP.thy	Wed Feb 12 10:59:25 2014 +0100
    25.3 @@ -27,13 +27,13 @@
    25.4  lemma neq_eq_eq_contradict: "\<lbrakk>t \<noteq> u; s = t; s = u\<rbrakk> \<Longrightarrow> P"
    25.5  by fast
    25.6  
    25.7 -lemma sum_case_expand_Inr: "f o Inl = g \<Longrightarrow> f x = sum_case g (f o Inr) x"
    25.8 +lemma case_sum_expand_Inr: "f o Inl = g \<Longrightarrow> f x = case_sum g (f o Inr) x"
    25.9  by (auto split: sum.splits)
   25.10  
   25.11 -lemma sum_case_expand_Inr': "f o Inl = g \<Longrightarrow> h = f o Inr \<longleftrightarrow> sum_case g h = f"
   25.12 +lemma case_sum_expand_Inr': "f o Inl = g \<Longrightarrow> h = f o Inr \<longleftrightarrow> case_sum g h = f"
   25.13  apply rule
   25.14   apply (rule ext, force split: sum.split)
   25.15 -by (rule ext, metis sum_case_o_inj(2))
   25.16 +by (rule ext, metis case_sum_o_inj(2))
   25.17  
   25.18  lemma converse_Times: "(A \<times> B) ^-1 = B \<times> A"
   25.19  by fast
   25.20 @@ -266,16 +266,16 @@
   25.21  lemma Inr_Field_csum: "a \<in> Field s \<Longrightarrow> Inr a \<in> Field (r +c s)"
   25.22  unfolding Field_card_of csum_def by auto
   25.23  
   25.24 -lemma nat_rec_0_imp: "f = nat_rec f1 (%n rec. f2 n rec) \<Longrightarrow> f 0 = f1"
   25.25 +lemma rec_nat_0_imp: "f = rec_nat f1 (%n rec. f2 n rec) \<Longrightarrow> f 0 = f1"
   25.26  by auto
   25.27  
   25.28 -lemma nat_rec_Suc_imp: "f = nat_rec f1 (%n rec. f2 n rec) \<Longrightarrow> f (Suc n) = f2 n (f n)"
   25.29 +lemma rec_nat_Suc_imp: "f = rec_nat f1 (%n rec. f2 n rec) \<Longrightarrow> f (Suc n) = f2 n (f n)"
   25.30  by auto
   25.31  
   25.32 -lemma list_rec_Nil_imp: "f = list_rec f1 (%x xs rec. f2 x xs rec) \<Longrightarrow> f [] = f1"
   25.33 +lemma rec_list_Nil_imp: "f = rec_list f1 (%x xs rec. f2 x xs rec) \<Longrightarrow> f [] = f1"
   25.34  by auto
   25.35  
   25.36 -lemma list_rec_Cons_imp: "f = list_rec f1 (%x xs rec. f2 x xs rec) \<Longrightarrow> f (x # xs) = f2 x xs (f xs)"
   25.37 +lemma rec_list_Cons_imp: "f = rec_list f1 (%x xs rec. f2 x xs rec) \<Longrightarrow> f (x # xs) = f2 x xs (f xs)"
   25.38  by auto
   25.39  
   25.40  lemma not_arg_cong_Inr: "x \<noteq> y \<Longrightarrow> Inr x \<noteq> Inr y"
    26.1 --- a/src/HOL/Bali/Basis.thy	Wed Feb 12 09:06:04 2014 +0100
    26.2 +++ b/src/HOL/Bali/Basis.thy	Wed Feb 12 10:59:25 2014 +0100
    26.3 @@ -147,7 +147,7 @@
    26.4  
    26.5  hide_const In0 In1
    26.6  
    26.7 -notation sum_case  (infixr "'(+')"80)
    26.8 +notation case_sum  (infixr "'(+')"80)
    26.9  
   26.10  primrec the_Inl :: "'a + 'b \<Rightarrow> 'a"
   26.11    where "the_Inl (Inl a) = a"
    27.1 --- a/src/HOL/Bali/Conform.thy	Wed Feb 12 09:06:04 2014 +0100
    27.2 +++ b/src/HOL/Bali/Conform.thy	Wed Feb 12 10:59:25 2014 +0100
    27.3 @@ -437,9 +437,10 @@
    27.4  lemma conforms_absorb [rule_format]:
    27.5    "(a, b)\<Colon>\<preceq>(G, L) \<longrightarrow> (absorb j a, b)\<Colon>\<preceq>(G, L)"
    27.6  apply (rule impI)
    27.7 -apply ( case_tac a)
    27.8 +apply (case_tac a)
    27.9  apply (case_tac "absorb j a")
   27.10  apply auto
   27.11 +apply (rename_tac a)
   27.12  apply (case_tac "absorb j (Some a)",auto)
   27.13  apply (erule conforms_NormI)
   27.14  done
   27.15 @@ -554,5 +555,4 @@
   27.16  apply (force dest: conforms_globsD)+
   27.17  done
   27.18  
   27.19 -
   27.20  end
    28.1 --- a/src/HOL/Bali/Eval.thy	Wed Feb 12 09:06:04 2014 +0100
    28.2 +++ b/src/HOL/Bali/Eval.thy	Wed Feb 12 10:59:25 2014 +0100
    28.3 @@ -141,7 +141,7 @@
    28.4    where "\<lfloor>es\<rfloor>\<^sub>l == In3 es"
    28.5  
    28.6  definition undefined3 :: "('al + 'ar, 'b, 'c) sum3 \<Rightarrow> vals" where
    28.7 - "undefined3 = sum3_case (In1 \<circ> sum_case (\<lambda>x. undefined) (\<lambda>x. Unit))
    28.8 + "undefined3 = case_sum3 (In1 \<circ> case_sum (\<lambda>x. undefined) (\<lambda>x. Unit))
    28.9                       (\<lambda>x. In2 undefined) (\<lambda>x. In3 undefined)"
   28.10  
   28.11  lemma [simp]: "undefined3 (In1l x) = In1 undefined"
    29.1 --- a/src/HOL/Bali/State.thy	Wed Feb 12 09:06:04 2014 +0100
    29.2 +++ b/src/HOL/Bali/State.thy	Wed Feb 12 10:59:25 2014 +0100
    29.3 @@ -232,11 +232,11 @@
    29.4  
    29.5  definition
    29.6    globs :: "st \<Rightarrow> globs"
    29.7 -  where "globs = st_case (\<lambda>g l. g)"
    29.8 +  where "globs = case_st (\<lambda>g l. g)"
    29.9    
   29.10  definition
   29.11    locals :: "st \<Rightarrow> locals"
   29.12 -  where "locals = st_case (\<lambda>g l. l)"
   29.13 +  where "locals = case_st (\<lambda>g l. l)"
   29.14  
   29.15  definition heap :: "st \<Rightarrow> heap" where
   29.16   "heap s = globs s \<circ> Heap"
   29.17 @@ -303,19 +303,19 @@
   29.18  
   29.19  definition
   29.20    gupd :: "oref  \<Rightarrow> obj \<Rightarrow> st \<Rightarrow> st" ("gupd'(_\<mapsto>_')" [10, 10] 1000)
   29.21 -  where "gupd r obj = st_case (\<lambda>g l. st (g(r\<mapsto>obj)) l)"
   29.22 +  where "gupd r obj = case_st (\<lambda>g l. st (g(r\<mapsto>obj)) l)"
   29.23  
   29.24  definition
   29.25    lupd :: "lname \<Rightarrow> val \<Rightarrow> st \<Rightarrow> st" ("lupd'(_\<mapsto>_')" [10, 10] 1000)
   29.26 -  where "lupd vn v = st_case (\<lambda>g l. st g (l(vn\<mapsto>v)))"
   29.27 +  where "lupd vn v = case_st (\<lambda>g l. st g (l(vn\<mapsto>v)))"
   29.28  
   29.29  definition
   29.30    upd_gobj :: "oref \<Rightarrow> vn \<Rightarrow> val \<Rightarrow> st \<Rightarrow> st"
   29.31 -  where "upd_gobj r n v = st_case (\<lambda>g l. st (chg_map (upd_obj n v) r g) l)"
   29.32 +  where "upd_gobj r n v = case_st (\<lambda>g l. st (chg_map (upd_obj n v) r g) l)"
   29.33  
   29.34  definition
   29.35    set_locals  :: "locals \<Rightarrow> st \<Rightarrow> st"
   29.36 -  where "set_locals l = st_case (\<lambda>g l'. st g l)"
   29.37 +  where "set_locals l = case_st (\<lambda>g l'. st g l)"
   29.38  
   29.39  definition
   29.40    init_obj :: "prog \<Rightarrow> obj_tag \<Rightarrow> oref \<Rightarrow> st \<Rightarrow> st"
    30.1 --- a/src/HOL/Bali/TypeSafe.thy	Wed Feb 12 09:06:04 2014 +0100
    30.2 +++ b/src/HOL/Bali/TypeSafe.thy	Wed Feb 12 10:59:25 2014 +0100
    30.3 @@ -825,7 +825,7 @@
    30.4  
    30.5  
    30.6  lemma lconf_map_lname [simp]: 
    30.7 -  "G,s\<turnstile>(lname_case l1 l2)[\<Colon>\<preceq>](lname_case L1 L2)
    30.8 +  "G,s\<turnstile>(case_lname l1 l2)[\<Colon>\<preceq>](case_lname L1 L2)
    30.9     =
   30.10    (G,s\<turnstile>l1[\<Colon>\<preceq>]L1 \<and> G,s\<turnstile>(\<lambda>x::unit . l2)[\<Colon>\<preceq>](\<lambda>x::unit. L2))"
   30.11  apply (unfold lconf_def)
   30.12 @@ -833,7 +833,7 @@
   30.13  done
   30.14  
   30.15  lemma wlconf_map_lname [simp]: 
   30.16 -  "G,s\<turnstile>(lname_case l1 l2)[\<sim>\<Colon>\<preceq>](lname_case L1 L2)
   30.17 +  "G,s\<turnstile>(case_lname l1 l2)[\<sim>\<Colon>\<preceq>](case_lname L1 L2)
   30.18     =
   30.19    (G,s\<turnstile>l1[\<sim>\<Colon>\<preceq>]L1 \<and> G,s\<turnstile>(\<lambda>x::unit . l2)[\<sim>\<Colon>\<preceq>](\<lambda>x::unit. L2))"
   30.20  apply (unfold wlconf_def)
   30.21 @@ -841,7 +841,7 @@
   30.22  done
   30.23  
   30.24  lemma lconf_map_ename [simp]:
   30.25 -  "G,s\<turnstile>(ename_case l1 l2)[\<Colon>\<preceq>](ename_case L1 L2)
   30.26 +  "G,s\<turnstile>(case_ename l1 l2)[\<Colon>\<preceq>](case_ename L1 L2)
   30.27     =
   30.28    (G,s\<turnstile>l1[\<Colon>\<preceq>]L1 \<and> G,s\<turnstile>(\<lambda>x::unit. l2)[\<Colon>\<preceq>](\<lambda>x::unit. L2))"
   30.29  apply (unfold lconf_def)
   30.30 @@ -849,7 +849,7 @@
   30.31  done
   30.32  
   30.33  lemma wlconf_map_ename [simp]:
   30.34 -  "G,s\<turnstile>(ename_case l1 l2)[\<sim>\<Colon>\<preceq>](ename_case L1 L2)
   30.35 +  "G,s\<turnstile>(case_ename l1 l2)[\<sim>\<Colon>\<preceq>](case_ename L1 L2)
   30.36     =
   30.37    (G,s\<turnstile>l1[\<sim>\<Colon>\<preceq>]L1 \<and> G,s\<turnstile>(\<lambda>x::unit. l2)[\<sim>\<Colon>\<preceq>](\<lambda>x::unit. L2))"
   30.38  apply (unfold wlconf_def)
   30.39 @@ -1436,9 +1436,9 @@
   30.40  
   30.41     
   30.42  lemma dom_vname_split:
   30.43 - "dom (lname_case (ename_case (tab(x\<mapsto>y)(xs[\<mapsto>]ys)) a) b)
   30.44 -   = dom (lname_case (ename_case (tab(x\<mapsto>y)) a) b) \<union> 
   30.45 -     dom (lname_case (ename_case (tab(xs[\<mapsto>]ys)) a) b)"
   30.46 + "dom (case_lname (case_ename (tab(x\<mapsto>y)(xs[\<mapsto>]ys)) a) b)
   30.47 +   = dom (case_lname (case_ename (tab(x\<mapsto>y)) a) b) \<union> 
   30.48 +     dom (case_lname (case_ename (tab(xs[\<mapsto>]ys)) a) b)"
   30.49    (is "?List x xs y ys = ?Hd x y \<union> ?Tl xs ys")
   30.50  proof 
   30.51    show "?List x xs y ys \<subseteq> ?Hd x y \<union> ?Tl xs ys"
   30.52 @@ -1514,37 +1514,37 @@
   30.53    qed
   30.54  qed
   30.55   
   30.56 -lemma dom_ename_case_None_simp:
   30.57 - "dom (ename_case vname_tab None) = VNam ` (dom vname_tab)"
   30.58 +lemma dom_case_ename_None_simp:
   30.59 + "dom (case_ename vname_tab None) = VNam ` (dom vname_tab)"
   30.60    apply (auto simp add: dom_def image_def )
   30.61    apply (case_tac "x")
   30.62    apply auto
   30.63    done
   30.64  
   30.65 -lemma dom_ename_case_Some_simp:
   30.66 - "dom (ename_case vname_tab (Some a)) = VNam ` (dom vname_tab) \<union> {Res}"
   30.67 +lemma dom_case_ename_Some_simp:
   30.68 + "dom (case_ename vname_tab (Some a)) = VNam ` (dom vname_tab) \<union> {Res}"
   30.69    apply (auto simp add: dom_def image_def )
   30.70    apply (case_tac "x")
   30.71    apply auto
   30.72    done
   30.73  
   30.74 -lemma dom_lname_case_None_simp:
   30.75 -  "dom (lname_case ename_tab None) = EName ` (dom ename_tab)"
   30.76 +lemma dom_case_lname_None_simp:
   30.77 +  "dom (case_lname ename_tab None) = EName ` (dom ename_tab)"
   30.78    apply (auto simp add: dom_def image_def )
   30.79    apply (case_tac "x")
   30.80    apply auto
   30.81    done
   30.82  
   30.83 -lemma dom_lname_case_Some_simp:
   30.84 - "dom (lname_case ename_tab (Some a)) = EName ` (dom ename_tab) \<union> {This}"
   30.85 +lemma dom_case_lname_Some_simp:
   30.86 + "dom (case_lname ename_tab (Some a)) = EName ` (dom ename_tab) \<union> {This}"
   30.87    apply (auto simp add: dom_def image_def)
   30.88    apply (case_tac "x")
   30.89    apply auto
   30.90    done
   30.91  
   30.92 -lemmas dom_lname_ename_case_simps =  
   30.93 -     dom_ename_case_None_simp dom_ename_case_Some_simp 
   30.94 -     dom_lname_case_None_simp dom_lname_case_Some_simp
   30.95 +lemmas dom_lname_case_ename_simps =  
   30.96 +     dom_case_ename_None_simp dom_case_ename_Some_simp 
   30.97 +     dom_case_lname_None_simp dom_case_lname_Some_simp
   30.98  
   30.99  lemma image_comp: 
  30.100   "f ` g ` A = (f \<circ> g) ` A"
  30.101 @@ -1569,13 +1569,13 @@
  30.102      with static_m' dom_vnames m
  30.103      show ?thesis
  30.104        by (cases s) (simp add: init_lvars_def Let_def parameters_def
  30.105 -                              dom_lname_ename_case_simps image_comp)
  30.106 +                              dom_lname_case_ename_simps image_comp)
  30.107    next
  30.108      case False
  30.109      with static_m' dom_vnames m
  30.110      show ?thesis
  30.111        by (cases s) (simp add: init_lvars_def Let_def parameters_def
  30.112 -                              dom_lname_ename_case_simps image_comp)
  30.113 +                              dom_lname_case_ename_simps image_comp)
  30.114    qed
  30.115  qed
  30.116  
    31.1 --- a/src/HOL/Cardinals/Ordinal_Arithmetic.thy	Wed Feb 12 09:06:04 2014 +0100
    31.2 +++ b/src/HOL/Cardinals/Ordinal_Arithmetic.thy	Wed Feb 12 10:59:25 2014 +0100
    31.3 @@ -365,9 +365,9 @@
    31.4  proof safe
    31.5    assume ?L
    31.6    from `?L` show ?R1 unfolding fin_support_def support_def
    31.7 -    by (fastforce simp: image_iff elim: finite_surj[of _ _ "sum_case id undefined"])
    31.8 +    by (fastforce simp: image_iff elim: finite_surj[of _ _ "case_sum id undefined"])
    31.9    from `?L` show ?R2 unfolding fin_support_def support_def
   31.10 -    by (fastforce simp: image_iff elim: finite_surj[of _ _ "sum_case undefined id"])
   31.11 +    by (fastforce simp: image_iff elim: finite_surj[of _ _ "case_sum undefined id"])
   31.12  next
   31.13    assume ?R1 ?R2
   31.14    thus ?L unfolding fin_support_def support_Un
   31.15 @@ -1506,15 +1506,15 @@
   31.16  qed
   31.17  
   31.18  lemma max_fun_diff_eq_Inl:
   31.19 -  assumes "wo_rel.max_fun_diff (s +o t) (sum_case f1 g1) (sum_case f2 g2) = Inl x"
   31.20 -    "sum_case f1 g1 \<noteq> sum_case f2 g2"
   31.21 -    "sum_case f1 g1 \<in> FinFunc r (s +o t)" "sum_case f2 g2 \<in> FinFunc r (s +o t)"
   31.22 +  assumes "wo_rel.max_fun_diff (s +o t) (case_sum f1 g1) (case_sum f2 g2) = Inl x"
   31.23 +    "case_sum f1 g1 \<noteq> case_sum f2 g2"
   31.24 +    "case_sum f1 g1 \<in> FinFunc r (s +o t)" "case_sum f2 g2 \<in> FinFunc r (s +o t)"
   31.25    shows "wo_rel.max_fun_diff s f1 f2 = x" (is ?P) "g1 = g2" (is ?Q)
   31.26  proof -
   31.27    interpret st!: wo_rel "s +o t" by unfold_locales (rule osum_Well_order[OF s t])
   31.28    interpret s!: wo_rel s by unfold_locales (rule s)
   31.29    interpret rst!: wo_rel2 r "s +o t" by unfold_locales (rule r, rule osum_Well_order[OF s t])
   31.30 -  from assms(1) have *: "st.isMaxim {a \<in> Field (s +o t). sum_case f1 g1 a \<noteq> sum_case f2 g2 a} (Inl x)"
   31.31 +  from assms(1) have *: "st.isMaxim {a \<in> Field (s +o t). case_sum f1 g1 a \<noteq> case_sum f2 g2 a} (Inl x)"
   31.32      using rst.isMaxim_max_fun_diff[OF assms(2-4)] by simp
   31.33    hence "s.isMaxim {a \<in> Field s. f1 a \<noteq> f2 a} x"
   31.34      unfolding st.isMaxim_def s.isMaxim_def Field_osum by (auto simp: osum_def)
   31.35 @@ -1530,15 +1530,15 @@
   31.36  qed
   31.37  
   31.38  lemma max_fun_diff_eq_Inr:
   31.39 -  assumes "wo_rel.max_fun_diff (s +o t) (sum_case f1 g1) (sum_case f2 g2) = Inr x"
   31.40 -    "sum_case f1 g1 \<noteq> sum_case f2 g2"
   31.41 -    "sum_case f1 g1 \<in> FinFunc r (s +o t)" "sum_case f2 g2 \<in> FinFunc r (s +o t)"
   31.42 +  assumes "wo_rel.max_fun_diff (s +o t) (case_sum f1 g1) (case_sum f2 g2) = Inr x"
   31.43 +    "case_sum f1 g1 \<noteq> case_sum f2 g2"
   31.44 +    "case_sum f1 g1 \<in> FinFunc r (s +o t)" "case_sum f2 g2 \<in> FinFunc r (s +o t)"
   31.45    shows "wo_rel.max_fun_diff t g1 g2 = x" (is ?P) "g1 \<noteq> g2" (is ?Q)
   31.46  proof -
   31.47    interpret st!: wo_rel "s +o t" by unfold_locales (rule osum_Well_order[OF s t])
   31.48    interpret t!: wo_rel t by unfold_locales (rule t)
   31.49    interpret rst!: wo_rel2 r "s +o t" by unfold_locales (rule r, rule osum_Well_order[OF s t])
   31.50 -  from assms(1) have *: "st.isMaxim {a \<in> Field (s +o t). sum_case f1 g1 a \<noteq> sum_case f2 g2 a} (Inr x)"
   31.51 +  from assms(1) have *: "st.isMaxim {a \<in> Field (s +o t). case_sum f1 g1 a \<noteq> case_sum f2 g2 a} (Inr x)"
   31.52      using rst.isMaxim_max_fun_diff[OF assms(2-4)] by simp
   31.53    hence "t.isMaxim {a \<in> Field t. g1 a \<noteq> g2 a} x"
   31.54      unfolding st.isMaxim_def t.isMaxim_def Field_osum by (auto simp: osum_def)
   31.55 @@ -1551,7 +1551,7 @@
   31.56    interpret rst!: wo_rel2 r "s +o t" by unfold_locales (rule r, rule osum_Well_order[OF s t])
   31.57    interpret rs!: wo_rel2 r s by unfold_locales (rule r, rule s)
   31.58    interpret rt!: wo_rel2 r t by unfold_locales (rule r, rule t)
   31.59 -  let ?f = "\<lambda>(f, g). sum_case f g"
   31.60 +  let ?f = "\<lambda>(f, g). case_sum f g"
   31.61    have "bij_betw ?f (Field ?L) (Field ?R)"
   31.62    unfolding bij_betw_def rst.Field_oexp rs.Field_oexp rt.Field_oexp Field_oprod proof (intro conjI)
   31.63      show "inj_on ?f (FinFunc r s \<times> FinFunc r t)" unfolding inj_on_def
    32.1 --- a/src/HOL/Code_Numeral.thy	Wed Feb 12 09:06:04 2014 +0100
    32.2 +++ b/src/HOL/Code_Numeral.thy	Wed Feb 12 10:59:25 2014 +0100
    32.3 @@ -384,7 +384,7 @@
    32.4      by (auto simp add: sgn_if)
    32.5    have aux2: "\<And>q::int. - int_of_integer k = int_of_integer l * q \<longleftrightarrow> int_of_integer k = int_of_integer l * - q" by auto
    32.6    show ?thesis
    32.7 -    by (simp add: prod_eq_iff integer_eq_iff prod_case_beta aux1)
    32.8 +    by (simp add: prod_eq_iff integer_eq_iff case_prod_beta aux1)
    32.9        (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if div_minus_right mod_minus_right aux2)
   32.10  qed
   32.11  
   32.12 @@ -475,7 +475,7 @@
   32.13    }
   32.14    note aux = this
   32.15    show ?thesis
   32.16 -    by (auto simp add: num_of_integer_def nat_of_integer_def Let_def prod_case_beta
   32.17 +    by (auto simp add: num_of_integer_def nat_of_integer_def Let_def case_prod_beta
   32.18        not_le integer_eq_iff less_eq_integer_def
   32.19        nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
   32.20         mult_2 [where 'a=nat] aux add_One)
   32.21 @@ -792,7 +792,7 @@
   32.22    by (rule is_measure_trivial)
   32.23  
   32.24  
   32.25 -subsection {* Inductive represenation of target language naturals *}
   32.26 +subsection {* Inductive representation of target language naturals *}
   32.27  
   32.28  lift_definition Suc :: "natural \<Rightarrow> natural"
   32.29    is Nat.Suc
   32.30 @@ -803,7 +803,7 @@
   32.31  rep_datatype "0::natural" Suc
   32.32    by (transfer, fact nat.induct nat.inject nat.distinct)+
   32.33  
   32.34 -lemma natural_case [case_names nat, cases type: natural]:
   32.35 +lemma natural_cases [case_names nat, cases type: natural]:
   32.36    fixes m :: natural
   32.37    assumes "\<And>n. m = of_nat n \<Longrightarrow> P"
   32.38    shows P
   32.39 @@ -885,7 +885,7 @@
   32.40    by transfer (simp add: fun_eq_iff)
   32.41  
   32.42  lemma [code, code_unfold]:
   32.43 -  "natural_case f g n = (if n = 0 then f else g (n - 1))"
   32.44 +  "case_natural f g n = (if n = 0 then f else g (n - 1))"
   32.45    by (cases n rule: natural.exhaust) (simp_all, simp add: Suc_def)
   32.46  
   32.47  declare natural.recs [code del]
    33.1 --- a/src/HOL/Datatype.thy	Wed Feb 12 09:06:04 2014 +0100
    33.2 +++ b/src/HOL/Datatype.thy	Wed Feb 12 10:59:25 2014 +0100
    33.3 @@ -56,7 +56,7 @@
    33.4    Push_Node_def:  "Push_Node == (%n x. Abs_Node (apfst (Push n) (Rep_Node x)))"
    33.5  
    33.6    (*crude "lists" of nats -- needed for the constructions*)
    33.7 -  Push_def:   "Push == (%b h. nat_case b h)"
    33.8 +  Push_def:   "Push == (%b h. case_nat b h)"
    33.9  
   33.10    (** operations on S-expressions -- sets of nodes **)
   33.11  
   33.12 @@ -133,7 +133,7 @@
   33.13  
   33.14  lemma Node_Push_I: "p: Node ==> apfst (Push i) p : Node"
   33.15  apply (simp add: Node_def Push_def) 
   33.16 -apply (fast intro!: apfst_conv nat_case_Suc [THEN trans])
   33.17 +apply (fast intro!: apfst_conv nat.cases(2)[THEN trans])
   33.18  done
   33.19  
   33.20  
   33.21 @@ -251,7 +251,7 @@
   33.22  by (simp add: ndepth_def  Node_K0_I [THEN Abs_Node_inverse] Least_equality)
   33.23  
   33.24  lemma ndepth_Push_Node_aux:
   33.25 -     "nat_case (Inr (Suc i)) f k = Inr 0 --> Suc(LEAST x. f x = Inr 0) <= k"
   33.26 +     "case_nat (Inr (Suc i)) f k = Inr 0 --> Suc(LEAST x. f x = Inr 0) <= k"
   33.27  apply (induct_tac "k", auto)
   33.28  apply (erule Least_le)
   33.29  done
    34.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Wed Feb 12 09:06:04 2014 +0100
    34.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Wed Feb 12 10:59:25 2014 +0100
    34.3 @@ -182,7 +182,7 @@
    34.4                else if x < 0 then - ub_sqrt prec (- x)
    34.5                              else 0)"
    34.6  by pat_completeness auto
    34.7 -termination by (relation "measure (\<lambda> v. let (prec, x) = sum_case id id v in (if x < 0 then 1 else 0))", auto)
    34.8 +termination by (relation "measure (\<lambda> v. let (prec, x) = case_sum id id v in (if x < 0 then 1 else 0))", auto)
    34.9  
   34.10  declare lb_sqrt.simps[simp del]
   34.11  declare ub_sqrt.simps[simp del]
   34.12 @@ -484,7 +484,7 @@
   34.13                                             else Float 1 1 * ub_horner y
   34.14                            else ub_pi prec * Float 1 -1 - lb_horner (float_divl prec 1 x)))"
   34.15  by pat_completeness auto
   34.16 -termination by (relation "measure (\<lambda> v. let (prec, x) = sum_case id id v in (if x < 0 then 1 else 0))", auto)
   34.17 +termination by (relation "measure (\<lambda> v. let (prec, x) = case_sum id id v in (if x < 0 then 1 else 0))", auto)
   34.18  
   34.19  declare ub_arctan_horner.simps[simp del]
   34.20  declare lb_arctan_horner.simps[simp del]
   34.21 @@ -1387,7 +1387,7 @@
   34.22               else if x < - 1  then ub_exp_horner prec (get_odd (prec + 2)) 1 1 (float_divr prec x (- floor_fl x)) ^ (nat (- int_floor_fl x))
   34.23                                else ub_exp_horner prec (get_odd (prec + 2)) 1 1 x)"
   34.24  by pat_completeness auto
   34.25 -termination by (relation "measure (\<lambda> v. let (prec, x) = sum_case id id v in (if 0 < x then 1 else 0))", auto)
   34.26 +termination by (relation "measure (\<lambda> v. let (prec, x) = case_sum id id v in (if 0 < x then 1 else 0))", auto)
   34.27  
   34.28  lemma exp_m1_ge_quarter: "(1 / 4 :: real) \<le> exp (- 1)"
   34.29  proof -
   34.30 @@ -1709,7 +1709,7 @@
   34.31                                          Some (lb_ln2 prec * (Float (exponent x + l) 0) + horner (Float (mantissa x) (- l) - 1)))"
   34.32  by pat_completeness auto
   34.33  
   34.34 -termination proof (relation "measure (\<lambda> v. let (prec, x) = sum_case id id v in (if x < 1 then 1 else 0))", auto)
   34.35 +termination proof (relation "measure (\<lambda> v. let (prec, x) = case_sum id id v in (if x < 1 then 1 else 0))", auto)
   34.36    fix prec and x :: float assume "\<not> real x \<le> 0" and "real x < 1" and "real (float_divl (max prec (Suc 0)) 1 x) < 1"
   34.37    hence "0 < real x" "1 \<le> max prec (Suc 0)" "real x < 1" by auto
   34.38    from float_divl_pos_less1_bound[OF `0 < real x` `real x < 1` `1 \<le> max prec (Suc 0)`]
   34.39 @@ -3062,7 +3062,7 @@
   34.40    case 0
   34.41    then obtain ly uy
   34.42      where *: "approx_tse prec 0 t ((l + u) * Float 1 -1) 1 f [Some (l, u)] = Some (ly, uy)"
   34.43 -    and **: "cmp ly uy" by (auto elim!: option_caseE)
   34.44 +    and **: "cmp ly uy" by (auto elim!: case_optionE)
   34.45    with 0 show ?case by auto
   34.46  next
   34.47    case (Suc s)
   34.48 @@ -3163,7 +3163,7 @@
   34.49    with assms obtain l u l' u'
   34.50      where a: "approx prec a [None] = Some (l, u)"
   34.51      and b: "approx prec b [None] = Some (l', u')"
   34.52 -    unfolding approx_tse_form_def by (auto elim!: option_caseE)
   34.53 +    unfolding approx_tse_form_def by (auto elim!: case_optionE)
   34.54  
   34.55    from Bound assms have "i = Var 0" unfolding approx_tse_form_def by auto
   34.56    hence i: "interpret_floatarith i [x] = x" by auto
   34.57 @@ -3198,10 +3198,10 @@
   34.58        show ?thesis using AtLeastAtMost by auto
   34.59      next
   34.60        case (Bound x a b f') with assms
   34.61 -      show ?thesis by (auto elim!: option_caseE simp add: f_def approx_tse_form_def)
   34.62 +      show ?thesis by (auto elim!: case_optionE simp add: f_def approx_tse_form_def)
   34.63      next
   34.64        case (Assign x a f') with assms
   34.65 -      show ?thesis by (auto elim!: option_caseE simp add: f_def approx_tse_form_def)
   34.66 +      show ?thesis by (auto elim!: case_optionE simp add: f_def approx_tse_form_def)
   34.67      qed } thus ?thesis unfolding f_def by auto
   34.68  next
   34.69    case Assign
    36.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Wed Feb 12 09:06:04 2014 +0100
    36.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Wed Feb 12 10:59:25 2014 +0100
    36.3 @@ -2030,4 +2030,3 @@
    36.4    by rferrack
    36.5  
    36.6  end
    36.7 -
    37.1 --- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Wed Feb 12 09:06:04 2014 +0100
    37.2 +++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Wed Feb 12 10:59:25 2014 +0100
    37.3 @@ -3003,5 +3003,3 @@
    37.4  oops
    37.5  *)
    37.6  end
    37.7 -
    37.8 -
    38.1 --- a/src/HOL/Decision_Procs/Polynomial_List.thy	Wed Feb 12 09:06:04 2014 +0100
    38.2 +++ b/src/HOL/Decision_Procs/Polynomial_List.thy	Wed Feb 12 10:59:25 2014 +0100
    38.3 @@ -919,6 +919,7 @@
    38.4    "last ((a %* p) +++ (x#(b %* p))) = (if p = [] then x else b * last p)"
    38.5    apply (induct p arbitrary: a x b)
    38.6    apply auto
    38.7 +  apply (rename_tac a p aa x b)
    38.8    apply (subgoal_tac "padd (cmult aa p) (times b a # cmult b p) \<noteq> []")
    38.9    apply simp
   38.10    apply (induct_tac p)
   38.11 @@ -1042,6 +1043,7 @@
   38.12  lemma poly_mono: "abs(x) \<le> k \<Longrightarrow> abs(poly p (x::'a::{linordered_idom})) \<le> poly (map abs p) k"
   38.13    apply (induct p)
   38.14    apply auto
   38.15 +  apply (rename_tac a p)
   38.16    apply (rule_tac y = "abs a + abs (x * poly p x)" in order_trans)
   38.17    apply (rule abs_triangle_ineq)
   38.18    apply (auto intro!: mult_mono simp add: abs_mult)
    39.1 --- a/src/HOL/Divides.thy	Wed Feb 12 09:06:04 2014 +0100
    39.2 +++ b/src/HOL/Divides.thy	Wed Feb 12 10:59:25 2014 +0100
    39.3 @@ -928,7 +928,7 @@
    39.4  
    39.5  lemma divmod_nat_if [code]: "divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else
    39.6    let (q, r) = divmod_nat (m - n) n in (Suc q, r))"
    39.7 -  by (simp add: prod_eq_iff prod_case_beta not_less le_div_geq le_mod_geq)
    39.8 +  by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq)
    39.9  
   39.10  text {* Simproc for cancelling @{const div} and @{const mod} *}
   39.11  
    40.1 --- a/src/HOL/Extraction.thy	Wed Feb 12 09:06:04 2014 +0100
    40.2 +++ b/src/HOL/Extraction.thy	Wed Feb 12 10:59:25 2014 +0100
    40.3 @@ -5,7 +5,7 @@
    40.4  header {* Program extraction for HOL *}
    40.5  
    40.6  theory Extraction
    40.7 -imports Option
    40.8 +imports Datatype Option
    40.9  begin
   40.10  
   40.11  ML_file "Tools/rewrite_hol_proof.ML"
    41.1 --- a/src/HOL/Fun.thy	Wed Feb 12 09:06:04 2014 +0100
    41.2 +++ b/src/HOL/Fun.thy	Wed Feb 12 10:59:25 2014 +0100
    41.3 @@ -662,10 +662,10 @@
    41.4    "_Update f (_updbinds b bs)" == "_Update (_Update f b) bs"
    41.5    "f(x:=y)" == "CONST fun_upd f x y"
    41.6  
    41.7 -(* Hint: to define the sum of two functions (or maps), use sum_case.
    41.8 +(* Hint: to define the sum of two functions (or maps), use case_sum.
    41.9           A nice infix syntax could be defined (in Datatype.thy or below) by
   41.10  notation
   41.11 -  sum_case  (infixr "'(+')"80)
   41.12 +  case_sum  (infixr "'(+')"80)
   41.13  *)
   41.14  
   41.15  lemma fun_upd_idem_iff: "(f(x:=y) = f) = (f x = y)"
    42.1 --- a/src/HOL/HOLCF/Completion.thy	Wed Feb 12 09:06:04 2014 +0100
    42.2 +++ b/src/HOL/HOLCF/Completion.thy	Wed Feb 12 10:59:25 2014 +0100
    42.3 @@ -198,7 +198,7 @@
    42.4    def b \<equiv> "\<lambda>i. LEAST j. enum j \<in> rep x \<and> \<not> enum j \<preceq> enum i"
    42.5    def c \<equiv> "\<lambda>i j. LEAST k. enum k \<in> rep x \<and> enum i \<preceq> enum k \<and> enum j \<preceq> enum k"
    42.6    def P \<equiv> "\<lambda>i. \<exists>j. enum j \<in> rep x \<and> \<not> enum j \<preceq> enum i"
    42.7 -  def X \<equiv> "nat_rec a (\<lambda>n i. if P i then c i (b i) else i)"
    42.8 +  def X \<equiv> "rec_nat a (\<lambda>n i. if P i then c i (b i) else i)"
    42.9    have X_0: "X 0 = a" unfolding X_def by simp
   42.10    have X_Suc: "\<And>n. X (Suc n) = (if P (X n) then c (X n) (b (X n)) else X n)"
   42.11      unfolding X_def by simp
    43.1 --- a/src/HOL/HOLCF/IOA/Storage/Action.thy	Wed Feb 12 09:06:04 2014 +0100
    43.2 +++ b/src/HOL/HOLCF/IOA/Storage/Action.thy	Wed Feb 12 10:59:25 2014 +0100
    43.3 @@ -8,9 +8,9 @@
    43.4  imports Main
    43.5  begin
    43.6  
    43.7 -datatype action = New  | Loc nat | Free nat
    43.8 +datatype action = New | Loc nat | Free nat
    43.9  
   43.10 -lemma [cong]: "!!x. x = y ==> action_case a b c x = action_case a b c y"
   43.11 +lemma [cong]: "!!x. x = y ==> case_action a b c x = case_action a b c y"
   43.12    by simp
   43.13  
   43.14  end
    44.1 --- a/src/HOL/HOLCF/Library/List_Cpo.thy	Wed Feb 12 09:06:04 2014 +0100
    44.2 +++ b/src/HOL/HOLCF/Library/List_Cpo.thy	Wed Feb 12 10:59:25 2014 +0100
    44.3 @@ -165,7 +165,7 @@
    44.4    shows "(\<Squnion>i. A i # B i) = (\<Squnion>i. A i) # (\<Squnion>i. B i)"
    44.5  by (intro lub_eqI is_lub_Cons cpo_lubI A B)
    44.6  
    44.7 -lemma cont2cont_list_case:
    44.8 +lemma cont2cont_case_list:
    44.9    assumes f: "cont (\<lambda>x. f x)"
   44.10    assumes g: "cont (\<lambda>x. g x)"
   44.11    assumes h1: "\<And>y ys. cont (\<lambda>x. h x y ys)"
   44.12 @@ -186,17 +186,17 @@
   44.13  apply (case_tac y, simp_all add: g h1)
   44.14  done
   44.15  
   44.16 -lemma cont2cont_list_case' [simp, cont2cont]:
   44.17 +lemma cont2cont_case_list' [simp, cont2cont]:
   44.18    assumes f: "cont (\<lambda>x. f x)"
   44.19    assumes g: "cont (\<lambda>x. g x)"
   44.20    assumes h: "cont (\<lambda>p. h (fst p) (fst (snd p)) (snd (snd p)))"
   44.21    shows "cont (\<lambda>x. case f x of [] \<Rightarrow> g x | y # ys \<Rightarrow> h x y ys)"
   44.22 -using assms by (simp add: cont2cont_list_case prod_cont_iff)
   44.23 +using assms by (simp add: cont2cont_case_list prod_cont_iff)
   44.24  
   44.25  text {* The simple version (due to Joachim Breitner) is needed if the
   44.26    element type of the list is not a cpo. *}
   44.27  
   44.28 -lemma cont2cont_list_case_simple [simp, cont2cont]:
   44.29 +lemma cont2cont_case_list_simple [simp, cont2cont]:
   44.30    assumes "cont (\<lambda>x. f1 x)"
   44.31    assumes "\<And>y ys. cont (\<lambda>x. f2 x y ys)"
   44.32    shows "cont (\<lambda>x. case l of [] \<Rightarrow> f1 x | y # ys \<Rightarrow> f2 x y ys)"
    45.1 --- a/src/HOL/HOLCF/Library/Option_Cpo.thy	Wed Feb 12 09:06:04 2014 +0100
    45.2 +++ b/src/HOL/HOLCF/Library/Option_Cpo.thy	Wed Feb 12 10:59:25 2014 +0100
    45.3 @@ -117,7 +117,7 @@
    45.4  
    45.5  lemmas lub_Some = cont2contlubE [OF cont_Some, symmetric]
    45.6  
    45.7 -lemma cont2cont_option_case:
    45.8 +lemma cont2cont_case_option:
    45.9    assumes f: "cont (\<lambda>x. f x)"
   45.10    assumes g: "cont (\<lambda>x. g x)"
   45.11    assumes h1: "\<And>a. cont (\<lambda>x. h x a)"
   45.12 @@ -134,16 +134,16 @@
   45.13  apply (case_tac y, simp_all add: g h1)
   45.14  done
   45.15  
   45.16 -lemma cont2cont_option_case' [simp, cont2cont]:
   45.17 +lemma cont2cont_case_option' [simp, cont2cont]:
   45.18    assumes f: "cont (\<lambda>x. f x)"
   45.19    assumes g: "cont (\<lambda>x. g x)"
   45.20    assumes h: "cont (\<lambda>p. h (fst p) (snd p))"
   45.21    shows "cont (\<lambda>x. case f x of None \<Rightarrow> g x | Some a \<Rightarrow> h x a)"
   45.22 -using assms by (simp add: cont2cont_option_case prod_cont_iff)
   45.23 +using assms by (simp add: cont2cont_case_option prod_cont_iff)
   45.24  
   45.25  text {* Simple version for when the element type is not a cpo. *}
   45.26  
   45.27 -lemma cont2cont_option_case_simple [simp, cont2cont]:
   45.28 +lemma cont2cont_case_option_simple [simp, cont2cont]:
   45.29    assumes "cont (\<lambda>x. f x)"
   45.30    assumes "\<And>a. cont (\<lambda>x. g x a)"
   45.31    shows "cont (\<lambda>x. case z of None \<Rightarrow> f x | Some a \<Rightarrow> g x a)"
    46.1 --- a/src/HOL/HOLCF/Library/Sum_Cpo.thy	Wed Feb 12 09:06:04 2014 +0100
    46.2 +++ b/src/HOL/HOLCF/Library/Sum_Cpo.thy	Wed Feb 12 10:59:25 2014 +0100
    46.3 @@ -145,39 +145,39 @@
    46.4  lemmas lub_Inl = cont2contlubE [OF cont_Inl, symmetric]
    46.5  lemmas lub_Inr = cont2contlubE [OF cont_Inr, symmetric]
    46.6  
    46.7 -lemma cont_sum_case1:
    46.8 +lemma cont_case_sum1:
    46.9    assumes f: "\<And>a. cont (\<lambda>x. f x a)"
   46.10    assumes g: "\<And>b. cont (\<lambda>x. g x b)"
   46.11    shows "cont (\<lambda>x. case y of Inl a \<Rightarrow> f x a | Inr b \<Rightarrow> g x b)"
   46.12  by (induct y, simp add: f, simp add: g)
   46.13  
   46.14 -lemma cont_sum_case2: "\<lbrakk>cont f; cont g\<rbrakk> \<Longrightarrow> cont (sum_case f g)"
   46.15 +lemma cont_case_sum2: "\<lbrakk>cont f; cont g\<rbrakk> \<Longrightarrow> cont (case_sum f g)"
   46.16  apply (rule contI)
   46.17  apply (erule sum_chain_cases)
   46.18  apply (simp add: cont2contlubE [OF cont_Inl, symmetric] contE)
   46.19  apply (simp add: cont2contlubE [OF cont_Inr, symmetric] contE)
   46.20  done
   46.21  
   46.22 -lemma cont2cont_sum_case:
   46.23 +lemma cont2cont_case_sum:
   46.24    assumes f1: "\<And>a. cont (\<lambda>x. f x a)" and f2: "\<And>x. cont (\<lambda>a. f x a)"
   46.25    assumes g1: "\<And>b. cont (\<lambda>x. g x b)" and g2: "\<And>x. cont (\<lambda>b. g x b)"
   46.26    assumes h: "cont (\<lambda>x. h x)"
   46.27    shows "cont (\<lambda>x. case h x of Inl a \<Rightarrow> f x a | Inr b \<Rightarrow> g x b)"
   46.28  apply (rule cont_apply [OF h])
   46.29 -apply (rule cont_sum_case2 [OF f2 g2])
   46.30 -apply (rule cont_sum_case1 [OF f1 g1])
   46.31 +apply (rule cont_case_sum2 [OF f2 g2])
   46.32 +apply (rule cont_case_sum1 [OF f1 g1])
   46.33  done
   46.34  
   46.35 -lemma cont2cont_sum_case' [simp, cont2cont]:
   46.36 +lemma cont2cont_case_sum' [simp, cont2cont]:
   46.37    assumes f: "cont (\<lambda>p. f (fst p) (snd p))"
   46.38    assumes g: "cont (\<lambda>p. g (fst p) (snd p))"
   46.39    assumes h: "cont (\<lambda>x. h x)"
   46.40    shows "cont (\<lambda>x. case h x of Inl a \<Rightarrow> f x a | Inr b \<Rightarrow> g x b)"
   46.41 -using assms by (simp add: cont2cont_sum_case prod_cont_iff)
   46.42 +using assms by (simp add: cont2cont_case_sum prod_cont_iff)
   46.43  
   46.44  text {* Continuity of map function. *}
   46.45  
   46.46 -lemma sum_map_eq: "sum_map f g = sum_case (\<lambda>a. Inl (f a)) (\<lambda>b. Inr (g b))"
   46.47 +lemma sum_map_eq: "sum_map f g = case_sum (\<lambda>a. Inl (f a)) (\<lambda>b. Inr (g b))"
   46.48  by (rule ext, case_tac x, simp_all)
   46.49  
   46.50  lemma cont2cont_sum_map [simp, cont2cont]:
    47.1 --- a/src/HOL/HOLCF/Lift.thy	Wed Feb 12 09:06:04 2014 +0100
    47.2 +++ b/src/HOL/HOLCF/Lift.thy	Wed Feb 12 10:59:25 2014 +0100
    47.3 @@ -71,23 +71,23 @@
    47.4      by (induct x) auto
    47.5  qed
    47.6  
    47.7 -subsection {* Continuity of @{const lift_case} *}
    47.8 +subsection {* Continuity of @{const case_lift} *}
    47.9  
   47.10 -lemma lift_case_eq: "lift_case \<bottom> f x = fup\<cdot>(\<Lambda> y. f (undiscr y))\<cdot>(Rep_lift x)"
   47.11 +lemma case_lift_eq: "case_lift \<bottom> f x = fup\<cdot>(\<Lambda> y. f (undiscr y))\<cdot>(Rep_lift x)"
   47.12  apply (induct x, unfold lift.cases)
   47.13  apply (simp add: Rep_lift_strict)
   47.14  apply (simp add: Def_def Abs_lift_inverse)
   47.15  done
   47.16  
   47.17 -lemma cont2cont_lift_case [simp]:
   47.18 -  "\<lbrakk>\<And>y. cont (\<lambda>x. f x y); cont g\<rbrakk> \<Longrightarrow> cont (\<lambda>x. lift_case \<bottom> (f x) (g x))"
   47.19 -unfolding lift_case_eq by (simp add: cont_Rep_lift)
   47.20 +lemma cont2cont_case_lift [simp]:
   47.21 +  "\<lbrakk>\<And>y. cont (\<lambda>x. f x y); cont g\<rbrakk> \<Longrightarrow> cont (\<lambda>x. case_lift \<bottom> (f x) (g x))"
   47.22 +unfolding case_lift_eq by (simp add: cont_Rep_lift)
   47.23  
   47.24  subsection {* Further operations *}
   47.25  
   47.26  definition
   47.27    flift1 :: "('a \<Rightarrow> 'b::pcpo) \<Rightarrow> ('a lift \<rightarrow> 'b)"  (binder "FLIFT " 10)  where
   47.28 -  "flift1 = (\<lambda>f. (\<Lambda> x. lift_case \<bottom> f x))"
   47.29 +  "flift1 = (\<lambda>f. (\<Lambda> x. case_lift \<bottom> f x))"
   47.30  
   47.31  translations
   47.32    "\<Lambda>(XCONST Def x). t" => "CONST flift1 (\<lambda>x. t)"
    48.1 --- a/src/HOL/HOLCF/Product_Cpo.thy	Wed Feb 12 09:06:04 2014 +0100
    48.2 +++ b/src/HOL/HOLCF/Product_Cpo.thy	Wed Feb 12 10:59:25 2014 +0100
    48.3 @@ -213,7 +213,7 @@
    48.4  
    48.5  lemmas cont2cont_snd [simp, cont2cont] = cont_compose [OF cont_snd]
    48.6  
    48.7 -lemma cont2cont_prod_case:
    48.8 +lemma cont2cont_case_prod:
    48.9    assumes f1: "\<And>a b. cont (\<lambda>x. f x a b)"
   48.10    assumes f2: "\<And>x b. cont (\<lambda>a. f x a b)"
   48.11    assumes f3: "\<And>x a. cont (\<lambda>b. f x a b)"
   48.12 @@ -233,7 +233,7 @@
   48.13    shows "cont f"
   48.14  proof -
   48.15    have "cont (\<lambda>(x, y). f (x, y))"
   48.16 -    by (intro cont2cont_prod_case f1 f2 cont2cont)
   48.17 +    by (intro cont2cont_case_prod f1 f2 cont2cont)
   48.18    thus "cont f"
   48.19      by (simp only: split_eta)
   48.20  qed
   48.21 @@ -246,11 +246,11 @@
   48.22  apply (simp only: prod_contI)
   48.23  done
   48.24  
   48.25 -lemma cont2cont_prod_case' [simp, cont2cont]:
   48.26 +lemma cont2cont_case_prod' [simp, cont2cont]:
   48.27    assumes f: "cont (\<lambda>p. f (fst p) (fst (snd p)) (snd (snd p)))"
   48.28    assumes g: "cont (\<lambda>x. g x)"
   48.29 -  shows "cont (\<lambda>x. prod_case (f x) (g x))"
   48.30 -using assms by (simp add: cont2cont_prod_case prod_cont_iff)
   48.31 +  shows "cont (\<lambda>x. case_prod (f x) (g x))"
   48.32 +using assms by (simp add: cont2cont_case_prod prod_cont_iff)
   48.33  
   48.34  text {* The simple version (due to Joachim Breitner) is needed if
   48.35    either element type of the pair is not a cpo. *}
   48.36 @@ -262,10 +262,10 @@
   48.37  
   48.38  text {* Admissibility of predicates on product types. *}
   48.39  
   48.40 -lemma adm_prod_case [simp]:
   48.41 +lemma adm_case_prod [simp]:
   48.42    assumes "adm (\<lambda>x. P x (fst (f x)) (snd (f x)))"
   48.43    shows "adm (\<lambda>x. case f x of (a, b) \<Rightarrow> P x a b)"
   48.44 -unfolding prod_case_beta using assms .
   48.45 +unfolding case_prod_beta using assms .
   48.46  
   48.47  subsection {* Compactness and chain-finiteness *}
   48.48  
    49.1 --- a/src/HOL/Hilbert_Choice.thy	Wed Feb 12 09:06:04 2014 +0100
    49.2 +++ b/src/HOL/Hilbert_Choice.thy	Wed Feb 12 10:59:25 2014 +0100
    49.3 @@ -289,7 +289,7 @@
    49.4    shows "\<exists>f. inj (f::nat \<Rightarrow> 'a) \<and> range f \<subseteq> S"
    49.5    -- {* Courtesy of Stephan Merz *}
    49.6  proof -
    49.7 -  def Sseq \<equiv> "nat_rec S (\<lambda>n T. T - {SOME e. e \<in> T})"
    49.8 +  def Sseq \<equiv> "rec_nat S (\<lambda>n T. T - {SOME e. e \<in> T})"
    49.9    def pick \<equiv> "\<lambda>n. (SOME e. e \<in> Sseq n)"
   49.10    { fix n have "Sseq n \<subseteq> S" "\<not> finite (Sseq n)" by (induct n) (auto simp add: Sseq_def inf) }
   49.11    moreover then have *: "\<And>n. pick n \<in> Sseq n" by (metis someI_ex pick_def ex_in_conv finite.simps)
   49.12 @@ -534,8 +534,8 @@
   49.13   apply (erule exE)
   49.14   apply (erule_tac x = "{w. \<exists>i. w=f i}" in allE, blast)
   49.15  apply (erule contrapos_np, simp, clarify)
   49.16 -apply (subgoal_tac "\<forall>n. nat_rec x (%i y. @z. z:Q & (z,y) :r) n \<in> Q")
   49.17 - apply (rule_tac x = "nat_rec x (%i y. @z. z:Q & (z,y) :r)" in exI)
   49.18 +apply (subgoal_tac "\<forall>n. rec_nat x (%i y. @z. z:Q & (z,y) :r) n \<in> Q")
   49.19 + apply (rule_tac x = "rec_nat x (%i y. @z. z:Q & (z,y) :r)" in exI)
   49.20   apply (rule allI, simp)
   49.21   apply (rule someI2_ex, blast, blast)
   49.22  apply (rule allI)
    50.1 --- a/src/HOL/Hoare/hoare_syntax.ML	Wed Feb 12 09:06:04 2014 +0100
    50.2 +++ b/src/HOL/Hoare/hoare_syntax.ML	Wed Feb 12 10:59:25 2014 +0100
    50.3 @@ -28,7 +28,7 @@
    50.4  
    50.5  fun mk_abstuple [x] body = Syntax_Trans.abs_tr [x, body]
    50.6    | mk_abstuple (x :: xs) body =
    50.7 -      Syntax.const @{const_syntax prod_case} $ Syntax_Trans.abs_tr [x, mk_abstuple xs body];
    50.8 +      Syntax.const @{const_syntax case_prod} $ Syntax_Trans.abs_tr [x, mk_abstuple xs body];
    50.9  
   50.10  fun mk_fbody x e [y] = if eq_idt (x, y) then e else y
   50.11    | mk_fbody x e (y :: xs) =
   50.12 @@ -82,21 +82,21 @@
   50.13  local
   50.14  
   50.15  fun dest_abstuple
   50.16 -      (Const (@{const_syntax prod_case}, _) $ Abs (v, _, body)) =
   50.17 +      (Const (@{const_syntax case_prod}, _) $ Abs (v, _, body)) =
   50.18          subst_bound (Syntax.free v, dest_abstuple body)
   50.19    | dest_abstuple (Abs (v,_, body)) = subst_bound (Syntax.free v, body)
   50.20    | dest_abstuple tm = tm;
   50.21  
   50.22 -fun abs2list (Const (@{const_syntax prod_case}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
   50.23 +fun abs2list (Const (@{const_syntax case_prod}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
   50.24    | abs2list (Abs (x, T, t)) = [Free (x, T)]
   50.25    | abs2list _ = [];
   50.26  
   50.27 -fun mk_ts (Const (@{const_syntax prod_case}, _) $ Abs (x, _, t)) = mk_ts t
   50.28 +fun mk_ts (Const (@{const_syntax case_prod}, _) $ Abs (x, _, t)) = mk_ts t
   50.29    | mk_ts (Abs (x, _, t)) = mk_ts t
   50.30    | mk_ts (Const (@{const_syntax Pair}, _) $ a $ b) = a :: mk_ts b
   50.31    | mk_ts t = [t];
   50.32  
   50.33 -fun mk_vts (Const (@{const_syntax prod_case},_) $ Abs (x, _, t)) =
   50.34 +fun mk_vts (Const (@{const_syntax case_prod},_) $ Abs (x, _, t)) =
   50.35        (Syntax.free x :: abs2list t, mk_ts t)
   50.36    | mk_vts (Abs (x, _, t)) = ([Syntax.free x], [t])
   50.37    | mk_vts t = raise Match;
   50.38 @@ -106,7 +106,7 @@
   50.39        if t = Bound i then find_ch vts (i - 1) xs
   50.40        else (true, (v, subst_bounds (xs, t)));
   50.41  
   50.42 -fun is_f (Const (@{const_syntax prod_case}, _) $ Abs (x, _, t)) = true
   50.43 +fun is_f (Const (@{const_syntax case_prod}, _) $ Abs (x, _, t)) = true
   50.44    | is_f (Abs (x, _, t)) = true
   50.45    | is_f t = false;
   50.46  
    51.1 --- a/src/HOL/Hoare/hoare_tac.ML	Wed Feb 12 09:06:04 2014 +0100
    51.2 +++ b/src/HOL/Hoare/hoare_tac.ML	Wed Feb 12 10:59:25 2014 +0100
    51.3 @@ -18,7 +18,7 @@
    51.4  local
    51.5  
    51.6  (** maps (%x1 ... xn. t) to [x1,...,xn] **)
    51.7 -fun abs2list (Const (@{const_name prod_case}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
    51.8 +fun abs2list (Const (@{const_name case_prod}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
    51.9    | abs2list (Abs (x, T, t)) = [Free (x, T)]
   51.10    | abs2list _ = [];
   51.11  
   51.12 @@ -39,7 +39,7 @@
   51.13              Abs (_, T, _) => T
   51.14            | Const (_, Type (_, [_, Type (_, [T, _])])) $ _ => T);
   51.15        in
   51.16 -        Const (@{const_name prod_case},
   51.17 +        Const (@{const_name case_prod},
   51.18              (T --> T2 --> HOLogic.boolT) --> HOLogic.mk_prodT (T, T2) --> HOLogic.boolT) $
   51.19            absfree (x, T) z
   51.20        end;
    52.1 --- a/src/HOL/Hoare_Parallel/Graph.thy	Wed Feb 12 09:06:04 2014 +0100
    52.2 +++ b/src/HOL/Hoare_Parallel/Graph.thy	Wed Feb 12 10:59:25 2014 +0100
    52.3 @@ -53,6 +53,7 @@
    52.4  apply(case_tac "list")
    52.5   apply force
    52.6  apply simp
    52.7 +apply(rename_tac lista)
    52.8  apply(rotate_tac -2)
    52.9  apply(erule_tac x = "0" in all_dupE)
   52.10  apply simp
    53.1 --- a/src/HOL/Hoare_Parallel/RG_Hoare.thy	Wed Feb 12 09:06:04 2014 +0100
    53.2 +++ b/src/HOL/Hoare_Parallel/RG_Hoare.thy	Wed Feb 12 10:59:25 2014 +0100
    53.3 @@ -636,6 +636,7 @@
    53.4    prefer 2
    53.5    apply force
    53.6   apply(case_tac xsa,simp,simp)
    53.7 + apply(rename_tac list)
    53.8   apply(rule_tac x="(Some Pa, sa) #(Some Pa, t) # list" in exI,simp)
    53.9   apply(rule conjI,erule CptnEnv)
   53.10   apply(simp (no_asm_use) add:lift_def)
   53.11 @@ -733,6 +734,7 @@
   53.12   apply(case_tac xs,simp add:cp_def)
   53.13   apply clarify
   53.14   apply (simp del:map.simps)
   53.15 + apply (rename_tac list)
   53.16   apply(subgoal_tac "(map (lift Q) ((a, b) # list))\<noteq>[]")
   53.17    apply(drule last_conv_nth)
   53.18    apply (simp del:map.simps)
   53.19 @@ -1032,6 +1034,7 @@
   53.20   apply(drule last_conv_nth)
   53.21   apply (simp del:map.simps last.simps)
   53.22   apply(simp add:nth_append del:last.simps)
   53.23 + apply(rename_tac a list)
   53.24   apply(subgoal_tac "((Some (While b P), snd (last ((Some P, sa) # xs))) # a # list)\<noteq>[]")
   53.25    apply(drule last_conv_nth)
   53.26    apply (simp del:map.simps last.simps)
   53.27 @@ -1349,6 +1352,7 @@
   53.28  apply(subgoal_tac "xs\<noteq>[]")
   53.29   prefer 2
   53.30   apply simp
   53.31 +apply(rename_tac a list)
   53.32  apply(thin_tac "xs = a # list")
   53.33  apply(simp add:par_com_validity_def par_comm_def)
   53.34  apply clarify
    54.1 --- a/src/HOL/Hoare_Parallel/RG_Tran.thy	Wed Feb 12 09:06:04 2014 +0100
    54.2 +++ b/src/HOL/Hoare_Parallel/RG_Tran.thy	Wed Feb 12 10:59:25 2014 +0100
    54.3 @@ -838,6 +838,7 @@
    54.4    apply(case_tac x)
    54.5     apply(force elim:par_cptn.cases)
    54.6    apply simp
    54.7 +  apply(rename_tac a list)
    54.8    apply(erule_tac x="list" in allE)
    54.9    apply clarify
   54.10    apply simp
    55.1 --- a/src/HOL/Imperative_HOL/ex/Linked_Lists.thy	Wed Feb 12 09:06:04 2014 +0100
    55.2 +++ b/src/HOL/Imperative_HOL/ex/Linked_Lists.thy	Wed Feb 12 10:59:25 2014 +0100
    55.3 @@ -692,7 +692,7 @@
    55.4  
    55.5  
    55.6  
    55.7 -lemma sum_distrib: "sum_case fl fr (case x of Empty \<Rightarrow> y | Node v n \<Rightarrow> (z v n)) = (case x of Empty \<Rightarrow> sum_case fl fr y | Node v n \<Rightarrow> sum_case fl fr (z v n))"
    55.8 +lemma sum_distrib: "case_sum fl fr (case x of Empty \<Rightarrow> y | Node v n \<Rightarrow> (z v n)) = (case x of Empty \<Rightarrow> case_sum fl fr y | Node v n \<Rightarrow> case_sum fl fr (z v n))"
    55.9  by (cases x) auto
   55.10  
   55.11  subsection {* Induction refinement by applying the abstraction function to our induct rule *}
    56.1 --- a/src/HOL/Imperative_HOL/ex/SatChecker.thy	Wed Feb 12 09:06:04 2014 +0100
    56.2 +++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy	Wed Feb 12 10:59:25 2014 +0100
    56.3 @@ -459,7 +459,7 @@
    56.4                  else raise(''No empty clause''))
    56.5    }"
    56.6  
    56.7 -lemma effect_option_case:
    56.8 +lemma effect_case_option:
    56.9    assumes "effect (case x of None \<Rightarrow> n | Some y \<Rightarrow> s y) h h' r"
   56.10    obtains "x = None" "effect n h h' r"
   56.11           | y where "x = Some y" "effect (s y) h h' r" 
   56.12 @@ -500,7 +500,7 @@
   56.13    }
   56.14    with assms show ?thesis
   56.15      unfolding res_thm2.simps get_clause_def
   56.16 -    by (elim effect_bindE effect_ifE effect_nthE effect_raiseE effect_returnE effect_option_case) auto
   56.17 +    by (elim effect_bindE effect_ifE effect_nthE effect_raiseE effect_returnE effect_case_option) auto
   56.18  qed
   56.19  
   56.20  lemma foldM_Inv2:
   56.21 @@ -543,7 +543,7 @@
   56.22    show ?thesis
   56.23      apply auto
   56.24      apply (auto simp: get_clause_def elim!: effect_bindE effect_nthE)
   56.25 -    apply (auto elim!: effect_bindE effect_nthE effect_option_case effect_raiseE
   56.26 +    apply (auto elim!: effect_bindE effect_nthE effect_case_option effect_raiseE
   56.27        effect_returnE effect_updE)
   56.28      apply (frule foldM_Inv2)
   56.29      apply assumption
    57.1 --- a/src/HOL/Import/HOL_Light_Maps.thy	Wed Feb 12 09:06:04 2014 +0100
    57.2 +++ b/src/HOL/Import/HOL_Light_Maps.thy	Wed Feb 12 10:59:25 2014 +0100
    57.3 @@ -210,14 +210,14 @@
    57.4  
    57.5  lemma sum_RECURSION:
    57.6    "\<forall>Inl' Inr'. \<exists>fn. (\<forall>a :: 'A. fn (Inl a) = (Inl' a :: 'Z)) \<and> (\<forall>a :: 'B. fn (Inr a) = Inr' a)"
    57.7 -  by (intro allI, rule_tac x="sum_case Inl' Inr'" in exI) auto
    57.8 +  by (intro allI, rule_tac x="case_sum Inl' Inr'" in exI) auto
    57.9  
   57.10 -lemma OUTL[import_const "OUTL" : "Sum_Type.Projl"]:
   57.11 -  "Sum_Type.Projl (Inl x) = x"
   57.12 +lemma OUTL[import_const "OUTL" : "Sum_Type.projl"]:
   57.13 +  "Sum_Type.projl (Inl x) = x"
   57.14    by simp
   57.15  
   57.16 -lemma OUTR[import_const "OUTR" : "Sum_Type.Projr"]:
   57.17 -  "Sum_Type.Projr (Inr y) = y"
   57.18 +lemma OUTR[import_const "OUTR" : "Sum_Type.projr"]:
   57.19 +  "Sum_Type.projr (Inr y) = y"
   57.20    by simp
   57.21  
   57.22  import_type_map list : List.list
   57.23 @@ -230,13 +230,13 @@
   57.24  
   57.25  lemma list_RECURSION:
   57.26   "\<forall>nil' cons'. \<exists>fn\<Colon>'A list \<Rightarrow> 'Z. fn [] = nil' \<and> (\<forall>(a0\<Colon>'A) a1\<Colon>'A list. fn (a0 # a1) = cons' a0 a1 (fn a1))"
   57.27 -  by (intro allI, rule_tac x="list_rec nil' cons'" in exI) auto
   57.28 +  by (intro allI, rule_tac x="rec_list nil' cons'" in exI) auto
   57.29  
   57.30 -lemma HD[import_const HD : List.hd]:
   57.31 +lemma HD[import_const HD : List.list.hd]:
   57.32    "hd ((h\<Colon>'A) # t) = h"
   57.33    by simp
   57.34  
   57.35 -lemma TL[import_const TL : List.tl]:
   57.36 +lemma TL[import_const TL : List.list.tl]:
   57.37    "tl ((h\<Colon>'A) # t) = t"
   57.38    by simp
   57.39  
    58.1 --- a/src/HOL/Induct/QuoNestedDataType.thy	Wed Feb 12 09:06:04 2014 +0100
    58.2 +++ b/src/HOL/Induct/QuoNestedDataType.thy	Wed Feb 12 10:59:25 2014 +0100
    58.3 @@ -212,6 +212,7 @@
    58.4  
    58.5  lemma ExpList_rep: "\<exists>Us. z = Abs_ExpList Us"
    58.6  apply (induct z)
    58.7 +apply (rename_tac [2] a b)
    58.8  apply (rule_tac [2] z=a in eq_Abs_Exp)
    58.9  apply (auto simp add: Abs_ExpList_def Cons_eq_map_conv intro: exprel_refl)
   58.10  done
    59.1 --- a/src/HOL/Int.thy	Wed Feb 12 09:06:04 2014 +0100
    59.2 +++ b/src/HOL/Int.thy	Wed Feb 12 10:59:25 2014 +0100
    59.3 @@ -6,7 +6,7 @@
    59.4  header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *} 
    59.5  
    59.6  theory Int
    59.7 -imports Equiv_Relations Wellfounded Power Quotient Fun_Def
    59.8 +imports Equiv_Relations Power Quotient Fun_Def
    59.9  begin
   59.10  
   59.11  subsection {* Definition of integers as a quotient type *}
    60.1 --- a/src/HOL/Lazy_Sequence.thy	Wed Feb 12 09:06:04 2014 +0100
    60.2 +++ b/src/HOL/Lazy_Sequence.thy	Wed Feb 12 10:59:25 2014 +0100
    60.3 @@ -35,12 +35,12 @@
    60.4    "size (xq :: 'a lazy_sequence) = 0"
    60.5    by (cases xq) simp
    60.6  
    60.7 -lemma lazy_sequence_case [simp]:
    60.8 -  "lazy_sequence_case f xq = f (list_of_lazy_sequence xq)"
    60.9 +lemma case_lazy_sequence [simp]:
   60.10 +  "case_lazy_sequence f xq = f (list_of_lazy_sequence xq)"
   60.11    by (cases xq) auto
   60.12  
   60.13 -lemma lazy_sequence_rec [simp]:
   60.14 -  "lazy_sequence_rec f xq = f (list_of_lazy_sequence xq)"
   60.15 +lemma rec_lazy_sequence [simp]:
   60.16 +  "rec_lazy_sequence f xq = f (list_of_lazy_sequence xq)"
   60.17    by (cases xq) auto
   60.18  
   60.19  definition Lazy_Sequence :: "(unit \<Rightarrow> ('a \<times> 'a lazy_sequence) option) \<Rightarrow> 'a lazy_sequence"
   60.20 @@ -71,8 +71,8 @@
   60.21    "yield (Lazy_Sequence f) = f ()"
   60.22    by (cases "f ()") (simp_all add: yield_def split_def)
   60.23  
   60.24 -lemma case_yield_eq [simp]: "option_case g h (yield xq) =
   60.25 -  list_case g (\<lambda>x. curry h x \<circ> lazy_sequence_of_list) (list_of_lazy_sequence xq)"
   60.26 +lemma case_yield_eq [simp]: "case_option g h (yield xq) =
   60.27 +  case_list g (\<lambda>x. curry h x \<circ> lazy_sequence_of_list) (list_of_lazy_sequence xq)"
   60.28    by (cases "list_of_lazy_sequence xq") (simp_all add: yield_def)
   60.29  
   60.30  lemma lazy_sequence_size_code [code]:
   60.31 @@ -346,4 +346,3 @@
   60.32    if_seq_def those_def not_seq_def product_def 
   60.33  
   60.34  end
   60.35 -
    61.1 --- a/src/HOL/Library/AList.thy	Wed Feb 12 09:06:04 2014 +0100
    61.2 +++ b/src/HOL/Library/AList.thy	Wed Feb 12 10:59:25 2014 +0100
    61.3 @@ -79,7 +79,7 @@
    61.4    by (simp add: update_conv')
    61.5  
    61.6  definition updates :: "'key list \<Rightarrow> 'val list \<Rightarrow> ('key \<times> 'val) list \<Rightarrow> ('key \<times> 'val) list" where
    61.7 -  "updates ks vs = fold (prod_case update) (zip ks vs)"
    61.8 +  "updates ks vs = fold (case_prod update) (zip ks vs)"
    61.9  
   61.10  lemma updates_simps [simp]:
   61.11    "updates [] vs ps = ps"
   61.12 @@ -94,7 +94,7 @@
   61.13  
   61.14  lemma updates_conv': "map_of (updates ks vs al) = (map_of al)(ks[\<mapsto>]vs)"
   61.15  proof -
   61.16 -  have "map_of \<circ> fold (prod_case update) (zip ks vs) =
   61.17 +  have "map_of \<circ> fold (case_prod update) (zip ks vs) =
   61.18      fold (\<lambda>(k, v) f. f(k \<mapsto> v)) (zip ks vs) \<circ> map_of"
   61.19      by (rule fold_commute) (auto simp add: fun_eq_iff update_conv')
   61.20    then show ?thesis by (auto simp add: updates_def fun_eq_iff map_upds_fold_map_upd foldl_conv_fold split_def)
   61.21 @@ -111,9 +111,9 @@
   61.22         (\<lambda>(k, v) al. if k \<in> set al then al else al @ [k])
   61.23         (zip ks vs) (map fst al))"
   61.24      by (rule fold_invariant [of "zip ks vs" "\<lambda>_. True"]) (auto intro: assms)
   61.25 -  moreover have "map fst \<circ> fold (prod_case update) (zip ks vs) =
   61.26 +  moreover have "map fst \<circ> fold (case_prod update) (zip ks vs) =
   61.27      fold (\<lambda>(k, v) al. if k \<in> set al then al else al @ [k]) (zip ks vs) \<circ> map fst"
   61.28 -    by (rule fold_commute) (simp add: update_keys split_def prod_case_beta comp_def)
   61.29 +    by (rule fold_commute) (simp add: update_keys split_def case_prod_beta comp_def)
   61.30    ultimately show ?thesis by (simp add: updates_def fun_eq_iff)
   61.31  qed
   61.32  
   61.33 @@ -339,9 +339,9 @@
   61.34  lemma clearjunk_updates:
   61.35    "clearjunk (updates ks vs al) = updates ks vs (clearjunk al)"
   61.36  proof -
   61.37 -  have "clearjunk \<circ> fold (prod_case update) (zip ks vs) =
   61.38 -    fold (prod_case update) (zip ks vs) \<circ> clearjunk"
   61.39 -    by (rule fold_commute) (simp add: clearjunk_update prod_case_beta o_def)
   61.40 +  have "clearjunk \<circ> fold (case_prod update) (zip ks vs) =
   61.41 +    fold (case_prod update) (zip ks vs) \<circ> clearjunk"
   61.42 +    by (rule fold_commute) (simp add: clearjunk_update case_prod_beta o_def)
   61.43    then show ?thesis by (simp add: updates_def fun_eq_iff)
   61.44  qed
   61.45  
   61.46 @@ -444,9 +444,9 @@
   61.47  lemma merge_conv':
   61.48    "map_of (merge xs ys) = map_of xs ++ map_of ys"
   61.49  proof -
   61.50 -  have "map_of \<circ> fold (prod_case update) (rev ys) =
   61.51 +  have "map_of \<circ> fold (case_prod update) (rev ys) =
   61.52      fold (\<lambda>(k, v) m. m(k \<mapsto> v)) (rev ys) \<circ> map_of"
   61.53 -    by (rule fold_commute) (simp add: update_conv' prod_case_beta split_def fun_eq_iff)
   61.54 +    by (rule fold_commute) (simp add: update_conv' case_prod_beta split_def fun_eq_iff)
   61.55    then show ?thesis
   61.56      by (simp add: merge_def map_add_map_of_foldr foldr_conv_fold fun_eq_iff)
   61.57  qed
    62.1 --- a/src/HOL/Library/Bit.thy	Wed Feb 12 09:06:04 2014 +0100
    62.2 +++ b/src/HOL/Library/Bit.thy	Wed Feb 12 10:59:25 2014 +0100
    62.3 @@ -102,10 +102,10 @@
    62.4  begin
    62.5  
    62.6  definition plus_bit_def:
    62.7 -  "x + y = bit_case y (bit_case 1 0 y) x"
    62.8 +  "x + y = case_bit y (case_bit 1 0 y) x"
    62.9  
   62.10  definition times_bit_def:
   62.11 -  "x * y = bit_case 0 y x"
   62.12 +  "x * y = case_bit 0 y x"
   62.13  
   62.14  definition uminus_bit_def [simp]:
   62.15    "- x = (x :: bit)"
   62.16 @@ -167,7 +167,7 @@
   62.17  
   62.18  definition of_bit :: "bit \<Rightarrow> 'a"
   62.19  where
   62.20 -  "of_bit b = bit_case 0 1 b" 
   62.21 +  "of_bit b = case_bit 0 1 b" 
   62.22  
   62.23  lemma of_bit_eq [simp, code]:
   62.24    "of_bit 0 = 0"
    63.1 --- a/src/HOL/Library/Code_Abstract_Nat.thy	Wed Feb 12 09:06:04 2014 +0100
    63.2 +++ b/src/HOL/Library/Code_Abstract_Nat.thy	Wed Feb 12 10:59:25 2014 +0100
    63.3 @@ -24,7 +24,7 @@
    63.4  *}
    63.5  
    63.6  lemma [code, code_unfold]:
    63.7 -  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
    63.8 +  "case_nat = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
    63.9    by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
   63.10  
   63.11  
    64.1 --- a/src/HOL/Library/Countable.thy	Wed Feb 12 09:06:04 2014 +0100
    64.2 +++ b/src/HOL/Library/Countable.thy	Wed Feb 12 10:59:25 2014 +0100
    64.3 @@ -90,7 +90,7 @@
    64.4  text {* Options *}
    64.5  
    64.6  instance option :: (countable) countable
    64.7 -  by (rule countable_classI [of "option_case 0 (Suc \<circ> to_nat)"])
    64.8 +  by (rule countable_classI [of "case_option 0 (Suc \<circ> to_nat)"])
    64.9      (simp split: option.split_asm)
   64.10  
   64.11  
    65.1 --- a/src/HOL/Library/Countable_Set_Type.thy	Wed Feb 12 09:06:04 2014 +0100
    65.2 +++ b/src/HOL/Library/Countable_Set_Type.thy	Wed Feb 12 10:59:25 2014 +0100
    65.3 @@ -140,7 +140,7 @@
    65.4    have L: "countable ?L'" by auto
    65.5    hence *: "rcset R' = ?L'" unfolding R'_def by (intro rcset_to_rcset)
    65.6    thus ?R unfolding Grp_def relcompp.simps conversep.simps
    65.7 -  proof (intro CollectI prod_caseI exI[of _ a] exI[of _ b] exI[of _ R'] conjI refl)
    65.8 +  proof (intro CollectI case_prodI exI[of _ a] exI[of _ b] exI[of _ R'] conjI refl)
    65.9      from * `?L` show "a = cimage fst R'" by transfer (auto simp: image_def Collect_Int_Times)
   65.10    next
   65.11      from * `?L` show "b = cimage snd R'" by transfer (auto simp: image_def Collect_Int_Times)
    66.1 --- a/src/HOL/Library/FSet.thy	Wed Feb 12 09:06:04 2014 +0100
    66.2 +++ b/src/HOL/Library/FSet.thy	Wed Feb 12 10:59:25 2014 +0100
    66.3 @@ -1017,7 +1017,7 @@
    66.4    have "finite ?L'" by (intro finite_Int[OF disjI2] finite_cartesian_product) (transfer, simp)+
    66.5    hence *: "fset R' = ?L'" unfolding R'_def by (intro fset_to_fset)
    66.6    show ?R unfolding Grp_def relcompp.simps conversep.simps
    66.7 -  proof (intro CollectI prod_caseI exI[of _ a] exI[of _ b] exI[of _ R'] conjI refl)
    66.8 +  proof (intro CollectI case_prodI exI[of _ a] exI[of _ b] exI[of _ R'] conjI refl)
    66.9      from * show "a = fimage fst R'" using conjunct1[OF `?L`]
   66.10        by (transfer, auto simp add: image_def Int_def split: prod.splits)
   66.11      from * show "b = fimage snd R'" using conjunct2[OF `?L`]
    67.1 --- a/src/HOL/Library/IArray.thy	Wed Feb 12 09:06:04 2014 +0100
    67.2 +++ b/src/HOL/Library/IArray.thy	Wed Feb 12 10:59:25 2014 +0100
    67.3 @@ -63,11 +63,11 @@
    67.4  by (cases as) simp
    67.5  
    67.6  lemma [code]:
    67.7 -"iarray_rec f as = f (IArray.list_of as)"
    67.8 +"rec_iarray f as = f (IArray.list_of as)"
    67.9  by (cases as) simp
   67.10  
   67.11  lemma [code]:
   67.12 -"iarray_case f as = f (IArray.list_of as)"
   67.13 +"case_iarray f as = f (IArray.list_of as)"
   67.14  by (cases as) simp
   67.15  
   67.16  lemma [code]:
    68.1 --- a/src/HOL/Library/Multiset.thy	Wed Feb 12 09:06:04 2014 +0100
    68.2 +++ b/src/HOL/Library/Multiset.thy	Wed Feb 12 10:59:25 2014 +0100
    68.3 @@ -955,6 +955,7 @@
    68.4  lemma distinct_count_atmost_1:
    68.5    "distinct x = (! a. count (multiset_of x) a = (if a \<in> set x then 1 else 0))"
    68.6  apply (induct x, simp, rule iffI, simp_all)
    68.7 +apply (rename_tac a b)
    68.8  apply (rule conjI)
    68.9  apply (simp_all add: set_of_multiset_of [THEN sym] del: set_of_multiset_of)
   68.10  apply (erule_tac x = a in allE, simp, clarify)
    69.1 --- a/src/HOL/Library/Polynomial.thy	Wed Feb 12 09:06:04 2014 +0100
    69.2 +++ b/src/HOL/Library/Polynomial.thy	Wed Feb 12 10:59:25 2014 +0100
    69.3 @@ -145,9 +145,9 @@
    69.4    with that show thesis .
    69.5  qed
    69.6  
    69.7 -lemma almost_everywhere_zero_nat_case:
    69.8 +lemma almost_everywhere_zero_case_nat:
    69.9    assumes "almost_everywhere_zero f"
   69.10 -  shows "almost_everywhere_zero (nat_case a f)"
   69.11 +  shows "almost_everywhere_zero (case_nat a f)"
   69.12    using assms
   69.13    by (auto intro!: almost_everywhere_zeroI elim!: almost_everywhere_zeroE split: nat.split)
   69.14      blast
   69.15 @@ -258,8 +258,8 @@
   69.16  subsection {* List-style constructor for polynomials *}
   69.17  
   69.18  lift_definition pCons :: "'a::zero \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   69.19 -  is "\<lambda>a p. nat_case a (coeff p)"
   69.20 -  using coeff_almost_everywhere_zero by (rule almost_everywhere_zero_nat_case)
   69.21 +  is "\<lambda>a p. case_nat a (coeff p)"
   69.22 +  using coeff_almost_everywhere_zero by (rule almost_everywhere_zero_case_nat)
   69.23  
   69.24  lemmas coeff_pCons = pCons.rep_eq
   69.25  
   69.26 @@ -405,8 +405,8 @@
   69.27  proof -
   69.28    { fix ms :: "nat list" and f :: "nat \<Rightarrow> 'a" and x :: "'a"
   69.29      assume "\<forall>m\<in>set ms. m > 0"
   69.30 -    then have "map (nat_case x f) ms = map f (map (\<lambda>n. n - 1) ms)"
   69.31 -      by (induct ms) (auto, metis Suc_pred' nat_case_Suc) }
   69.32 +    then have "map (case_nat x f) ms = map f (map (\<lambda>n. n - 1) ms)"
   69.33 +      by (induct ms) (auto, metis Suc_pred' nat.cases(2)) }
   69.34    note * = this
   69.35    show ?thesis
   69.36      by (simp add: coeffs_def * upt_conv_Cons coeff_pCons map_decr_upt One_nat_def del: upt_Suc)
   69.37 @@ -452,7 +452,7 @@
   69.38  lemma coeff_Poly_eq:
   69.39    "coeff (Poly xs) n = nth_default 0 xs n"
   69.40    apply (induct xs arbitrary: n) apply simp_all
   69.41 -  by (metis nat_case_0 nat_case_Suc not0_implies_Suc nth_default_Cons_0 nth_default_Cons_Suc pCons.rep_eq)
   69.42 +  by (metis nat.cases not0_implies_Suc nth_default_Cons_0 nth_default_Cons_Suc pCons.rep_eq)
   69.43  
   69.44  lemma nth_default_coeffs_eq:
   69.45    "nth_default 0 (coeffs p) = coeff p"
    70.1 --- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Wed Feb 12 09:06:04 2014 +0100
    70.2 +++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Wed Feb 12 10:59:25 2014 +0100
    70.3 @@ -22,7 +22,7 @@
    70.4  
    70.5  section {* Pairs *}
    70.6  
    70.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name fst}, @{const_name snd}, @{const_name prod_case}] *}
    70.8 +setup {* Predicate_Compile_Data.ignore_consts [@{const_name fst}, @{const_name snd}, @{const_name case_prod}] *}
    70.9  
   70.10  section {* Bounded quantifiers *}
   70.11  
    71.1 --- a/src/HOL/Library/Quotient_Product.thy	Wed Feb 12 09:06:04 2014 +0100
    71.2 +++ b/src/HOL/Library/Quotient_Product.thy	Wed Feb 12 10:59:25 2014 +0100
    71.3 @@ -78,7 +78,7 @@
    71.4  
    71.5  lemma split_rsp [quot_respect]:
    71.6    shows "((R1 ===> R2 ===> (op =)) ===> (prod_rel R1 R2) ===> (op =)) split split"
    71.7 -  by (rule prod_case_transfer)
    71.8 +  by (rule case_prod_transfer)
    71.9  
   71.10  lemma split_prs [quot_preserve]:
   71.11    assumes q1: "Quotient3 R1 Abs1 Rep1"
    72.1 --- a/src/HOL/Library/RBT.thy	Wed Feb 12 09:06:04 2014 +0100
    72.2 +++ b/src/HOL/Library/RBT.thy	Wed Feb 12 10:59:25 2014 +0100
    72.3 @@ -135,7 +135,7 @@
    72.4    by transfer (rule rbt_lookup_map)
    72.5  
    72.6  lemma fold_fold:
    72.7 -  "fold f t = List.fold (prod_case f) (entries t)"
    72.8 +  "fold f t = List.fold (case_prod f) (entries t)"
    72.9    by transfer (rule RBT_Impl.fold_def)
   72.10  
   72.11  lemma impl_of_empty:
   72.12 @@ -175,7 +175,7 @@
   72.13    by transfer (simp add: keys_entries)
   72.14  
   72.15  lemma fold_def_alt:
   72.16 -  "fold f t = List.fold (prod_case f) (entries t)"
   72.17 +  "fold f t = List.fold (case_prod f) (entries t)"
   72.18    by transfer (auto simp: RBT_Impl.fold_def)
   72.19  
   72.20  lemma distinct_entries: "distinct (List.map fst (entries t))"
    73.1 --- a/src/HOL/Library/RBT_Impl.thy	Wed Feb 12 09:06:04 2014 +0100
    73.2 +++ b/src/HOL/Library/RBT_Impl.thy	Wed Feb 12 10:59:25 2014 +0100
    73.3 @@ -1067,7 +1067,7 @@
    73.4  subsection {* Folding over entries *}
    73.5  
    73.6  definition fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> 'c) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> 'c \<Rightarrow> 'c" where
    73.7 -  "fold f t = List.fold (prod_case f) (entries t)"
    73.8 +  "fold f t = List.fold (case_prod f) (entries t)"
    73.9  
   73.10  lemma fold_simps [simp]:
   73.11    "fold f Empty = id"
   73.12 @@ -1110,10 +1110,10 @@
   73.13  proof -
   73.14    obtain ys where "ys = rev xs" by simp
   73.15    have "\<And>t. is_rbt t \<Longrightarrow>
   73.16 -    rbt_lookup (List.fold (prod_case rbt_insert) ys t) = rbt_lookup t ++ map_of (rev ys)"
   73.17 -      by (induct ys) (simp_all add: rbt_bulkload_def rbt_lookup_rbt_insert prod_case_beta)
   73.18 +    rbt_lookup (List.fold (case_prod rbt_insert) ys t) = rbt_lookup t ++ map_of (rev ys)"
   73.19 +      by (induct ys) (simp_all add: rbt_bulkload_def rbt_lookup_rbt_insert case_prod_beta)
   73.20    from this Empty_is_rbt have
   73.21 -    "rbt_lookup (List.fold (prod_case rbt_insert) (rev xs) Empty) = rbt_lookup Empty ++ map_of xs"
   73.22 +    "rbt_lookup (List.fold (case_prod rbt_insert) (rev xs) Empty) = rbt_lookup Empty ++ map_of xs"
   73.23       by (simp add: `ys = rev xs`)
   73.24    then show ?thesis by (simp add: rbt_bulkload_def rbt_lookup_Empty foldr_conv_fold)
   73.25  qed
   73.26 @@ -1167,7 +1167,7 @@
   73.27            apfst (Branch B t1 k v) (rbtreeify_g n' kvs')
   73.28        else case rbtreeify_f n' kvs of (t1, (k, v) # kvs') \<Rightarrow>
   73.29            apfst (Branch B t1 k v) (rbtreeify_f n' kvs'))"
   73.30 -by(subst rbtreeify_f.simps)(simp only: Let_def divmod_nat_div_mod prod.simps)
   73.31 +by (subst rbtreeify_f.simps) (simp only: Let_def divmod_nat_div_mod prod.case)
   73.32  
   73.33  lemma rbtreeify_g_code [code]:
   73.34    "rbtreeify_g n kvs =
   73.35 @@ -1178,7 +1178,7 @@
   73.36            apfst (Branch B t1 k v) (rbtreeify_g n' kvs')
   73.37        else case rbtreeify_f n' kvs of (t1, (k, v) # kvs') \<Rightarrow>
   73.38            apfst (Branch B t1 k v) (rbtreeify_g n' kvs'))"
   73.39 -by(subst rbtreeify_g.simps)(simp only: Let_def divmod_nat_div_mod prod.simps)
   73.40 +by(subst rbtreeify_g.simps)(simp only: Let_def divmod_nat_div_mod prod.case)
   73.41  
   73.42  lemma Suc_double_half: "Suc (2 * n) div 2 = n"
   73.43  by simp
   73.44 @@ -1250,8 +1250,8 @@
   73.45        with "1.prems" False obtain t1 k' v' kvs''
   73.46          where kvs'': "rbtreeify_f (n div 2) kvs = (t1, (k', v') # kvs'')"
   73.47           by(cases ?rest1)(auto simp add: snd_def split: prod.split_asm)
   73.48 -      note this also note prod.simps(2) also note list.simps(5) 
   73.49 -      also note prod.simps(2) also note snd_apfst
   73.50 +      note this also note prod.case also note list.simps(5) 
   73.51 +      also note prod.case also note snd_apfst
   73.52        also have "0 < n div 2" "n div 2 \<le> Suc (length kvs'')" 
   73.53          using len "1.prems" False unfolding kvs'' by simp_all
   73.54        with True kvs''[symmetric] refl refl
   73.55 @@ -1276,8 +1276,8 @@
   73.56        with "1.prems" `\<not> n \<le> 1` obtain t1 k' v' kvs''
   73.57          where kvs'': "rbtreeify_f (n div 2) kvs = (t1, (k', v') # kvs'')"
   73.58          by(cases ?rest1)(auto simp add: snd_def split: prod.split_asm)
   73.59 -      note this also note prod.simps(2) also note list.simps(5) 
   73.60 -      also note prod.simps(2) also note snd_apfst
   73.61 +      note this also note prod.case also note list.simps(5)
   73.62 +      also note prod.case also note snd_apfst
   73.63        also have "n div 2 \<le> length kvs''" 
   73.64          using len "1.prems" False unfolding kvs'' by simp arith
   73.65        with False kvs''[symmetric] refl refl
   73.66 @@ -1315,8 +1315,8 @@
   73.67        with "2.prems" obtain t1 k' v' kvs''
   73.68          where kvs'': "rbtreeify_g (n div 2) kvs = (t1, (k', v') # kvs'')"
   73.69          by(cases ?rest1)(auto simp add: snd_def split: prod.split_asm)
   73.70 -      note this also note prod.simps(2) also note list.simps(5) 
   73.71 -      also note prod.simps(2) also note snd_apfst
   73.72 +      note this also note prod.case also note list.simps(5) 
   73.73 +      also note prod.case also note snd_apfst
   73.74        also have "n div 2 \<le> Suc (length kvs'')" 
   73.75          using len "2.prems" unfolding kvs'' by simp
   73.76        with True kvs''[symmetric] refl refl `0 < n div 2`
   73.77 @@ -1341,8 +1341,8 @@
   73.78        with "2.prems" `1 < n` False obtain t1 k' v' kvs'' 
   73.79          where kvs'': "rbtreeify_f (n div 2) kvs = (t1, (k', v') # kvs'')"
   73.80          by(cases ?rest1)(auto simp add: snd_def split: prod.split_asm, arith)
   73.81 -      note this also note prod.simps(2) also note list.simps(5) 
   73.82 -      also note prod.simps(2) also note snd_apfst
   73.83 +      note this also note prod.case also note list.simps(5) 
   73.84 +      also note prod.case also note snd_apfst
   73.85        also have "n div 2 \<le> Suc (length kvs'')" 
   73.86          using len "2.prems" False unfolding kvs'' by simp arith
   73.87        with False kvs''[symmetric] refl refl `0 < n div 2`
   73.88 @@ -1748,14 +1748,14 @@
   73.89  
   73.90  hide_type (open) compare
   73.91  hide_const (open)
   73.92 -  compare_height skip_black skip_red LT GT EQ compare_case compare_rec 
   73.93 -  Abs_compare Rep_compare compare_rep_set
   73.94 +  compare_height skip_black skip_red LT GT EQ case_compare rec_compare
   73.95 +  Abs_compare Rep_compare rep_set_compare
   73.96  hide_fact (open)
   73.97    Abs_compare_cases Abs_compare_induct Abs_compare_inject Abs_compare_inverse
   73.98    Rep_compare Rep_compare_cases Rep_compare_induct Rep_compare_inject Rep_compare_inverse
   73.99    compare.simps compare.exhaust compare.induct compare.recs compare.simps
  73.100    compare.size compare.case_cong compare.weak_case_cong compare.cases 
  73.101 -  compare.nchotomy compare.split compare.split_asm compare_rec_def
  73.102 +  compare.nchotomy compare.split compare.split_asm rec_compare_def
  73.103    compare.eq.refl compare.eq.simps
  73.104    compare.EQ_def compare.GT_def compare.LT_def
  73.105    equal_compare_def
    74.1 --- a/src/HOL/Library/Transitive_Closure_Table.thy	Wed Feb 12 09:06:04 2014 +0100
    74.2 +++ b/src/HOL/Library/Transitive_Closure_Table.thy	Wed Feb 12 10:59:25 2014 +0100
    74.3 @@ -1,6 +1,6 @@
    74.4  (* Author: Stefan Berghofer, Lukas Bulwahn, TU Muenchen *)
    74.5  
    74.6 -header {* A tabled implementation of the reflexive transitive closure *}
    74.7 +header {* A table-based implementation of the reflexive transitive closure *}
    74.8  
    74.9  theory Transitive_Closure_Table
   74.10  imports Main
    75.1 --- a/src/HOL/Library/refute.ML	Wed Feb 12 09:06:04 2014 +0100
    75.2 +++ b/src/HOL/Library/refute.ML	Wed Feb 12 10:59:25 2014 +0100
    75.3 @@ -3163,8 +3163,8 @@
    75.4     add_interpreter "lfp" lfp_interpreter #>
    75.5     add_interpreter "gfp" gfp_interpreter #>
    75.6  *)
    75.7 -   add_interpreter "Product_Type.fst" Product_Type_fst_interpreter #>
    75.8 -   add_interpreter "Product_Type.snd" Product_Type_snd_interpreter #>
    75.9 +   add_interpreter "Product_Type.prod.fst" Product_Type_fst_interpreter #>
   75.10 +   add_interpreter "Product_Type.prod.snd" Product_Type_snd_interpreter #>
   75.11     add_printer "stlc" stlc_printer #>
   75.12     add_printer "set" set_printer #>
   75.13     add_printer "IDT"  IDT_printer;
    76.1 --- a/src/HOL/Lifting_Option.thy	Wed Feb 12 09:06:04 2014 +0100
    76.2 +++ b/src/HOL/Lifting_Option.thy	Wed Feb 12 10:59:25 2014 +0100
    76.3 @@ -26,7 +26,7 @@
    76.4    unfolding option_rel_def by simp_all
    76.5  
    76.6  abbreviation (input) option_pred :: "('a \<Rightarrow> bool) \<Rightarrow> 'a option \<Rightarrow> bool" where
    76.7 -  "option_pred \<equiv> option_case True"
    76.8 +  "option_pred \<equiv> case_option True"
    76.9  
   76.10  lemma option_rel_eq [relator_eq]:
   76.11    "option_rel (op =) = (op =)"
   76.12 @@ -100,8 +100,8 @@
   76.13  lemma Some_transfer [transfer_rule]: "(A ===> option_rel A) Some Some"
   76.14    unfolding fun_rel_def by simp
   76.15  
   76.16 -lemma option_case_transfer [transfer_rule]:
   76.17 -  "(B ===> (A ===> B) ===> option_rel A ===> B) option_case option_case"
   76.18 +lemma case_option_transfer [transfer_rule]:
   76.19 +  "(B ===> (A ===> B) ===> option_rel A ===> B) case_option case_option"
   76.20    unfolding fun_rel_def split_option_all by simp
   76.21  
   76.22  lemma option_map_transfer [transfer_rule]:
   76.23 @@ -115,57 +115,4 @@
   76.24  
   76.25  end
   76.26  
   76.27 -
   76.28 -subsubsection {* BNF setup *}
   76.29 -
   76.30 -lemma option_rec_conv_option_case: "option_rec = option_case"
   76.31 -by (simp add: fun_eq_iff split: option.split)
   76.32 -
   76.33 -bnf "'a option"
   76.34 -  map: Option.map
   76.35 -  sets: Option.set
   76.36 -  bd: natLeq
   76.37 -  wits: None
   76.38 -  rel: option_rel
   76.39 -proof -
   76.40 -  show "Option.map id = id" by (rule Option.map.id)
   76.41 -next
   76.42 -  fix f g
   76.43 -  show "Option.map (g \<circ> f) = Option.map g \<circ> Option.map f"
   76.44 -    by (auto simp add: fun_eq_iff Option.map_def split: option.split)
   76.45 -next
   76.46 -  fix f g x
   76.47 -  assume "\<And>z. z \<in> Option.set x \<Longrightarrow> f z = g z"
   76.48 -  thus "Option.map f x = Option.map g x"
   76.49 -    by (simp cong: Option.map_cong)
   76.50 -next
   76.51 -  fix f
   76.52 -  show "Option.set \<circ> Option.map f = op ` f \<circ> Option.set"
   76.53 -    by fastforce
   76.54 -next
   76.55 -  show "card_order natLeq" by (rule natLeq_card_order)
   76.56 -next
   76.57 -  show "cinfinite natLeq" by (rule natLeq_cinfinite)
   76.58 -next
   76.59 -  fix x
   76.60 -  show "|Option.set x| \<le>o natLeq"
   76.61 -    by (cases x) (simp_all add: ordLess_imp_ordLeq finite_iff_ordLess_natLeq[symmetric])
   76.62 -next
   76.63 -  fix R S
   76.64 -  show "option_rel R OO option_rel S \<le> option_rel (R OO S)"
   76.65 -    by (auto simp: option_rel_def split: option.splits)
   76.66 -next
   76.67 -  fix z
   76.68 -  assume "z \<in> Option.set None"
   76.69 -  thus False by simp
   76.70 -next
   76.71 -  fix R
   76.72 -  show "option_rel R =
   76.73 -        (Grp {x. Option.set x \<subseteq> Collect (split R)} (Option.map fst))\<inverse>\<inverse> OO
   76.74 -         Grp {x. Option.set x \<subseteq> Collect (split R)} (Option.map snd)"
   76.75 -  unfolding option_rel_def Grp_def relcompp.simps conversep.simps fun_eq_iff prod.cases
   76.76 -  by (auto simp: trans[OF eq_commute option_map_is_None] trans[OF eq_commute option_map_eq_Some]
   76.77 -           split: option.splits)
   76.78 -qed
   76.79 -
   76.80  end
    77.1 --- a/src/HOL/Lifting_Product.thy	Wed Feb 12 09:06:04 2014 +0100
    77.2 +++ b/src/HOL/Lifting_Product.thy	Wed Feb 12 10:59:25 2014 +0100
    77.3 @@ -95,8 +95,8 @@
    77.4  lemma snd_transfer [transfer_rule]: "(prod_rel A B ===> B) snd snd"
    77.5    unfolding fun_rel_def prod_rel_def by simp
    77.6  
    77.7 -lemma prod_case_transfer [transfer_rule]:
    77.8 -  "((A ===> B ===> C) ===> prod_rel A B ===> C) prod_case prod_case"
    77.9 +lemma case_prod_transfer [transfer_rule]:
   77.10 +  "((A ===> B ===> C) ===> prod_rel A B ===> C) case_prod case_prod"
   77.11    unfolding fun_rel_def prod_rel_def by simp
   77.12  
   77.13  lemma curry_transfer [transfer_rule]:
    78.1 --- a/src/HOL/Lifting_Sum.thy	Wed Feb 12 09:06:04 2014 +0100
    78.2 +++ b/src/HOL/Lifting_Sum.thy	Wed Feb 12 10:59:25 2014 +0100
    78.3 @@ -10,7 +10,7 @@
    78.4  
    78.5  subsection {* Relator and predicator properties *}
    78.6  
    78.7 -abbreviation (input) "sum_pred \<equiv> sum_case"
    78.8 +abbreviation (input) "sum_pred \<equiv> case_sum"
    78.9  
   78.10  lemmas sum_rel_eq[relator_eq] = sum.rel_eq
   78.11  lemmas sum_rel_mono[relator_mono] = sum.rel_mono
   78.12 @@ -80,8 +80,8 @@
   78.13  lemma Inr_transfer [transfer_rule]: "(B ===> sum_rel A B) Inr Inr"
   78.14    unfolding fun_rel_def by simp
   78.15  
   78.16 -lemma sum_case_transfer [transfer_rule]:
   78.17 -  "((A ===> C) ===> (B ===> C) ===> sum_rel A B ===> C) sum_case sum_case"
   78.18 +lemma case_sum_transfer [transfer_rule]:
   78.19 +  "((A ===> C) ===> (B ===> C) ===> sum_rel A B ===> C) case_sum case_sum"
   78.20    unfolding fun_rel_def sum_rel_def by (simp split: sum.split)
   78.21  
   78.22  end
    79.1 --- a/src/HOL/Limits.thy	Wed Feb 12 09:06:04 2014 +0100
    79.2 +++ b/src/HOL/Limits.thy	Wed Feb 12 10:59:25 2014 +0100
    79.3 @@ -1750,7 +1750,7 @@
    79.4    assumes local: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<exists>d>0. \<forall>a b. a \<le> x \<and> x \<le> b \<and> b - a < d \<longrightarrow> P a b"
    79.5    shows "P a b"
    79.6  proof -
    79.7 -  def bisect \<equiv> "nat_rec (a, b) (\<lambda>n (x, y). if P x ((x+y) / 2) then ((x+y)/2, y) else (x, (x+y)/2))"
    79.8 +  def bisect \<equiv> "rec_nat (a, b) (\<lambda>n (x, y). if P x ((x+y) / 2) then ((x+y)/2, y) else (x, (x+y)/2))"
    79.9    def l \<equiv> "\<lambda>n. fst (bisect n)" and u \<equiv> "\<lambda>n. snd (bisect n)"
   79.10    have l[simp]: "l 0 = a" "\<And>n. l (Suc n) = (if P (l n) ((l n + u n) / 2) then (l n + u n) / 2 else l n)"
   79.11      and u[simp]: "u 0 = b" "\<And>n. u (Suc n) = (if P (l n) ((l n + u n) / 2) then u n else (l n + u n) / 2)"
    80.1 --- a/src/HOL/List.thy	Wed Feb 12 09:06:04 2014 +0100
    80.2 +++ b/src/HOL/List.thy	Wed Feb 12 10:59:25 2014 +0100
    80.3 @@ -8,9 +8,32 @@
    80.4  imports Presburger Code_Numeral Quotient Lifting_Set Lifting_Option Lifting_Product
    80.5  begin
    80.6  
    80.7 -datatype 'a list =
    80.8 -    Nil    ("[]")
    80.9 -  | Cons 'a  "'a list"    (infixr "#" 65)
   80.10 +datatype_new 'a list =
   80.11 +    =: Nil (defaults tl: "[]")  ("[]")
   80.12 +  | Cons (hd: 'a) (tl: "'a list")  (infixr "#" 65)
   80.13 +
   80.14 +datatype_new_compat list
   80.15 +
   80.16 +thm list.exhaust[no_vars]
   80.17 +
   80.18 +lemma [case_names Nil Cons, cases type: list]:
   80.19 +  -- {* for backward compatibility -- names of variables differ *}
   80.20 +  "(y = [] \<Longrightarrow> P) \<Longrightarrow> (\<And>a list. y = a # list \<Longrightarrow> P) \<Longrightarrow> P"
   80.21 +by (rule list.exhaust)
   80.22 +
   80.23 +lemma [case_names Nil Cons, induct type: list]:
   80.24 +  -- {* for backward compatibility -- names of variables differ *}
   80.25 +  "P [] \<Longrightarrow> (\<And>a list. P list \<Longrightarrow> P (a # list)) \<Longrightarrow> P list"
   80.26 +by (rule list.induct)
   80.27 +
   80.28 +-- {* Compatibility *}
   80.29 +setup {* Sign.mandatory_path "list" *}
   80.30 +
   80.31 +lemmas inducts = list.induct
   80.32 +lemmas recs = list.rec
   80.33 +lemmas cases = list.case
   80.34 +
   80.35 +setup {* Sign.parent_path *}
   80.36  
   80.37  syntax
   80.38    -- {* list Enumeration *}
   80.39 @@ -23,13 +46,6 @@
   80.40  
   80.41  subsection {* Basic list processing functions *}
   80.42  
   80.43 -primrec hd :: "'a list \<Rightarrow> 'a" where
   80.44 -"hd (x # xs) = x"
   80.45 -
   80.46 -primrec tl :: "'a list \<Rightarrow> 'a list" where
   80.47 -"tl [] = []" |
   80.48 -"tl (x # xs) = xs"
   80.49 -
   80.50  primrec last :: "'a list \<Rightarrow> 'a" where
   80.51  "last (x # xs) = (if xs = [] then x else last xs)"
   80.52  
   80.53 @@ -1632,10 +1648,10 @@
   80.54  lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}"
   80.55  apply (induct xs, simp, simp)
   80.56  apply safe
   80.57 -apply (metis nat_case_0 nth.simps zero_less_Suc)
   80.58 +apply (metis nat.cases(1) nth.simps zero_less_Suc)
   80.59  apply (metis less_Suc_eq_0_disj nth_Cons_Suc)
   80.60  apply (case_tac i, simp)
   80.61 -apply (metis diff_Suc_Suc nat_case_Suc nth.simps zero_less_diff)
   80.62 +apply (metis diff_Suc_Suc nat.cases(2) nth.simps zero_less_diff)
   80.63  done
   80.64  
   80.65  lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)"
   80.66 @@ -3379,7 +3395,8 @@
   80.67  
   80.68  lemma distinct_length_2_or_more:
   80.69  "distinct (a # b # xs) \<longleftrightarrow> (a \<noteq> b \<and> distinct (a # xs) \<and> distinct (b # xs))"
   80.70 -by (metis distinct.simps(2) hd.simps hd_in_set list.simps(2) set_ConsD set_rev_mp set_subset_Cons)
   80.71 +by (metis distinct.simps(2) list.sel(1) hd_in_set list.simps(2) set_ConsD set_rev_mp
   80.72 +      set_subset_Cons)
   80.73  
   80.74  lemma remdups_adj_Cons: "remdups_adj (x # xs) =
   80.75    (case remdups_adj xs of [] \<Rightarrow> [x] | y # xs \<Rightarrow> if x = y then y # xs else x # y # xs)"
   80.76 @@ -4275,12 +4292,12 @@
   80.77  by pat_completeness auto
   80.78  
   80.79  lemma transpose_aux_filter_head:
   80.80 -  "concat (map (list_case [] (\<lambda>h t. [h])) xss) =
   80.81 +  "concat (map (case_list [] (\<lambda>h t. [h])) xss) =
   80.82    map (\<lambda>xs. hd xs) [ys\<leftarrow>xss . ys \<noteq> []]"
   80.83    by (induct xss) (auto split: list.split)
   80.84  
   80.85  lemma transpose_aux_filter_tail:
   80.86 -  "concat (map (list_case [] (\<lambda>h t. [t])) xss) =
   80.87 +  "concat (map (case_list [] (\<lambda>h t. [t])) xss) =
   80.88    map (\<lambda>xs. tl xs) [ys\<leftarrow>xss . ys \<noteq> []]"
   80.89    by (induct xss) (auto split: list.split)
   80.90  
   80.91 @@ -4354,13 +4371,13 @@
   80.92        by (cases x) simp_all
   80.93      } note *** = this
   80.94  
   80.95 -    have j_less: "j < length (transpose (xs # concat (map (list_case [] (\<lambda>h t. [t])) xss)))"
   80.96 +    have j_less: "j < length (transpose (xs # concat (map (case_list [] (\<lambda>h t. [t])) xss)))"
   80.97        using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc)
   80.98  
   80.99      show ?thesis
  80.100        unfolding transpose.simps `i = Suc j` nth_Cons_Suc "3.hyps"[OF j_less]
  80.101        apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric])
  80.102 -      apply (rule_tac y=x in list.exhaust)
  80.103 +      apply (rule list.exhaust)
  80.104        by auto
  80.105    qed
  80.106  qed simp_all
  80.107 @@ -6672,19 +6689,19 @@
  80.108    "(A ===> list_all2 A ===> list_all2 A) Cons Cons"
  80.109    unfolding fun_rel_def by simp
  80.110  
  80.111 -lemma list_case_transfer [transfer_rule]:
  80.112 +lemma case_list_transfer [transfer_rule]:
  80.113    "(B ===> (A ===> list_all2 A ===> B) ===> list_all2 A ===> B)
  80.114 -    list_case list_case"
  80.115 +    case_list case_list"
  80.116    unfolding fun_rel_def by (simp split: list.split)
  80.117  
  80.118 -lemma list_rec_transfer [transfer_rule]:
  80.119 +lemma rec_list_transfer [transfer_rule]:
  80.120    "(B ===> (A ===> list_all2 A ===> B ===> B) ===> list_all2 A ===> B)
  80.121 -    list_rec list_rec"
  80.122 +    rec_list rec_list"
  80.123    unfolding fun_rel_def by (clarify, erule list_all2_induct, simp_all)
  80.124  
  80.125  lemma tl_transfer [transfer_rule]:
  80.126    "(list_all2 A ===> list_all2 A) tl tl"
  80.127 -  unfolding tl_def by transfer_prover
  80.128 +  unfolding tl_def[abs_def] by transfer_prover
  80.129  
  80.130  lemma butlast_transfer [transfer_rule]:
  80.131    "(list_all2 A ===> list_all2 A) butlast butlast"
  80.132 @@ -6876,46 +6893,4 @@
  80.133  
  80.134  end
  80.135  
  80.136 -
  80.137 -subsection {* BNF setup *}
  80.138 -
  80.139 -bnf "'a list"
  80.140 -  map: map
  80.141 -  sets: set
  80.142 -  bd: natLeq
  80.143 -  wits: Nil
  80.144 -  rel: list_all2
  80.145 -proof -
  80.146 -  show "map id = id" by (rule List.map.id)
  80.147 -next
  80.148 -  fix f g
  80.149 -  show "map (g o f) = map g o map f" by (rule List.map.comp[symmetric])
  80.150 -next
  80.151 -  fix x f g
  80.152 -  assume "\<And>z. z \<in> set x \<Longrightarrow> f z = g z"
  80.153 -  thus "map f x = map g x" by simp
  80.154 -next
  80.155 -  fix f
  80.156 -  show "set o map f = image f o set" by (rule ext, unfold comp_apply, rule set_map)
  80.157 -next
  80.158 -  show "card_order natLeq" by (rule natLeq_card_order)
  80.159 -next
  80.160 -  show "cinfinite natLeq" by (rule natLeq_cinfinite)
  80.161 -next
  80.162 -  fix x
  80.163 -  show "|set x| \<le>o natLeq"
  80.164 -    by (metis List.finite_set finite_iff_ordLess_natLeq ordLess_imp_ordLeq)
  80.165 -next
  80.166 -  fix R S
  80.167 -  show "list_all2 R OO list_all2 S \<le> list_all2 (R OO S)"
  80.168 -    by (metis list_all2_OO order_refl)
  80.169 -next
  80.170 -  fix R
  80.171 -  show "list_all2 R =
  80.172 -         (Grp {x. set x \<subseteq> {(x, y). R x y}} (map fst))\<inverse>\<inverse> OO
  80.173 -         Grp {x. set x \<subseteq> {(x, y). R x y}} (map snd)"
  80.174 -    unfolding list_all2_def[abs_def] Grp_def fun_eq_iff relcompp.simps conversep.simps
  80.175 -    by (force simp: zip_map_fst_snd)
  80.176 -qed simp
  80.177 -
  80.178  end
    81.1 --- a/src/HOL/Matrix_LP/ComputeHOL.thy	Wed Feb 12 09:06:04 2014 +0100
    81.2 +++ b/src/HOL/Matrix_LP/ComputeHOL.thy	Wed Feb 12 10:59:25 2014 +0100
    81.3 @@ -50,9 +50,9 @@
    81.4  lemma compute_snd: "snd (x,y) = y" by simp
    81.5  lemma compute_pair_eq: "((a, b) = (c, d)) = (a = c \<and> b = d)" by auto
    81.6  
    81.7 -lemma prod_case_simp: "prod_case f (x,y) = f x y" by simp
    81.8 +lemma case_prod_simp: "case_prod f (x,y) = f x y" by simp
    81.9  
   81.10 -lemmas compute_pair = compute_fst compute_snd compute_pair_eq prod_case_simp
   81.11 +lemmas compute_pair = compute_fst compute_snd compute_pair_eq case_prod_simp
   81.12  
   81.13  (*** compute_option ***)
   81.14  
   81.15 @@ -62,25 +62,25 @@
   81.16  lemma compute_None_None_eq: "(None = None) = True" by auto
   81.17  lemma compute_Some_Some_eq: "(Some x = Some y) = (x = y)" by auto
   81.18  
   81.19 -definition option_case_compute :: "'b option \<Rightarrow> 'a \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a"
   81.20 -  where "option_case_compute opt a f = option_case a f opt"
   81.21 +definition case_option_compute :: "'b option \<Rightarrow> 'a \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a"
   81.22 +  where "case_option_compute opt a f = case_option a f opt"
   81.23  
   81.24 -lemma option_case_compute: "option_case = (\<lambda> a f opt. option_case_compute opt a f)"
   81.25 -  by (simp add: option_case_compute_def)
   81.26 +lemma case_option_compute: "case_option = (\<lambda> a f opt. case_option_compute opt a f)"
   81.27 +  by (simp add: case_option_compute_def)
   81.28  
   81.29 -lemma option_case_compute_None: "option_case_compute None = (\<lambda> a f. a)"
   81.30 +lemma case_option_compute_None: "case_option_compute None = (\<lambda> a f. a)"
   81.31    apply (rule ext)+
   81.32 -  apply (simp add: option_case_compute_def)
   81.33 +  apply (simp add: case_option_compute_def)
   81.34    done
   81.35  
   81.36 -lemma option_case_compute_Some: "option_case_compute (Some x) = (\<lambda> a f. f x)"
   81.37 +lemma case_option_compute_Some: "case_option_compute (Some x) = (\<lambda> a f. f x)"
   81.38    apply (rule ext)+
   81.39 -  apply (simp add: option_case_compute_def)
   81.40 +  apply (simp add: case_option_compute_def)
   81.41    done
   81.42  
   81.43 -lemmas compute_option_case = option_case_compute option_case_compute_None option_case_compute_Some
   81.44 +lemmas compute_case_option = case_option_compute case_option_compute_None case_option_compute_Some
   81.45  
   81.46 -lemmas compute_option = compute_the compute_None_Some_eq compute_Some_None_eq compute_None_None_eq compute_Some_Some_eq compute_option_case
   81.47 +lemmas compute_option = compute_the compute_None_Some_eq compute_Some_None_eq compute_None_None_eq compute_Some_Some_eq compute_case_option
   81.48  
   81.49  (**** compute_list_length ****)
   81.50  
   81.51 @@ -92,27 +92,27 @@
   81.52  
   81.53  lemmas compute_list_length = length_nil length_cons
   81.54  
   81.55 -(*** compute_list_case ***)
   81.56 +(*** compute_case_list ***)
   81.57  
   81.58 -definition list_case_compute :: "'b list \<Rightarrow> 'a \<Rightarrow> ('b \<Rightarrow> 'b list \<Rightarrow> 'a) \<Rightarrow> 'a"
   81.59 -  where "list_case_compute l a f = list_case a f l"
   81.60 +definition case_list_compute :: "'b list \<Rightarrow> 'a \<Rightarrow> ('b \<Rightarrow> 'b list \<Rightarrow> 'a) \<Rightarrow> 'a"
   81.61 +  where "case_list_compute l a f = case_list a f l"
   81.62  
   81.63 -lemma list_case_compute: "list_case = (\<lambda> (a::'a) f (l::'b list). list_case_compute l a f)"
   81.64 +lemma case_list_compute: "case_list = (\<lambda> (a::'a) f (l::'b list). case_list_compute l a f)"
   81.65    apply (rule ext)+
   81.66 -  apply (simp add: list_case_compute_def)
   81.67 +  apply (simp add: case_list_compute_def)
   81.68    done
   81.69  
   81.70 -lemma list_case_compute_empty: "list_case_compute ([]::'b list) = (\<lambda> (a::'a) f. a)"
   81.71 +lemma case_list_compute_empty: "case_list_compute ([]::'b list) = (\<lambda> (a::'a) f. a)"
   81.72    apply (rule ext)+
   81.73 -  apply (simp add: list_case_compute_def)
   81.74 +  apply (simp add: case_list_compute_def)
   81.75    done
   81.76  
   81.77 -lemma list_case_compute_cons: "list_case_compute (u#v) = (\<lambda> (a::'a) f. (f (u::'b) v))"
   81.78 +lemma case_list_compute_cons: "case_list_compute (u#v) = (\<lambda> (a::'a) f. (f (u::'b) v))"
   81.79    apply (rule ext)+
   81.80 -  apply (simp add: list_case_compute_def)
   81.81 +  apply (simp add: case_list_compute_def)
   81.82    done
   81.83  
   81.84 -lemmas compute_list_case = list_case_compute list_case_compute_empty list_case_compute_cons
   81.85 +lemmas compute_case_list = case_list_compute case_list_compute_empty case_list_compute_cons
   81.86  
   81.87  (*** compute_list_nth ***)
   81.88  (* Of course, you will need computation with nats for this to work \<dots> *)
   81.89 @@ -122,7 +122,7 @@
   81.90    
   81.91  (*** compute_list ***)
   81.92  
   81.93 -lemmas compute_list = compute_list_case compute_list_length compute_list_nth
   81.94 +lemmas compute_list = compute_case_list compute_list_length compute_list_nth
   81.95  
   81.96  (*** compute_let ***)
   81.97  
    82.1 --- a/src/HOL/Matrix_LP/matrixlp.ML	Wed Feb 12 09:06:04 2014 +0100
    82.2 +++ b/src/HOL/Matrix_LP/matrixlp.ML	Wed Feb 12 10:59:25 2014 +0100
    82.3 @@ -11,7 +11,7 @@
    82.4  structure MatrixLP : MATRIX_LP =
    82.5  struct
    82.6  
    82.7 -val compute_thms = ComputeHOL.prep_thms @{thms "ComputeHOL.compute_list_case" "ComputeHOL.compute_let"
    82.8 +val compute_thms = ComputeHOL.prep_thms @{thms "ComputeHOL.compute_case_list" "ComputeHOL.compute_let"
    82.9    "ComputeHOL.compute_if" "ComputeFloat.arith" "SparseMatrix.sparse_row_matrix_arith_simps"
   82.10    "ComputeHOL.compute_bool" "ComputeHOL.compute_pair"
   82.11    "SparseMatrix.sorted_sp_simps"
    83.1 --- a/src/HOL/Metis_Examples/Clausification.thy	Wed Feb 12 09:06:04 2014 +0100
    83.2 +++ b/src/HOL/Metis_Examples/Clausification.thy	Wed Feb 12 10:59:25 2014 +0100
    83.3 @@ -138,7 +138,7 @@
    83.4  by (metis split_list_last_prop[where P = P] in_set_conv_decomp)
    83.5  
    83.6  lemma ex_tl: "EX ys. tl ys = xs"
    83.7 -using tl.simps(2) by fast
    83.8 +using list.sel(3) by fast
    83.9  
   83.10  lemma "(\<exists>ys\<Colon>nat list. tl ys = xs) \<and> (\<exists>bs\<Colon>int list. tl bs = as)"
   83.11  by (metis ex_tl)
    84.1 --- a/src/HOL/MicroJava/Comp/CorrCompTp.thy	Wed Feb 12 09:06:04 2014 +0100
    84.2 +++ b/src/HOL/MicroJava/Comp/CorrCompTp.thy	Wed Feb 12 10:59:25 2014 +0100
    84.3 @@ -80,7 +80,7 @@
    84.4  apply (rule allI)
    84.5  apply (drule_tac x="a # ys" in spec)
    84.6  apply (simp only: rev.simps append_assoc append_Cons append_Nil
    84.7 -  map.simps map_of.simps map_upds_Cons hd.simps tl.simps)
    84.8 +  map.simps map_of.simps map_upds_Cons list.sel)
    84.9  done
   84.10  
   84.11  lemma map_of_as_map_upds: "map_of (rev xs) = empty ((map fst xs) [\<mapsto>] (map snd xs))"
    85.1 --- a/src/HOL/MicroJava/Comp/Index.thy	Wed Feb 12 09:06:04 2014 +0100
    85.2 +++ b/src/HOL/MicroJava/Comp/Index.thy	Wed Feb 12 10:59:25 2014 +0100
    85.3 @@ -54,6 +54,7 @@
    85.4  apply (simp only: index_def gjmb_plns_def)
    85.5  apply (case_tac "gmb G C S" rule: prod.exhaust)
    85.6  apply (simp add: galldefs del: set_append map_append)
    85.7 +apply (rename_tac a b)
    85.8  apply (case_tac b, simp add: gmb_def gjmb_lvs_def del: set_append map_append)
    85.9  apply (intro strip)
   85.10  apply (simp del: set_append map_append)
   85.11 @@ -73,6 +74,7 @@
   85.12            locvars_xstate G C S (Norm (h, l(x\<mapsto>val)))"
   85.13  apply (simp only: locvars_xstate_def locvars_locals_def index_def)
   85.14  apply (case_tac "gmb G C S" rule: prod.exhaust, simp)
   85.15 +apply (rename_tac a b)
   85.16  apply (case_tac b, simp)
   85.17  apply (rule conjI)
   85.18  apply (simp add: gl_def)
    86.1 --- a/src/HOL/Multivariate_Analysis/Integration.thy	Wed Feb 12 09:06:04 2014 +0100
    86.2 +++ b/src/HOL/Multivariate_Analysis/Integration.thy	Wed Feb 12 10:59:25 2014 +0100
    86.3 @@ -3870,6 +3870,7 @@
    86.4      apply rule
    86.5      apply (erule_tac x="Some y" in allE)
    86.6      defer
    86.7 +    apply (rename_tac x)
    86.8      apply (erule_tac x="Some x" in allE)
    86.9      apply auto
   86.10      done
    87.1 --- a/src/HOL/Multivariate_Analysis/Ordered_Euclidean_Space.thy	Wed Feb 12 09:06:04 2014 +0100
    87.2 +++ b/src/HOL/Multivariate_Analysis/Ordered_Euclidean_Space.thy	Wed Feb 12 10:59:25 2014 +0100
    87.3 @@ -766,7 +766,7 @@
    87.4      bs: "set bs = Basis" "distinct bs"
    87.5      by (metis finite_distinct_list)
    87.6    from nonempty_Basis s obtain j where j: "j \<in> Basis" "s j \<in> S" by blast
    87.7 -  def y \<equiv> "list_rec
    87.8 +  def y \<equiv> "rec_list
    87.9      (s j)
   87.10      (\<lambda>j _ Y. (\<Sum>i\<in>Basis. (if i = j then s i \<bullet> i else Y \<bullet> i) *\<^sub>R i))"
   87.11    have "x = (\<Sum>i\<in>Basis. (if i \<in> set bs then s i \<bullet> i else s j \<bullet> i) *\<^sub>R i)"
    88.1 --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Wed Feb 12 09:06:04 2014 +0100
    88.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Wed Feb 12 10:59:25 2014 +0100
    88.3 @@ -2776,7 +2776,7 @@
    88.4        unfolding s_def by (auto intro: someI2_ex)
    88.5    }
    88.6    note s = this
    88.7 -  def r \<equiv> "nat_rec (s 0 0) s"
    88.8 +  def r \<equiv> "rec_nat (s 0 0) s"
    88.9    have "subseq r"
   88.10      by (auto simp: r_def s subseq_Suc_iff)
   88.11    moreover
   88.12 @@ -3376,7 +3376,7 @@
   88.13        unfolding s_def by (auto intro: someI2_ex)
   88.14    }
   88.15    note s = this
   88.16 -  def r \<equiv> "nat_rec (s 0 0) s"
   88.17 +  def r \<equiv> "rec_nat (s 0 0) s"
   88.18    have "subseq r"
   88.19      by (auto simp: r_def s subseq_Suc_iff)
   88.20    moreover
   88.21 @@ -3953,7 +3953,7 @@
   88.22        }
   88.23        note B = this
   88.24  
   88.25 -      def F \<equiv> "nat_rec (B 0 UNIV) B"
   88.26 +      def F \<equiv> "rec_nat (B 0 UNIV) B"
   88.27        {
   88.28          fix n
   88.29          have "infinite {i. f i \<in> F n}"
   88.30 @@ -3974,7 +3974,7 @@
   88.31            by (simp add: set_eq_iff not_le conj_commute)
   88.32        qed
   88.33  
   88.34 -      def t \<equiv> "nat_rec (sel 0 0) (\<lambda>n i. sel (Suc n) i)"
   88.35 +      def t \<equiv> "rec_nat (sel 0 0) (\<lambda>n i. sel (Suc n) i)"
   88.36        have "subseq t"
   88.37          unfolding subseq_Suc_iff by (simp add: t_def sel)
   88.38        moreover have "\<forall>i. (f \<circ> t) i \<in> s"
    89.1 --- a/src/HOL/Nat.thy	Wed Feb 12 09:06:04 2014 +0100
    89.2 +++ b/src/HOL/Nat.thy	Wed Feb 12 10:59:25 2014 +0100
    89.3 @@ -71,33 +71,81 @@
    89.4  lemma Suc_Rep_inject': "Suc_Rep x = Suc_Rep y \<longleftrightarrow> x = y"
    89.5    by (rule iffI, rule Suc_Rep_inject) simp_all
    89.6  
    89.7 +lemma nat_induct0:
    89.8 +  fixes n
    89.9 +  assumes "P 0" and "\<And>n. P n \<Longrightarrow> P (Suc n)"
   89.10 +  shows "P n"
   89.11 +using assms
   89.12 +apply (unfold Zero_nat_def Suc_def)
   89.13 +apply (rule Rep_Nat_inverse [THEN subst]) -- {* types force good instantiation *}
   89.14 +apply (erule Nat_Rep_Nat [THEN Nat.induct])
   89.15 +apply (iprover elim: Nat_Abs_Nat_inverse [THEN subst])
   89.16 +done
   89.17 +
   89.18 +wrap_free_constructors ["0 \<Colon> nat", Suc] case_nat [=] [[], [pred]]
   89.19 +  apply atomize_elim
   89.20 +  apply (rename_tac n, induct_tac n rule: nat_induct0, auto)
   89.21 + apply (simp add: Suc_def Nat_Abs_Nat_inject Nat_Rep_Nat Suc_RepI
   89.22 +   Suc_Rep_inject' Rep_Nat_inject)
   89.23 +apply (simp only: Suc_not_Zero)
   89.24 +done
   89.25 +
   89.26 +-- {* Avoid name clashes by prefixing the output of @{text rep_datatype} with @{text old}. *}
   89.27 +setup {* Sign.mandatory_path "old" *}
   89.28 +
   89.29  rep_datatype "0 \<Colon> nat" Suc
   89.30 -  apply (unfold Zero_nat_def Suc_def)
   89.31 -  apply (rule Rep_Nat_inverse [THEN subst]) -- {* types force good instantiation *}
   89.32 -   apply (erule Nat_Rep_Nat [THEN Nat.induct])
   89.33 -   apply (iprover elim: Nat_Abs_Nat_inverse [THEN subst])
   89.34 -    apply (simp_all add: Nat_Abs_Nat_inject Nat_Rep_Nat
   89.35 -      Suc_RepI Zero_RepI Suc_Rep_not_Zero_Rep
   89.36 -      Suc_Rep_not_Zero_Rep [symmetric]
   89.37 -      Suc_Rep_inject' Rep_Nat_inject)
   89.38 -  done
   89.39 +  apply (erule nat_induct0, assumption)
   89.40 + apply (rule nat.inject)
   89.41 +apply (rule nat.distinct(1))
   89.42 +done
   89.43 +
   89.44 +setup {* Sign.parent_path *}
   89.45 +
   89.46 +-- {* But erase the prefix for properties that are not generated by @{text wrap_free_constructors}. *}
   89.47 +setup {* Sign.mandatory_path "nat" *}
   89.48 +
   89.49 +declare
   89.50 +  old.nat.inject[iff del]
   89.51 +  old.nat.distinct(1)[simp del, induct_simp del]
   89.52 +
   89.53 +lemmas induct = old.nat.induct
   89.54 +lemmas inducts = old.nat.inducts
   89.55 +lemmas recs = old.nat.recs
   89.56 +lemmas cases = nat.case
   89.57 +lemmas simps = nat.inject nat.distinct nat.case old.nat.recs
   89.58 +
   89.59 +setup {* Sign.parent_path *}
   89.60 +
   89.61 +abbreviation rec_nat :: "'a \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a" where
   89.62 +  "rec_nat \<equiv> old.rec_nat"
   89.63 +
   89.64 +declare nat.sel[code del]
   89.65 +
   89.66 +hide_const Nat.pred -- {* hide everything related to the selector *}
   89.67 +hide_fact
   89.68 +  nat.case_eq_if
   89.69 +  nat.collapse
   89.70 +  nat.expand
   89.71 +  nat.sel
   89.72 +  nat.sel_exhaust
   89.73 +  nat.sel_split
   89.74 +  nat.sel_split_asm
   89.75 +
   89.76 +lemma nat_exhaust [case_names 0 Suc, cases type: nat]:
   89.77 +  -- {* for backward compatibility -- names of variables differ *}
   89.78 +  "(y = 0 \<Longrightarrow> P) \<Longrightarrow> (\<And>nat. y = Suc nat \<Longrightarrow> P) \<Longrightarrow> P"
   89.79 +by (rule old.nat.exhaust)
   89.80  
   89.81  lemma nat_induct [case_names 0 Suc, induct type: nat]:
   89.82    -- {* for backward compatibility -- names of variables differ *}
   89.83    fixes n
   89.84 -  assumes "P 0"
   89.85 -    and "\<And>n. P n \<Longrightarrow> P (Suc n)"
   89.86 +  assumes "P 0" and "\<And>n. P n \<Longrightarrow> P (Suc n)"
   89.87    shows "P n"
   89.88 -  using assms by (rule nat.induct)
   89.89 -
   89.90 -declare nat.exhaust [case_names 0 Suc, cases type: nat]
   89.91 +using assms by (rule nat.induct)
   89.92  
   89.93 -lemmas nat_rec_0 = nat.recs(1)
   89.94 -  and nat_rec_Suc = nat.recs(2)
   89.95 -
   89.96 -lemmas nat_case_0 = nat.cases(1)
   89.97 -  and nat_case_Suc = nat.cases(2)
   89.98 -   
   89.99 +hide_fact
  89.100 +  nat_exhaust
  89.101 +  nat_induct0
  89.102  
  89.103  text {* Injectiveness and distinctness lemmas *}
  89.104  
  89.105 @@ -632,14 +680,6 @@
  89.106  
  89.107  lemmas not_less_simps = not_less_less_Suc_eq le_less_Suc_eq
  89.108  
  89.109 -text {* These two rules ease the use of primitive recursion.
  89.110 -NOTE USE OF @{text "=="} *}
  89.111 -lemma def_nat_rec_0: "(!!n. f n == nat_rec c h n) ==> f 0 = c"
  89.112 -by simp
  89.113 -
  89.114 -lemma def_nat_rec_Suc: "(!!n. f n == nat_rec c h n) ==> f (Suc n) = h n (f n)"
  89.115 -by simp
  89.116 -
  89.117  lemma not0_implies_Suc: "n \<noteq> 0 ==> \<exists>m. n = Suc m"
  89.118  by (cases n) simp_all
  89.119  
  89.120 @@ -1905,13 +1945,13 @@
  89.121  qed
  89.122  
  89.123  
  89.124 -subsection {* aliasses *}
  89.125 +subsection {* aliases *}
  89.126  
  89.127  lemma nat_mult_1: "(1::nat) * n = n"
  89.128 -  by simp
  89.129 +  by (rule mult_1_left)
  89.130   
  89.131  lemma nat_mult_1_right: "n * (1::nat) = n"
  89.132 -  by simp
  89.133 +  by (rule mult_1_right)
  89.134  
  89.135  
  89.136  subsection {* size of a datatype value *}
  89.137 @@ -1928,4 +1968,3 @@
  89.138  hide_const (open) of_nat_aux
  89.139  
  89.140  end
  89.141 -
    90.1 --- a/src/HOL/Nitpick.thy	Wed Feb 12 09:06:04 2014 +0100
    90.2 +++ b/src/HOL/Nitpick.thy	Wed Feb 12 10:59:25 2014 +0100
    90.3 @@ -96,16 +96,16 @@
    90.4  apply (erule contrapos_np)
    90.5  by (rule someI)
    90.6  
    90.7 -lemma unit_case_unfold [nitpick_unfold]:
    90.8 -"unit_case x u \<equiv> x"
    90.9 +lemma case_unit_unfold [nitpick_unfold]:
   90.10 +"case_unit x u \<equiv> x"
   90.11  apply (subgoal_tac "u = ()")
   90.12   apply (simp only: unit.cases)
   90.13  by simp
   90.14  
   90.15  declare unit.cases [nitpick_simp del]
   90.16  
   90.17 -lemma nat_case_unfold [nitpick_unfold]:
   90.18 -"nat_case x f n \<equiv> if n = 0 then x else f (n - 1)"
   90.19 +lemma case_nat_unfold [nitpick_unfold]:
   90.20 +"case_nat x f n \<equiv> if n = 0 then x else f (n - 1)"
   90.21  apply (rule eq_reflection)
   90.22  by (cases n) auto
   90.23  
   90.24 @@ -241,7 +241,7 @@
   90.25  hide_type (open) bisim_iterator fun_box pair_box unsigned_bit signed_bit word
   90.26  hide_fact (open) Ex1_unfold rtrancl_unfold rtranclp_unfold tranclp_unfold
   90.27      prod_def refl'_def wf'_def card'_def setsum'_def
   90.28 -    fold_graph'_def The_psimp Eps_psimp unit_case_unfold nat_case_unfold
   90.29 +    fold_graph'_def The_psimp Eps_psimp case_unit_unfold case_nat_unfold
   90.30      list_size_simp nat_gcd_def nat_lcm_def int_gcd_def int_lcm_def Frac_def
   90.31      zero_frac_def one_frac_def num_def denom_def norm_frac_def frac_def
   90.32      plus_frac_def times_frac_def uminus_frac_def number_of_frac_def
    91.1 --- a/src/HOL/Nitpick_Examples/Core_Nits.thy	Wed Feb 12 09:06:04 2014 +0100
    91.2 +++ b/src/HOL/Nitpick_Examples/Core_Nits.thy	Wed Feb 12 10:59:25 2014 +0100
    91.3 @@ -925,18 +925,6 @@
    91.4  nitpick [card = 2, expect = none]
    91.5  by auto
    91.6  
    91.7 -lemma "bool_rec x y True = x"
    91.8 -nitpick [card = 2, expect = none]
    91.9 -by auto
   91.10 -
   91.11 -lemma "bool_rec x y False = y"
   91.12 -nitpick [card = 2, expect = none]
   91.13 -by auto
   91.14 -
   91.15 -lemma "(x\<Colon>bool) = bool_rec x x True"
   91.16 -nitpick [card = 2, expect = none]
   91.17 -by auto
   91.18 -
   91.19  lemma "x = (case (x, y) of (x', y') \<Rightarrow> x')"
   91.20  nitpick [expect = none]
   91.21  sorry
    92.1 --- a/src/HOL/Nitpick_Examples/Refute_Nits.thy	Wed Feb 12 09:06:04 2014 +0100
    92.2 +++ b/src/HOL/Nitpick_Examples/Refute_Nits.thy	Wed Feb 12 10:59:25 2014 +0100
    92.3 @@ -519,18 +519,6 @@
    92.4  nitpick [expect = genuine]
    92.5  oops
    92.6  
    92.7 -lemma "prod_rec f p = f (fst p) (snd p)"
    92.8 -nitpick [expect = none]
    92.9 -by (case_tac p) auto
   92.10 -
   92.11 -lemma "prod_rec f (a, b) = f a b"
   92.12 -nitpick [expect = none]
   92.13 -by auto
   92.14 -
   92.15 -lemma "P (prod_rec f x)"
   92.16 -nitpick [expect = genuine]
   92.17 -oops
   92.18 -
   92.19  lemma "P (case x of Pair a b \<Rightarrow> f a b)"
   92.20  nitpick [expect = genuine]
   92.21  oops
   92.22 @@ -575,15 +563,6 @@
   92.23  nitpick [expect = genuine]
   92.24  oops
   92.25  
   92.26 -lemma "unit_rec u x = u"
   92.27 -nitpick [expect = none]
   92.28 -apply simp
   92.29 -done
   92.30 -
   92.31 -lemma "P (unit_rec u x)"
   92.32 -nitpick [expect = genuine]
   92.33 -oops
   92.34 -
   92.35  lemma "P (case x of () \<Rightarrow> u)"
   92.36  nitpick [expect = genuine]
   92.37  oops
   92.38 @@ -606,17 +585,17 @@
   92.39  nitpick [expect = genuine]
   92.40  oops
   92.41  
   92.42 -lemma "option_rec n s None = n"
   92.43 +lemma "rec_option n s None = n"
   92.44  nitpick [expect = none]
   92.45  apply simp
   92.46  done
   92.47  
   92.48 -lemma "option_rec n s (Some x) = s x"
   92.49 +lemma "rec_option n s (Some x) = s x"
   92.50  nitpick [expect = none]
   92.51  apply simp
   92.52  done
   92.53  
   92.54 -lemma "P (option_rec n s x)"
   92.55 +lemma "P (rec_option n s x)"
   92.56  nitpick [expect = genuine]
   92.57  oops
   92.58  
   92.59 @@ -646,20 +625,6 @@
   92.60  nitpick [expect = genuine]
   92.61  oops
   92.62  
   92.63 -lemma "sum_rec l r (Inl x) = l x"
   92.64 -nitpick [expect = none]
   92.65 -apply simp
   92.66 -done
   92.67 -
   92.68 -lemma "sum_rec l r (Inr x) = r x"
   92.69 -nitpick [expect = none]
   92.70 -apply simp
   92.71 -done
   92.72 -
   92.73 -lemma "P (sum_rec l r x)"
   92.74 -nitpick [expect = genuine]
   92.75 -oops
   92.76 -
   92.77  lemma "P (case x of Inl a \<Rightarrow> l a | Inr b \<Rightarrow> r b)"
   92.78  nitpick [expect = genuine]
   92.79  oops
   92.80 @@ -684,17 +649,17 @@
   92.81  nitpick [expect = genuine]
   92.82  oops
   92.83  
   92.84 -lemma "T1_rec a b A = a"
   92.85 +lemma "rec_T1 a b A = a"
   92.86  nitpick [expect = none]
   92.87  apply simp
   92.88  done
   92.89  
   92.90 -lemma "T1_rec a b B = b"
   92.91 +lemma "rec_T1 a b B = b"
   92.92  nitpick [expect = none]
   92.93  apply simp
   92.94  done
   92.95  
   92.96 -lemma "P (T1_rec a b x)"
   92.97 +lemma "P (rec_T1 a b x)"
   92.98  nitpick [expect = genuine]
   92.99  oops
  92.100  
  92.101 @@ -716,17 +681,17 @@
  92.102  nitpick [expect = genuine]
  92.103  oops
  92.104  
  92.105 -lemma "T2_rec c d (C x) = c x"
  92.106 +lemma "rec_T2 c d (C x) = c x"
  92.107  nitpick [expect = none]
  92.108  apply simp
  92.109  done
  92.110  
  92.111 -lemma "T2_rec c d (D x) = d x"
  92.112 +lemma "rec_T2 c d (D x) = d x"
  92.113  nitpick [expect = none]
  92.114  apply simp
  92.115  done
  92.116  
  92.117 -lemma "P (T2_rec c d x)"
  92.118 +lemma "P (rec_T2 c d x)"
  92.119  nitpick [expect = genuine]
  92.120  oops
  92.121  
  92.122 @@ -748,12 +713,12 @@
  92.123  nitpick [expect = genuine]
  92.124  oops
  92.125  
  92.126 -lemma "T3_rec e (E x) = e x"
  92.127 +lemma "rec_T3 e (E x) = e x"
  92.128  nitpick [card = 1\<emdash>4, expect = none]
  92.129  apply simp
  92.130  done
  92.131  
  92.132 -lemma "P (T3_rec e x)"
  92.133 +lemma "P (rec_T3 e x)"
  92.134  nitpick [expect = genuine]
  92.135  oops
  92.136  
  92.137 @@ -781,17 +746,17 @@
  92.138  nitpick [card = 1\<emdash>7, expect = none]
  92.139  oops
  92.140  
  92.141 -lemma "nat_rec zero suc 0 = zero"
  92.142 +lemma "rec_nat zero suc 0 = zero"
  92.143  nitpick [expect = none]
  92.144  apply simp
  92.145  done
  92.146  
  92.147 -lemma "nat_rec zero suc (Suc x) = suc x (nat_rec zero suc x)"
  92.148 +lemma "rec_nat zero suc (Suc x) = suc x (rec_nat zero suc x)"
  92.149  nitpick [expect = none]
  92.150  apply simp
  92.151  done
  92.152  
  92.153 -lemma "P (nat_rec zero suc x)"
  92.154 +lemma "P (rec_nat zero suc x)"
  92.155  nitpick [expect = genuine]
  92.156  oops
  92.157  
  92.158 @@ -813,17 +778,17 @@
  92.159  nitpick [expect = genuine]
  92.160  oops
  92.161  
  92.162 -lemma "list_rec nil cons [] = nil"
  92.163 +lemma "rec_list nil cons [] = nil"
  92.164  nitpick [card = 1\<emdash>5, expect = none]
  92.165  apply simp
  92.166  done
  92.167  
  92.168 -lemma "list_rec nil cons (x#xs) = cons x xs (list_rec nil cons xs)"
  92.169 +lemma "rec_list nil cons (x#xs) = cons x xs (rec_list nil cons xs)"
  92.170  nitpick [card = 1\<emdash>5, expect = none]
  92.171  apply simp
  92.172  done
  92.173  
  92.174 -lemma "P (list_rec nil cons xs)"
  92.175 +lemma "P (rec_list nil cons xs)"
  92.176  nitpick [expect = genuine]
  92.177  oops
  92.178  
  92.179 @@ -853,22 +818,22 @@
  92.180  nitpick [expect = genuine]
  92.181  oops
  92.182  
  92.183 -lemma "BitList_rec nil bit0 bit1 BitListNil = nil"
  92.184 +lemma "rec_BitList nil bit0 bit1 BitListNil = nil"
  92.185  nitpick [expect = none]
  92.186  apply simp
  92.187  done
  92.188  
  92.189 -lemma "BitList_rec nil bit0 bit1 (Bit0 xs) = bit0 xs (BitList_rec nil bit0 bit1 xs)"
  92.190 +lemma "rec_BitList nil bit0 bit1 (Bit0 xs) = bit0 xs (rec_BitList nil bit0 bit1 xs)"
  92.191  nitpick [expect = none]
  92.192  apply simp
  92.193  done
  92.194  
  92.195 -lemma "BitList_rec nil bit0 bit1 (Bit1 xs) = bit1 xs (BitList_rec nil bit0 bit1 xs)"
  92.196 +lemma "rec_BitList nil bit0 bit1 (Bit1 xs) = bit1 xs (rec_BitList nil bit0 bit1 xs)"
  92.197  nitpick [expect = none]
  92.198  apply simp
  92.199  done
  92.200  
  92.201 -lemma "P (BitList_rec nil bit0 bit1 x)"
  92.202 +lemma "P (rec_BitList nil bit0 bit1 x)"
  92.203  nitpick [expect = genuine]
  92.204  oops
  92.205  
  92.206 @@ -886,17 +851,17 @@
  92.207  nitpick [expect = genuine]
  92.208  oops
  92.209  
  92.210 -lemma "BinTree_rec l n (Leaf x) = l x"
  92.211 +lemma "rec_BinTree l n (Leaf x) = l x"
  92.212  nitpick [expect = none]
  92.213  apply simp
  92.214  done
  92.215  
  92.216 -lemma "BinTree_rec l n (Node x y) = n x y (BinTree_rec l n x) (BinTree_rec l n y)"
  92.217 +lemma "rec_BinTree l n (Node x y) = n x y (rec_BinTree l n x) (rec_BinTree l n y)"
  92.218  nitpick [card = 1\<emdash>5, expect = none]
  92.219  apply simp
  92.220  done
  92.221  
  92.222 -lemma "P (BinTree_rec l n x)"
  92.223 +lemma "P (rec_BinTree l n x)"
  92.224  nitpick [expect = genuine]
  92.225  oops
  92.226  
  92.227 @@ -929,17 +894,17 @@
  92.228  nitpick [expect = genuine]
  92.229  oops
  92.230  
  92.231 -lemma "aexp_bexp_rec_1 number ite equal (Number x) = number x"
  92.232 +lemma "rec_aexp_bexp_1 number ite equal (Number x) = number x"
  92.233  nitpick [card = 1\<emdash>3, expect = none]
  92.234  apply simp
  92.235  done
  92.236  
  92.237 -lemma "aexp_bexp_rec_1 number ite equal (ITE x y z) = ite x y z (aexp_bexp_rec_2 number ite equal x) (aexp_bexp_rec_1 number ite equal y) (aexp_bexp_rec_1 number ite equal z)"
  92.238 +lemma "rec_aexp_bexp_1 number ite equal (ITE x y z) = ite x y z (rec_aexp_bexp_2 number ite equal x) (rec_aexp_bexp_1 number ite equal y) (rec_aexp_bexp_1 number ite equal z)"
  92.239  nitpick [card = 1\<emdash>3, expect = none]
  92.240  apply simp
  92.241  done
  92.242  
  92.243 -lemma "P (aexp_bexp_rec_1 number ite equal x)"
  92.244 +lemma "P (rec_aexp_bexp_1 number ite equal x)"
  92.245  nitpick [expect = genuine]
  92.246  oops
  92.247  
  92.248 @@ -947,12 +912,12 @@
  92.249  nitpick [expect = genuine]
  92.250  oops
  92.251  
  92.252 -lemma "aexp_bexp_rec_2 number ite equal (Equal x y) = equal x y (aexp_bexp_rec_1 number ite equal x) (aexp_bexp_rec_1 number ite equal y)"
  92.253 +lemma "rec_aexp_bexp_2 number ite equal (Equal x y) = equal x y (rec_aexp_bexp_1 number ite equal x) (rec_aexp_bexp_1 number ite equal y)"
  92.254  nitpick [card = 1\<emdash>3, expect = none]
  92.255  apply simp
  92.256  done
  92.257  
  92.258 -lemma "P (aexp_bexp_rec_2 number ite equal x)"
  92.259 +lemma "P (rec_aexp_bexp_2 number ite equal x)"
  92.260  nitpick [expect = genuine]
  92.261  oops
  92.262  
  92.263 @@ -1007,41 +972,41 @@
  92.264  nitpick [expect = genuine]
  92.265  oops
  92.266  
  92.267 -lemma "X_Y_rec_1 a b c d e f A = a"
  92.268 +lemma "rec_X_Y_1 a b c d e f A = a"
  92.269  nitpick [card = 1\<emdash>5, expect = none]
  92.270  apply simp
  92.271  done
  92.272  
  92.273 -lemma "X_Y_rec_1 a b c d e f (B x) = b x (X_Y_rec_1 a b c d e f x)"
  92.274 +lemma "rec_X_Y_1 a b c d e f (B x) = b x (rec_X_Y_1 a b c d e f x)"
  92.275  nitpick [card = 1\<emdash>5, expect = none]
  92.276  apply simp
  92.277  done
  92.278  
  92.279 -lemma "X_Y_rec_1 a b c d e f (C y) = c y (X_Y_rec_2 a b c d e f y)"
  92.280 +lemma "rec_X_Y_1 a b c d e f (C y) = c y (rec_X_Y_2 a b c d e f y)"
  92.281  nitpick [card = 1\<emdash>5, expect = none]
  92.282  apply simp
  92.283  done
  92.284  
  92.285 -lemma "X_Y_rec_2 a b c d e f (D x) = d x (X_Y_rec_1 a b c d e f x)"
  92.286 +lemma "rec_X_Y_2 a b c d e f (D x) = d x (rec_X_Y_1 a b c d e f x)"
  92.287  nitpick [card = 1\<emdash>5, expect = none]
  92.288  apply simp
  92.289  done
  92.290  
  92.291 -lemma "X_Y_rec_2 a b c d e f (E y) = e y (X_Y_rec_2 a b c d e f y)"
  92.292 +lemma "rec_X_Y_2 a b c d e f (E y) = e y (rec_X_Y_2 a b c d e f y)"
  92.293  nitpick [card = 1\<emdash>5, expect = none]
  92.294  apply simp
  92.295  done
  92.296  
  92.297 -lemma "X_Y_rec_2 a b c d e f F = f"
  92.298 +lemma "rec_X_Y_2 a b c d e f F = f"
  92.299  nitpick [card = 1\<emdash>5, expect = none]
  92.300  apply simp
  92.301  done
  92.302  
  92.303 -lemma "P (X_Y_rec_1 a b c d e f x)"
  92.304 +lemma "P (rec_X_Y_1 a b c d e f x)"
  92.305  nitpick [expect = genuine]
  92.306  oops
  92.307  
  92.308 -lemma "P (X_Y_rec_2 a b c d e f y)"
  92.309 +lemma "P (rec_X_Y_2 a b c d e f y)"
  92.310  nitpick [expect = genuine]
  92.311  oops
  92.312  
  92.313 @@ -1063,45 +1028,45 @@
  92.314  nitpick [expect = genuine]
  92.315  oops
  92.316  
  92.317 -lemma "XOpt_rec_1 cx dx n1 s1 n2 s2 (CX x) = cx x (XOpt_rec_2 cx dx n1 s1 n2 s2 x)"
  92.318 +lemma "rec_XOpt_1 cx dx n1 s1 n2 s2 (CX x) = cx x (rec_XOpt_2 cx dx n1 s1 n2 s2 x)"
  92.319  nitpick [card = 1\<emdash>5, expect = none]
  92.320  apply simp
  92.321  done
  92.322  
  92.323 -lemma "XOpt_rec_1 cx dx n1 s1 n2 s2 (DX x) = dx x (\<lambda>b. XOpt_rec_3 cx dx n1 s1 n2 s2 (x b))"
  92.324 +lemma "rec_XOpt_1 cx dx n1 s1 n2 s2 (DX x) = dx x (\<lambda>b. rec_XOpt_3 cx dx n1 s1 n2 s2 (x b))"
  92.325  nitpick [card = 1\<emdash>3, expect = none]
  92.326  apply simp
  92.327  done
  92.328  
  92.329 -lemma "XOpt_rec_2 cx dx n1 s1 n2 s2 None = n1"
  92.330 +lemma "rec_XOpt_2 cx dx n1 s1 n2 s2 None = n1"
  92.331  nitpick [card = 1\<emdash>4, expect = none]
  92.332  apply simp
  92.333  done
  92.334  
  92.335 -lemma "XOpt_rec_2 cx dx n1 s1 n2 s2 (Some x) = s1 x (XOpt_rec_1 cx dx n1 s1 n2 s2 x)"
  92.336 +lemma "rec_XOpt_2 cx dx n1 s1 n2 s2 (Some x) = s1 x (rec_XOpt_1 cx dx n1 s1 n2 s2 x)"
  92.337  nitpick [card = 1\<emdash>4, expect = none]
  92.338  apply simp
  92.339  done
  92.340  
  92.341 -lemma "XOpt_rec_3 cx dx n1 s1 n2 s2 None = n2"
  92.342 +lemma "rec_XOpt_3 cx dx n1 s1 n2 s2 None = n2"
  92.343  nitpick [card = 1\<emdash>4, expect = none]
  92.344  apply simp
  92.345  done
  92.346  
  92.347 -lemma "XOpt_rec_3 cx dx n1 s1 n2 s2 (Some x) = s2 x (XOpt_rec_1 cx dx n1 s1 n2 s2 x)"
  92.348 +lemma "rec_XOpt_3 cx dx n1 s1 n2 s2 (Some x) = s2 x (rec_XOpt_1 cx dx n1 s1 n2 s2 x)"
  92.349  nitpick [card = 1\<emdash>4, expect = none]
  92.350  apply simp
  92.351  done
  92.352  
  92.353 -lemma "P (XOpt_rec_1 cx dx n1 s1 n2 s2 x)"
  92.354 +lemma "P (rec_XOpt_1 cx dx n1 s1 n2 s2 x)"
  92.355  nitpick [expect = genuine]
  92.356  oops
  92.357  
  92.358 -lemma "P (XOpt_rec_2 cx dx n1 s1 n2 s2 x)"
  92.359 +lemma "P (rec_XOpt_2 cx dx n1 s1 n2 s2 x)"
  92.360  nitpick [expect = genuine]
  92.361  oops
  92.362  
  92.363 -lemma "P (XOpt_rec_3 cx dx n1 s1 n2 s2 x)"
  92.364 +lemma "P (rec_XOpt_3 cx dx n1 s1 n2 s2 x)"
  92.365  nitpick [expect = genuine]
  92.366  oops
  92.367  
  92.368 @@ -1119,26 +1084,26 @@
  92.369  nitpick [expect = genuine]
  92.370  oops
  92.371  
  92.372 -lemma "YOpt_rec_1 cy n s (CY x) = cy x (YOpt_rec_2 cy n s x)"
  92.373 +lemma "rec_YOpt_1 cy n s (CY x) = cy x (rec_YOpt_2 cy n s x)"
  92.374  nitpick [card = 1\<emdash>2, expect = none]
  92.375  apply simp
  92.376  done
  92.377  
  92.378 -lemma "YOpt_rec_2 cy n s None = n"
  92.379 +lemma "rec_YOpt_2 cy n s None = n"
  92.380  nitpick [card = 1\<emdash>2, expect = none]
  92.381  apply simp
  92.382  done
  92.383  
  92.384 -lemma "YOpt_rec_2 cy n s (Some x) = s x (\<lambda>a. YOpt_rec_1 cy n s (x a))"
  92.385 +lemma "rec_YOpt_2 cy n s (Some x) = s x (\<lambda>a. rec_YOpt_1 cy n s (x a))"
  92.386  nitpick [card = 1\<emdash>2, expect = none]
  92.387  apply simp
  92.388  done
  92.389  
  92.390 -lemma "P (YOpt_rec_1 cy n s x)"
  92.391 +lemma "P (rec_YOpt_1 cy n s x)"
  92.392  nitpick [expect = genuine]
  92.393  oops
  92.394  
  92.395 -lemma "P (YOpt_rec_2 cy n s x)"
  92.396 +lemma "P (rec_YOpt_2 cy n s x)"
  92.397  nitpick [expect = genuine]
  92.398  oops
  92.399  
  92.400 @@ -1156,26 +1121,26 @@
  92.401  nitpick [expect = genuine]
  92.402  oops
  92.403  
  92.404 -lemma "Trie_rec_1 tr nil cons (TR x) = tr x (Trie_rec_2 tr nil cons x)"
  92.405 +lemma "rec_Trie_1 tr nil cons (TR x) = tr x (rec_Trie_2 tr nil cons x)"
  92.406  nitpick [card = 1\<emdash>4, expect = none]
  92.407  apply simp
  92.408  done
  92.409  
  92.410 -lemma "Trie_rec_2 tr nil cons [] = nil"
  92.411 +lemma "rec_Trie_2 tr nil cons [] = nil"
  92.412  nitpick [card = 1\<emdash>4, expect = none]
  92.413  apply simp
  92.414  done
  92.415  
  92.416 -lemma "Trie_rec_2 tr nil cons (x#xs) = cons x xs (Trie_rec_1 tr nil cons x) (Trie_rec_2 tr nil cons xs)"
  92.417 +lemma "rec_Trie_2 tr nil cons (x#xs) = cons x xs (rec_Trie_1 tr nil cons x) (rec_Trie_2 tr nil cons xs)"
  92.418  nitpick [card = 1\<emdash>4, expect = none]
  92.419  apply simp
  92.420  done
  92.421  
  92.422 -lemma "P (Trie_rec_1 tr nil cons x)"
  92.423 +lemma "P (rec_Trie_1 tr nil cons x)"
  92.424  nitpick [card = 1, expect = genuine]
  92.425  oops
  92.426  
  92.427 -lemma "P (Trie_rec_2 tr nil cons x)"
  92.428 +lemma "P (rec_Trie_2 tr nil cons x)"
  92.429  nitpick [card = 1, expect = genuine]
  92.430  oops
  92.431  
  92.432 @@ -1193,17 +1158,17 @@
  92.433  nitpick [expect = genuine]
  92.434  oops
  92.435  
  92.436 -lemma "InfTree_rec leaf node Leaf = leaf"
  92.437 +lemma "rec_InfTree leaf node Leaf = leaf"
  92.438  nitpick [card = 1\<emdash>3, expect = none]
  92.439  apply simp
  92.440  done
  92.441  
  92.442 -lemma "InfTree_rec leaf node (Node x) = node x (\<lambda>n. InfTree_rec leaf node (x n))"
  92.443 +lemma "rec_InfTree leaf node (Node x) = node x (\<lambda>n. rec_InfTree leaf node (x n))"
  92.444  nitpick [card = 1\<emdash>3, expect = none]
  92.445  apply simp
  92.446  done
  92.447  
  92.448 -lemma "P (InfTree_rec leaf node x)"
  92.449 +lemma "P (rec_InfTree leaf node x)"
  92.450  nitpick [expect = genuine]
  92.451  oops
  92.452  
  92.453 @@ -1222,22 +1187,22 @@
  92.454  nitpick [card 'a = 4, card "'a lambda" = 5, expect = genuine]
  92.455  oops
  92.456  
  92.457 -lemma "lambda_rec var app lam (Var x) = var x"
  92.458 +lemma "rec_lambda var app lam (Var x) = var x"
  92.459  nitpick [card = 1\<emdash>3, expect = none]
  92.460  apply simp
  92.461  done
  92.462  
  92.463 -lemma "lambda_rec var app lam (App x y) = app x y (lambda_rec var app lam x) (lambda_rec var app lam y)"
  92.464 +lemma "rec_lambda var app lam (App x y) = app x y (rec_lambda var app lam x) (rec_lambda var app lam y)"
  92.465  nitpick [card = 1\<emdash>3, expect = none]
  92.466  apply simp
  92.467  done
  92.468  
  92.469 -lemma "lambda_rec var app lam (Lam x) = lam x (\<lambda>a. lambda_rec var app lam (x a))"
  92.470 +lemma "rec_lambda var app lam (Lam x) = lam x (\<lambda>a. rec_lambda var app lam (x a))"
  92.471  nitpick [card = 1\<emdash>3, expect = none]
  92.472  apply simp
  92.473  done
  92.474  
  92.475 -lemma "P (lambda_rec v a l x)"
  92.476 +lemma "P (rec_lambda v a l x)"
  92.477  nitpick [expect = genuine]
  92.478  oops
  92.479  
  92.480 @@ -1258,40 +1223,40 @@
  92.481  nitpick [expect = genuine]
  92.482  oops
  92.483  
  92.484 -lemma "U_rec_1 e c d nil cons (E x) = e x (U_rec_2 e c d nil cons x)"
  92.485 +lemma "rec_U_1 e c d nil cons (E x) = e x (rec_U_2 e c d nil cons x)"
  92.486  nitpick [card = 1\<emdash>3, expect = none]
  92.487  apply simp
  92.488  done
  92.489  
  92.490 -lemma "U_rec_2 e c d nil cons (C x) = c x"
  92.491 +lemma "rec_U_2 e c d nil cons (C x) = c x"
  92.492  nitpick [card = 1\<emdash>3, expect = none]
  92.493  apply simp
  92.494  done
  92.495  
  92.496 -lemma "U_rec_2 e c d nil cons (D x) = d x (U_rec_3 e c d nil cons x)"
  92.497 +lemma "rec_U_2 e c d nil cons (D x) = d x (rec_U_3 e c d nil cons x)"
  92.498  nitpick [card = 1\<emdash>3, expect = none]
  92.499  apply simp
  92.500  done
  92.501  
  92.502 -lemma "U_rec_3 e c d nil cons [] = nil"
  92.503 +lemma "rec_U_3 e c d nil cons [] = nil"
  92.504  nitpick [card = 1\<emdash>3, expect = none]
  92.505  apply simp
  92.506  done
  92.507  
  92.508 -lemma "U_rec_3 e c d nil cons (x#xs) = cons x xs (U_rec_1 e c d nil cons x) (U_rec_3 e c d nil cons xs)"
  92.509 +lemma "rec_U_3 e c d nil cons (x#xs) = cons x xs (rec_U_1 e c d nil cons x) (rec_U_3 e c d nil cons xs)"
  92.510  nitpick [card = 1\<emdash>3, expect = none]
  92.511  apply simp
  92.512  done
  92.513  
  92.514 -lemma "P (U_rec_1 e c d nil cons x)"
  92.515 +lemma "P (rec_U_1 e c d nil cons x)"
  92.516  nitpick [expect = genuine]
  92.517  oops
  92.518  
  92.519 -lemma "P (U_rec_2 e c d nil cons x)"
  92.520 +lemma "P (rec_U_2 e c d nil cons x)"
  92.521  nitpick [card = 1, expect = genuine]
  92.522  oops
  92.523  
  92.524 -lemma "P (U_rec_3 e c d nil cons x)"
  92.525 +lemma "P (rec_U_3 e c d nil cons x)"
  92.526  nitpick [card = 1, expect = genuine]
  92.527  oops
  92.528  
    93.1 --- a/src/HOL/Nitpick_Examples/Typedef_Nits.thy	Wed Feb 12 09:06:04 2014 +0100
    93.2 +++ b/src/HOL/Nitpick_Examples/Typedef_Nits.thy	Wed Feb 12 10:59:25 2014 +0100
    93.3 @@ -164,7 +164,7 @@
    93.4  by (rule Rep_Nat_inverse)
    93.5  
    93.6  lemma "Abs_list (Rep_list a) = a"
    93.7 -nitpick [card = 1\<emdash>2, expect = none]
    93.8 +(* nitpick [card = 1\<emdash>2, expect = none] FIXME *)
    93.9  by (rule Rep_list_inverse)
   93.10  
   93.11  record point =
    94.1 --- a/src/HOL/Nominal/Examples/Class2.thy	Wed Feb 12 09:06:04 2014 +0100
    94.2 +++ b/src/HOL/Nominal/Examples/Class2.thy	Wed Feb 12 10:59:25 2014 +0100
    94.3 @@ -2881,7 +2881,7 @@
    94.4  done
    94.5  
    94.6  termination
    94.7 -apply(relation "measure (sum_case (size\<circ>fst) (size\<circ>fst))")
    94.8 +apply(relation "measure (case_sum (size\<circ>fst) (size\<circ>fst))")
    94.9  apply(simp_all)
   94.10  done
   94.11  
    95.1 --- a/src/HOL/Nominal/Examples/Class3.thy	Wed Feb 12 09:06:04 2014 +0100
    95.2 +++ b/src/HOL/Nominal/Examples/Class3.thy	Wed Feb 12 10:59:25 2014 +0100
    95.3 @@ -2311,6 +2311,7 @@
    95.4  apply(rule_tac my_wf_induct_triple[OF a])
    95.5  apply(case_tac x rule: prod.exhaust)
    95.6  apply(simp)
    95.7 +apply(rename_tac p a b)
    95.8  apply(case_tac b)
    95.9  apply(simp)
   95.10  apply(rule b)
   95.11 @@ -3618,7 +3619,7 @@
   95.12  apply(simp add: fresh_atm)
   95.13  done
   95.14  
   95.15 -lemma option_case_eqvt1[eqvt_force]:
   95.16 +lemma case_option_eqvt1[eqvt_force]:
   95.17    fixes pi1::"name prm"
   95.18    and   pi2::"coname prm"
   95.19    and   B::"(name\<times>trm) option"
   95.20 @@ -3635,7 +3636,7 @@
   95.21  apply(perm_simp)
   95.22  done
   95.23  
   95.24 -lemma option_case_eqvt2[eqvt_force]:
   95.25 +lemma case_option_eqvt2[eqvt_force]:
   95.26    fixes pi1::"name prm"
   95.27    and   pi2::"coname prm"
   95.28    and   B::"(coname\<times>trm) option"
    96.1 --- a/src/HOL/Nominal/Examples/Fsub.thy	Wed Feb 12 09:06:04 2014 +0100
    96.2 +++ b/src/HOL/Nominal/Examples/Fsub.thy	Wed Feb 12 10:59:25 2014 +0100
    96.3 @@ -167,7 +167,8 @@
    96.4    assumes a: "X\<in>(ty_dom \<Gamma>)" 
    96.5    shows "\<exists>T.(TVarB X T)\<in>set \<Gamma>"
    96.6    using a 
    96.7 -  apply (induct \<Gamma>, auto) 
    96.8 +  apply (induct \<Gamma>, auto)
    96.9 +  apply (rename_tac a \<Gamma>') 
   96.10    apply (subgoal_tac "\<exists>T.(TVarB X T=a)")
   96.11    apply (auto)
   96.12    apply (auto simp add: ty_binding_existence)
    97.1 --- a/src/HOL/Nominal/Examples/W.thy	Wed Feb 12 09:06:04 2014 +0100
    97.2 +++ b/src/HOL/Nominal/Examples/W.thy	Wed Feb 12 10:59:25 2014 +0100
    97.3 @@ -1,5 +1,5 @@
    97.4  theory W
    97.5 -imports Nominal
    97.6 +imports "../Nominal"
    97.7  begin
    97.8  
    97.9  text {* Example for strong induction rules avoiding sets of atoms. *}
   97.10 @@ -388,6 +388,7 @@
   97.11    shows "supp \<Gamma> = set (ftv \<Gamma>)"
   97.12  apply (induct \<Gamma>)
   97.13  apply (simp_all add: supp_list_nil supp_list_cons)
   97.14 +apply (rename_tac a \<Gamma>')
   97.15  apply (case_tac a)
   97.16  apply (simp add: supp_prod supp_atm ftv_tyS)
   97.17  done
   97.18 @@ -443,6 +444,7 @@
   97.19  using asm
   97.20  apply(induct Xs)
   97.21  apply(simp)
   97.22 +apply(rename_tac a Xs')
   97.23  apply(case_tac "X=a")
   97.24  apply(simp add: abs_fresh)
   97.25  apply(simp add: abs_fresh)
    98.1 --- a/src/HOL/Num.thy	Wed Feb 12 09:06:04 2014 +0100
    98.2 +++ b/src/HOL/Num.thy	Wed Feb 12 10:59:25 2014 +0100
    98.3 @@ -1050,24 +1050,24 @@
    98.4    "min (numeral k) (Suc n) = Suc (min (pred_numeral k) n)"
    98.5    by (simp add: numeral_eq_Suc)
    98.6  
    98.7 -text {* For @{term nat_case} and @{term nat_rec}. *}
    98.8 +text {* For @{term case_nat} and @{term rec_nat}. *}
    98.9  
   98.10 -lemma nat_case_numeral [simp]:
   98.11 -  "nat_case a f (numeral v) = (let pv = pred_numeral v in f pv)"
   98.12 +lemma case_nat_numeral [simp]:
   98.13 +  "case_nat a f (numeral v) = (let pv = pred_numeral v in f pv)"
   98.14    by (simp add: numeral_eq_Suc)
   98.15  
   98.16 -lemma nat_case_add_eq_if [simp]:
   98.17 -  "nat_case a f ((numeral v) + n) = (let pv = pred_numeral v in f (pv + n))"
   98.18 +lemma case_nat_add_eq_if [simp]:
   98.19 +  "case_nat a f ((numeral v) + n) = (let pv = pred_numeral v in f (pv + n))"
   98.20    by (simp add: numeral_eq_Suc)
   98.21  
   98.22 -lemma nat_rec_numeral [simp]:
   98.23 -  "nat_rec a f (numeral v) =
   98.24 -    (let pv = pred_numeral v in f pv (nat_rec a f pv))"
   98.25 +lemma rec_nat_numeral [simp]:
   98.26 +  "rec_nat a f (numeral v) =
   98.27 +    (let pv = pred_numeral v in f pv (rec_nat a f pv))"
   98.28    by (simp add: numeral_eq_Suc Let_def)
   98.29  
   98.30 -lemma nat_rec_add_eq_if [simp]:
   98.31 -  "nat_rec a f (numeral v + n) =
   98.32 -    (let pv = pred_numeral v in f (pv + n) (nat_rec a f (pv + n)))"
   98.33 +lemma rec_nat_add_eq_if [simp]:
   98.34 +  "rec_nat a f (numeral v + n) =
   98.35 +    (let pv = pred_numeral v in f (pv + n) (rec_nat a f (pv + n)))"
   98.36    by (simp add: numeral_eq_Suc Let_def)
   98.37  
   98.38  text {* Case analysis on @{term "n < 2"} *}
    99.1 --- a/src/HOL/Option.thy	Wed Feb 12 09:06:04 2014 +0100
    99.2 +++ b/src/HOL/Option.thy	Wed Feb 12 10:59:25 2014 +0100
    99.3 @@ -5,10 +5,33 @@
    99.4  header {* Datatype option *}
    99.5  
    99.6  theory Option
    99.7 -imports Datatype Finite_Set
    99.8 +imports BNF_LFP Datatype Finite_Set
    99.9  begin
   99.10  
   99.11 -datatype 'a option = None | Some 'a
   99.12 +datatype_new 'a option =
   99.13 +    =: None
   99.14 +  | Some (the: 'a)
   99.15 +
   99.16 +datatype_new_compat option
   99.17 +
   99.18 +lemma [case_names None Some, cases type: option]:
   99.19 +  -- {* for backward compatibility -- names of variables differ *}
   99.20 +  "(y = None \<Longrightarrow> P) \<Longrightarrow> (\<And>a. y = Some a \<Longrightarrow> P) \<Longrightarrow> P"
   99.21 +by (rule option.exhaust)
   99.22 +
   99.23 +lemma [case_names None Some, induct type: option]:
   99.24 +  -- {* for backward compatibility -- names of variables differ *}
   99.25 +  "P None \<Longrightarrow> (\<And>option. P (Some option)) \<Longrightarrow> P option"
   99.26 +by (rule option.induct)
   99.27 +
   99.28 +-- {* Compatibility *}
   99.29 +setup {* Sign.mandatory_path "option" *}
   99.30 +
   99.31 +lemmas inducts = option.induct
   99.32 +lemmas recs = option.rec
   99.33 +lemmas cases = option.case
   99.34 +
   99.35 +setup {* Sign.parent_path *}
   99.36  
   99.37  lemma not_None_eq [iff]: "(x ~= None) = (EX y. x = Some y)"
   99.38    by (induct x) auto
   99.39 @@ -23,7 +46,7 @@
   99.40  lemma inj_Some [simp]: "inj_on Some A"
   99.41  by (rule inj_onI) simp
   99.42  
   99.43 -lemma option_caseE:
   99.44 +lemma case_optionE:
   99.45    assumes c: "(case x of None => P | Some y => Q y)"
   99.46    obtains
   99.47      (None) "x = None" and P
   99.48 @@ -41,9 +64,6 @@
   99.49  
   99.50  subsubsection {* Operations *}
   99.51  
   99.52 -primrec the :: "'a option => 'a" where
   99.53 -"the (Some x) = x"
   99.54 -
   99.55  primrec set :: "'a option => 'a set" where
   99.56  "set None = {}" |
   99.57  "set (Some x) = {x}"
   99.58 @@ -80,8 +100,8 @@
   99.59      "map f (map g opt) = map (f o g) opt"
   99.60    by (simp add: map_def split add: option.split)
   99.61  
   99.62 -lemma option_map_o_sum_case [simp]:
   99.63 -    "map f o sum_case g h = sum_case (map f o g) (map f o h)"
   99.64 +lemma option_map_o_case_sum [simp]:
   99.65 +    "map f o case_sum g h = case_sum (map f o g) (map f o h)"
   99.66    by (rule ext) (simp split: sum.split)
   99.67  
   99.68  lemma map_cong: "x = y \<Longrightarrow> (\<And>a. y = Some a \<Longrightarrow> f a = g a) \<Longrightarrow> map f x = map g y"
   99.69 @@ -104,8 +124,8 @@
   99.70    qed
   99.71  qed
   99.72  
   99.73 -lemma option_case_map [simp]:
   99.74 -  "option_case g h (Option.map f x) = option_case g (h \<circ> f) x"
   99.75 +lemma case_option_map [simp]:
   99.76 +  "case_option g h (Option.map f x) = case_option g (h \<circ> f) x"
   99.77    by (cases x) simp_all
   99.78  
   99.79  primrec bind :: "'a option \<Rightarrow> ('a \<Rightarrow> 'b option) \<Rightarrow> 'b option" where
   100.1 --- a/src/HOL/Predicate.thy	Wed Feb 12 09:06:04 2014 +0100
   100.2 +++ b/src/HOL/Predicate.thy	Wed Feb 12 10:59:25 2014 +0100
   100.3 @@ -531,11 +531,11 @@
   100.4    by (fact equal_refl)
   100.5  
   100.6  lemma [code]:
   100.7 -  "pred_case f P = f (eval P)"
   100.8 +  "case_pred f P = f (eval P)"
   100.9    by (cases P) simp
  100.10  
  100.11  lemma [code]:
  100.12 -  "pred_rec f P = f (eval P)"
  100.13 +  "rec_pred f P = f (eval P)"
  100.14    by (cases P) simp
  100.15  
  100.16  inductive eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where "eq x x"
  100.17 @@ -722,4 +722,3 @@
  100.18  hide_fact (open) null_def member_def
  100.19  
  100.20  end
  100.21 -
   101.1 --- a/src/HOL/Probability/Finite_Product_Measure.thy	Wed Feb 12 09:06:04 2014 +0100
   101.2 +++ b/src/HOL/Probability/Finite_Product_Measure.thy	Wed Feb 12 10:59:25 2014 +0100
   101.3 @@ -442,15 +442,15 @@
   101.4    "i \<in> I \<Longrightarrow> f \<in> measurable (M i) N \<Longrightarrow> (\<lambda>x. f (x i)) \<in> measurable (PiM I M) N"
   101.5    by simp
   101.6  
   101.7 -lemma measurable_nat_case[measurable (raw)]:
   101.8 +lemma measurable_case_nat[measurable (raw)]:
   101.9    assumes [measurable (raw)]: "i = 0 \<Longrightarrow> f \<in> measurable M N"
  101.10      "\<And>j. i = Suc j \<Longrightarrow> (\<lambda>x. g x j) \<in> measurable M N"
  101.11 -  shows "(\<lambda>x. nat_case (f x) (g x) i) \<in> measurable M N"
  101.12 +  shows "(\<lambda>x. case_nat (f x) (g x) i) \<in> measurable M N"
  101.13    by (cases i) simp_all
  101.14  
  101.15 -lemma measurable_nat_case'[measurable (raw)]:
  101.16 +lemma measurable_case_nat'[measurable (raw)]:
  101.17    assumes fg[measurable]: "f \<in> measurable N M" "g \<in> measurable N (\<Pi>\<^sub>M i\<in>UNIV. M)"
  101.18 -  shows "(\<lambda>x. nat_case (f x) (g x)) \<in> measurable N (\<Pi>\<^sub>M i\<in>UNIV. M)"
  101.19 +  shows "(\<lambda>x. case_nat (f x) (g x)) \<in> measurable N (\<Pi>\<^sub>M i\<in>UNIV. M)"
  101.20    using fg[THEN measurable_space]
  101.21    by (auto intro!: measurable_PiM_single' simp add: space_PiM PiE_iff split: nat.split)
  101.22  
  101.23 @@ -465,7 +465,7 @@
  101.24    also have "\<dots> \<in> sets ?P"
  101.25      using A j
  101.26      by (auto intro!: measurable_sets[OF measurable_comp, OF _ measurable_component_singleton])
  101.27 -  finally show "{\<omega> \<in> space ?P. prod_case (\<lambda>f. fun_upd f i) \<omega> j \<in> A} \<in> sets ?P" .
  101.28 +  finally show "{\<omega> \<in> space ?P. case_prod (\<lambda>f. fun_upd f i) \<omega> j \<in> A} \<in> sets ?P" .
  101.29  qed (auto simp: space_pair_measure space_PiM PiE_def)
  101.30  
  101.31  lemma measurable_component_update:
  101.32 @@ -1132,27 +1132,27 @@
  101.33  lemma pair_measure_eq_distr_PiM:
  101.34    fixes M1 :: "'a measure" and M2 :: "'a measure"
  101.35    assumes "sigma_finite_measure M1" "sigma_finite_measure M2"
  101.36 -  shows "(M1 \<Otimes>\<^sub>M M2) = distr (Pi\<^sub>M UNIV (bool_case M1 M2)) (M1 \<Otimes>\<^sub>M M2) (\<lambda>x. (x True, x False))"
  101.37 +  shows "(M1 \<Otimes>\<^sub>M M2) = distr (Pi\<^sub>M UNIV (case_bool M1 M2)) (M1 \<Otimes>\<^sub>M M2) (\<lambda>x. (x True, x False))"
  101.38      (is "?P = ?D")
  101.39  proof (rule pair_measure_eqI[OF assms])
  101.40 -  interpret B: product_sigma_finite "bool_case M1 M2"
  101.41 +  interpret B: product_sigma_finite "case_bool M1 M2"
  101.42      unfolding product_sigma_finite_def using assms by (auto split: bool.split)
  101.43 -  let ?B = "Pi\<^sub>M UNIV (bool_case M1 M2)"
  101.44 +  let ?B = "Pi\<^sub>M UNIV (case_bool M1 M2)"
  101.45  
  101.46    have [simp]: "fst \<circ> (\<lambda>x. (x True, x False)) = (\<lambda>x. x True)" "snd \<circ> (\<lambda>x. (x True, x False)) = (\<lambda>x. x False)"
  101.47      by auto
  101.48    fix A B assume A: "A \<in> sets M1" and B: "B \<in> sets M2"
  101.49 -  have "emeasure M1 A * emeasure M2 B = (\<Prod> i\<in>UNIV. emeasure (bool_case M1 M2 i) (bool_case A B i))"
  101.50 +  have "emeasure M1 A * emeasure M2 B = (\<Prod> i\<in>UNIV. emeasure (case_bool M1 M2 i) (case_bool A B i))"
  101.51      by (simp add: UNIV_bool ac_simps)
  101.52 -  also have "\<dots> = emeasure ?B (Pi\<^sub>E UNIV (bool_case A B))"
  101.53 +  also have "\<dots> = emeasure ?B (Pi\<^sub>E UNIV (case_bool A B))"
  101.54      using A B by (subst B.emeasure_PiM) (auto split: bool.split)
  101.55 -  also have "Pi\<^sub>E UNIV (bool_case A B) = (\<lambda>x. (x True, x False)) -` (A \<times> B) \<inter> space ?B"
  101.56 +  also have "Pi\<^sub>E UNIV (case_bool A B) = (\<lambda>x. (x True, x False)) -` (A \<times> B) \<inter> space ?B"
  101.57      using A[THEN sets.sets_into_space] B[THEN sets.sets_into_space]
  101.58      by (auto simp: PiE_iff all_bool_eq space_PiM split: bool.split)
  101.59    finally show "emeasure M1 A * emeasure M2 B = emeasure ?D (A \<times> B)"
  101.60      using A B
  101.61 -      measurable_component_singleton[of True UNIV "bool_case M1 M2"]
  101.62 -      measurable_component_singleton[of False UNIV "bool_case M1 M2"]
  101.63 +      measurable_component_singleton[of True UNIV "case_bool M1 M2"]
  101.64 +      measurable_component_singleton[of False UNIV "case_bool M1 M2"]
  101.65      by (subst emeasure_distr) (auto simp: measurable_pair_iff)
  101.66  qed simp
  101.67  
   102.1 --- a/src/HOL/Probability/Independent_Family.thy	Wed Feb 12 09:06:04 2014 +0100
   102.2 +++ b/src/HOL/Probability/Independent_Family.thy	Wed Feb 12 10:59:25 2014 +0100
   102.3 @@ -13,7 +13,7 @@
   102.4      (\<forall>J\<subseteq>I. J \<noteq> {} \<longrightarrow> finite J \<longrightarrow> (\<forall>A\<in>Pi J F. prob (\<Inter>j\<in>J. A j) = (\<Prod>j\<in>J. prob (A j))))"
   102.5  
   102.6  definition (in prob_space)
   102.7 -  "indep_set A B \<longleftrightarrow> indep_sets (bool_case A B) UNIV"
   102.8 +  "indep_set A B \<longleftrightarrow> indep_sets (case_bool A B) UNIV"
   102.9  
  102.10  definition (in prob_space)
  102.11    indep_events_def_alt: "indep_events A I \<longleftrightarrow> indep_sets (\<lambda>i. {A i}) I"
  102.12 @@ -28,7 +28,7 @@
  102.13    done
  102.14  
  102.15  definition (in prob_space)
  102.16 -  "indep_event A B \<longleftrightarrow> indep_events (bool_case A B) UNIV"
  102.17 +  "indep_event A B \<longleftrightarrow> indep_events (case_bool A B) UNIV"
  102.18  
  102.19  lemma (in prob_space) indep_sets_cong:
  102.20    "I = J \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i = G i) \<Longrightarrow> indep_sets F I \<longleftrightarrow> indep_sets G J"
  102.21 @@ -104,7 +104,7 @@
  102.22  lemma (in prob_space) indep_setD:
  102.23    assumes indep: "indep_set A B" and ev: "a \<in> A" "b \<in> B"
  102.24    shows "prob (a \<inter> b) = prob a * prob b"
  102.25 -  using indep[unfolded indep_set_def, THEN indep_setsD, of UNIV "bool_case a b"] ev
  102.26 +  using indep[unfolded indep_set_def, THEN indep_setsD, of UNIV "case_bool a b"] ev
  102.27    by (simp add: ac_simps UNIV_bool)
  102.28  
  102.29  lemma (in prob_space)
  102.30 @@ -312,7 +312,7 @@
  102.31      indep_sets (\<lambda>i. { X i -` A \<inter> space M | A. A \<in> sets (M' i)}) I"
  102.32  
  102.33  definition (in prob_space)
  102.34 -  "indep_var Ma A Mb B \<longleftrightarrow> indep_vars (bool_case Ma Mb) (bool_case A B) UNIV"
  102.35 +  "indep_var Ma A Mb B \<longleftrightarrow> indep_vars (case_bool Ma Mb) (case_bool A B) UNIV"
  102.36  
  102.37  lemma (in prob_space) indep_vars_def:
  102.38    "indep_vars M' X I \<longleftrightarrow>
  102.39 @@ -340,16 +340,16 @@
  102.40    "indep_set A B \<longleftrightarrow> A \<subseteq> events \<and> B \<subseteq> events \<and> (\<forall>a\<in>A. \<forall>b\<in>B. prob (a \<inter> b) = prob a * prob b)"
  102.41    unfolding indep_set_def
  102.42  proof (intro iffI ballI conjI)
  102.43 -  assume indep: "indep_sets (bool_case A B) UNIV"
  102.44 +  assume indep: "indep_sets (case_bool A B) UNIV"
  102.45    { fix a b assume "a \<in> A" "b \<in> B"
  102.46 -    with indep_setsD[OF indep, of UNIV "bool_case a b"]
  102.47 +    with indep_setsD[OF indep, of UNIV "case_bool a b"]
  102.48      show "prob (a \<inter> b) = prob a * prob b"
  102.49        unfolding UNIV_bool by (simp add: ac_simps) }
  102.50    from indep show "A \<subseteq> events" "B \<subseteq> events"
  102.51      unfolding indep_sets_def UNIV_bool by auto
  102.52  next
  102.53    assume *: "A \<subseteq> events \<and> B \<subseteq> events \<and> (\<forall>a\<in>A. \<forall>b\<in>B. prob (a \<inter> b) = prob a * prob b)"
  102.54 -  show "indep_sets (bool_case A B) UNIV"
  102.55 +  show "indep_sets (case_bool A B) UNIV"
  102.56    proof (rule indep_setsI)
  102.57      fix i show "(case i of True \<Rightarrow> A | False \<Rightarrow> B) \<subseteq> events"
  102.58        using * by (auto split: bool.split)
  102.59 @@ -369,7 +369,7 @@
  102.60  proof -
  102.61    have "indep_sets (\<lambda>i. sigma_sets (space M) (case i of True \<Rightarrow> A | False \<Rightarrow> B)) UNIV"
  102.62    proof (rule indep_sets_sigma)
  102.63 -    show "indep_sets (bool_case A B) UNIV"
  102.64 +    show "indep_sets (case_bool A B) UNIV"
  102.65        by (rule `indep_set A B`[unfolded indep_set_def])
  102.66      fix i show "Int_stable (case i of True \<Rightarrow> A | False \<Rightarrow> B)"
  102.67        using A B by (cases i) auto
  102.68 @@ -572,19 +572,19 @@
  102.69    qed
  102.70  
  102.71    { fix n
  102.72 -    have "indep_sets (\<lambda>b. sigma_sets (space M) (\<Union>m\<in>bool_case {..n} {Suc n..} b. A m)) UNIV"
  102.73 +    have "indep_sets (\<lambda>b. sigma_sets (space M) (\<Union>m\<in>case_bool {..n} {Suc n..} b. A m)) UNIV"
  102.74      proof (rule indep_sets_collect_sigma)
  102.75        have *: "(\<Union>b. case b of True \<Rightarrow> {..n} | False \<Rightarrow> {Suc n..}) = UNIV" (is "?U = _")
  102.76          by (simp split: bool.split add: set_eq_iff) (metis not_less_eq_eq)
  102.77        with indep show "indep_sets A ?U" by simp
  102.78 -      show "disjoint_family (bool_case {..n} {Suc n..})"
  102.79 +      show "disjoint_family (case_bool {..n} {Suc n..})"
  102.80          unfolding disjoint_family_on_def by (auto split: bool.split)
  102.81        fix m
  102.82        show "Int_stable (A m)"
  102.83          unfolding Int_stable_def using A.Int by auto
  102.84      qed
  102.85 -    also have "(\<lambda>b. sigma_sets (space M) (\<Union>m\<in>bool_case {..n} {Suc n..} b. A m)) =
  102.86 -      bool_case (sigma_sets (space M) (\<Union>m\<in>{..n}. A m)) (sigma_sets (space M) (\<Union>m\<in>{Suc n..}. A m))"
  102.87 +    also have "(\<lambda>b. sigma_sets (space M) (\<Union>m\<in>case_bool {..n} {Suc n..} b. A m)) =
  102.88 +      case_bool (sigma_sets (space M) (\<Union>m\<in>{..n}. A m)) (sigma_sets (space M) (\<Union>m\<in>{Suc n..}. A m))"
  102.89        by (auto intro!: ext split: bool.split)
  102.90      finally have indep: "indep_set (sigma_sets (space M) (\<Union>m\<in>{..n}. A m)) (sigma_sets (space M) (\<Union>m\<in>{Suc n..}. A m))"
  102.91        unfolding indep_set_def by simp
  102.92 @@ -923,9 +923,9 @@
  102.93      prob (A -` Xa \<inter> space M) * prob (B -` Xb \<inter> space M)"
  102.94  proof -
  102.95    have "prob ((\<lambda>x. (A x, B x)) -` (Xa \<times> Xb) \<inter> space M) =
  102.96 -    prob (\<Inter>i\<in>UNIV. (bool_case A B i -` bool_case Xa Xb i \<inter> space M))"
  102.97 +    prob (\<Inter>i\<in>UNIV. (case_bool A B i -` case_bool Xa Xb i \<inter> space M))"
  102.98      by (auto intro!: arg_cong[where f=prob] simp: UNIV_bool)
  102.99 -  also have "\<dots> = (\<Prod>i\<in>UNIV. prob (bool_case A B i -` bool_case Xa Xb i \<inter> space M))"
 102.100 +  also have "\<dots> = (\<Prod>i\<in>UNIV. prob (case_bool A B i -` case_bool Xa Xb i \<inter> space M))"
 102.101      using indep unfolding indep_var_def
 102.102      by (rule indep_varsD) (auto split: bool.split intro: sets)
 102.103    also have "\<dots> = prob (A -` Xa \<inter> space M) * prob (B -` Xb \<inter> space M)"
 102.104 @@ -938,7 +938,7 @@
 102.105    shows indep_var_rv1: "random_variable S X"
 102.106      and indep_var_rv2: "random_variable T Y"
 102.107  proof -
 102.108 -  have "\<forall>i\<in>UNIV. random_variable (bool_case S T i) (bool_case X Y i)"
 102.109 +  have "\<forall>i\<in>UNIV. random_variable (case_bool S T i) (case_bool X Y i)"
 102.110      using assms unfolding indep_var_def indep_vars_def by auto
 102.111    then show "random_variable S X" "random_variable T Y"
 102.112      unfolding UNIV_bool by auto
   103.1 --- a/src/HOL/Probability/Infinite_Product_Measure.thy	Wed Feb 12 09:06:04 2014 +0100
   103.2 +++ b/src/HOL/Probability/Infinite_Product_Measure.thy	Wed Feb 12 10:59:25 2014 +0100
   103.3 @@ -190,13 +190,13 @@
   103.4        let ?P =
   103.5          "\<lambda>k wk w. w \<in> space (Pi\<^sub>M (J (Suc k)) M) \<and> restrict w (J k) = wk \<and>
   103.6            (\<forall>n. ?a / 2 ^ (Suc k + 1) \<le> ?q (Suc k) n w)"
   103.7 -      def w \<equiv> "nat_rec w0 (\<lambda>k wk. Eps (?P k wk))"
   103.8 +      def w \<equiv> "rec_nat w0 (\<lambda>k wk. Eps (?P k wk))"
   103.9  
  103.10        { fix k have w: "w k \<in> space (Pi\<^sub>M (J k) M) \<and>
  103.11            (\<forall>n. ?a / 2 ^ (k + 1) \<le> ?q k n (w k)) \<and> (k \<noteq> 0 \<longrightarrow> restrict (w k) (J (k - 1)) = w (k - 1))"
  103.12          proof (induct k)
  103.13            case 0 with w0 show ?case
  103.14 -            unfolding w_def nat_rec_0 by auto
  103.15 +            unfolding w_def nat.recs(1) by auto
  103.16          next
  103.17            case (Suc k)
  103.18            then have wk: "w k \<in> space (Pi\<^sub>M (J k) M)" by auto
  103.19 @@ -241,7 +241,7 @@
  103.20                   (auto split: split_merge intro!: extensional_merge_sub ext simp: space_PiM PiE_iff)
  103.21            qed
  103.22            then have "?P k (w k) (w (Suc k))"
  103.23 -            unfolding w_def nat_rec_Suc unfolding w_def[symmetric]
  103.24 +            unfolding w_def nat.recs(2) unfolding w_def[symmetric]
  103.25              by (rule someI_ex)
  103.26            then show ?case by auto
  103.27          qed
  103.28 @@ -464,11 +464,11 @@
  103.29    show "(\<lambda>(\<omega>, \<omega>'). comb_seq i \<omega> \<omega>') \<in> space ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M)) \<rightarrow> (UNIV \<rightarrow>\<^sub>E space M)"
  103.30      by (auto simp: space_pair_measure space_PiM PiE_iff split: split_comb_seq)
  103.31    fix j :: nat and A assume A: "A \<in> sets M"
  103.32 -  then have *: "{\<omega> \<in> space ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M)). prod_case (comb_seq i) \<omega> j \<in> A} =
  103.33 +  then have *: "{\<omega> \<in> space ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M)). case_prod (comb_seq i) \<omega> j \<in> A} =
  103.34      (if j < i then {\<omega> \<in> space (\<Pi>\<^sub>M i\<in>UNIV. M). \<omega> j \<in> A} \<times> space (\<Pi>\<^sub>M i\<in>UNIV. M)
  103.35                else space (\<Pi>\<^sub>M i\<in>UNIV. M) \<times> {\<omega> \<in> space (\<Pi>\<^sub>M i\<in>UNIV. M). \<omega> (j - i) \<in> A})"
  103.36      by (auto simp: space_PiM space_pair_measure comb_seq_def dest: sets.sets_into_space)
  103.37 -  show "{\<omega> \<in> space ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M)). prod_case (comb_seq i) \<omega> j \<in> A} \<in> sets ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M))"
  103.38 +  show "{\<omega> \<in> space ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M)). case_prod (comb_seq i) \<omega> j \<in> A} \<in> sets ((\<Pi>\<^sub>M i\<in>UNIV. M) \<Otimes>\<^sub>M (\<Pi>\<^sub>M i\<in>UNIV. M))"
  103.39      unfolding * by (auto simp: A intro!: sets_Collect_single)
  103.40  qed
  103.41  
  103.42 @@ -480,10 +480,10 @@
  103.43  lemma comb_seq_0: "comb_seq 0 \<omega> \<omega>' = \<omega>'"
  103.44    by (auto simp add: comb_seq_def)
  103.45  
  103.46 -lemma comb_seq_Suc: "comb_seq (Suc n) \<omega> \<omega>' = comb_seq n \<omega> (nat_case (\<omega> n) \<omega>')"
  103.47 +lemma comb_seq_Suc: "comb_seq (Suc n) \<omega> \<omega>' = comb_seq n \<omega> (case_nat (\<omega> n) \<omega>')"
  103.48    by (auto simp add: comb_seq_def not_less less_Suc_eq le_imp_diff_is_add intro!: ext split: nat.split)
  103.49  
  103.50 -lemma comb_seq_Suc_0[simp]: "comb_seq (Suc 0) \<omega> = nat_case (\<omega> 0)"
  103.51 +lemma comb_seq_Suc_0[simp]: "comb_seq (Suc 0) \<omega> = case_nat (\<omega> 0)"
  103.52    by (intro ext) (simp add: comb_seq_Suc comb_seq_0)
  103.53  
  103.54  lemma comb_seq_less: "i < n \<Longrightarrow> comb_seq n \<omega> \<omega>' i = \<omega> i"
  103.55 @@ -492,11 +492,11 @@
  103.56  lemma comb_seq_add: "comb_seq n \<omega> \<omega>' (i + n) = \<omega>' i"
  103.57    by (auto split: nat.split split_comb_seq)
  103.58  
  103.59 -lemma nat_case_comb_seq: "nat_case s' (comb_seq n \<omega> \<omega>') (i + n) = nat_case (nat_case s' \<omega> n) \<omega>' i"
  103.60 +lemma case_nat_comb_seq: "case_nat s' (comb_seq n \<omega> \<omega>') (i + n) = case_nat (case_nat s' \<omega> n) \<omega>' i"
  103.61    by (auto split: nat.split split_comb_seq)
  103.62  
  103.63 -lemma nat_case_comb_seq':
  103.64 -  "nat_case s (comb_seq i \<omega> \<omega>') = comb_seq (Suc i) (nat_case s \<omega>) \<omega>'"
  103.65 +lemma case_nat_comb_seq':
  103.66 +  "case_nat s (comb_seq i \<omega> \<omega>') = comb_seq (Suc i) (case_nat s \<omega>) \<omega>'"
  103.67    by (auto split: split_comb_seq nat.split)
  103.68  
  103.69  locale sequence_space = product_prob_space "\<lambda>i. M" "UNIV :: nat set" for M
  103.70 @@ -570,7 +570,7 @@
  103.71  qed simp_all
  103.72  
  103.73  lemma PiM_iter:
  103.74 -  "distr (M \<Otimes>\<^sub>M S) S (\<lambda>(s, \<omega>). nat_case s \<omega>) = S" (is "?D = _")
  103.75 +  "distr (M \<Otimes>\<^sub>M S) S (\<lambda>(s, \<omega>). case_nat s \<omega>) = S" (is "?D = _")
  103.76  proof (rule PiM_eq)
  103.77    let ?I = "UNIV::nat set" and ?M = "\<lambda>n. M"
  103.78    let "distr _ _ ?f" = "?D"
   104.1 --- a/src/HOL/Probability/Radon_Nikodym.thy	Wed Feb 12 09:06:04 2014 +0100
   104.2 +++ b/src/HOL/Probability/Radon_Nikodym.thy	Wed Feb 12 10:59:25 2014 +0100
   104.3 @@ -244,13 +244,13 @@
   104.4        by (simp add: measure_restricted sets_eq sets.Int) (metis inf_absorb2)
   104.5      hence "\<exists>A. ?P A S n" .. }
   104.6    note Ex_P = this
   104.7 -  def A \<equiv> "nat_rec (space M) (\<lambda>n A. SOME B. ?P B A n)"
   104.8 +  def A \<equiv> "rec_nat (space M) (\<lambda>n A. SOME B. ?P B A n)"
   104.9    have A_Suc: "\<And>n. A (Suc n) = (SOME B. ?P B (A n) n)" by (simp add: A_def)
  104.10    have A_0[simp]: "A 0 = space M" unfolding A_def by simp
  104.11    { fix i have "A i \<in> sets M" unfolding A_def
  104.12      proof (induct i)
  104.13        case (Suc i)
  104.14 -      from Ex_P[OF this, of i] show ?case unfolding nat_rec_Suc
  104.15 +      from Ex_P[OF this, of i] show ?case unfolding nat.recs(2)
  104.16          by (rule someI2_ex) simp
  104.17      qed simp }
  104.18    note A_in_sets = this
  104.19 @@ -281,7 +281,7 @@
  104.20        from ex_inverse_of_nat_Suc_less[OF this]
  104.21        obtain n where *: "?d B < - 1 / real (Suc n)"
  104.22          by (auto simp: real_eq_of_nat inverse_eq_divide field_simps)
  104.23 -      have "B \<subseteq> A (Suc n)" using B by (auto simp del: nat_rec_Suc)
  104.24 +      have "B \<subseteq> A (Suc n)" using B by (auto simp del: nat.recs(2))
  104.25        from epsilon[OF B(1) this] *
  104.26        show False by auto
  104.27      qed
   105.1 --- a/src/HOL/Product_Type.thy	Wed Feb 12 09:06:04 2014 +0100
   105.2 +++ b/src/HOL/Product_Type.thy	Wed Feb 12 10:59:25 2014 +0100
   105.3 @@ -12,8 +12,27 @@
   105.4  
   105.5  subsection {* @{typ bool} is a datatype *}
   105.6  
   105.7 +wrap_free_constructors [True, False] case_bool [=]
   105.8 +by auto
   105.9 +
  105.10 +-- {* Avoid name clashes by prefixing the output of @{text rep_datatype} with @{text old}. *}
  105.11 +setup {* Sign.mandatory_path "old" *}
  105.12 +
  105.13  rep_datatype True False by (auto intro: bool_induct)
  105.14  
  105.15 +setup {* Sign.parent_path *}
  105.16 +
  105.17 +-- {* But erase the prefix for properties that are not generated by @{text wrap_free_constructors}. *}
  105.18 +setup {* Sign.mandatory_path "bool" *}
  105.19 +
  105.20 +lemmas induct = old.bool.induct
  105.21 +lemmas inducts = old.bool.inducts
  105.22 +lemmas recs = old.bool.recs
  105.23 +lemmas cases = bool.case
  105.24 +lemmas simps = bool.distinct bool.case old.bool.recs
  105.25 +
  105.26 +setup {* Sign.parent_path *}
  105.27 +
  105.28  declare case_split [cases type: bool]
  105.29    -- "prefer plain propositional version"
  105.30  
  105.31 @@ -61,8 +80,27 @@
  105.32      else SOME (mk_meta_eq @{thm unit_eq})
  105.33  *}
  105.34  
  105.35 +wrap_free_constructors ["()"] case_unit
  105.36 +by auto
  105.37 +
  105.38 +-- {* Avoid name clashes by prefixing the output of @{text rep_datatype} with @{text old}. *}
  105.39 +setup {* Sign.mandatory_path "old" *}
  105.40 +
  105.41  rep_datatype "()" by simp
  105.42  
  105.43 +setup {* Sign.parent_path *}
  105.44 +
  105.45 +-- {* But erase the prefix for properties that are not generated by @{text wrap_free_constructors}. *}
  105.46 +setup {* Sign.mandatory_path "unit" *}
  105.47 +
  105.48 +lemmas induct = old.unit.induct
  105.49 +lemmas inducts = old.unit.inducts
  105.50 +lemmas recs = old.unit.recs
  105.51 +lemmas cases = unit.case
  105.52 +lemmas simps = unit.case old.unit.recs
  105.53 +
  105.54 +setup {* Sign.parent_path *}
  105.55 +
  105.56  lemma unit_all_eq1: "(!!x::unit. PROP P x) == PROP P ()"
  105.57    by simp
  105.58  
  105.59 @@ -139,10 +177,14 @@
  105.60  definition Pair :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<times> 'b" where
  105.61    "Pair a b = Abs_prod (Pair_Rep a b)"
  105.62  
  105.63 -rep_datatype Pair proof -
  105.64 -  fix P :: "'a \<times> 'b \<Rightarrow> bool" and p
  105.65 -  assume "\<And>a b. P (Pair a b)"
  105.66 -  then show "P p" by (cases p) (auto simp add: prod_def Pair_def Pair_Rep_def)
  105.67 +lemma prod_cases: "(\<And>a b. P (Pair a b)) \<Longrightarrow> P p"
  105.68 +  by (cases p) (auto simp add: prod_def Pair_def Pair_Rep_def)
  105.69 +
  105.70 +wrap_free_constructors [Pair] case_prod [] [[fst, snd]]
  105.71 +proof -
  105.72 +  fix P :: bool and p :: "'a \<times> 'b"
  105.73 +  show "(\<And>x1 x2. p = Pair x1 x2 \<Longrightarrow> P) \<Longrightarrow> P"
  105.74 +    by (cases p) (auto simp add: prod_def Pair_def Pair_Rep_def)
  105.75  next
  105.76    fix a c :: 'a and b d :: 'b
  105.77    have "Pair_Rep a b = Pair_Rep c d \<longleftrightarrow> a = c \<and> b = d"
  105.78 @@ -153,15 +195,36 @@
  105.79      by (simp add: Pair_def Abs_prod_inject)
  105.80  qed
  105.81  
  105.82 -declare prod.simps(2) [nitpick_simp del]
  105.83 +-- {* Avoid name clashes by prefixing the output of @{text rep_datatype} with @{text old}. *}
  105.84 +setup {* Sign.mandatory_path "old" *}
  105.85 +
  105.86 +rep_datatype Pair
  105.87 +by (erule prod_cases) (rule prod.inject)
  105.88 +
  105.89 +setup {* Sign.parent_path *}
  105.90 +
  105.91 +-- {* But erase the prefix for properties that are not generated by @{text wrap_free_constructors}. *}
  105.92 +setup {* Sign.mandatory_path "prod" *}
  105.93  
  105.94 +declare
  105.95 +  old.prod.inject[iff del]
  105.96 +
  105.97 +lemmas induct = old.prod.induct
  105.98 +lemmas inducts = old.prod.inducts
  105.99 +lemmas recs = old.prod.recs
 105.100 +lemmas cases = prod.case
 105.101 +lemmas simps = prod.inject prod.case old.prod.recs
 105.102 +
 105.103 +setup {* Sign.parent_path *}
 105.104 +
 105.105 +declare prod.case [nitpick_simp del]
 105.106  declare prod.weak_case_cong [cong del]
 105.107  
 105.108  
 105.109  subsubsection {* Tuple syntax *}
 105.110  
 105.111  abbreviation (input) split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
 105.112 -  "split \<equiv> prod_case"
 105.113 +  "split \<equiv> case_prod"
 105.114  
 105.115  text {*
 105.116    Patterns -- extends pre-defined type @{typ pttrn} used in
 105.117 @@ -183,8 +246,8 @@
 105.118    "_pattern x y" => "CONST Pair x y"
 105.119    "_patterns x y" => "CONST Pair x y"
 105.120    "_tuple x (_tuple_args y z)" == "_tuple x (_tuple_arg (_tuple y z))"
 105.121 -  "%(x, y, zs). b" == "CONST prod_case (%x (y, zs). b)"
 105.122 -  "%(x, y). b" == "CONST prod_case (%x y. b)"
 105.123 +  "%(x, y, zs). b" == "CONST case_prod (%x (y, zs). b)"
 105.124 +  "%(x, y). b" == "CONST case_prod (%x y. b)"
 105.125    "_abs (CONST Pair x y) t" => "%(x, y). t"
 105.126    -- {* The last rule accommodates tuples in `case C ... (x,y) ... => ...'
 105.127       The (x,y) is parsed as `Pair x y' because it is logic, not pttrn *}
 105.128 @@ -202,7 +265,7 @@
 105.129              Syntax.const @{syntax_const "_abs"} $
 105.130                (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
 105.131            end
 105.132 -      | split_tr' [Abs (x, T, (s as Const (@{const_syntax prod_case}, _) $ t))] =
 105.133 +      | split_tr' [Abs (x, T, (s as Const (@{const_syntax case_prod}, _) $ t))] =
 105.134            (* split (%x. (split (%y z. t))) => %(x,y,z). t *)
 105.135            let
 105.136              val Const (@{syntax_const "_abs"}, _) $
 105.137 @@ -213,7 +276,7 @@
 105.138                (Syntax.const @{syntax_const "_pattern"} $ x' $
 105.139                  (Syntax.const @{syntax_const "_patterns"} $ y $ z)) $ t''
 105.140            end
 105.141 -      | split_tr' [Const (@{const_syntax prod_case}, _) $ t] =
 105.142 +      | split_tr' [Const (@{const_syntax case_prod}, _) $ t] =
 105.143            (* split (split (%x y z. t)) => %((x, y), z). t *)
 105.144            split_tr' [(split_tr' [t])] (* inner split_tr' creates next pattern *)
 105.145        | split_tr' [Const (@{syntax_const "_abs"}, _) $ x_y $ Abs abs] =
 105.146 @@ -223,7 +286,7 @@
 105.147                (Syntax.const @{syntax_const "_pattern"} $ x_y $ z) $ t
 105.148            end
 105.149        | split_tr' _ = raise Match;
 105.150 -  in [(@{const_syntax prod_case}, K split_tr')] end
 105.151 +  in [(@{const_syntax case_prod}, K split_tr')] end
 105.152  *}
 105.153  
 105.154  (* print "split f" as "\<lambda>(x,y). f x y" and "split (\<lambda>x. f x)" as "\<lambda>(x,y). f x y" *) 
 105.155 @@ -232,7 +295,7 @@
 105.156      fun split_guess_names_tr' T [Abs (x, _, Abs _)] = raise Match
 105.157        | split_guess_names_tr' T [Abs (x, xT, t)] =
 105.158            (case (head_of t) of
 105.159 -            Const (@{const_syntax prod_case}, _) => raise Match
 105.160 +            Const (@{const_syntax case_prod}, _) => raise Match
 105.161            | _ =>
 105.162              let 
 105.163                val (_ :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
 105.164 @@ -244,7 +307,7 @@
 105.165              end)
 105.166        | split_guess_names_tr' T [t] =
 105.167            (case head_of t of
 105.168 -            Const (@{const_syntax prod_case}, _) => raise Match
 105.169 +            Const (@{const_syntax case_prod}, _) => raise Match
 105.170            | _ =>
 105.171              let
 105.172                val (xT :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
 105.173 @@ -256,10 +319,10 @@
 105.174                  (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
 105.175              end)
 105.176        | split_guess_names_tr' _ _ = raise Match;
 105.177 -  in [(@{const_syntax prod_case}, K split_guess_names_tr')] end
 105.178 +  in [(@{const_syntax case_prod}, K split_guess_names_tr')] end
 105.179  *}
 105.180  
 105.181 -(* Force eta-contraction for terms of the form "Q A (%p. prod_case P p)"
 105.182 +(* Force eta-contraction for terms of the form "Q A (%p. case_prod P p)"
 105.183     where Q is some bounded quantifier or set operator.
 105.184     Reason: the above prints as "Q p : A. case p of (x,y) \<Rightarrow> P x y"
 105.185     whereas we want "Q (x,y):A. P x y".
 105.186 @@ -269,7 +332,7 @@
 105.187    let
 105.188      fun contract Q tr ctxt ts =
 105.189        (case ts of
 105.190 -        [A, Abs (_, _, (s as Const (@{const_syntax prod_case},_) $ t) $ Bound 0)] =>
 105.191 +        [A, Abs (_, _, (s as Const (@{const_syntax case_prod},_) $ t) $ Bound 0)] =>
 105.192            if Term.is_dependent t then tr ctxt ts
 105.193            else Syntax.const Q $ A $ s
 105.194        | _ => tr ctxt ts);
 105.195 @@ -312,23 +375,11 @@
 105.196  lemma surj_pair [simp]: "EX x y. p = (x, y)"
 105.197    by (cases p) simp
 105.198  
 105.199 -definition fst :: "'a \<times> 'b \<Rightarrow> 'a" where
 105.200 -  "fst p = (case p of (a, b) \<Rightarrow> a)"
 105.201 -
 105.202 -definition snd :: "'a \<times> 'b \<Rightarrow> 'b" where
 105.203 -  "snd p = (case p of (a, b) \<Rightarrow> b)"
 105.204 -
 105.205 -lemma fst_conv [simp, code]: "fst (a, b) = a"
 105.206 -  unfolding fst_def by simp
 105.207 -
 105.208 -lemma snd_conv [simp, code]: "snd (a, b) = b"
 105.209 -  unfolding snd_def by simp
 105.210 -
 105.211  code_printing
 105.212    constant fst \<rightharpoonup> (Haskell) "fst"
 105.213  | constant snd \<rightharpoonup> (Haskell) "snd"
 105.214  
 105.215 -lemma prod_case_unfold [nitpick_unfold]: "prod_case = (%c p. c (fst p) (snd p))"
 105.216 +lemma case_prod_unfold [nitpick_unfold]: "case_prod = (%c p. c (fst p) (snd p))"
 105.217    by (simp add: fun_eq_iff split: prod.split)
 105.218  
 105.219  lemma fst_eqD: "fst (x, y) = a ==> x = a"
 105.220 @@ -337,10 +388,7 @@
 105.221  lemma snd_eqD: "snd (x, y) = a ==> y = a"
 105.222    by simp
 105.223  
 105.224 -lemma pair_collapse [simp]: "(fst p, snd p) = p"
 105.225 -  by (cases p) simp
 105.226 -
 105.227 -lemmas surjective_pairing = pair_collapse [symmetric]
 105.228 +lemmas surjective_pairing = prod.collapse [symmetric]
 105.229  
 105.230  lemma prod_eq_iff: "s = t \<longleftrightarrow> fst s = fst t \<and> snd s = snd t"
 105.231    by (cases s, cases t) simp
 105.232 @@ -371,7 +419,7 @@
 105.233    by (cases p) simp
 105.234  
 105.235  lemma The_split: "The (split P) = (THE xy. P (fst xy) (snd xy))"
 105.236 -  by (simp add: prod_case_unfold)
 105.237 +  by (simp add: case_prod_unfold)
 105.238  
 105.239  lemma split_weak_cong: "p = q \<Longrightarrow> split c p = split c q"
 105.240    -- {* Prevents simplification of @{term c}: much faster *}
 105.241 @@ -463,7 +511,7 @@
 105.242      | no_args k i (Bound m) = m < k orelse m > k + i
 105.243      | no_args _ _ _ = true;
 105.244    fun split_pat tp i (Abs  (_, _, t)) = if tp 0 i t then SOME (i, t) else NONE
 105.245 -    | split_pat tp i (Const (@{const_name prod_case}, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
 105.246 +    | split_pat tp i (Const (@{const_name case_prod}, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
 105.247      | split_pat tp i _ = NONE;
 105.248    fun metaeq ctxt lhs rhs = mk_meta_eq (Goal.prove ctxt [] []
 105.249          (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)))
 105.250 @@ -481,12 +529,12 @@
 105.251          else (subst arg k i t $ subst arg k i u)
 105.252      | subst arg k i t = t;
 105.253  in
 105.254 -  fun beta_proc ctxt (s as Const (@{const_name prod_case}, _) $ Abs (_, _, t) $ arg) =
 105.255 +  fun beta_proc ctxt (s as Const (@{const_name case_prod}, _) $ Abs (_, _, t) $ arg) =
 105.256          (case split_pat beta_term_pat 1 t of
 105.257            SOME (i, f) => SOME (metaeq ctxt s (subst arg 0 i f))
 105.258          | NONE => NONE)
 105.259      | beta_proc _ _ = NONE;
 105.260 -  fun eta_proc ctxt (s as Const (@{const_name prod_case}, _) $ Abs (_, _, t)) =
 105.261 +  fun eta_proc ctxt (s as Const (@{const_name case_prod}, _) $ Abs (_, _, t)) =
 105.262          (case split_pat eta_term_pat 1 t of
 105.263            SOME (_, ft) => SOME (metaeq ctxt s (let val (f $ arg) = ft in f end))
 105.264          | NONE => NONE)
 105.265 @@ -563,14 +611,14 @@
 105.266    assumes major: "z \<in> split c p"
 105.267      and cases: "\<And>x y. p = (x, y) \<Longrightarrow> z \<in> c x y \<Longrightarrow> Q"
 105.268    shows Q
 105.269 -  by (rule major [unfolded prod_case_unfold] cases surjective_pairing)+
 105.270 +  by (rule major [unfolded case_prod_unfold] cases surjective_pairing)+
 105.271  
 105.272  declare mem_splitI2 [intro!] mem_splitI [intro!] splitI2' [intro!] splitI2 [intro!] splitI [intro!]
 105.273  declare mem_splitE [elim!] splitE' [elim!] splitE [elim!]
 105.274  
 105.275  ML {*
 105.276  local (* filtering with exists_p_split is an essential optimization *)
 105.277 -  fun exists_p_split (Const (@{const_name prod_case},_) $ _ $ (Const (@{const_name Pair},_)$_$_)) = true
 105.278 +  fun exists_p_split (Const (@{const_name case_prod},_) $ _ $ (Const (@{const_name Pair},_)$_$_)) = true
 105.279      | exists_p_split (t $ u) = exists_p_split t orelse exists_p_split u
 105.280      | exists_p_split (Abs (_, _, t)) = exists_p_split t
 105.281      | exists_p_split _ = false;
 105.282 @@ -630,24 +678,24 @@
 105.283    Setup of internal @{text split_rule}.
 105.284  *}
 105.285  
 105.286 -lemmas prod_caseI = prod.cases [THEN iffD2]
 105.287 +lemmas case_prodI = prod.cases [THEN iffD2]
 105.288  
 105.289 -lemma prod_caseI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> prod_case c p"
 105.290 +lemma case_prodI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> case_prod c p"
 105.291    by (fact splitI2)
 105.292  
 105.293 -lemma prod_caseI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> prod_case c p x"
 105.294 +lemma case_prodI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> case_prod c p x"
 105.295    by (fact splitI2')
 105.296  
 105.297 -lemma prod_caseE: "prod_case c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
 105.298 +lemma case_prodE: "case_prod c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
 105.299    by (fact splitE)
 105.300  
 105.301 -lemma prod_caseE': "prod_case c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
 105.302 +lemma case_prodE': "case_prod c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
 105.303    by (fact splitE')
 105.304  
 105.305 -declare prod_caseI [intro!]
 105.306 +declare case_prodI [intro!]
 105.307  
 105.308 -lemma prod_case_beta:
 105.309 -  "prod_case f p = f (fst p) (snd p)"
 105.310 +lemma case_prod_beta:
 105.311 +  "case_prod f p = f (fst p) (snd p)"
 105.312    by (fact split_beta)
 105.313  
 105.314  lemma prod_cases3 [cases type]:
 105.315 @@ -692,7 +740,7 @@
 105.316  
 105.317  lemma split_def:
 105.318    "split = (\<lambda>c p. c (fst p) (snd p))"
 105.319 -  by (fact prod_case_unfold)
 105.320 +  by (fact case_prod_unfold)
 105.321  
 105.322  definition internal_split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
 105.323    "internal_split == split"
 105.324 @@ -739,13 +787,13 @@
 105.325  notation fcomp (infixl "\<circ>>" 60)
 105.326  
 105.327  definition scomp :: "('a \<Rightarrow> 'b \<times> 'c) \<Rightarrow> ('b \<Rightarrow> 'c \<Rightarrow> 'd) \<Rightarrow> 'a \<Rightarrow> 'd" (infixl "\<circ>\<rightarrow>" 60) where
 105.328 -  "f \<circ>\<rightarrow> g = (\<lambda>x. prod_case g (f x))"
 105.329 +  "f \<circ>\<rightarrow> g = (\<lambda>x. case_prod g (f x))"
 105.330  
 105.331  lemma scomp_unfold: "scomp = (\<lambda>f g x. g (fst (f x)) (snd (f x)))"
 105.332 -  by (simp add: fun_eq_iff scomp_def prod_case_unfold)
 105.333 +  by (simp add: fun_eq_iff scomp_def case_prod_unfold)
 105.334  
 105.335 -lemma scomp_apply [simp]: "(f \<circ>\<rightarrow> g) x = prod_case g (f x)"
 105.336 -  by (simp add: scomp_unfold prod_case_unfold)
 105.337 +lemma scomp_apply [simp]: "(f \<circ>\<rightarrow> g) x = case_prod g (f x)"
 105.338 +  by (simp add: scomp_unfold case_prod_unfold)
 105.339  
 105.340  lemma Pair_scomp: "Pair x \<circ>\<rightarrow> f = f x"
 105.341    by (simp add: fun_eq_iff)
 105.342 @@ -1179,9 +1227,10 @@
 105.343    by (fact prod.exhaust)
 105.344  
 105.345  lemmas Pair_eq = prod.inject
 105.346 -
 105.347 -lemmas split = split_conv  -- {* for backwards compatibility *}
 105.348 -
 105.349 +lemmas fst_conv = prod.sel(1)
 105.350 +lemmas snd_conv = prod.sel(2)
 105.351 +lemmas pair_collapse = prod.collapse
 105.352 +lemmas split = split_conv
 105.353  lemmas Pair_fst_snd_eq = prod_eq_iff
 105.354  
 105.355  hide_const (open) prod
   106.1 --- a/src/HOL/Proofs/Lambda/LambdaType.thy	Wed Feb 12 09:06:04 2014 +0100
   106.2 +++ b/src/HOL/Proofs/Lambda/LambdaType.thy	Wed Feb 12 10:59:25 2014 +0100
   106.3 @@ -30,12 +30,7 @@
   106.4    by (simp add: shift_def)
   106.5  
   106.6  lemma shift_commute [simp]: "e\<langle>i:U\<rangle>\<langle>0:T\<rangle> = e\<langle>0:T\<rangle>\<langle>Suc i:U\<rangle>"
   106.7 -  apply (rule ext)
   106.8 -  apply (case_tac x)
   106.9 -   apply simp
  106.10 -  apply (case_tac nat)
  106.11 -   apply (simp_all add: shift_def)
  106.12 -  done
  106.13 +  by (rule ext) (simp_all add: shift_def split: nat.split)
  106.14  
  106.15  
  106.16  subsection {* Types and typing rules *}
  106.17 @@ -157,6 +152,7 @@
  106.18      "e \<turnstile> t \<degree>\<degree> ts : T \<Longrightarrow> \<exists>Ts. e \<turnstile> t : Ts \<Rrightarrow> T \<and> e \<tturnstile> ts : Ts"
  106.19    apply (induct ts arbitrary: t T)
  106.20     apply simp
  106.21 +  apply (rename_tac a b t T)
  106.22    apply atomize
  106.23    apply simp
  106.24    apply (erule_tac x = "t \<degree> a" in allE)
  106.25 @@ -177,12 +173,14 @@
  106.26      "e \<turnstile> t : Ts \<Rrightarrow> T \<Longrightarrow> e \<tturnstile> ts : Ts \<Longrightarrow> e \<turnstile> t \<degree>\<degree> ts : T"
  106.27    apply (induct ts arbitrary: t T Ts)
  106.28     apply simp
  106.29 +  apply (rename_tac a b t T Ts)
  106.30    apply atomize
  106.31    apply (case_tac Ts)
  106.32     apply simp
  106.33    apply simp
  106.34    apply (erule_tac x = "t \<degree> a" in allE)
  106.35    apply (erule_tac x = T in allE)
  106.36 +  apply (rename_tac list)
  106.37    apply (erule_tac x = list in allE)
  106.38    apply (erule impE)
  106.39     apply (erule conjE)
  106.40 @@ -225,6 +223,7 @@
  106.41    apply (erule var_app_type_eq)
  106.42    apply assumption
  106.43    apply simp
  106.44 +  apply (rename_tac a b ts Ts U)
  106.45    apply atomize
  106.46    apply (case_tac U)
  106.47    apply (rule FalseE)
   107.1 --- a/src/HOL/ROOT	Wed Feb 12 09:06:04 2014 +0100
   107.2 +++ b/src/HOL/ROOT	Wed Feb 12 10:59:25 2014 +0100
   107.3 @@ -464,7 +464,7 @@
   107.4      Author:     Tobias Nipkow and Konrad Slind and Olaf Müller
   107.5      Copyright   1994--1996  TU Muenchen
   107.6  
   107.7 -    The meta theory of I/O-Automata in HOL. This formalization has been
   107.8 +    The meta-theory of I/O-Automata in HOL. This formalization has been
   107.9      significantly changed and extended, see HOLCF/IOA. There are also the
  107.10      proofs of two communication protocols which formerly have been here.
  107.11  
   108.1 --- a/src/HOL/Relation.thy	Wed Feb 12 09:06:04 2014 +0100
   108.2 +++ b/src/HOL/Relation.thy	Wed Feb 12 10:59:25 2014 +0100
   108.3 @@ -54,7 +54,7 @@
   108.4  lemma lfp_induct2: -- {* Version of @{thm [source] lfp_induct} for binary relations *}
   108.5    "(a, b) \<in> lfp f \<Longrightarrow> mono f \<Longrightarrow>
   108.6      (\<And>a b. (a, b) \<in> f (lfp f \<inter> {(x, y). P x y}) \<Longrightarrow> P a b) \<Longrightarrow> P a b"
   108.7 -  using lfp_induct_set [of "(a, b)" f "prod_case P"] by auto
   108.8 +  using lfp_induct_set [of "(a, b)" f "case_prod P"] by auto
   108.9  
  108.10  
  108.11  subsubsection {* Conversions between set and predicate relations *}
  108.12 @@ -113,7 +113,7 @@
  108.13  lemma INF_Int_eq [pred_set_conv]: "(\<Sqinter>i\<in>S. (\<lambda>x. x \<in> i)) = (\<lambda>x. x \<in> \<Inter>S)"
  108.14    by (simp add: fun_eq_iff)
  108.15  
  108.16 -lemma Inf_INT_eq2 [pred_set_conv]: "\<Sqinter>S = (\<lambda>x y. (x, y) \<in> INTER (prod_case ` S) Collect)"
  108.17 +lemma Inf_INT_eq2 [pred_set_conv]: "\<Sqinter>S = (\<lambda>x y. (x, y) \<in> INTER (case_prod ` S) Collect)"
  108.18    by (simp add: fun_eq_iff)
  108.19  
  108.20  lemma INF_Int_eq2 [pred_set_conv]: "(\<Sqinter>i\<in>S. (\<lambda>x y. (x, y) \<in> i)) = (\<lambda>x y. (x, y) \<in> \<Inter>S)"
  108.21 @@ -125,7 +125,7 @@
  108.22  lemma SUP_Sup_eq [pred_set_conv]: "(\<Squnion>i\<in>S. (\<lambda>x. x \<in> i)) = (\<lambda>x. x \<in> \<Union>S)"
  108.23    by (simp add: fun_eq_iff)
  108.24  
  108.25 -lemma Sup_SUP_eq2 [pred_set_conv]: "\<Squnion>S = (\<lambda>x y. (x, y) \<in> UNION (prod_case ` S) Collect)"
  108.26 +lemma Sup_SUP_eq2 [pred_set_conv]: "\<Squnion>S = (\<lambda>x y. (x, y) \<in> UNION (case_prod ` S) Collect)"
  108.27    by (simp add: fun_eq_iff)
  108.28  
  108.29  lemma SUP_Sup_eq2 [pred_set_conv]: "(\<Squnion>i\<in>S. (\<lambda>x y. (x, y) \<in> i)) = (\<lambda>x y. (x, y) \<in> \<Union>S)"
   109.1 --- a/src/HOL/SET_Protocol/Cardholder_Registration.thy	Wed Feb 12 09:06:04 2014 +0100
   109.2 +++ b/src/HOL/SET_Protocol/Cardholder_Registration.thy	Wed Feb 12 10:59:25 2014 +0100
   109.3 @@ -671,6 +671,7 @@
   109.4  lemma N_fresh_not_KeyCryptNonce:
   109.5       "\<forall>C. DK \<noteq> priEK C ==> Nonce N \<notin> used evs --> ~ KeyCryptNonce DK N evs"
   109.6  apply (induct_tac "evs")
   109.7 +apply (rename_tac [2] a evs')
   109.8  apply (case_tac [2] "a")
   109.9  apply (auto simp add: parts_insert2)
  109.10  done
   110.1 --- a/src/HOL/SET_Protocol/Event_SET.thy	Wed Feb 12 09:06:04 2014 +0100
   110.2 +++ b/src/HOL/SET_Protocol/Event_SET.thy	Wed Feb 12 10:59:25 2014 +0100
   110.3 @@ -159,6 +159,7 @@
   110.4  lemma Notes_imp_parts_subset_used [rule_format]:
   110.5       "Notes A X \<in> set evs --> parts {X} <= used evs"
   110.6  apply (induct_tac "evs")
   110.7 +apply (rename_tac [2] a evs')
   110.8  apply (induct_tac [2] "a", auto)
   110.9  done
  110.10  
   111.1 --- a/src/HOL/SET_Protocol/Message_SET.thy	Wed Feb 12 09:06:04 2014 +0100
   111.2 +++ b/src/HOL/SET_Protocol/Message_SET.thy	Wed Feb 12 10:59:25 2014 +0100
   111.3 @@ -80,7 +80,7 @@
   111.4  
   111.5  
   111.6  definition nat_of_agent :: "agent => nat" where
   111.7 -   "nat_of_agent == agent_case (curry prod_encode 0)
   111.8 +   "nat_of_agent == case_agent (curry prod_encode 0)
   111.9                                 (curry prod_encode 1)
  111.10                                 (curry prod_encode 2)
  111.11                                 (curry prod_encode 3)
   112.1 --- a/src/HOL/SMT_Examples/SMT_Examples.certs	Wed Feb 12 09:06:04 2014 +0100
   112.2 +++ b/src/HOL/SMT_Examples/SMT_Examples.certs	Wed Feb 12 10:59:25 2014 +0100
   112.3 @@ -101,40 +101,6 @@
   112.4  #45 := [and-elim #44]: #11
   112.5  [mp #45 #65]: false
   112.6  unsat
   112.7 -050883983ebe99dc3b7f24a011b1724b1b2c4dd9 33 0
   112.8 -#2 := false
   112.9 -decl f1 :: S1
  112.10 -#3 := f1
  112.11 -decl f6 :: S1
  112.12 -#14 := f6
  112.13 -#15 := (= f6 f1)
  112.14 -decl f5 :: S1
  112.15 -#12 := f5
  112.16 -#13 := (= f5 f1)
  112.17 -#16 := (and #13 #15)
  112.18 -decl f4 :: S1
  112.19 -#9 := f4
  112.20 -#10 := (= f4 f1)
  112.21 -decl f3 :: S1
  112.22 -#7 := f3
  112.23 -#8 := (= f3 f1)
  112.24 -#11 := (and #8 #10)
  112.25 -#17 := (or #11 #16)
  112.26 -#18 := (implies #17 #17)
  112.27 -#19 := (not #18)
  112.28 -#48 := (iff #19 false)
  112.29 -#1 := true
  112.30 -#43 := (not true)
  112.31 -#46 := (iff #43 false)
  112.32 -#47 := [rewrite]: #46
  112.33 -#44 := (iff #19 #43)
  112.34 -#41 := (iff #18 true)
  112.35 -#42 := [rewrite]: #41
  112.36 -#45 := [monotonicity #42]: #44
  112.37 -#49 := [trans #45 #47]: #48
  112.38 -#40 := [asserted]: #19
  112.39 -[mp #40 #49]: false
  112.40 -unsat
  112.41  79d9d246dd9d27e03e8f1ea895e790f3a4420bfd 55 0
  112.42  #2 := false
  112.43  decl f1 :: S1
  112.44 @@ -191,6 +157,40 @@
  112.45  #42 := [asserted]: #21
  112.46  [mp #42 #72]: false
  112.47  unsat
  112.48 +050883983ebe99dc3b7f24a011b1724b1b2c4dd9 33 0
  112.49 +#2 := false
  112.50 +decl f1 :: S1
  112.51 +#3 := f1
  112.52 +decl f6 :: S1
  112.53 +#14 := f6
  112.54 +#15 := (= f6 f1)
  112.55 +decl f5 :: S1
  112.56 +#12 := f5
  112.57 +#13 := (= f5 f1)
  112.58 +#16 := (and #13 #15)
  112.59 +decl f4 :: S1
  112.60 +#9 := f4
  112.61 +#10 := (= f4 f1)
  112.62 +decl f3 :: S1
  112.63 +#7 := f3
  112.64 +#8 := (= f3 f1)
  112.65 +#11 := (and #8 #10)
  112.66 +#17 := (or #11 #16)
  112.67 +#18 := (implies #17 #17)
  112.68 +#19 := (not #18)
  112.69 +#48 := (iff #19 false)
  112.70 +#1 := true
  112.71 +#43 := (not true)
  112.72 +#46 := (iff #43 false)
  112.73 +#47 := [rewrite]: #46
  112.74 +#44 := (iff #19 #43)
  112.75 +#41 := (iff #18 true)
  112.76 +#42 := [rewrite]: #41
  112.77 +#45 := [monotonicity #42]: #44
  112.78 +#49 := [trans #45 #47]: #48
  112.79 +#40 := [asserted]: #19
  112.80 +[mp #40 #49]: false
  112.81 +unsat
  112.82  8575241c64c02491d277f6598ca57e576f5a6b45 60 0
  112.83  #2 := false
  112.84  decl f1 :: S1
  112.85 @@ -546,6 +546,124 @@
  112.86  #83 := [and-elim #82]: #57
  112.87  [unit-resolution #83 #90]: false
  112.88  unsat
  112.89 +a69a9e8c5e31ec6b9da4cf96f47b52cf6b9404d9 117 0
  112.90 +#2 := false
  112.91 +decl f3 :: (-> S3 S2 S1)
  112.92 +#10 := (:var 0 S2)
  112.93 +decl f4 :: (-> S4 S1 S3)
  112.94 +decl f6 :: S1
  112.95 +#16 := f6
  112.96 +decl f5 :: S4
  112.97 +#7 := f5
  112.98 +#17 := (f4 f5 f6)
  112.99 +#18 := (f3 #17 #10)
 112.100 +#573 := (pattern #18)
 112.101 +decl f1 :: S1
 112.102 +#3 := f1
 112.103 +#19 := (= #18 f1)
 112.104 +#76 := (not #19)
 112.105 +#574 := (forall (vars (?v0 S2)) (:pat #573) #76)
 112.106 +decl f7 :: S2
 112.107 +#21 := f7
 112.108 +#22 := (f3 #17 f7)
 112.109 +#23 := (= #22 f1)
 112.110 +#150 := (= f6 f1)
 112.111 +#151 := (iff #23 #150)
 112.112 +#8 := (:var 1 S1)
 112.113 +#9 := (f4 f5 #8)
 112.114 +#11 := (f3 #9 #10)
 112.115 +#566 := (pattern #11)
 112.116 +#13 := (= #8 f1)
 112.117 +#12 := (= #11 f1)
 112.118 +#14 := (iff #12 #13)
 112.119 +#567 := (forall (vars (?v0 S1) (?v1 S2)) (:pat #566) #14)
 112.120 +#15 := (forall (vars (?v0 S1) (?v1 S2)) #14)
 112.121 +#570 := (iff #15 #567)
 112.122 +#568 := (iff #14 #14)
 112.123 +#569 := [refl]: #568
 112.124 +#571 := [quant-intro #569]: #570
 112.125 +#62 := (~ #15 #15)
 112.126 +#60 := (~ #14 #14)
 112.127 +#61 := [refl]: #60
 112.128 +#63 := [nnf-pos #61]: #62
 112.129 +#46 := [asserted]: #15
 112.130 +#53 := [mp~ #46 #63]: #15
 112.131 +#572 := [mp #53 #571]: #567
 112.132 +#152 := (not #567)
 112.133 +#228 := (or #152 #151)
 112.134 +#561 := [quant-inst #16 #21]: #228
 112.135 +#237 := [unit-resolution #561 #572]: #151
 112.136 +decl ?v0!0 :: S2
 112.137 +#66 := ?v0!0
 112.138 +#67 := (f3 #17 ?v0!0)
 112.139 +#68 := (= #67 f1)
 112.140 +#236 := (iff #68 #150)
 112.141 +#238 := (or #152 #236)
 112.142 +#229 := [quant-inst #16 #66]: #238
 112.143 +#227 := [unit-resolution #229 #572]: #236
 112.144 +#240 := (not #236)
 112.145 +#199 := (or #240 #150)
 112.146 +#55 := (not #23)
 112.147 +#215 := [hypothesis]: #55
 112.148 +#83 := (or #68 #23)
 112.149 +#79 := (forall (vars (?v0 S2)) #76)
 112.150 +#82 := (or #79 #55)
 112.151 +#84 := (and #83 #82)
 112.152 +#20 := (exists (vars (?v0 S2)) #19)
 112.153 +#48 := (not #20)
 112.154 +#49 := (iff #48 #23)
 112.155 +#85 := (~ #49 #84)
 112.156 +#57 := (~ #23 #23)
 112.157 +#65 := [refl]: #57
 112.158 +#64 := (~ #55 #55)
 112.159 +#56 := [refl]: #64
 112.160 +#80 := (~ #48 #79)
 112.161 +#77 := (~ #76 #76)
 112.162 +#78 := [refl]: #77
 112.163 +#81 := [nnf-neg #78]: #80
 112.164 +#73 := (not #48)
 112.165 +#74 := (~ #73 #68)
 112.166 +#69 := (~ #20 #68)
 112.167 +#70 := [sk]: #69
 112.168 +#75 := [nnf-neg #70]: #74
 112.169 +#86 := [nnf-pos #75 #81 #56 #65]: #85
 112.170 +#24 := (iff #20 #23)
 112.171 +#25 := (not #24)
 112.172 +#50 := (iff #25 #49)
 112.173 +#51 := [rewrite]: #50
 112.174 +#47 := [asserted]: #25
 112.175 +#54 := [mp #47 #51]: #49
 112.176 +#87 := [mp~ #54 #86]: #84
 112.177 +#90 := [and-elim #87]: #83
 112.178 +#557 := [unit-resolution #90 #215]: #68
 112.179 +#243 := (not #68)
 112.180 +#222 := (or #240 #243 #150)
 112.181 +#558 := [def-axiom]: #222
 112.182 +#541 := [unit-resolution #558 #557]: #199
 112.183 +#203 := [unit-resolution #541 #227]: #150
 112.184 +#241 := (not #150)
 112.185 +#562 := (not #151)
 112.186 +#204 := (or #562 #241)
 112.187 +#563 := (or #562 #23 #241)
 112.188 +#564 := [def-axiom]: #563
 112.189 +#205 := [unit-resolution #564 #215]: #204
 112.190 +#206 := [unit-resolution #205 #203 #237]: false
 112.191 +#543 := [lemma #206]: #23
 112.192 +#579 := (or #574 #55)
 112.193 +#580 := (iff #82 #579)
 112.194 +#577 := (iff #79 #574)
 112.195 +#575 := (iff #76 #76)
 112.196 +#576 := [refl]: #575
 112.197 +#578 := [quant-intro #576]: #577
 112.198 +#581 := [monotonicity #578]: #580
 112.199 +#91 := [and-elim #87]: #82
 112.200 +#582 := [mp #91 #581]: #579
 112.201 +#242 := [unit-resolution #582 #543]: #574
 112.202 +#555 := (not #574)
 112.203 +#214 := (or #555 #55)
 112.204 +#219 := [quant-inst #21]: #214
 112.205 +[unit-resolution #219 #543 #242]: false
 112.206 +unsat
 112.207  d97439af6f5bc7794ab403d0f6cc318d103016a1 1288 0
 112.208  #2 := false
 112.209  decl f1 :: S1
 112.210 @@ -1835,124 +1953,6 @@
 112.211  #1532 := [unit-resolution #769 #1531]: #20
 112.212  [unit-resolution #606 #1532 #1528]: false
 112.213  unsat
 112.214 -a69a9e8c5e31ec6b9da4cf96f47b52cf6b9404d9 117 0
 112.215 -#2 := false
 112.216 -decl f3 :: (-> S3 S2 S1)
 112.217 -#10 := (:var 0 S2)
 112.218 -decl f4 :: (-> S4 S1 S3)
 112.219 -decl f6 :: S1
 112.220 -#16 := f6
 112.221 -decl f5 :: S4
 112.222 -#7 := f5
 112.223 -#17 := (f4 f5 f6)
 112.224 -#18 := (f3 #17 #10)
 112.225 -#573 := (pattern #18)
 112.226 -decl f1 :: S1
 112.227 -#3 := f1
 112.228 -#19 := (= #18 f1)
 112.229 -#76 := (not #19)
 112.230 -#574 := (forall (vars (?v0 S2)) (:pat #573) #76)
 112.231 -decl f7 :: S2
 112.232 -#21 := f7
 112.233 -#22 := (f3 #17 f7)
 112.234 -#23 := (= #22 f1)
 112.235 -#150 := (= f6 f1)
 112.236 -#151 := (iff #23 #150)
 112.237 -#8 := (:var 1 S1)
 112.238 -#9 := (f4 f5 #8)
 112.239 -#11 := (f3 #9 #10)
 112.240 -#566 := (pattern #11)
 112.241 -#13 := (= #8 f1)
 112.242 -#12 := (= #11 f1)
 112.243 -#14 := (iff #12 #13)
 112.244 -#567 := (forall (vars (?v0 S1) (?v1 S2)) (:pat #566) #14)
 112.245 -#15 := (forall (vars (?v0 S1) (?v1 S2)) #14)
 112.246 -#570 := (iff #15 #567)
 112.247 -#568 := (iff #14 #14)
 112.248 -#569 := [refl]: #568
 112.249 -#571 := [quant-intro #569]: #570
 112.250 -#62 := (~ #15 #15)
 112.251 -#60 := (~ #14 #14)
 112.252 -#61 := [refl]: #60
 112.253 -#63 := [nnf-pos #61]: #62
 112.254 -#46 := [asserted]: #15
 112.255 -#53 := [mp~ #46 #63]: #15
 112.256 -#572 := [mp #53 #571]: #567
 112.257 -#152 := (not #567)
 112.258 -#228 := (or #152 #151)
 112.259 -#561 := [quant-inst #16 #21]: #228
 112.260 -#237 := [unit-resolution #561 #572]: #151
 112.261 -decl ?v0!0 :: S2
 112.262 -#66 := ?v0!0
 112.263 -#67 := (f3 #17 ?v0!0)
 112.264 -#68 := (= #67 f1)
 112.265 -#236 := (iff #68 #150)
 112.266 -#238 := (or #152 #236)
 112.267 -#229 := [quant-inst #16 #66]: #238
 112.268 -#227 := [unit-resolution #229 #572]: #236
 112.269 -#240 := (not #236)
 112.270 -#199 := (or #240 #150)
 112.271 -#55 := (not #23)
 112.272 -#215 := [hypothesis]: #55
 112.273 -#83 := (or #68 #23)
 112.274 -#79 := (forall (vars (?v0 S2)) #76)
 112.275 -#82 := (or #79 #55)
 112.276 -#84 := (and #83 #82)
 112.277 -#20 := (exists (vars (?v0 S2)) #19)
 112.278 -#48 := (not #20)
 112.279 -#49 := (iff #48 #23)
 112.280 -#85 := (~ #49 #84)
 112.281 -#57 := (~ #23 #23)
 112.282 -#65 := [refl]: #57
 112.283 -#64 := (~ #55 #55)
 112.284 -#56 := [refl]: #64
 112.285 -#80 := (~ #48 #79)
 112.286 -#77 := (~ #76 #76)
 112.287 -#78 := [refl]: #77
 112.288 -#81 := [nnf-neg #78]: #80
 112.289 -#73 := (not #48)
 112.290 -#74 := (~ #73 #68)
 112.291 -#69 := (~ #20 #68)
 112.292 -#70 := [sk]: #69
 112.293 -#75 := [nnf-neg #70]: #74
 112.294 -#86 := [nnf-pos #75 #81 #56 #65]: #85
 112.295 -#24 := (iff #20 #23)
 112.296 -#25 := (not #24)
 112.297 -#50 := (iff #25 #49)
 112.298 -#51 := [rewrite]: #50
 112.299 -#47 := [asserted]: #25
 112.300 -#54 := [mp #47 #51]: #49
 112.301 -#87 := [mp~ #54 #86]: #84
 112.302 -#90 := [and-elim #87]: #83
 112.303 -#557 := [unit-resolution #90 #215]: #68
 112.304 -#243 := (not #68)
 112.305 -#222 := (or #240 #243 #150)
 112.306 -#558 := [def-axiom]: #222
 112.307 -#541 := [unit-resolution #558 #557]: #199
 112.308 -#203 := [unit-resolution #541 #227]: #150
 112.309 -#241 := (not #150)
 112.310 -#562 := (not #151)
 112.311 -#204 := (or #562 #241)
 112.312 -#563 := (or #562 #23 #241)
 112.313 -#564 := [def-axiom]: #563
 112.314 -#205 := [unit-resolution #564 #215]: #204
 112.315 -#206 := [unit-resolution #205 #203 #237]: false
 112.316 -#543 := [lemma #206]: #23
 112.317 -#579 := (or #574 #55)
 112.318 -#580 := (iff #82 #579)
 112.319 -#577 := (iff #79 #574)
 112.320 -#575 := (iff #76 #76)
 112.321 -#576 := [refl]: #575
 112.322 -#578 := [quant-intro #576]: #577
 112.323 -#581 := [monotonicity #578]: #580
 112.324 -#91 := [and-elim #87]: #82
 112.325 -#582 := [mp #91 #581]: #579
 112.326 -#242 := [unit-resolution #582 #543]: #574
 112.327 -#555 := (not #574)
 112.328 -#214 := (or #555 #55)
 112.329 -#219 := [quant-inst #21]: #214
 112.330 -[unit-resolution #219 #543 #242]: false
 112.331 -unsat
 112.332  fdf61e060f49731790f4d6c8f9b26c21349c60b3 117 0
 112.333  #2 := false
 112.334  decl f1 :: S1
 112.335 @@ -2071,24 +2071,6 @@
 112.336  #603 := [unit-resolution #271 #618]: #602
 112.337  [unit-resolution #603 #601 #297]: false
 112.338  unsat
 112.339 -0ce3a745d60cdbf0fe26b07c5e76de09d459dd25 17 0
 112.340 -#2 := false
 112.341 -#7 := 3::Int
 112.342 -#8 := (= 3::Int 3::Int)
 112.343 -#9 := (not #8)
 112.344 -#38 := (iff #9 false)
 112.345 -#1 := true
 112.346 -#33 := (not true)
 112.347 -#36 := (iff #33 false)
 112.348 -#37 := [rewrite]: #36
 112.349 -#34 := (iff #9 #33)
 112.350 -#31 := (iff #8 true)
 112.351 -#32 := [rewrite]: #31
 112.352 -#35 := [monotonicity #32]: #34
 112.353 -#39 := [trans #35 #37]: #38
 112.354 -#30 := [asserted]: #9
 112.355 -[mp #30 #39]: false
 112.356 -unsat
 112.357  5c792581e65682628e5c59ca9f3f8801e6aeba72 61 0
 112.358  #2 := false
 112.359  decl f1 :: S1
 112.360 @@ -2151,6 +2133,24 @@
 112.361  #136 := [quant-inst #7]: #221
 112.362  [unit-resolution #136 #556 #52]: false
 112.363  unsat
 112.364 +0ce3a745d60cdbf0fe26b07c5e76de09d459dd25 17 0
 112.365 +#2 := false
 112.366 +#7 := 3::Int
 112.367 +#8 := (= 3::Int 3::Int)
 112.368 +#9 := (not #8)
 112.369 +#38 := (iff #9 false)
 112.370 +#1 := true
 112.371 +#33 := (not true)
 112.372 +#36 := (iff #33 false)
 112.373 +#37 := [rewrite]: #36
 112.374 +#34 := (iff #9 #33)
 112.375 +#31 := (iff #8 true)
 112.376 +#32 := [rewrite]: #31
 112.377 +#35 := [monotonicity #32]: #34
 112.378 +#39 := [trans #35 #37]: #38
 112.379 +#30 := [asserted]: #9
 112.380 +[mp #30 #39]: false
 112.381 +unsat
 112.382  1532b1dde71eb42ca0a012bb62d9bbadf37fa326 17 0
 112.383  #2 := false
 112.384  #7 := 3::Real
 112.385 @@ -7256,9 +7256,9 @@
 112.386  unsat
 112.387  c4f4c8220660d1979009b33a643f0927bee816b1 1 0
 112.388  unsat
 112.389 -db6426d59fdd57da8ca5d11de399761d1f1443de 1 0
 112.390 +e7ef76d73ccb9bc09d2b5368495a7a59d1bae3dc 1 0
 112.391  unsat
 112.392 -e7ef76d73ccb9bc09d2b5368495a7a59d1bae3dc 1 0
 112.393 +db6426d59fdd57da8ca5d11de399761d1f1443de 1 0
 112.394  unsat
 112.395  a2da5fa16f268876e3dcbc1874e34212d0a36218 54 0
 112.396  #2 := false
 112.397 @@ -7799,6 +7799,70 @@
 112.398  #63 := [mp~ #61 #70]: #56
 112.399  [unit-resolution #63 #529]: false
 112.400  unsat
 112.401 +f6f0c702e5caae5d1fc0a3e7862c44d261de6d47 63 0
 112.402 +#2 := false
 112.403 +#15 := 1::Int
 112.404 +#12 := (:var 1 Int)
 112.405 +#10 := 6::Int
 112.406 +#11 := (- 6::Int)
 112.407 +#13 := (* #11 #12)
 112.408 +#8 := (:var 2 Int)
 112.409 +#7 := 4::Int
 112.410 +#9 := (* 4::Int #8)
 112.411 +#14 := (+ #9 #13)
 112.412 +#16 := (= #14 1::Int)
 112.413 +#17 := (exists (vars (?v0 Int) (?v1 Int) (?v2 Int)) #16)
 112.414 +#18 := (not #17)
 112.415 +#19 := (not #18)
 112.416 +#86 := (iff #19 false)
 112.417 +#56 := (:var 0 Int)
 112.418 +#41 := -6::Int
 112.419 +#58 := (* -6::Int #56)
 112.420 +#57 := (* 4::Int #12)
 112.421 +#59 := (+ #57 #58)
 112.422 +#60 := (= #59 1::Int)
 112.423 +#61 := (exists (vars (?v0 Int) (?v1 Int)) #60)
 112.424 +#84 := (iff #61 false)
 112.425 +#77 := (exists (vars (?v0 Int) (?v1 Int)) false)
 112.426 +#82 := (iff #77 false)
 112.427 +#83 := [elim-unused]: #82
 112.428 +#80 := (iff #61 #77)
 112.429 +#78 := (iff #60 false)
 112.430 +#79 := [rewrite]: #78
 112.431 +#81 := [quant-intro #79]: #80
 112.432 +#85 := [trans #81 #83]: #84
 112.433 +#74 := (iff #19 #61)
 112.434 +#66 := (not #61)
 112.435 +#69 := (not #66)
 112.436 +#72 := (iff #69 #61)
 112.437 +#73 := [rewrite]: #72
 112.438 +#70 := (iff #19 #69)
 112.439 +#67 := (iff #18 #66)
 112.440 +#64 := (iff #17 #61)
 112.441 +#44 := (* -6::Int #12)
 112.442 +#47 := (+ #9 #44)
 112.443 +#50 := (= #47 1::Int)
 112.444 +#53 := (exists (vars (?v0 Int) (?v1 Int) (?v2 Int)) #50)
 112.445 +#62 := (iff #53 #61)
 112.446 +#63 := [elim-unused]: #62
 112.447 +#54 := (iff #17 #53)
 112.448 +#51 := (iff #16 #50)
 112.449 +#48 := (= #14 #47)
 112.450 +#45 := (= #13 #44)
 112.451 +#42 := (= #11 -6::Int)
 112.452 +#43 := [rewrite]: #42
 112.453 +#46 := [monotonicity #43]: #45
 112.454 +#49 := [monotonicity #46]: #48
 112.455 +#52 := [monotonicity #49]: #51
 112.456 +#55 := [quant-intro #52]: #54
 112.457 +#65 := [trans #55 #63]: #64
 112.458 +#68 := [monotonicity #65]: #67
 112.459 +#71 := [monotonicity #68]: #70
 112.460 +#75 := [trans #71 #73]: #74
 112.461 +#87 := [trans #75 #85]: #86
 112.462 +#40 := [asserted]: #19
 112.463 +[mp #40 #87]: false
 112.464 +unsat
 112.465  252d255c564463d916bc68156eea8dbe7fb0be0a 165 0
 112.466  WARNING: failed to find a pattern for quantifier (quantifier id: k!10)
 112.467  #2 := false
 112.468 @@ -7965,70 +8029,6 @@
 112.469  #563 := [unit-resolution #136 #574]: #62
 112.470  [unit-resolution #563 #570]: false
 112.471  unsat
 112.472 -f6f0c702e5caae5d1fc0a3e7862c44d261de6d47 63 0
 112.473 -#2 := false
 112.474 -#15 := 1::Int
 112.475 -#12 := (:var 1 Int)
 112.476 -#10 := 6::Int
 112.477 -#11 := (- 6::Int)
 112.478 -#13 := (* #11 #12)
 112.479 -#8 := (:var 2 Int)
 112.480 -#7 := 4::Int
 112.481 -#9 := (* 4::Int #8)
 112.482 -#14 := (+ #9 #13)
 112.483 -#16 := (= #14 1::Int)
 112.484 -#17 := (exists (vars (?v0 Int) (?v1 Int) (?v2 Int)) #16)
 112.485 -#18 := (not #17)
 112.486 -#19 := (not #18)
 112.487 -#86 := (iff #19 false)
 112.488 -#56 := (:var 0 Int)
 112.489 -#41 := -6::Int
 112.490 -#58 := (* -6::Int #56)
 112.491 -#57 := (* 4::Int #12)
 112.492 -#59 := (+ #57 #58)
 112.493 -#60 := (= #59 1::Int)
 112.494 -#61 := (exists (vars (?v0 Int) (?v1 Int)) #60)
 112.495 -#84 := (iff #61 false)
 112.496 -#77 := (exists (vars (?v0 Int) (?v1 Int)) false)
 112.497 -#82 := (iff #77 false)
 112.498 -#83 := [elim-unused]: #82
 112.499 -#80 := (iff #61 #77)
 112.500 -#78 := (iff #60 false)
 112.501 -#79 := [rewrite]: #78
 112.502 -#81 := [quant-intro #79]: #80
 112.503 -#85 := [trans #81 #83]: #84
 112.504 -#74 := (iff #19 #61)
 112.505 -#66 := (not #61)
 112.506 -#69 := (not #66)
 112.507 -#72 := (iff #69 #61)
 112.508 -#73 := [rewrite]: #72
 112.509 -#70 := (iff #19 #69)
 112.510 -#67 := (iff #18 #66)
 112.511 -#64 := (iff #17 #61)
 112.512 -#44 := (* -6::Int #12)
 112.513 -#47 := (+ #9 #44)
 112.514 -#50 := (= #47 1::Int)
 112.515 -#53 := (exists (vars (?v0 Int) (?v1 Int) (?v2 Int)) #50)
 112.516 -#62 := (iff #53 #61)
 112.517 -#63 := [elim-unused]: #62
 112.518 -#54 := (iff #17 #53)
 112.519 -#51 := (iff #16 #50)
 112.520 -#48 := (= #14 #47)
 112.521 -#45 := (= #13 #44)
 112.522 -#42 := (= #11 -6::Int)
 112.523 -#43 := [rewrite]: #42
 112.524 -#46 := [monotonicity #43]: #45
 112.525 -#49 := [monotonicity #46]: #48
 112.526 -#52 := [monotonicity #49]: #51
 112.527 -#55 := [quant-intro #52]: #54
 112.528 -#65 := [trans #55 #63]: #64
 112.529 -#68 := [monotonicity #65]: #67
 112.530 -#71 := [monotonicity #68]: #70
 112.531 -#75 := [trans #71 #73]: #74
 112.532 -#87 := [trans #75 #85]: #86
 112.533 -#40 := [asserted]: #19
 112.534 -[mp #40 #87]: false
 112.535 -unsat
 112.536  302156fb98e1f9b5657a3c89c418d5e1813f274a 101 0
 112.537  #2 := false
 112.538  #7 := 0::Int
 112.539 @@ -10281,33 +10281,33 @@
 112.540  #55 := [not-or-elim #54]: #53
 112.541  [unit-resolution #55 #214]: false
 112.542  unsat
 112.543 -22f5a208d6aa87f9794b1ab4d7ebb0a58f9ec89d 106 0
 112.544 +86345bce2206ce27e174d4b1d6d3e0182564f8a1 106 0
 112.545  #2 := false
 112.546 -decl f11 :: (-> S9 S7 S2)
 112.547 -decl f16 :: S7
 112.548 +decl f11 :: (-> S9 S5 S3)
 112.549 +decl f16 :: S5
 112.550  #34 := f16
 112.551  decl f12 :: S9
 112.552  #25 := f12
 112.553  #39 := (f11 f12 f16)
 112.554 -decl f3 :: (-> S4 S5 S2)
 112.555 -decl f13 :: S5
 112.556 +decl f6 :: (-> S6 S7 S3)
 112.557 +decl f13 :: S7
 112.558  #29 := f13
 112.559 -decl f4 :: S4
 112.560 -#7 := f4
 112.561 -#38 := (f3 f4 f13)
 112.562 +decl f7 :: S6
 112.563 +#14 := f7
 112.564 +#38 := (f6 f7 f13)
 112.565  #40 := (= #38 #39)
 112.566 -decl f8 :: (-> S3 S2 S7)
 112.567 -decl f14 :: S2
 112.568 +decl f5 :: (-> S2 S3 S5)
 112.569 +decl f14 :: S3
 112.570  #30 := f14
 112.571 -decl f15 :: S3
 112.572 +decl f15 :: S2
 112.573  #31 := f15
 112.574 -#35 := (f8 f15 f14)
 112.575 -#236 := (f11 f12 #35)
 112.576 -#233 := (= #236 #39)
 112.577 -#573 := (= #39 #236)
 112.578 +#35 := (f5 f15 f14)
 112.579 +#165 := (f11 f12 #35)
 112.580 +#233 := (= #165 #39)
 112.581 +#573 := (= #39 #165)
 112.582  #36 := (= f16 #35)
 112.583 -decl f5 :: (-> S2 S3 S5)
 112.584 -#32 := (f5 f14 f15)
 112.585 +decl f8 :: (-> S3 S2 S7)
 112.586 +#32 := (f8 f14 f15)
 112.587  #33 := (= f13 #32)
 112.588  #37 := (and #33 #36)
 112.589  #68 := (not #37)
 112.590 @@ -10325,17 +10325,17 @@
 112.591  #78 := [and-elim #75]: #36
 112.592  #579 := [monotonicity #78]: #573
 112.593  #570 := [symm #579]: #233
 112.594 -#213 := (= #38 #236)
 112.595 -#569 := (= f14 #236)
 112.596 -#572 := (= #236 f14)
 112.597 -#16 := (:var 0 S2)
 112.598 -#15 := (:var 1 S3)
 112.599 -#17 := (f8 #15 #16)
 112.600 -#587 := (pattern #17)
 112.601 -#26 := (f11 f12 #17)
 112.602 -#27 := (= #26 #16)
 112.603 -#600 := (forall (vars (?v0 S3) (?v1 S2)) (:pat #587) #27)
 112.604 -#28 := (forall (vars (?v0 S3) (?v1 S2)) #27)
 112.605 +#213 := (= #38 #165)
 112.606 +#569 := (= f14 #165)
 112.607 +#251 := (= #165 f14)
 112.608 +#9 := (:var 0 S3)
 112.609 +#8 := (:var 1 S2)
 112.610 +#10 := (f5 #8 #9)
 112.611 +#580 := (pattern #10)
 112.612 +#26 := (f11 f12 #10)
 112.613 +#27 := (= #26 #9)
 112.614 +#600 := (forall (vars (?v0 S2) (?v1 S3)) (:pat #580) #27)
 112.615 +#28 := (forall (vars (?v0 S2) (?v1 S3)) #27)
 112.616  #603 := (iff #28 #600)
 112.617  #601 := (iff #27 #27)
 112.618  #602 := [refl]: #601
 112.619 @@ -10347,38 +10347,38 @@
 112.620  #66 := [asserted]: #28
 112.621  #109 := [mp~ #66 #89]: #28
 112.622  #605 := [mp #109 #604]: #600
 112.623 -#242 := (not #600)
 112.624 -#575 := (or #242 #572)
 112.625 -#576 := [quant-inst #31 #30]: #575
 112.626 -#568 := [unit-resolution #576 #605]: #572
 112.627 +#256 := (not #600)
 112.628 +#253 := (or #256 #251)
 112.629 +#257 := [quant-inst #31 #30]: #253
 112.630 +#568 := [unit-resolution #257 #605]: #251
 112.631  #228 := [symm #568]: #569
 112.632  #229 := (= #38 f14)
 112.633 -#164 := (f3 f4 #32)
 112.634 -#250 := (= #164 f14)
 112.635 -#9 := (:var 0 S3)
 112.636 -#8 := (:var 1 S2)
 112.637 -#10 := (f5 #8 #9)
 112.638 -#580 := (pattern #10)
 112.639 -#11 := (f3 f4 #10)
 112.640 -#12 := (= #11 #8)
 112.641 -#581 := (forall (vars (?v0 S2) (?v1 S3)) (:pat #580) #12)
 112.642 -#13 := (forall (vars (?v0 S2) (?v1 S3)) #12)
 112.643 -#584 := (iff #13 #581)
 112.644 -#582 := (iff #12 #12)
 112.645 -#583 := [refl]: #582
 112.646 -#585 := [quant-intro #583]: #584
 112.647 -#100 := (~ #13 #13)
 112.648 -#98 := (~ #12 #12)
 112.649 -#99 := [refl]: #98
 112.650 -#101 := [nnf-pos #99]: #100
 112.651 -#63 := [asserted]: #13
 112.652 -#82 := [mp~ #63 #101]: #13
 112.653 -#586 := [mp #82 #585]: #581
 112.654 -#166 := (not #581)
 112.655 -#252 := (or #166 #250)
 112.656 -#243 := [quant-inst #30 #31]: #252
 112.657 -#241 := [unit-resolution #243 #586]: #250
 112.658 -#577 := (= #38 #164)
 112.659 +#254 := (f6 f7 #32)
 112.660 +#255 := (= #254 f14)
 112.661 +#16 := (:var 0 S2)
 112.662 +#15 := (:var 1 S3)
 112.663 +#17 := (f8 #15 #16)
 112.664 +#587 := (pattern #17)
 112.665 +#18 := (f6 f7 #17)
 112.666 +#19 := (= #18 #15)
 112.667 +#588 := (forall (vars (?v0 S3) (?v1 S2)) (:pat #587) #19)
 112.668 +#20 := (forall (vars (?v0 S3) (?v1 S2)) #19)
 112.669 +#591 := (iff #20 #588)
 112.670 +#589 := (iff #19 #19)
 112.671 +#590 := [refl]: #589
 112.672 +#592 := [quant-intro #590]: #591
 112.673 +#84 := (~ #20 #20)
 112.674 +#83 := (~ #19 #19)
 112.675 +#102 := [refl]: #83
 112.676 +#85 := [nnf-pos #102]: #84
 112.677 +#64 := [asserted]: #20
 112.678 +#103 := [mp~ #64 #85]: #20
 112.679 +#593 := [mp #103 #592]: #588
 112.680 +#574 := (not #588)
 112.681 +#230 := (or #574 #255)
 112.682 +#361 := [quant-inst #30 #31]: #230
 112.683 +#241 := [unit-resolution #361 #593]: #255
 112.684 +#577 := (= #38 #254)
 112.685  #76 := [and-elim #75]: #33
 112.686  #578 := [monotonicity #76]: #577
 112.687  #571 := [trans #578 #241]: #229
   113.1 --- a/src/HOL/SMT_Examples/SMT_Tests.thy	Wed Feb 12 09:06:04 2014 +0100
   113.2 +++ b/src/HOL/SMT_Examples/SMT_Tests.thy	Wed Feb 12 10:59:25 2014 +0100
   113.3 @@ -669,13 +669,13 @@
   113.4    "tl [x, y, z] = [y, z]"
   113.5    "hd (tl [x, y, z]) = y"
   113.6    "tl (tl [x, y, z]) = [z]"
   113.7 -  using hd.simps tl.simps(2) list.simps
   113.8 +  using list.sel(1,3) list.simps
   113.9    by smt+
  113.10  
  113.11  lemma
  113.12    "fst (hd [(a, b)]) = a"
  113.13    "snd (hd [(a, b)]) = b"
  113.14 -  using fst_conv snd_conv pair_collapse hd.simps tl.simps(2) list.simps
  113.15 +  using fst_conv snd_conv pair_collapse list.sel(1,3) list.simps
  113.16    by smt+
  113.17  
  113.18  
  113.19 @@ -808,14 +808,14 @@
  113.20    "tl [x, y, z] = [y, z]"
  113.21    "hd (tl [x, y, z]) = y"
  113.22    "tl (tl [x, y, z]) = [z]"
  113.23 -  using hd.simps tl.simps(2)
  113.24 +  using list.sel(1,3)
  113.25    using [[smt_datatypes, smt_oracle, z3_with_extensions]]
  113.26    by smt+
  113.27  
  113.28  lemma
  113.29    "fst (hd [(a, b)]) = a"
  113.30    "snd (hd [(a, b)]) = b"
  113.31 -  using fst_conv snd_conv pair_collapse hd.simps tl.simps(2)
  113.32 +  using fst_conv snd_conv pair_collapse list.sel(1,3)
  113.33    using [[smt_datatypes, smt_oracle, z3_with_extensions]]
  113.34    by smt+
  113.35  
   114.1 --- a/src/HOL/String.thy	Wed Feb 12 09:06:04 2014 +0100
   114.2 +++ b/src/HOL/String.thy	Wed Feb 12 10:59:25 2014 +0100
   114.3 @@ -286,13 +286,13 @@
   114.4  
   114.5  code_datatype Char -- {* drop case certificate for char *}
   114.6  
   114.7 -lemma char_case_code [code]:
   114.8 -  "char_case f c = (let n = nat_of_char c in f (nibble_of_nat (n div 16)) (nibble_of_nat n))"
   114.9 +lemma case_char_code [code]:
  114.10 +  "case_char f c = (let n = nat_of_char c in f (nibble_of_nat (n div 16)) (nibble_of_nat n))"
  114.11    by (cases c)
  114.12      (simp only: Let_def nibble_of_nat_of_char_div_16 nibble_of_nat_nat_of_char char.cases)
  114.13  
  114.14  lemma [code]:
  114.15 -  "char_rec = char_case"
  114.16 +  "rec_char = case_char"
  114.17    by (simp add: fun_eq_iff split: char.split)
  114.18  
  114.19  definition char_of_nat :: "nat \<Rightarrow> char" where
   115.1 --- a/src/HOL/Sum_Type.thy	Wed Feb 12 09:06:04 2014 +0100
   115.2 +++ b/src/HOL/Sum_Type.thy	Wed Feb 12 10:59:25 2014 +0100
   115.3 @@ -85,6 +85,12 @@
   115.4    with assms show P by (auto simp add: sum_def Inl_def Inr_def)
   115.5  qed
   115.6  
   115.7 +wrap_free_constructors [Inl, Inr] case_sum [isl] [[projl], [projr]]
   115.8 +by (erule sumE, assumption) (auto dest: Inl_inject Inr_inject simp add: Inl_not_Inr)
   115.9 +
  115.10 +-- {* Avoid name clashes by prefixing the output of @{text rep_datatype} with @{text old}. *}
  115.11 +setup {* Sign.mandatory_path "old" *}
  115.12 +
  115.13  rep_datatype Inl Inr
  115.14  proof -
  115.15    fix P
  115.16 @@ -93,6 +99,23 @@
  115.17    then show "P s" by (auto intro: sumE [of s])
  115.18  qed (auto dest: Inl_inject Inr_inject simp add: Inl_not_Inr)
  115.19  
  115.20 +setup {* Sign.parent_path *}
  115.21 +
  115.22 +-- {* But erase the prefix for properties that are not generated by @{text wrap_free_constructors}. *}
  115.23 +setup {* Sign.mandatory_path "sum" *}
  115.24 +
  115.25 +declare
  115.26 +  old.sum.inject[iff del]
  115.27 +  old.sum.distinct(1)[simp del, induct_simp del]
  115.28 +
  115.29 +lemmas induct = old.sum.induct
  115.30 +lemmas inducts = old.sum.inducts
  115.31 +lemmas recs = old.sum.recs
  115.32 +lemmas cases = sum.case
  115.33 +lemmas simps = sum.inject sum.distinct sum.case old.sum.recs
  115.34 +
  115.35 +setup {* Sign.parent_path *}
  115.36 +
  115.37  primrec sum_map :: "('a \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'd) \<Rightarrow> 'a + 'b \<Rightarrow> 'c + 'd" where
  115.38    "sum_map f1 f2 (Inl a) = Inl (f1 a)"
  115.39  | "sum_map f1 f2 (Inr a) = Inr (f2 a)"
  115.40 @@ -123,44 +146,33 @@
  115.41  
  115.42  subsection {* Projections *}
  115.43  
  115.44 -lemma sum_case_KK [simp]: "sum_case (\<lambda>x. a) (\<lambda>x. a) = (\<lambda>x. a)"
  115.45 +lemma case_sum_KK [simp]: "case_sum (\<lambda>x. a) (\<lambda>x. a) = (\<lambda>x. a)"
  115.46    by (rule ext) (simp split: sum.split)
  115.47  
  115.48 -lemma surjective_sum: "sum_case (\<lambda>x::'a. f (Inl x)) (\<lambda>y::'b. f (Inr y)) = f"
  115.49 +lemma surjective_sum: "case_sum (\<lambda>x::'a. f (Inl x)) (\<lambda>y::'b. f (Inr y)) = f"
  115.50  proof
  115.51    fix s :: "'a + 'b"
  115.52    show "(case s of Inl (x\<Colon>'a) \<Rightarrow> f (Inl x) | Inr (y\<Colon>'b) \<Rightarrow> f (Inr y)) = f s"
  115.53      by (cases s) simp_all
  115.54  qed
  115.55  
  115.56 -lemma sum_case_inject:
  115.57 -  assumes a: "sum_case f1 f2 = sum_case g1 g2"
  115.58 +lemma case_sum_inject:
  115.59 +  assumes a: "case_sum f1 f2 = case_sum g1 g2"
  115.60    assumes r: "f1 = g1 \<Longrightarrow> f2 = g2 \<Longrightarrow> P"
  115.61    shows P
  115.62  proof (rule r)
  115.63    show "f1 = g1" proof
  115.64      fix x :: 'a
  115.65 -    from a have "sum_case f1 f2 (Inl x) = sum_case g1 g2 (Inl x)" by simp
  115.66 +    from a have "case_sum f1 f2 (Inl x) = case_sum g1 g2 (Inl x)" by simp
  115.67      then show "f1 x = g1 x" by simp
  115.68    qed
  115.69    show "f2 = g2" proof
  115.70      fix y :: 'b
  115.71 -    from a have "sum_case f1 f2 (Inr y) = sum_case g1 g2 (Inr y)" by simp
  115.72 +    from a have "case_sum f1 f2 (Inr y) = case_sum g1 g2 (Inr y)" by simp
  115.73      then show "f2 y = g2 y" by simp
  115.74    qed
  115.75  qed
  115.76  
  115.77 -lemma sum_case_weak_cong:
  115.78 -  "s = t \<Longrightarrow> sum_case f g s = sum_case f g t"
  115.79 -  -- {* Prevents simplification of @{text f} and @{text g}: much faster. *}
  115.80 -  by simp
  115.81 -
  115.82 -primrec Projl :: "'a + 'b \<Rightarrow> 'a" where
  115.83 -  Projl_Inl: "Projl (Inl x) = x"
  115.84 -
  115.85 -primrec Projr :: "'a + 'b \<Rightarrow> 'b" where
  115.86 -  Projr_Inr: "Projr (Inr x) = x"
  115.87 -
  115.88  primrec Suml :: "('a \<Rightarrow> 'c) \<Rightarrow> 'a + 'b \<Rightarrow> 'c" where
  115.89    "Suml f (Inl x) = f x"
  115.90  
  115.91 @@ -224,9 +236,6 @@
  115.92    } then show ?thesis by auto
  115.93  qed
  115.94  
  115.95 -hide_const (open) Suml Sumr Projl Projr
  115.96 -
  115.97 -hide_const (open) sum
  115.98 +hide_const (open) Suml Sumr sum
  115.99  
 115.100  end
 115.101 -
   116.1 --- a/src/HOL/Tools/BNF/bnf_def.ML	Wed Feb 12 09:06:04 2014 +0100
   116.2 +++ b/src/HOL/Tools/BNF/bnf_def.ML	Wed Feb 12 10:59:25 2014 +0100
   116.3 @@ -12,7 +12,6 @@
   116.4    type nonemptiness_witness = {I: int list, wit: term, prop: thm list}
   116.5  
   116.6    val morph_bnf: morphism -> bnf -> bnf
   116.7 -  val eq_bnf: bnf * bnf -> bool
   116.8    val bnf_of: Proof.context -> string -> bnf option
   116.9    val register_bnf: string -> (bnf * local_theory) -> (bnf * local_theory)
  116.10  
  116.11 @@ -452,16 +451,12 @@
  116.12      wits = List.map (morph_witness phi) wits,
  116.13      rel = Morphism.term phi rel};
  116.14  
  116.15 -fun eq_bnf (BNF {T = T1, live = live1, dead = dead1, ...},
  116.16 -  BNF {T = T2, live = live2, dead = dead2, ...}) =
  116.17 -  Type.could_unify (T1, T2) andalso live1 = live2 andalso dead1 = dead2;
  116.18 -
  116.19  structure Data = Generic_Data
  116.20  (
  116.21    type T = bnf Symtab.table;
  116.22    val empty = Symtab.empty;
  116.23    val extend = I;
  116.24 -  val merge = Symtab.merge eq_bnf;
  116.25 +  fun merge data : T = Symtab.merge (K true) data;
  116.26  );
  116.27  
  116.28  fun bnf_of ctxt =
   117.1 --- a/src/HOL/Tools/BNF/bnf_def_tactics.ML	Wed Feb 12 09:06:04 2014 +0100
   117.2 +++ b/src/HOL/Tools/BNF/bnf_def_tactics.ML	Wed Feb 12 10:59:25 2014 +0100
   117.3 @@ -265,7 +265,7 @@
   117.4            rtac (thm RS ord_eq_le_trans) THEN' etac @{thm subset_trans[OF image_mono Un_upper1]})
   117.5          set_maps,
   117.6          rtac sym,
   117.7 -        rtac (box_equals OF [map_cong0 OF replicate live @{thm fun_cong[OF sum_case_o_inj(1)]},
   117.8 +        rtac (box_equals OF [map_cong0 OF replicate live @{thm fun_cong[OF case_sum_o_inj(1)]},
   117.9             map_comp RS sym, map_id])] 1
  117.10    end;
  117.11  
   118.1 --- a/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML	Wed Feb 12 09:06:04 2014 +0100
   118.2 +++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML	Wed Feb 12 10:59:25 2014 +0100
   118.3 @@ -20,12 +20,12 @@
   118.4       co_iterss: term list list,
   118.5       mapss: thm list list,
   118.6       co_inducts: thm list,
   118.7 +     co_inductss: thm list list,
   118.8       co_iter_thmsss: thm list list list,
   118.9       disc_co_itersss: thm list list list,
  118.10       sel_co_iterssss: thm list list list list};
  118.11  
  118.12    val of_fp_sugar: (fp_sugar -> 'a list) -> fp_sugar -> 'a
  118.13 -  val eq_fp_sugar: fp_sugar * fp_sugar -> bool
  118.14    val morph_fp_sugar: morphism -> fp_sugar -> fp_sugar
  118.15    val transfer_fp_sugar: Proof.context -> fp_sugar -> fp_sugar
  118.16    val fp_sugar_of: Proof.context -> string -> fp_sugar option
  118.17 @@ -95,7 +95,7 @@
  118.18    val co_datatypes: BNF_FP_Util.fp_kind -> (mixfix list -> binding list -> binding list ->
  118.19        binding list list -> binding list -> (string * sort) list -> typ list * typ list list ->
  118.20        BNF_Def.bnf list -> local_theory -> BNF_FP_Util.fp_result * local_theory) ->
  118.21 -    (bool * (bool * bool)) * (((((binding * (typ * sort)) list * binding) * (binding * binding))
  118.22 +    (bool * bool) * (((((binding * (typ * sort)) list * binding) * (binding * binding))
  118.23        * mixfix) * ((((binding * binding) * (binding * typ) list) * (binding * term) list) *
  118.24          mixfix) list) list ->
  118.25      local_theory -> local_theory
  118.26 @@ -130,19 +130,16 @@
  118.27     co_iterss: term list list,
  118.28     mapss: thm list list,
  118.29     co_inducts: thm list,
  118.30 +   co_inductss: thm list list,
  118.31     co_iter_thmsss: thm list list list,
  118.32     disc_co_itersss: thm list list list,
  118.33     sel_co_iterssss: thm list list list list};
  118.34  
  118.35  fun of_fp_sugar f (fp_sugar as ({index, ...}: fp_sugar)) = nth (f fp_sugar) index;
  118.36  
  118.37 -fun eq_fp_sugar ({T = T1, fp = fp1, index = index1, fp_res = fp_res1, ...} : fp_sugar,
  118.38 -    {T = T2, fp = fp2, index = index2, fp_res = fp_res2, ...} : fp_sugar) =
  118.39 -  T1 = T2 andalso fp1 = fp2 andalso index1 = index2 andalso eq_fp_result (fp_res1, fp_res2);
  118.40 -
  118.41  fun morph_fp_sugar phi ({T, fp, index, pre_bnfs, nested_bnfs, nesting_bnfs, fp_res, ctr_defss,
  118.42 -    ctr_sugars, co_iterss, mapss, co_inducts, co_iter_thmsss, disc_co_itersss, sel_co_iterssss}
  118.43 -    : fp_sugar) =
  118.44 +    ctr_sugars, co_iterss, mapss, co_inducts, co_inductss, co_iter_thmsss, disc_co_itersss,
  118.45 +    sel_co_iterssss} : fp_sugar) =
  118.46    {T = Morphism.typ phi T, fp = fp, index = index, pre_bnfs = map (morph_bnf phi) pre_bnfs,
  118.47      nested_bnfs = map (morph_bnf phi) nested_bnfs, nesting_bnfs = map (morph_bnf phi) nesting_bnfs,
  118.48     fp_res = morph_fp_result phi fp_res,
  118.49 @@ -151,6 +148,7 @@
  118.50     co_iterss = map (map (Morphism.term phi)) co_iterss,
  118.51     mapss = map (map (Morphism.thm phi)) mapss,
  118.52     co_inducts = map (Morphism.thm phi) co_inducts,
  118.53 +   co_inductss = map (map (Morphism.thm phi)) co_inductss,
  118.54     co_iter_thmsss = map (map (map (Morphism.thm phi))) co_iter_thmsss,
  118.55     disc_co_itersss = map (map (map (Morphism.thm phi))) disc_co_itersss,
  118.56     sel_co_iterssss = map (map (map (map (Morphism.thm phi)))) sel_co_iterssss};
  118.57 @@ -163,7 +161,7 @@
  118.58    type T = fp_sugar Symtab.table;
  118.59    val empty = Symtab.empty;
  118.60    val extend = I;
  118.61 -  val merge = Symtab.merge eq_fp_sugar;
  118.62 +  fun merge data : T = Symtab.merge (K true) data;
  118.63  );
  118.64  
  118.65  fun fp_sugar_of ctxt =
  118.66 @@ -183,14 +181,15 @@
  118.67      (fn phi => Data.map (Symtab.default (key, morph_fp_sugar phi fp_sugar)));
  118.68  
  118.69  fun register_fp_sugars fp pre_bnfs nested_bnfs nesting_bnfs (fp_res as {Ts, ...}) ctr_defss
  118.70 -    ctr_sugars co_iterss mapss co_inducts co_iter_thmsss disc_co_itersss sel_co_iterssss lthy =
  118.71 +    ctr_sugars co_iterss mapss co_inducts co_inductss co_iter_thmsss disc_co_itersss
  118.72 +    sel_co_iterssss lthy =
  118.73    (0, lthy)
  118.74    |> fold (fn T as Type (s, _) => fn (kk, lthy) => (kk + 1,
  118.75      register_fp_sugar s {T = T, fp = fp, index = kk, pre_bnfs = pre_bnfs, nested_bnfs = nested_bnfs,
  118.76          nesting_bnfs = nesting_bnfs, fp_res = fp_res, ctr_defss = ctr_defss,
  118.77          ctr_sugars = ctr_sugars, co_iterss = co_iterss, mapss = mapss, co_inducts = co_inducts,
  118.78 -        co_iter_thmsss = co_iter_thmsss, disc_co_itersss = disc_co_itersss,
  118.79 -        sel_co_iterssss = sel_co_iterssss}
  118.80 +        co_inductss = co_inductss, co_iter_thmsss = co_iter_thmsss,
  118.81 +        disc_co_itersss = disc_co_itersss, sel_co_iterssss = sel_co_iterssss}
  118.82        lthy)) Ts
  118.83    |> snd;
  118.84  
  118.85 @@ -211,6 +210,7 @@
  118.86  val id_def = @{thm id_def};
  118.87  val mp_conj = @{thm mp_conj};
  118.88  
  118.89 +val fundefcong_attrs = @{attributes [fundef_cong]};
  118.90  val nitpicksimp_attrs = @{attributes [nitpick_simp]};
  118.91  val code_nitpicksimp_attrs = Code.add_default_eqn_attrib :: nitpicksimp_attrs;
  118.92  val simp_attrs = @{attributes [simp]};
  118.93 @@ -225,9 +225,7 @@
  118.94  fun flat_rec_arg_args xss =
  118.95    (* FIXME (once the old datatype package is phased out): The first line below gives the preferred
  118.96       order. The second line is for compatibility with the old datatype package. *)
  118.97 -(*
  118.98 -  flat xss
  118.99 -*)
 118.100 +  (* flat xss *)
 118.101    map hd xss @ maps tl xss;
 118.102  
 118.103  fun flat_corec_predss_getterss qss fss = maps (op @) (qss ~~ fss);
 118.104 @@ -543,7 +541,7 @@
 118.105      fun generate_iter pre (_, _, fss, xssss) ctor_iter =
 118.106        (mk_binding pre,
 118.107         fold_rev (fold_rev Term.lambda) fss (Term.list_comb (ctor_iter,
 118.108 -         map2 (mk_sum_caseN_balanced oo map2 mk_uncurried2_fun) fss xssss)));
 118.109 +         map2 (mk_case_sumN_balanced oo map2 mk_uncurried2_fun) fss xssss)));
 118.110    in
 118.111      define_co_iters Least_FP fpT Cs (map3 generate_iter iterNs iter_args_typess' ctor_iters) lthy
 118.112    end;
 118.113 @@ -670,7 +668,10 @@
 118.114              mk_induct_tac ctxt nn ns mss kksss (flat ctr_defss) ctor_induct' nested_set_maps
 118.115                pre_set_defss)
 118.116            |> singleton (Proof_Context.export names_lthy lthy)
 118.117 -          |> Thm.close_derivation;
 118.118 +          (* for "datatype_realizer.ML": *)
 118.119 +          |> Thm.name_derivation (fst (dest_Type (hd fpTs)) ^ Long_Name.separator ^
 118.120 +            (if nn > 1 then space_implode "_" (tl fp_b_names) ^ Long_Name.separator else "") ^
 118.121 +            inductN);
 118.122        in
 118.123          `(conj_dests nn) thm
 118.124        end;
 118.125 @@ -866,7 +867,7 @@
 118.126  
 118.127          fun tack z_name (c, u) f =
 118.128            let val z = Free (z_name, mk_sumT (fastype_of u, fastype_of c)) in
 118.129 -            Term.lambda z (mk_sum_case (Term.lambda u u, Term.lambda c (f $ c)) $ z)
 118.130 +            Term.lambda z (mk_case_sum (Term.lambda u u, Term.lambda c (f $ c)) $ z)
 118.131            end;
 118.132  
 118.133          fun build_coiter fcoiters maybe_mk_sumT maybe_tack cqf =
 118.134 @@ -901,7 +902,7 @@
 118.135          val unfold_thmss = map2 (map2 prove) unfold_goalss unfold_tacss;
 118.136          val corec_thmss =
 118.137            map2 (map2 prove) corec_goalss corec_tacss
 118.138 -          |> map (map (unfold_thms lthy @{thms sum_case_if}));
 118.139 +          |> map (map (unfold_thms lthy @{thms case_sum_if}));
 118.140        in
 118.141          (unfold_thmss, corec_thmss)
 118.142        end;
 118.143 @@ -977,7 +978,7 @@
 118.144    end;
 118.145  
 118.146  fun define_co_datatypes prepare_constraint prepare_typ prepare_term fp construct_fp
 118.147 -    (wrap_opts as (no_discs_sels, (_, rep_compat)), specs) no_defs_lthy0 =
 118.148 +    (wrap_opts as (no_discs_sels, _), specs) no_defs_lthy0 =
 118.149    let
 118.150      (* TODO: sanity checks on arguments *)
 118.151  
 118.152 @@ -986,9 +987,6 @@
 118.153        else
 118.154          ();
 118.155  
 118.156 -    fun qualify mandatory fp_b_name =
 118.157 -      Binding.qualify mandatory fp_b_name o (rep_compat ? Binding.qualify false rep_compat_prefix);
 118.158 -
 118.159      val nn = length specs;
 118.160      val fp_bs = map type_binding_of specs;
 118.161      val fp_b_names = map Binding.name_of fp_bs;
 118.162 @@ -1040,7 +1038,7 @@
 118.163  
 118.164      val disc_bindingss = map (map disc_of) ctr_specss;
 118.165      val ctr_bindingss =
 118.166 -      map2 (fn fp_b_name => map (qualify false fp_b_name o ctr_of)) fp_b_names ctr_specss;
 118.167 +      map2 (fn fp_b_name => map (Binding.qualify false fp_b_name o ctr_of)) fp_b_names ctr_specss;
 118.168      val ctr_argsss = map (map args_of) ctr_specss;
 118.169      val ctr_mixfixess = map (map ctr_mixfix_of) ctr_specss;
 118.170  
 118.171 @@ -1149,12 +1147,12 @@
 118.172      fun massage_simple_notes base =
 118.173        filter_out (null o #2)
 118.174        #> map (fn (thmN, thms, attrs) =>
 118.175 -        ((qualify true base (Binding.name thmN), attrs), [(thms, [])]));
 118.176 +        ((Binding.qualify true base (Binding.name thmN), attrs), [(thms, [])]));
 118.177  
 118.178      val massage_multi_notes =
 118.179        maps (fn (thmN, thmss, attrs) =>
 118.180          map3 (fn fp_b_name => fn Type (T_name, _) => fn thms =>
 118.181 -            ((qualify true fp_b_name (Binding.name thmN), attrs T_name), [(thms, [])]))
 118.182 +            ((Binding.qualify true fp_b_name (Binding.name thmN), attrs T_name), [(thms, [])]))
 118.183            fp_b_names fpTs thmss)
 118.184        #> filter_out (null o fst o hd o snd);
 118.185  
 118.186 @@ -1224,8 +1222,8 @@
 118.187                      Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, ...} =>
 118.188                        mk_ctor_iff_dtor_tac ctxt (map (SOME o certifyT lthy) [dtorT, fpT])
 118.189                          (certify lthy ctor) (certify lthy dtor) ctor_dtor dtor_ctor)
 118.190 +                    |> Morphism.thm phi
 118.191                      |> Thm.close_derivation
 118.192 -                    |> Morphism.thm phi
 118.193                    end;
 118.194  
 118.195                  val sumEN_thm' =
 118.196 @@ -1253,7 +1251,7 @@
 118.197                (sel_bindingss, sel_defaultss))) lthy
 118.198            end;
 118.199  
 118.200 -        fun derive_maps_sets_rels (ctr_sugar, lthy) =
 118.201 +        fun derive_maps_sets_rels (ctr_sugar as {case_cong, ...} : ctr_sugar, lthy) =
 118.202            if live = 0 then
 118.203              ((([], [], [], []), ctr_sugar), lthy)
 118.204            else
 118.205 @@ -1327,7 +1325,8 @@
 118.206                  join_halves n half_rel_distinct_thmss other_half_rel_distinct_thmss;
 118.207  
 118.208                val anonymous_notes =
 118.209 -                [(map (fn th => th RS @{thm eq_False[THEN iffD2]}) rel_distinct_thms,
 118.210 +                [([case_cong], fundefcong_attrs),
 118.211 +                 (map (fn th => th RS @{thm eq_False[THEN iffD2]}) rel_distinct_thms,
 118.212                    code_nitpicksimp_attrs),
 118.213                   (map2 (fn th => fn 0 => th RS @{thm eq_True[THEN iffD2]} | _ => th)
 118.214                      rel_inject_thms ms, code_nitpicksimp_attrs)]
 118.215 @@ -1344,7 +1343,7 @@
 118.216                 lthy |> Local_Theory.notes (anonymous_notes @ notes) |> snd)
 118.217              end;
 118.218  
 118.219 -        fun mk_binding pre = qualify false fp_b_name (Binding.prefix_name (pre ^ "_") fp_b);
 118.220 +        fun mk_binding pre = Binding.qualify false fp_b_name (Binding.prefix_name (pre ^ "_") fp_b);
 118.221  
 118.222          fun massage_res (((maps_sets_rels, ctr_sugar), co_iter_res), lthy) =
 118.223            (((maps_sets_rels, (ctrs, xss, ctr_defs, ctr_sugar)), co_iter_res), lthy);
 118.224 @@ -1396,7 +1395,8 @@
 118.225          lthy
 118.226          |> Local_Theory.notes (common_notes @ notes) |> snd
 118.227          |> register_fp_sugars Least_FP pre_bnfs nested_bnfs nesting_bnfs fp_res ctr_defss ctr_sugars
 118.228 -          iterss mapss [induct_thm] (transpose [fold_thmss, rec_thmss]) [] []
 118.229 +          iterss mapss [induct_thm] (transpose [induct_thms]) (transpose [fold_thmss, rec_thmss])
 118.230 +          [] []
 118.231        end;
 118.232  
 118.233      fun derive_note_coinduct_coiters_thms_for_types
 118.234 @@ -1454,6 +1454,7 @@
 118.235          |> Local_Theory.notes (common_notes @ notes) |> snd
 118.236          |> register_fp_sugars Greatest_FP pre_bnfs nested_bnfs nesting_bnfs fp_res ctr_defss
 118.237            ctr_sugars coiterss mapss [coinduct_thm, strong_coinduct_thm]
 118.238 +          (transpose [coinduct_thms, strong_coinduct_thms])
 118.239            (transpose [unfold_thmss, corec_thmss]) (transpose [disc_unfold_thmss, disc_corec_thmss])
 118.240            (transpose [sel_unfold_thmsss, sel_corec_thmsss])
 118.241        end;
   119.1 --- a/src/HOL/Tools/BNF/bnf_fp_def_sugar_tactics.ML	Wed Feb 12 09:06:04 2014 +0100
   119.2 +++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar_tactics.ML	Wed Feb 12 10:59:25 2014 +0100
   119.3 @@ -84,8 +84,8 @@
   119.4    unfold_thms_tac ctxt @{thms sum.inject Pair_eq conj_assoc} THEN HEADGOAL (rtac refl);
   119.5  
   119.6  val iter_unfold_thms =
   119.7 -  @{thms comp_def convol_def fst_conv id_def prod_case_Pair_iden snd_conv
   119.8 -      split_conv unit_case_Unity} @ sum_prod_thms_map;
   119.9 +  @{thms comp_def convol_def fst_conv id_def case_prod_Pair_iden snd_conv split_conv
  119.10 +      case_unit_Unity} @ sum_prod_thms_map;
  119.11  
  119.12  fun mk_iter_tac pre_map_defs map_idents iter_defs ctor_iter ctr_def ctxt =
  119.13    unfold_thms_tac ctxt (ctr_def :: ctor_iter :: iter_defs @ pre_map_defs @ map_idents @
   120.1 --- a/src/HOL/Tools/BNF/bnf_fp_n2m.ML	Wed Feb 12 09:06:04 2014 +0100
   120.2 +++ b/src/HOL/Tools/BNF/bnf_fp_n2m.ML	Wed Feb 12 10:59:25 2014 +0100
   120.3 @@ -69,7 +69,7 @@
   120.4      val dest_co_algT = co_swap o dest_funT;
   120.5      val co_alg_argT = fp_case fp range_type domain_type;
   120.6      val co_alg_funT = fp_case fp domain_type range_type;
   120.7 -    val mk_co_product = curry (fp_case fp mk_convol mk_sum_case);
   120.8 +    val mk_co_product = curry (fp_case fp mk_convol mk_case_sum);
   120.9      val mk_map_co_product = fp_case fp mk_prod_map mk_sum_map;
  120.10      val co_proj1_const = fp_case fp (fst_const o fst) (uncurry Inl_const o dest_sumT o snd);
  120.11      val mk_co_productT = curry (fp_case fp HOLogic.mk_prodT mk_sumT);
  120.12 @@ -97,12 +97,12 @@
  120.13      val pre_bnfss = map #pre_bnfs fp_sugars;
  120.14      val nesty_bnfss = map (fn sugar => #nested_bnfs sugar @ #nesting_bnfs sugar) fp_sugars;
  120.15      val fp_nesty_bnfss = fp_bnfs :: nesty_bnfss;
  120.16 -    val fp_nesty_bnfs = distinct eq_bnf (flat fp_nesty_bnfss);
  120.17 +    val fp_nesty_bnfs = distinct (op = o pairself T_of_bnf) (flat fp_nesty_bnfss);
  120.18  
  120.19      val rels =
  120.20        let
  120.21          fun find_rel T As Bs = fp_nesty_bnfss
  120.22 -          |> map (filter_out (curry eq_bnf BNF_Comp.DEADID_bnf))
  120.23 +          |> map (filter_out (curry (op = o pairself name_of_bnf) BNF_Comp.DEADID_bnf))
  120.24            |> get_first (find_first (fn bnf => Type.could_unify (T_of_bnf bnf, T)))
  120.25            |> Option.map (fn bnf =>
  120.26              let val live = live_of_bnf bnf;
  120.27 @@ -336,7 +336,7 @@
  120.28            o_apply comp_id id_comp map_pair.comp map_pair.id sum_map.comp sum_map.id};
  120.29          val rec_thms = fold_thms @ fp_case fp
  120.30            @{thms fst_convol map_pair_o_convol convol_o}
  120.31 -          @{thms sum_case_o_inj(1) sum_case_o_sum_map o_sum_case};
  120.32 +          @{thms case_sum_o_inj(1) case_sum_o_sum_map o_case_sum};
  120.33          val map_thms = no_refl (maps (fn bnf =>
  120.34            [map_comp0_of_bnf bnf RS sym, map_id0_of_bnf bnf]) fp_nesty_bnfs);
  120.35  
   121.1 --- a/src/HOL/Tools/BNF/bnf_fp_n2m_sugar.ML	Wed Feb 12 09:06:04 2014 +0100
   121.2 +++ b/src/HOL/Tools/BNF/bnf_fp_n2m_sugar.ML	Wed Feb 12 10:59:25 2014 +0100
   121.3 @@ -43,7 +43,7 @@
   121.4    type T = n2m_sugar Typtab.table;
   121.5    val empty = Typtab.empty;
   121.6    val extend = I;
   121.7 -  fun merge data : T = Typtab.merge (eq_fst (eq_list eq_fp_sugar)) data;
   121.8 +  fun merge data : T = Typtab.merge (K true) data;
   121.9  );
  121.10  
  121.11  fun morph_n2m_sugar phi (fp_sugars, (lfp_sugar_thms_opt, gfp_sugar_thms_opt)) =
  121.12 @@ -64,7 +64,7 @@
  121.13  
  121.14  fun unfold_lets_splits (Const (@{const_name Let}, _) $ arg1 $ arg2) =
  121.15      unfold_lets_splits (betapply (arg2, arg1))
  121.16 -  | unfold_lets_splits (t as Const (@{const_name prod_case}, _) $ u) =
  121.17 +  | unfold_lets_splits (t as Const (@{const_name case_prod}, _) $ u) =
  121.18      (case unfold_lets_splits u of
  121.19        u' as Abs (s1, T1, Abs (s2, T2, _)) =>
  121.20        let val v = Var ((s1 ^ s2, Term.maxidx_of_term u' + 1), HOLogic.mk_prodT (T1, T2)) in
  121.21 @@ -212,14 +212,14 @@
  121.22                (mk_binding b) fpTs Cs) fp_bs xtor_co_iterss lthy
  121.23            |>> split_list;
  121.24  
  121.25 -        val ((co_inducts, un_fold_thmss, co_rec_thmss, disc_unfold_thmss, disc_corec_thmss,
  121.26 -              sel_unfold_thmsss, sel_corec_thmsss), fp_sugar_thms) =
  121.27 +        val ((co_inducts, co_inductss, un_fold_thmss, co_rec_thmss, disc_unfold_thmss,
  121.28 +              disc_corec_thmss, sel_unfold_thmsss, sel_corec_thmsss), fp_sugar_thms) =
  121.29            if fp = Least_FP then
  121.30              derive_induct_iters_thms_for_types pre_bnfs (the iters_args_types) xtor_co_induct
  121.31                xtor_co_iter_thmss nesting_bnfs nested_bnfs fpTs Cs Xs ctrXs_Tsss ctrss ctr_defss
  121.32                co_iterss co_iter_defss lthy
  121.33 -            |> `(fn ((_, induct, _), (fold_thmss, rec_thmss, _)) =>
  121.34 -              ([induct], fold_thmss, rec_thmss, [], [], [], []))
  121.35 +            |> `(fn ((inducts, induct, _), (fold_thmss, rec_thmss, _)) =>
  121.36 +              ([induct], [inducts], fold_thmss, rec_thmss, [], [], [], []))
  121.37              ||> (fn info => (SOME info, NONE))
  121.38            else
  121.39              derive_coinduct_coiters_thms_for_types pre_bnfs (the coiters_args_types) xtor_co_induct
  121.40 @@ -229,8 +229,8 @@
  121.41              |> `(fn ((coinduct_thms_pairs, _), (unfold_thmss, corec_thmss, _),
  121.42                      (disc_unfold_thmss, disc_corec_thmss, _), _,
  121.43                      (sel_unfold_thmsss, sel_corec_thmsss, _)) =>
  121.44 -              (map snd coinduct_thms_pairs, unfold_thmss, corec_thmss, disc_unfold_thmss,
  121.45 -               disc_corec_thmss, sel_unfold_thmsss, sel_corec_thmsss))
  121.46 +              (map snd coinduct_thms_pairs, map fst coinduct_thms_pairs, unfold_thmss, corec_thmss,
  121.47 +               disc_unfold_thmss, disc_corec_thmss, sel_unfold_thmsss, sel_corec_thmsss))
  121.48              ||> (fn info => (NONE, SOME info));
  121.49  
  121.50          val phi = Proof_Context.export_morphism no_defs_lthy no_defs_lthy0;
  121.51 @@ -239,6 +239,7 @@
  121.52            {T = T, fp = fp, index = kk, pre_bnfs = pre_bnfs, nested_bnfs = nested_bnfs,
  121.53             nesting_bnfs = nesting_bnfs, fp_res = fp_res, ctr_defss = ctr_defss,
  121.54             ctr_sugars = ctr_sugars, co_iterss = co_iterss, mapss = mapss, co_inducts = co_inducts,
  121.55 +           co_inductss = transpose co_inductss,
  121.56             co_iter_thmsss = transpose [un_fold_thmss, co_rec_thmss],
  121.57             disc_co_itersss = transpose [disc_unfold_thmss, disc_corec_thmss],
  121.58             sel_co_iterssss = transpose [sel_unfold_thmsss, sel_corec_thmsss]}
   122.1 --- a/src/HOL/Tools/BNF/bnf_fp_util.ML	Wed Feb 12 09:06:04 2014 +0100
   122.2 +++ b/src/HOL/Tools/BNF/bnf_fp_util.ML	Wed Feb 12 10:59:25 2014 +0100
   122.3 @@ -30,7 +30,6 @@
   122.4       rel_xtor_co_induct_thm: thm}
   122.5  
   122.6    val morph_fp_result: morphism -> fp_result -> fp_result
   122.7 -  val eq_fp_result: fp_result * fp_result -> bool
   122.8    val un_fold_of: 'a list -> 'a
   122.9    val co_rec_of: 'a list -> 'a
  122.10  
  122.11 @@ -145,13 +144,13 @@
  122.12    val Inl_const: typ -> typ -> term
  122.13    val Inr_const: typ -> typ -> term
  122.14  
  122.15 +  val mk_case_sum: term * term -> term
  122.16 +  val mk_case_sumN: term list -> term
  122.17 +  val mk_case_sumN_balanced: term list -> term
  122.18    val mk_Inl: typ -> term -> term
  122.19    val mk_Inr: typ -> term -> term
  122.20    val mk_InN: typ list -> term -> int -> term
  122.21    val mk_InN_balanced: typ -> int -> term -> int -> term
  122.22 -  val mk_sum_case: term * term -> term
  122.23 -  val mk_sum_caseN: term list -> term
  122.24 -  val mk_sum_caseN_balanced: term list -> term
  122.25  
  122.26    val dest_sumT: typ -> typ * typ
  122.27    val dest_sumTN: int -> typ -> typ list
  122.28 @@ -167,8 +166,8 @@
  122.29    val mk_sumEN: int -> thm
  122.30    val mk_sumEN_balanced: int -> thm
  122.31    val mk_sumEN_tupled_balanced: int list -> thm
  122.32 -  val mk_sum_casesN: int -> int -> thm
  122.33 -  val mk_sum_casesN_balanced: int -> int -> thm
  122.34 +  val mk_sum_caseN: int -> int -> thm
  122.35 +  val mk_sum_caseN_balanced: int -> int -> thm
  122.36  
  122.37    val fixpoint: ('a * 'a -> bool) -> ('a list -> 'a list) -> 'a list -> 'a list
  122.38  
  122.39 @@ -239,9 +238,6 @@
  122.40     xtor_co_iter_o_map_thmss = map (map (Morphism.thm phi)) xtor_co_iter_o_map_thmss,
  122.41     rel_xtor_co_induct_thm = Morphism.thm phi rel_xtor_co_induct_thm};
  122.42  
  122.43 -fun eq_fp_result ({bnfs = bnfs1, ...} : fp_result, {bnfs = bnfs2, ...} : fp_result) =
  122.44 -  eq_list eq_bnf (bnfs1, bnfs2);
  122.45 -
  122.46  fun un_fold_of [f, _] = f;
  122.47  fun co_rec_of [_, r] = r;
  122.48  
  122.49 @@ -413,17 +409,17 @@
  122.50      |> repair_types sum_T
  122.51    end;
  122.52  
  122.53 -fun mk_sum_case (f, g) =
  122.54 +fun mk_case_sum (f, g) =
  122.55    let
  122.56      val fT = fastype_of f;
  122.57      val gT = fastype_of g;
  122.58    in
  122.59 -    Const (@{const_name sum_case},
  122.60 +    Const (@{const_name case_sum},
  122.61        fT --> gT --> mk_sumT (domain_type fT, domain_type gT) --> range_type fT) $ f $ g
  122.62    end;
  122.63  
  122.64 -val mk_sum_caseN = Library.foldr1 mk_sum_case;
  122.65 -val mk_sum_caseN_balanced = Balanced_Tree.make mk_sum_case;
  122.66 +val mk_case_sumN = Library.foldr1 mk_case_sum;
  122.67 +val mk_case_sumN_balanced = Balanced_Tree.make mk_case_sum;
  122.68  
  122.69  fun If_const T = Const (@{const_name If}, HOLogic.boolT --> T --> T --> T);
  122.70  fun mk_If p t f = let val T = fastype_of t in If_const T $ p $ t $ f end;
  122.71 @@ -474,18 +470,18 @@
  122.72      else mk_sumEN_balanced' n (map mk_tupled_allIN ms)
  122.73    end;
  122.74  
  122.75 -fun mk_sum_casesN 1 1 = refl
  122.76 -  | mk_sum_casesN _ 1 = @{thm sum.cases(1)}
  122.77 -  | mk_sum_casesN 2 2 = @{thm sum.cases(2)}
  122.78 -  | mk_sum_casesN n k = trans OF [@{thm sum_case_step(2)}, mk_sum_casesN (n - 1) (k - 1)];
  122.79 +fun mk_sum_caseN 1 1 = refl
  122.80 +  | mk_sum_caseN _ 1 = @{thm sum.case(1)}
  122.81 +  | mk_sum_caseN 2 2 = @{thm sum.case(2)}
  122.82 +  | mk_sum_caseN n k = trans OF [@{thm case_sum_step(2)}, mk_sum_caseN (n - 1) (k - 1)];
  122.83  
  122.84  fun mk_sum_step base step thm =
  122.85    if Thm.eq_thm_prop (thm, refl) then base else trans OF [step, thm];
  122.86  
  122.87 -fun mk_sum_casesN_balanced 1 1 = refl
  122.88 -  | mk_sum_casesN_balanced n k =
  122.89 -    Balanced_Tree.access {left = mk_sum_step @{thm sum.cases(1)} @{thm sum_case_step(1)},
  122.90 -      right = mk_sum_step @{thm sum.cases(2)} @{thm sum_case_step(2)}, init = refl} n k;
  122.91 +fun mk_sum_caseN_balanced 1 1 = refl
  122.92 +  | mk_sum_caseN_balanced n k =
  122.93 +    Balanced_Tree.access {left = mk_sum_step @{thm sum.cases(1)} @{thm case_sum_step(1)},
  122.94 +      right = mk_sum_step @{thm sum.cases(2)} @{thm case_sum_step(2)}, init = refl} n k;
  122.95  
  122.96  fun mk_rel_xtor_co_induct_thm fp pre_rels pre_phis rels phis xs ys xtors xtor's tac lthy =
  122.97    let
  122.98 @@ -536,11 +532,11 @@
  122.99      val rewrite_comp_comp = fp_case fp @{thm rewriteR_comp_comp} @{thm rewriteL_comp_comp};
 122.100      val map_cong_passive_args1 = replicate m (fp_case fp @{thm id_comp} @{thm comp_id} RS fun_cong);
 122.101      val map_cong_active_args1 = replicate n (if is_rec
 122.102 -      then fp_case fp @{thm convol_o} @{thm o_sum_case} RS fun_cong
 122.103 +      then fp_case fp @{thm convol_o} @{thm o_case_sum} RS fun_cong
 122.104        else refl);
 122.105      val map_cong_passive_args2 = replicate m (fp_case fp @{thm comp_id} @{thm id_comp} RS fun_cong);
 122.106      val map_cong_active_args2 = replicate n (if is_rec
 122.107 -      then fp_case fp @{thm map_pair_o_convol_id} @{thm sum_case_o_sum_map_id}
 122.108 +      then fp_case fp @{thm map_pair_o_convol_id} @{thm case_sum_o_sum_map_id}
 122.109        else fp_case fp @{thm id_comp} @{thm comp_id} RS fun_cong);
 122.110      fun mk_map_congs passive active = map (fn thm => thm OF (passive @ active) RS ext) map_cong0s;
 122.111      val map_cong1s = mk_map_congs map_cong_passive_args1 map_cong_active_args1;
   123.1 --- a/src/HOL/Tools/BNF/bnf_gfp.ML	Wed Feb 12 09:06:04 2014 +0100
   123.2 +++ b/src/HOL/Tools/BNF/bnf_gfp.ML	Wed Feb 12 10:59:25 2014 +0100
   123.3 @@ -493,16 +493,16 @@
   123.4          |> Thm.close_derivation
   123.5        end;
   123.6  
   123.7 -    val mor_sum_case_thm =
   123.8 +    val mor_case_sum_thm =
   123.9        let
  123.10          val maps = map3 (fn s => fn sum_s => fn mapx =>
  123.11 -          mk_sum_case (HOLogic.mk_comp (Term.list_comb (mapx, passive_ids @ Inls), s), sum_s))
  123.12 +          mk_case_sum (HOLogic.mk_comp (Term.list_comb (mapx, passive_ids @ Inls), s), sum_s))
  123.13            s's sum_ss map_Inls;
  123.14        in
  123.15          Goal.prove_sorry lthy [] []
  123.16            (fold_rev Logic.all (s's @ sum_ss) (HOLogic.mk_Trueprop
  123.17              (mk_mor (map HOLogic.mk_UNIV activeBs) s's sum_UNIVs maps Inls)))
  123.18 -          (K (mk_mor_sum_case_tac ks mor_UNIV_thm))
  123.19 +          (K (mk_mor_case_sum_tac ks mor_UNIV_thm))
  123.20          |> Thm.close_derivation
  123.21        end;
  123.22  
  123.23 @@ -525,7 +525,7 @@
  123.24          val Suc = Term.absdummy HOLogic.natT (Term.absfree hrec'
  123.25            (HOLogic.mk_tuple (map4 mk_Suc ss setssAs zs zs')));
  123.26  
  123.27 -        val rhs = mk_nat_rec Zero Suc;
  123.28 +        val rhs = mk_rec_nat Zero Suc;
  123.29        in
  123.30          fold_rev (Term.absfree o Term.dest_Free) ss rhs
  123.31        end;
  123.32 @@ -555,8 +555,8 @@
  123.33          mk_nthN n (Term.list_comb (Const (nth hset_recs (j - 1), hset_recT), args)) i
  123.34        end;
  123.35  
  123.36 -    val hset_rec_0ss = mk_rec_simps n @{thm nat_rec_0_imp} hset_rec_defs;
  123.37 -    val hset_rec_Sucss = mk_rec_simps n @{thm nat_rec_Suc_imp} hset_rec_defs;
  123.38 +    val hset_rec_0ss = mk_rec_simps n @{thm rec_nat_0_imp} hset_rec_defs;
  123.39 +    val hset_rec_Sucss = mk_rec_simps n @{thm rec_nat_Suc_imp} hset_rec_defs;
  123.40      val hset_rec_0ss' = transpose hset_rec_0ss;
  123.41      val hset_rec_Sucss' = transpose hset_rec_Sucss;
  123.42  
  123.43 @@ -1133,7 +1133,7 @@
  123.44          val fs = map mk_undefined fTs1 @ (f :: map mk_undefined fTs2);
  123.45        in
  123.46          HOLogic.mk_split (Term.absfree Kl' (Term.absfree lab'
  123.47 -          (mk_sum_caseN fs $ (lab $ HOLogic.mk_list sum_sbdT []))))
  123.48 +          (mk_case_sumN fs $ (lab $ HOLogic.mk_list sum_sbdT []))))
  123.49        end;
  123.50  
  123.51      val ((strT_frees, (_, strT_def_frees)), (lthy, lthy_old)) =
  123.52 @@ -1202,7 +1202,7 @@
  123.53          val Suc = Term.absdummy HOLogic.natT (Term.absfree Lev_rec'
  123.54            (HOLogic.mk_tuple (map5 mk_Suc ks ss setssAs zs zs')));
  123.55  
  123.56 -        val rhs = mk_nat_rec Zero Suc;
  123.57 +        val rhs = mk_rec_nat Zero Suc;
  123.58        in
  123.59          fold_rev (Term.absfree o Term.dest_Free) ss rhs
  123.60        end;
  123.61 @@ -1226,8 +1226,8 @@
  123.62          mk_nthN n (Term.list_comb (Const (Lev, LevT), ss) $ nat) i
  123.63        end;
  123.64  
  123.65 -    val Lev_0s = flat (mk_rec_simps n @{thm nat_rec_0_imp} [Lev_def]);
  123.66 -    val Lev_Sucs = flat (mk_rec_simps n @{thm nat_rec_Suc_imp} [Lev_def]);
  123.67 +    val Lev_0s = flat (mk_rec_simps n @{thm rec_nat_0_imp} [Lev_def]);
  123.68 +    val Lev_Sucs = flat (mk_rec_simps n @{thm rec_nat_Suc_imp} [Lev_def]);
  123.69  
  123.70      val rv_bind = mk_internal_b rvN;
  123.71      val rv_def_bind = rpair [] (Thm.def_binding rv_bind);
  123.72 @@ -1239,13 +1239,13 @@
  123.73              fun mk_case i' =
  123.74                Term.absfree k' (mk_nthN n rv_rec i' $ (mk_from_sbd s b i i' $ k));
  123.75            in
  123.76 -            Term.absfree b' (mk_sum_caseN (map mk_case ks) $ sumx)
  123.77 +            Term.absfree b' (mk_case_sumN (map mk_case ks) $ sumx)
  123.78            end;
  123.79  
  123.80          val Cons = Term.absfree sumx' (Term.absdummy sum_sbd_listT (Term.absfree rv_rec'
  123.81            (HOLogic.mk_tuple (map4 mk_Cons ks ss zs zs'))));
  123.82  
  123.83 -        val rhs = mk_list_rec Nil Cons;
  123.84 +        val rhs = mk_rec_list Nil Cons;
  123.85        in
  123.86          fold_rev (Term.absfree o Term.dest_Free) ss rhs
  123.87        end;
  123.88 @@ -1270,8 +1270,8 @@
  123.89          mk_nthN n (Term.list_comb (Const (rv, rvT), ss) $ kl) i
  123.90        end;
  123.91  
  123.92 -    val rv_Nils = flat (mk_rec_simps n @{thm list_rec_Nil_imp} [rv_def]);
  123.93 -    val rv_Conss = flat (mk_rec_simps n @{thm list_rec_Cons_imp} [rv_def]);
  123.94 +    val rv_Nils = flat (mk_rec_simps n @{thm rec_list_Nil_imp} [rv_def]);
  123.95 +    val rv_Conss = flat (mk_rec_simps n @{thm rec_list_Cons_imp} [rv_def]);
  123.96  
  123.97      val beh_binds = mk_internal_bs behN;
  123.98      fun beh_bind i = nth beh_binds (i - 1);
  123.99 @@ -1285,7 +1285,7 @@
 123.100  
 123.101          val Lab = Term.absfree kl' (mk_If
 123.102            (HOLogic.mk_mem (kl, mk_Lev ss (mk_size kl) i $ z))
 123.103 -          (mk_sum_caseN (map5 mk_case ks to_sbd_maps ss zs zs') $ (mk_rv ss kl i $ z))
 123.104 +          (mk_case_sumN (map5 mk_case ks to_sbd_maps ss zs zs') $ (mk_rv ss kl i $ z))
 123.105            (mk_undefined sbdFT));
 123.106  
 123.107          val rhs = HOLogic.mk_prod (mk_UNION (HOLogic.mk_UNIV HOLogic.natT)
 123.108 @@ -1413,7 +1413,7 @@
 123.109  
 123.110          fun mk_conjunct i z B = HOLogic.mk_imp
 123.111            (HOLogic.mk_conj (HOLogic.mk_mem (kl, mk_Lev ss nat i $ z), HOLogic.mk_mem (z, B)),
 123.112 -          mk_sum_caseN (map4 mk_case ss setssAs zs zs') $ (mk_rv ss kl i $ z));
 123.113 +          mk_case_sumN (map4 mk_case ss setssAs zs zs') $ (mk_rv ss kl i $ z));
 123.114  
 123.115          val goal = list_all_free (kl :: zs)
 123.116            (Library.foldr1 HOLogic.mk_conj (map3 mk_conjunct ks zs Bs));
 123.117 @@ -1432,8 +1432,8 @@
 123.118          map (fn i => map (fn i' =>
 123.119            split_conj_thm (if n = 1 then set_rv_Lev' RS mk_conjunctN n i RS mp
 123.120              else set_rv_Lev' RS mk_conjunctN n i RS mp RSN
 123.121 -              (2, @{thm sum_case_weak_cong} RS iffD1) RS
 123.122 -              (mk_sum_casesN n i' RS iffD1))) ks) ks
 123.123 +              (2, @{thm sum.weak_case_cong} RS iffD1) RS
 123.124 +              (mk_sum_caseN n i' RS iffD1))) ks) ks
 123.125        end;
 123.126  
 123.127      val set_Lev_thmsss =
 123.128 @@ -1828,7 +1828,7 @@
 123.129  
 123.130      val corec_Inl_sum_thms =
 123.131        let
 123.132 -        val mor = mor_comp_thm OF [mor_sum_case_thm, mor_unfold_thm];
 123.133 +        val mor = mor_comp_thm OF [mor_case_sum_thm, mor_unfold_thm];
 123.134        in
 123.135          map2 (fn unique => fn unfold_dtor =>
 123.136            trans OF [mor RS unique, unfold_dtor]) unfold_unique_mor_thms unfold_dtor_thms
 123.137 @@ -1839,7 +1839,7 @@
 123.138  
 123.139      val corec_strs =
 123.140        map3 (fn dtor => fn sum_s => fn mapx =>
 123.141 -        mk_sum_case
 123.142 +        mk_case_sum
 123.143            (HOLogic.mk_comp (Term.list_comb (mapx, passive_ids @ corec_Inls), dtor), sum_s))
 123.144        dtors corec_ss corec_maps;
 123.145  
 123.146 @@ -1863,14 +1863,14 @@
 123.147      val corec_defs = map (fn def =>
 123.148        mk_unabs_def n (Morphism.thm phi def RS meta_eq_to_obj_eq)) corec_def_frees;
 123.149  
 123.150 -    val sum_cases =
 123.151 -      map2 (fn T => fn i => mk_sum_case (HOLogic.id_const T, mk_corec corec_ss i)) Ts ks;
 123.152 +    val case_sums =
 123.153 +      map2 (fn T => fn i => mk_case_sum (HOLogic.id_const T, mk_corec corec_ss i)) Ts ks;
 123.154      val dtor_corec_thms =
 123.155        let
 123.156          fun mk_goal i corec_s corec_map dtor z =
 123.157            let
 123.158              val lhs = dtor $ (mk_corec corec_ss i $ z);
 123.159 -            val rhs = Term.list_comb (corec_map, passive_ids @ sum_cases) $ (corec_s $ z);
 123.160 +            val rhs = Term.list_comb (corec_map, passive_ids @ case_sums) $ (corec_s $ z);
 123.161            in
 123.162              fold_rev Logic.all (z :: corec_ss) (mk_Trueprop_eq (lhs, rhs))
 123.163            end;
 123.164 @@ -1886,7 +1886,7 @@
 123.165  
 123.166      val corec_unique_mor_thm =
 123.167        let
 123.168 -        val id_fs = map2 (fn T => fn f => mk_sum_case (HOLogic.id_const T, f)) Ts unfold_fs;
 123.169 +        val id_fs = map2 (fn T => fn f => mk_case_sum (HOLogic.id_const T, f)) Ts unfold_fs;
 123.170          val prem = HOLogic.mk_Trueprop (mk_mor corec_UNIVs corec_strs UNIVs dtors id_fs);
 123.171          fun mk_fun_eq f i = HOLogic.mk_eq (f, mk_corec corec_ss i);
 123.172          val unique = HOLogic.mk_Trueprop (Library.foldr1 HOLogic.mk_conj
 123.173 @@ -1907,9 +1907,9 @@
 123.174      val (dtor_corec_unique_thms, dtor_corec_unique_thm) =
 123.175        `split_conj_thm (split_conj_prems n
 123.176          (mor_UNIV_thm RS iffD2 RS corec_unique_mor_thm)
 123.177 -        |> Local_Defs.unfold lthy (@{thms o_sum_case comp_id id_comp comp_assoc[symmetric]
 123.178 -           sum_case_o_inj(1)} @ map_id0s_o_id @ sym_map_comps)
 123.179 -        OF replicate n @{thm arg_cong2[of _ _ _ _ sum_case, OF refl]});
 123.180 +        |> Local_Defs.unfold lthy (@{thms o_case_sum comp_id id_comp comp_assoc[symmetric]
 123.181 +           case_sum_o_inj(1)} @ map_id0s_o_id @ sym_map_comps)
 123.182 +        OF replicate n @{thm arg_cong2[of _ _ _ _ case_sum, OF refl]});
 123.183  
 123.184      val timer = time (timer "corec definitions & thms");
 123.185  
   124.1 --- a/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML	Wed Feb 12 09:06:04 2014 +0100
   124.2 +++ b/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML	Wed Feb 12 10:59:25 2014 +0100
   124.3 @@ -195,7 +195,7 @@
   124.4            let val branches' = map (massage_rec bound_Ts) branches in
   124.5              Term.list_comb (If_const (typof (hd branches')) $ tap check_no_call obj, branches')
   124.6            end
   124.7 -        | (c as Const (@{const_name prod_case}, _), arg :: args) =>
   124.8 +        | (c as Const (@{const_name case_prod}, _), arg :: args) =>
   124.9            massage_rec bound_Ts
  124.10              (unfold_lets_splits (Term.list_comb (c $ Envir.eta_long bound_Ts arg, args)))
  124.11          | (Const (c, _), args as _ :: _ :: _) =>
  124.12 @@ -295,12 +295,12 @@
  124.13                end
  124.14              | NONE =>
  124.15                (case t of
  124.16 -                Const (@{const_name prod_case}, _) $ t' =>
  124.17 +                Const (@{const_name case_prod}, _) $ t' =>
  124.18                  let
  124.19                    val U' = curried_type U;
  124.20                    val T' = curried_type T;
  124.21                  in
  124.22 -                  Const (@{const_name prod_case}, U' --> U) $ massage_call bound_Ts U' T' t'
  124.23 +                  Const (@{const_name case_prod}, U' --> U) $ massage_call bound_Ts U' T' t'
  124.24                  end
  124.25                | t1 $ t2 =>
  124.26                  (if has_call t2 then
  124.27 @@ -340,22 +340,8 @@
  124.28  fun fold_rev_corec_code_rhs ctxt f =
  124.29    fold_rev_let_if_case ctxt (fn conds => uncurry (f conds) o Term.strip_comb);
  124.30  
  124.31 -fun case_thms_of_term ctxt bound_Ts t =
  124.32 -  let
  124.33 -    fun ctr_sugar_of_case c s =
  124.34 -      (case ctr_sugar_of ctxt s of
  124.35 -        SOME (ctr_sugar as {casex = Const (c', _), sel_splits = _ :: _, ...}) =>
  124.36 -        if c' = c then SOME ctr_sugar else NONE
  124.37 -      | _ => NONE);
  124.38 -    fun add_ctr_sugar (s, Type (@{type_name fun}, [_, T])) =
  124.39 -        binder_types T
  124.40 -        |> map_filter (try (fst o dest_Type))
  124.41 -        |> distinct (op =)
  124.42 -        |> map_filter (ctr_sugar_of_case s)
  124.43 -      | add_ctr_sugar _ = [];
  124.44 -
  124.45 -    val ctr_sugars = maps add_ctr_sugar (Term.add_consts t []);
  124.46 -  in
  124.47 +fun case_thms_of_term ctxt t =
  124.48 +  let val ctr_sugars = map_filter (Ctr_Sugar.ctr_sugar_of_case ctxt o fst) (Term.add_consts t []) in
  124.49      (maps #distincts ctr_sugars, maps #discIs ctr_sugars, maps #disc_exhausts ctr_sugars,
  124.50       maps #sel_splits ctr_sugars, maps #sel_split_asms ctr_sugars)
  124.51    end;
  124.52 @@ -785,7 +771,7 @@
  124.53                let val (u, vs) = strip_comb t in
  124.54                  if is_Free u andalso has_call u then
  124.55                    Inr_const U T $ mk_tuple1 bound_Ts vs
  124.56 -                else if try (fst o dest_Const) u = SOME @{const_name prod_case} then
  124.57 +                else if try (fst o dest_Const) u = SOME @{const_name case_prod} then
  124.58                    map (rewrite bound_Ts) vs |> chop 1
  124.59                    |>> HOLogic.mk_split o the_single
  124.60                    |> Term.list_comb
  124.61 @@ -1020,12 +1006,12 @@
  124.62          de_facto_exhaustives disc_eqnss
  124.63        |> list_all_fun_args []
  124.64      val nchotomy_taut_thmss =
  124.65 -      map6 (fn tac_opt => fn {disc_exhausts = res_disc_exhausts, ...} => fn arg_Ts =>
  124.66 +      map5 (fn tac_opt => fn {disc_exhausts = res_disc_exhausts, ...} =>
  124.67            fn {code_rhs_opt, ...} :: _ => fn [] => K []
  124.68              | [goal] => fn true =>
  124.69                let
  124.70                  val (_, _, arg_disc_exhausts, _, _) =
  124.71 -                  case_thms_of_term lthy arg_Ts (the_default Term.dummy code_rhs_opt);
  124.72 +                  case_thms_of_term lthy (the_default Term.dummy code_rhs_opt);
  124.73                in
  124.74                  [Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, ...} =>
  124.75                     mk_primcorec_nchotomy_tac ctxt (res_disc_exhausts @ arg_disc_exhausts))
  124.76 @@ -1035,7 +1021,7 @@
  124.77                (case tac_opt of
  124.78                  SOME tac => [Goal.prove_sorry lthy [] [] goal tac |> Thm.close_derivation]
  124.79                | NONE => []))
  124.80 -        tac_opts corec_specs arg_Tss disc_eqnss nchotomy_goalss syntactic_exhaustives;
  124.81 +        tac_opts corec_specs disc_eqnss nchotomy_goalss syntactic_exhaustives;
  124.82  
  124.83      val syntactic_exhaustives =
  124.84        map (fn disc_eqns => forall (null o #prems orf is_some o #code_rhs_opt) disc_eqns
  124.85 @@ -1132,7 +1118,7 @@
  124.86                |> HOLogic.mk_Trueprop o HOLogic.mk_eq
  124.87                |> curry Logic.list_implies (map HOLogic.mk_Trueprop prems)
  124.88                |> curry Logic.list_all (map dest_Free fun_args);
  124.89 -            val (distincts, _, _, sel_splits, sel_split_asms) = case_thms_of_term lthy [] rhs_term;
  124.90 +            val (distincts, _, _, sel_splits, sel_split_asms) = case_thms_of_term lthy rhs_term;
  124.91            in
  124.92              mk_primcorec_sel_tac lthy def_thms distincts sel_splits sel_split_asms nested_maps
  124.93                nested_map_idents nested_map_comps sel_corec k m excludesss
  124.94 @@ -1258,7 +1244,7 @@
  124.95                        |> pairself (curry mk_Trueprop_eq (applied_fun_of fun_name fun_T fun_args)
  124.96                          #> curry Logic.list_all (map dest_Free fun_args));
  124.97                      val (distincts, discIs, _, sel_splits, sel_split_asms) =
  124.98 -                      case_thms_of_term lthy bound_Ts raw_rhs;
  124.99 +                      case_thms_of_term lthy raw_rhs;
 124.100  
 124.101                      val raw_code_thm = mk_primcorec_raw_code_tac lthy distincts discIs sel_splits
 124.102                          sel_split_asms ms ctr_thms
   125.1 --- a/src/HOL/Tools/BNF/bnf_gfp_tactics.ML	Wed Feb 12 09:06:04 2014 +0100
   125.2 +++ b/src/HOL/Tools/BNF/bnf_gfp_tactics.ML	Wed Feb 12 10:59:25 2014 +0100
   125.3 @@ -57,13 +57,13 @@
   125.4      thm list -> thm list -> thm list -> thm list -> thm list list -> thm list list list ->
   125.5      thm list list list -> thm list list list -> thm list list -> thm list list -> thm list ->
   125.6      thm list -> thm list -> tactic
   125.7 +  val mk_mor_case_sum_tac: 'a list -> thm -> tactic
   125.8    val mk_mor_comp_tac: thm -> thm list -> thm list -> thm list -> tactic
   125.9    val mk_mor_elim_tac: thm -> tactic
  125.10    val mk_mor_hset_rec_tac: int -> int -> cterm option list -> int -> thm list -> thm list ->
  125.11      thm list -> thm list list -> thm list list -> tactic
  125.12    val mk_mor_incl_tac: thm -> thm list -> tactic
  125.13    val mk_mor_str_tac: 'a list -> thm -> tactic
  125.14 -  val mk_mor_sum_case_tac: 'a list -> thm -> tactic
  125.15    val mk_mor_unfold_tac: int -> thm -> thm list -> thm list -> thm list -> thm list -> thm list ->
  125.16      thm list -> tactic
  125.17    val mk_prefCl_Lev_tac: Proof.context -> cterm option list -> thm list -> thm list -> tactic
  125.18 @@ -112,7 +112,7 @@
  125.19    @{thm ord_eq_le_trans[OF trans[OF fun_cong[OF image_id] id_apply]]};
  125.20  val ordIso_ordLeq_trans = @{thm ordIso_ordLeq_trans};
  125.21  val snd_convol_fun_cong_sym = @{thm snd_convol} RS fun_cong RS sym;
  125.22 -val sum_case_weak_cong = @{thm sum_case_weak_cong};
  125.23 +val sum_weak_case_cong = @{thm sum.weak_case_cong};
  125.24  val trans_fun_cong_image_id_id_apply = @{thm trans[OF fun_cong[OF image_id] id_apply]};
  125.25  val Collect_splitD_set_mp = @{thm Collect_splitD[OF set_mp]};
  125.26  val rev_bspec = Drule.rotate_prems 1 bspec;
  125.27 @@ -170,8 +170,8 @@
  125.28  fun mk_mor_str_tac ks mor_UNIV =
  125.29    (stac mor_UNIV THEN' CONJ_WRAP' (K (rtac refl)) ks) 1;
  125.30  
  125.31 -fun mk_mor_sum_case_tac ks mor_UNIV =
  125.32 -  (stac mor_UNIV THEN' CONJ_WRAP' (K (rtac @{thm sum_case_o_inj(1)[symmetric]})) ks) 1;
  125.33 +fun mk_mor_case_sum_tac ks mor_UNIV =
  125.34 +  (stac mor_UNIV THEN' CONJ_WRAP' (K (rtac @{thm case_sum_o_inj(1)[symmetric]})) ks) 1;
  125.35  
  125.36  fun mk_set_incl_hset_tac def rec_Suc =
  125.37    EVERY' (stac def ::
  125.38 @@ -376,7 +376,7 @@
  125.39      fun coalg_tac (i, ((passive_sets, active_sets), def)) =
  125.40        EVERY' [rtac ballI, REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE],
  125.41          hyp_subst_tac ctxt, rtac (def RS trans RS @{thm ssubst_mem}), etac (arg_cong RS trans),
  125.42 -        rtac (mk_sum_casesN n i), rtac CollectI,
  125.43 +        rtac (mk_sum_caseN n i), rtac CollectI,
  125.44          EVERY' (map (fn thm => EVERY' [rtac conjI, rtac (thm RS ord_eq_le_trans),
  125.45            etac ((trans OF [@{thm image_id} RS fun_cong, id_apply]) RS ord_eq_le_trans)])
  125.46            passive_sets),
  125.47 @@ -504,7 +504,7 @@
  125.48        CONJ_WRAP' (fn rv_Cons =>
  125.49          CONJ_WRAP' (fn (i, rv_Nil) => (EVERY' [rtac exI,
  125.50            rtac (@{thm append_Nil} RS arg_cong RS trans),
  125.51 -          rtac (rv_Cons RS trans), rtac (mk_sum_casesN n i RS arg_cong RS trans), rtac rv_Nil]))
  125.52 +          rtac (rv_Cons RS trans), rtac (mk_sum_caseN n i RS arg_cong RS trans), rtac rv_Nil]))
  125.53          (ks ~~ rv_Nils))
  125.54        rv_Conss,
  125.55        REPEAT_DETERM o rtac allI, rtac (mk_sumEN n),
  125.56 @@ -512,8 +512,8 @@
  125.57          CONJ_WRAP' (fn rv_Cons => EVERY' [REPEAT_DETERM o etac allE, dtac (mk_conjunctN n i),
  125.58            CONJ_WRAP' (fn i' => EVERY' [dtac (mk_conjunctN n i'), etac exE, rtac exI,
  125.59              rtac (@{thm append_Cons} RS arg_cong RS trans),
  125.60 -            rtac (rv_Cons RS trans), etac (sum_case_weak_cong RS arg_cong RS trans),
  125.61 -            rtac (mk_sum_casesN n i RS arg_cong RS trans), atac])
  125.62 +            rtac (rv_Cons RS trans), etac (sum_weak_case_cong RS arg_cong RS trans),
  125.63 +            rtac (mk_sum_caseN n i RS arg_cong RS trans), atac])
  125.64            ks])
  125.65          rv_Conss)
  125.66        ks)] 1
  125.67 @@ -530,7 +530,7 @@
  125.68          EVERY' [rtac impI, REPEAT_DETERM o etac conjE,
  125.69            dtac (Lev_0 RS equalityD1 RS set_mp), etac @{thm singletonE}, etac ssubst,
  125.70            rtac (rv_Nil RS arg_cong RS iffD2),
  125.71 -          rtac (mk_sum_casesN n i RS iffD2),
  125.72 +          rtac (mk_sum_caseN n i RS iffD2),
  125.73            CONJ_WRAP' (fn thm => etac thm THEN' atac) (take m coalg_sets)])
  125.74        (ks ~~ ((Lev_0s ~~ rv_Nils) ~~ coalg_setss)),
  125.75        REPEAT_DETERM o rtac allI,
  125.76 @@ -540,7 +540,7 @@
  125.77              (fn (i, (from_to_sbd, coalg_set)) =>
  125.78                EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac ctxt,
  125.79                rtac (rv_Cons RS arg_cong RS iffD2),
  125.80 -              rtac (mk_sum_casesN n i RS arg_cong RS trans RS iffD2),
  125.81 +              rtac (mk_sum_caseN n i RS arg_cong RS trans RS iffD2),
  125.82                etac (from_to_sbd RS arg_cong), REPEAT_DETERM o etac allE,
  125.83                dtac (mk_conjunctN n i), etac mp, etac conjI, etac set_rev_mp,
  125.84                etac coalg_set, atac])
  125.85 @@ -583,7 +583,7 @@
  125.86                        rtac @{thm ssubst_mem[OF append_Cons]}, rtac (mk_UnIN n i),
  125.87                        rtac CollectI, REPEAT_DETERM o rtac exI, rtac conjI, rtac refl,
  125.88                        rtac conjI, atac, dtac (sym RS trans RS sym),
  125.89 -                      rtac (rv_Cons RS trans), rtac (mk_sum_casesN n i RS trans),
  125.90 +                      rtac (rv_Cons RS trans), rtac (mk_sum_caseN n i RS trans),
  125.91                        etac (from_to_sbd RS arg_cong), REPEAT_DETERM o etac allE,
  125.92                        dtac (mk_conjunctN n i), dtac mp, atac,
  125.93                        dtac (mk_conjunctN n i'), dtac mp, atac,
  125.94 @@ -639,7 +639,7 @@
  125.95                      atac, atac, hyp_subst_tac ctxt] THEN'
  125.96                      CONJ_WRAP' (fn i'' =>
  125.97                        EVERY' [rtac impI, dtac (sym RS trans),
  125.98 -                        rtac (rv_Cons RS trans), rtac (mk_sum_casesN n i RS arg_cong RS trans),
  125.99 +                        rtac (rv_Cons RS trans), rtac (mk_sum_caseN n i RS arg_cong RS trans),
 125.100                          etac (from_to_sbd RS arg_cong),
 125.101                          REPEAT_DETERM o etac allE,
 125.102                          dtac (mk_conjunctN n i), dtac mp, atac,
 125.103 @@ -684,7 +684,7 @@
 125.104                rtac exI, rtac conjI,
 125.105                (if n = 1 then rtac @{thm if_P} THEN' etac length_Lev'
 125.106                else rtac (@{thm if_P} RS arg_cong RS trans) THEN' etac length_Lev' THEN'
 125.107 -                etac (sum_case_weak_cong RS trans) THEN' rtac (mk_sum_casesN n i)),
 125.108 +                etac (sum_weak_case_cong RS trans) THEN' rtac (mk_sum_caseN n i)),
 125.109                EVERY' (map2 (fn set_map0 => fn set_rv_Lev =>
 125.110                  EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac (set_map0 RS trans),
 125.111                    rtac trans_fun_cong_image_id_id_apply,
 125.112 @@ -708,7 +708,7 @@
 125.113                rtac exI, rtac conjI,
 125.114                (if n = 1 then rtac @{thm if_P} THEN' etac length_Lev'
 125.115                else rtac (@{thm if_P} RS trans) THEN' etac length_Lev' THEN'
 125.116 -                etac (sum_case_weak_cong RS trans) THEN' rtac (mk_sum_casesN n i)),
 125.117 +                etac (sum_weak_case_cong RS trans) THEN' rtac (mk_sum_caseN n i)),
 125.118                EVERY' (map2 (fn set_map0 => fn set_rv_Lev =>
 125.119                  EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac (set_map0 RS trans),
 125.120                    rtac trans_fun_cong_image_id_id_apply,
 125.121 @@ -735,7 +735,7 @@
 125.122            rtac length_Lev', rtac (Lev_0 RS equalityD2 RS set_mp), rtac @{thm singletonI},
 125.123            CONVERSION (Conv.top_conv
 125.124              (K (Conv.try_conv (Conv.rewr_conv (rv_Nil RS eq_reflection)))) ctxt),
 125.125 -          if n = 1 then rtac refl else rtac (mk_sum_casesN n i),
 125.126 +          if n = 1 then rtac refl else rtac (mk_sum_caseN n i),
 125.127            EVERY' (map2 (fn set_map0 => fn coalg_set =>
 125.128              EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac (set_map0 RS trans),
 125.129                rtac trans_fun_cong_image_id_id_apply, etac coalg_set, atac])
 125.130 @@ -756,15 +756,14 @@
 125.131      fun mor_tac (i, (strT_def, (((Lev_0, Lev_Suc), (rv_Nil, rv_Cons)),
 125.132        ((map_comp_id, (map_cong0, map_arg_cong)), (length_Lev', (from_to_sbds, to_sbd_injs)))))) =
 125.133        EVERY' [rtac ballI, rtac sym, rtac trans, rtac strT_def,
 125.134 -        rtac (@{thm if_P} RS
 125.135 -          (if n = 1 then map_arg_cong else sum_case_weak_cong) RS trans),
 125.136 +        rtac (@{thm if_P} RS (if n = 1 then map_arg_cong else sum_weak_case_cong) RS trans),
 125.137          rtac (@{thm list.size(3)} RS arg_cong RS trans RS equalityD2 RS set_mp),
 125.138          rtac Lev_0, rtac @{thm singletonI},
 125.139          CONVERSION (Conv.top_conv
 125.140            (K (Conv.try_conv (Conv.rewr_conv (rv_Nil RS eq_reflection)))) ctxt),
 125.141          if n = 1 then K all_tac
 125.142 -        else (rtac (sum_case_weak_cong RS trans) THEN'
 125.143 -          rtac (mk_sum_casesN n i) THEN' rtac (mk_sum_casesN n i RS trans)),
 125.144 +        else (rtac (sum_weak_case_cong RS trans) THEN'
 125.145 +          rtac (mk_sum_caseN n i) THEN' rtac (mk_sum_caseN n i RS trans)),
 125.146          rtac (map_comp_id RS trans), rtac (map_cong0 OF replicate m refl),
 125.147          EVERY' (map3 (fn i' => fn to_sbd_inj => fn from_to_sbd =>
 125.148            DETERM o EVERY' [rtac trans, rtac o_apply, rtac Pair_eqI, rtac conjI,
 125.149 @@ -801,7 +800,7 @@
 125.150              CONVERSION (Conv.top_conv
 125.151                (K (Conv.try_conv (Conv.rewr_conv (rv_Cons RS eq_reflection)))) ctxt),
 125.152              if n = 1 then K all_tac
 125.153 -            else rtac sum_case_weak_cong THEN' rtac (mk_sum_casesN n i' RS trans),
 125.154 +            else rtac sum_weak_case_cong THEN' rtac (mk_sum_caseN n i' RS trans),
 125.155              SELECT_GOAL (unfold_thms_tac ctxt [from_to_sbd]), rtac refl,
 125.156              rtac refl])
 125.157          ks to_sbd_injs from_to_sbds)];
 125.158 @@ -928,11 +927,11 @@
 125.159    unfold_thms_tac ctxt corec_defs THEN EVERY' [rtac trans, rtac (o_apply RS arg_cong),
 125.160      rtac trans, rtac unfold, fo_rtac (@{thm sum.cases(2)} RS arg_cong RS trans) ctxt, rtac map_cong0,
 125.161      REPEAT_DETERM_N m o rtac refl,
 125.162 -    EVERY' (map (fn thm => rtac @{thm sum_case_expand_Inr} THEN' rtac thm) corec_Inls)] 1;
 125.163 +    EVERY' (map (fn thm => rtac @{thm case_sum_expand_Inr} THEN' rtac thm) corec_Inls)] 1;
 125.164  
 125.165  fun mk_corec_unique_mor_tac ctxt corec_defs corec_Inls unfold_unique_mor =
 125.166    unfold_thms_tac ctxt
 125.167 -    (corec_defs @ map (fn thm => thm RS @{thm sum_case_expand_Inr'}) corec_Inls) THEN
 125.168 +    (corec_defs @ map (fn thm => thm RS @{thm case_sum_expand_Inr'}) corec_Inls) THEN
 125.169    etac unfold_unique_mor 1;
 125.170  
 125.171  fun mk_dtor_coinduct_tac m raw_coind bis_rel rel_congs =
 125.172 @@ -947,7 +946,7 @@
 125.173      rel_congs,
 125.174      rtac impI, REPEAT_DETERM o etac conjE,
 125.175      CONJ_WRAP' (K (EVERY' [rtac impI, rtac @{thm IdD}, etac set_mp,
 125.176 -      rtac CollectI, etac @{thm prod_caseI}])) rel_congs] 1;
 125.177 +      rtac CollectI, etac @{thm case_prodI}])) rel_congs] 1;
 125.178  
 125.179  fun mk_dtor_map_coinduct_tac m ks raw_coind bis_def =
 125.180    let
 125.181 @@ -1141,7 +1140,7 @@
 125.182          passive_set_map0s dtor_set_incls),
 125.183          CONJ_WRAP' (fn (in_Jrel, (set_map0, dtor_set_set_incls)) =>
 125.184            EVERY' [rtac ord_eq_le_trans, rtac set_map0, rtac @{thm image_subsetI}, rtac CollectI,
 125.185 -            rtac @{thm prod_caseI}, rtac (in_Jrel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
 125.186 +            rtac @{thm case_prodI}, rtac (in_Jrel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
 125.187              CONJ_WRAP' (fn thm => etac (thm RS @{thm subset_trans}) THEN' atac) dtor_set_set_incls,
 125.188              rtac conjI, rtac refl, rtac refl])
 125.189          (in_Jrels ~~ (active_set_map0s ~~ dtor_set_set_inclss)),
 125.190 @@ -1165,7 +1164,7 @@
 125.191                  dtac set_rev_mp, etac @{thm image_mono}, etac imageE,
 125.192                  dtac @{thm ssubst_mem[OF pair_collapse]},
 125.193                  REPEAT_DETERM o eresolve_tac (CollectE :: conjE ::
 125.194 -                  @{thms prod_caseE iffD1[OF Pair_eq, elim_format]}),
 125.195 +                  @{thms case_prodE iffD1[OF Pair_eq, elim_format]}),
 125.196                  hyp_subst_tac ctxt,
 125.197                  dtac (in_Jrel RS iffD1),
 125.198                  dtac @{thm someI_ex}, REPEAT_DETERM o etac conjE,
 125.199 @@ -1181,7 +1180,7 @@
 125.200            EVERY' (map (fn in_Jrel => EVERY' [rtac trans, rtac o_apply, dtac set_rev_mp, atac,
 125.201              dtac @{thm ssubst_mem[OF pair_collapse]},
 125.202              REPEAT_DETERM o
 125.203 -              eresolve_tac (CollectE :: conjE :: @{thms prod_caseE iffD1[OF Pair_eq, elim_format]}),
 125.204 +              eresolve_tac (CollectE :: conjE :: @{thms case_prodE iffD1[OF Pair_eq, elim_format]}),
 125.205              hyp_subst_tac ctxt, dtac (in_Jrel RS iffD1),
 125.206              dtac @{thm someI_ex}, REPEAT_DETERM o etac conjE, atac]) in_Jrels),
 125.207            atac]]
   126.1 --- a/src/HOL/Tools/BNF/bnf_gfp_util.ML	Wed Feb 12 09:06:04 2014 +0100
   126.2 +++ b/src/HOL/Tools/BNF/bnf_gfp_util.ML	Wed Feb 12 10:59:25 2014 +0100
   126.3 @@ -22,12 +22,12 @@
   126.4    val mk_in_rel: term -> term
   126.5    val mk_equiv: term -> term -> term
   126.6    val mk_fromCard: term -> term -> term
   126.7 -  val mk_list_rec: term -> term -> term
   126.8 -  val mk_nat_rec: term -> term -> term
   126.9    val mk_prefCl: term -> term
  126.10    val mk_prefixeq: term -> term -> term
  126.11    val mk_proj: term -> term
  126.12    val mk_quotient: term -> term -> term
  126.13 +  val mk_rec_list: term -> term -> term
  126.14 +  val mk_rec_nat: term -> term -> term
  126.15    val mk_shift: term -> term -> term
  126.16    val mk_size: term -> term
  126.17    val mk_toCard: term -> term -> term
  126.18 @@ -146,16 +146,16 @@
  126.19  
  126.20  fun mk_undefined T = Const (@{const_name undefined}, T);
  126.21  
  126.22 -fun mk_nat_rec Zero Suc =
  126.23 +fun mk_rec_nat Zero Suc =
  126.24    let val T = fastype_of Zero;
  126.25 -  in Const (@{const_name nat_rec}, T --> fastype_of Suc --> HOLogic.natT --> T) $ Zero $ Suc end;
  126.26 +  in Const (@{const_name old.rec_nat}, T --> fastype_of Suc --> HOLogic.natT --> T) $ Zero $ Suc end;
  126.27  
  126.28 -fun mk_list_rec Nil Cons =
  126.29 +fun mk_rec_list Nil Cons =
  126.30    let
  126.31      val T = fastype_of Nil;
  126.32      val (U, consT) = `(Term.domain_type) (fastype_of Cons);
  126.33    in
  126.34 -    Const (@{const_name list_rec}, T --> consT --> HOLogic.listT U --> T) $ Nil $ Cons
  126.35 +    Const (@{const_name rec_list}, T --> consT --> HOLogic.listT U --> T) $ Nil $ Cons
  126.36    end;
  126.37  
  126.38  fun mk_InN_not_InM 1 _ = @{thm Inl_not_Inr}
   127.1 --- a/src/HOL/Tools/BNF/bnf_lfp_compat.ML	Wed Feb 12 09:06:04 2014 +0100
   127.2 +++ b/src/HOL/Tools/BNF/bnf_lfp_compat.ML	Wed Feb 12 10:59:25 2014 +0100
   127.3 @@ -99,9 +99,9 @@
   127.4        else
   127.5          ((fp_sugars0, (NONE, NONE)), lthy);
   127.6  
   127.7 -    val {ctr_sugars, co_inducts = [induct], co_iterss, co_iter_thmsss = iter_thmsss, ...} :: _ =
   127.8 -      fp_sugars;
   127.9 -    val inducts = conj_dests nn induct;
  127.10 +    val {ctr_sugars, co_inducts = [induct], co_inductss = inductss, co_iterss,
  127.11 +      co_iter_thmsss = iter_thmsss, ...} :: _ = fp_sugars;
  127.12 +    val inducts = map the_single inductss;
  127.13  
  127.14      val mk_dtyp = dtyp_of_typ Ts;
  127.15  
   128.1 --- a/src/HOL/Tools/BNF/bnf_lfp_tactics.ML	Wed Feb 12 09:06:04 2014 +0100
   128.2 +++ b/src/HOL/Tools/BNF/bnf_lfp_tactics.ML	Wed Feb 12 10:59:25 2014 +0100
   128.3 @@ -724,7 +724,7 @@
   128.4          passive_set_map0s ctor_set_incls),
   128.5          CONJ_WRAP' (fn (in_Irel, (set_map0, ctor_set_set_incls)) =>
   128.6            EVERY' [rtac ord_eq_le_trans, rtac set_map0, rtac @{thm image_subsetI}, rtac CollectI,
   128.7 -            rtac @{thm prod_caseI}, rtac (in_Irel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
   128.8 +            rtac @{thm case_prodI}, rtac (in_Irel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
   128.9              CONJ_WRAP' (fn thm =>
  128.10                EVERY' (map etac [thm RS subset_trans, le_arg_cong_ctor_dtor]))
  128.11              ctor_set_set_incls,
  128.12 @@ -750,7 +750,7 @@
  128.13                  dtac set_rev_mp, etac @{thm image_mono}, etac imageE,
  128.14                  dtac @{thm ssubst_mem[OF pair_collapse]},
  128.15                  REPEAT_DETERM o eresolve_tac (CollectE :: conjE ::
  128.16 -                  @{thms prod_caseE iffD1[OF Pair_eq, elim_format]}),
  128.17 +                  @{thms case_prodE iffD1[OF Pair_eq, elim_format]}),
  128.18                  hyp_subst_tac ctxt,
  128.19                  dtac (in_Irel RS iffD1), dtac @{thm someI_ex}, REPEAT_DETERM o etac conjE,
  128.20                  TRY o
  128.21 @@ -765,7 +765,7 @@
  128.22            EVERY' (map (fn in_Irel => EVERY' [rtac trans, rtac o_apply, dtac set_rev_mp, atac,
  128.23              dtac @{thm ssubst_mem[OF pair_collapse]},
  128.24              REPEAT_DETERM o
  128.25 -              eresolve_tac (CollectE :: conjE :: @{thms prod_caseE iffD1[OF Pair_eq, elim_format]}),
  128.26 +              eresolve_tac (CollectE :: conjE :: @{thms case_prodE iffD1[OF Pair_eq, elim_format]}),
  128.27              hyp_subst_tac ctxt,
  128.28              dtac (in_Irel RS iffD1), dtac @{thm someI_ex}, REPEAT_DETERM o etac conjE, atac])
  128.29            in_Irels),
   129.1 --- a/src/HOL/Tools/Ctr_Sugar/case_translation.ML	Wed Feb 12 09:06:04 2014 +0100
   129.2 +++ b/src/HOL/Tools/Ctr_Sugar/case_translation.ML	Wed Feb 12 10:59:25 2014 +0100
   129.3 @@ -221,8 +221,9 @@
   129.4      val constr_keys = map (fst o dest_Const) constrs;
   129.5      val data = (case_comb, constrs);
   129.6      val Tname = Tname_of_data data;
   129.7 -    val update_constrs = fold (fn key => Symtab.cons_list (key, (Tname, data))) constr_keys;
   129.8 -    val update_cases = Symtab.update (case_key, data);
   129.9 +    val update_constrs =
  129.10 +      fold (fn key => Symtab.insert_list (eq_fst (op =)) (key, (Tname, data))) constr_keys;
  129.11 +    val update_cases = Symtab.default (case_key, data);
  129.12    in
  129.13      context
  129.14      |> map_constrs update_constrs
   130.1 --- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML	Wed Feb 12 09:06:04 2014 +0100
   130.2 +++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML	Wed Feb 12 10:59:25 2014 +0100
   130.3 @@ -41,8 +41,6 @@
   130.4    val register_ctr_sugar: string -> ctr_sugar -> local_theory -> local_theory
   130.5    val register_ctr_sugar_global: string -> ctr_sugar -> theory -> theory
   130.6  
   130.7 -  val rep_compat_prefix: string
   130.8 -
   130.9    val mk_half_pairss: 'a list * 'a list -> ('a * 'a) list list
  130.10    val join_halves: int -> 'a list list -> 'a list list -> 'a list * 'a list list list
  130.11  
  130.12 @@ -56,10 +54,10 @@
  130.13      (ctr_sugar * term list * term list) option
  130.14  
  130.15    val wrap_free_constructors: ({prems: thm list, context: Proof.context} -> tactic) list list ->
  130.16 -    (((bool * (bool * bool)) * term list) * binding) *
  130.17 +    (((bool * bool) * term list) * binding) *
  130.18        (binding list * (binding list list * (binding * term) list list)) -> local_theory ->
  130.19      ctr_sugar * local_theory
  130.20 -  val parse_wrap_free_constructors_options: (bool * (bool * bool)) parser
  130.21 +  val parse_wrap_free_constructors_options: (bool * bool) parser
  130.22    val parse_bound_term: (binding * string) parser
  130.23  end;
  130.24  
  130.25 @@ -96,10 +94,6 @@
  130.26     sel_split_asms: thm list,
  130.27     case_eq_ifs: thm list};
  130.28  
  130.29 -fun eq_ctr_sugar ({ctrs = ctrs1, casex = case1, discs = discs1, selss = selss1, ...} : ctr_sugar,
  130.30 -    {ctrs = ctrs2, casex = case2, discs = discs2, selss = selss2, ...} : ctr_sugar) =
  130.31 -  ctrs1 = ctrs2 andalso case1 = case2 andalso discs1 = discs2 andalso selss1 = selss2;
  130.32 -
  130.33  fun morph_ctr_sugar phi {ctrs, casex, discs, selss, exhaust, nchotomy, injects, distincts,
  130.34      case_thms, case_cong, weak_case_cong, split, split_asm, disc_thmss, discIs, sel_thmss,
  130.35      disc_excludesss, disc_exhausts, sel_exhausts, collapses, expands, sel_splits, sel_split_asms,
  130.36 @@ -137,7 +131,7 @@
  130.37    type T = ctr_sugar Symtab.table;
  130.38    val empty = Symtab.empty;
  130.39    val extend = I;
  130.40 -  val merge = Symtab.merge eq_ctr_sugar;
  130.41 +  fun merge data : T = Symtab.merge (K true) data;
  130.42  );
  130.43  
  130.44  fun ctr_sugar_of ctxt =
  130.45 @@ -157,8 +151,6 @@
  130.46  fun register_ctr_sugar_global key ctr_sugar =
  130.47    Context.theory_map (Data.map (Symtab.default (key, ctr_sugar)));
  130.48  
  130.49 -val rep_compat_prefix = "new";
  130.50 -
  130.51  val isN = "is_";
  130.52  val unN = "un_";
  130.53  fun mk_unN 1 1 suf = unN ^ suf
  130.54 @@ -286,7 +278,7 @@
  130.55  
  130.56  fun eta_expand_arg xs f_xs = fold_rev Term.lambda xs f_xs;
  130.57  
  130.58 -fun prepare_wrap_free_constructors prep_term ((((no_discs_sels, (no_code, rep_compat)), raw_ctrs),
  130.59 +fun prepare_wrap_free_constructors prep_term ((((no_discs_sels, no_code), raw_ctrs),
  130.60      raw_case_binding), (raw_disc_bindings, (raw_sel_bindingss, raw_sel_defaultss))) no_defs_lthy =
  130.61    let
  130.62      (* TODO: sanity checks on arguments *)
  130.63 @@ -304,8 +296,7 @@
  130.64      val fc_b_name = Long_Name.base_name fcT_name;
  130.65      val fc_b = Binding.name fc_b_name;
  130.66  
  130.67 -    fun qualify mandatory =
  130.68 -      Binding.qualify mandatory fc_b_name o (rep_compat ? Binding.qualify false rep_compat_prefix);
  130.69 +    fun qualify mandatory = Binding.qualify mandatory fc_b_name;
  130.70  
  130.71      fun dest_TFree_or_TVar (TFree sS) = sS
  130.72        | dest_TFree_or_TVar (TVar ((s, _), S)) = (s, S)
  130.73 @@ -363,8 +354,10 @@
  130.74  
  130.75      val case_Ts = map (fn Ts => Ts ---> B) ctr_Tss;
  130.76  
  130.77 -    val ((((((((xss, xss'), yss), fs), gs), [u', v']), [w]), (p, p')), names_lthy) = no_defs_lthy |>
  130.78 -      mk_Freess' "x" ctr_Tss
  130.79 +    val (((((((([exh_y], (xss, xss')), yss), fs), gs), [u', v']), [w]), (p, p')), names_lthy) =
  130.80 +      no_defs_lthy
  130.81 +      |> mk_Frees "y" [fcT] (* for compatibility with "datatype_realizer.ML" *)
  130.82 +      ||>> mk_Freess' "x" ctr_Tss
  130.83        ||>> mk_Freess "y" ctr_Tss
  130.84        ||>> mk_Frees "f" case_Ts
  130.85        ||>> mk_Frees "g" case_Ts
  130.86 @@ -443,7 +436,7 @@
  130.87  
  130.88      val (all_sels_distinct, discs, selss, disc_defs, sel_defs, sel_defss, lthy') =
  130.89        if no_discs_sels then
  130.90 -        (true, [], [], [], [], [], lthy)
  130.91 +        (true, [], [], [], [], [], lthy')
  130.92        else
  130.93          let
  130.94            fun disc_free b = Free (Binding.name_of b, mk_pred1T fcT);
  130.95 @@ -533,8 +526,8 @@
  130.96      fun mk_imp_p Qs = Logic.list_implies (Qs, HOLogic.mk_Trueprop p);
  130.97  
  130.98      val exhaust_goal =
  130.99 -      let fun mk_prem xctr xs = fold_rev Logic.all xs (mk_imp_p [mk_Trueprop_eq (u, xctr)]) in
 130.100 -        fold_rev Logic.all [p, u] (mk_imp_p (map2 mk_prem xctrs xss))
 130.101 +      let fun mk_prem xctr xs = fold_rev Logic.all xs (mk_imp_p [mk_Trueprop_eq (exh_y, xctr)]) in
 130.102 +        fold_rev Logic.all [p, exh_y] (mk_imp_p (map2 mk_prem xctrs xss))
 130.103        end;
 130.104  
 130.105      val inject_goalss =
 130.106 @@ -560,7 +553,10 @@
 130.107  
 130.108      fun after_qed thmss lthy =
 130.109        let
 130.110 -        val ([exhaust_thm], (inject_thmss, half_distinct_thmss)) = (hd thmss, chop n (tl thmss));
 130.111 +        val ([exhaust_thm0], (inject_thmss, half_distinct_thmss)) = (hd thmss, chop n (tl thmss));
 130.112 +        (* for "datatype_realizer.ML": *)
 130.113 +        val exhaust_thm =
 130.114 +          Thm.name_derivation (fcT_name ^ Long_Name.separator ^ exhaustN) exhaust_thm0;
 130.115  
 130.116          val inject_thms = flat inject_thmss;
 130.117  
 130.118 @@ -615,7 +611,8 @@
 130.119            in
 130.120              (Goal.prove_sorry lthy [] [] goal (fn _ => mk_case_cong_tac lthy uexhaust_thm case_thms),
 130.121               Goal.prove_sorry lthy [] [] weak_goal (K (etac arg_cong 1)))
 130.122 -            |> pairself (Thm.close_derivation #> singleton (Proof_Context.export names_lthy lthy))
 130.123 +            |> pairself (singleton (Proof_Context.export names_lthy lthy) #>
 130.124 +              Thm.close_derivation)
 130.125            end;
 130.126  
 130.127          val split_lhs = q $ ufcase;
 130.128 @@ -636,14 +633,14 @@
 130.129          fun prove_split selss goal =
 130.130            Goal.prove_sorry lthy [] [] goal (fn _ =>
 130.131              mk_split_tac lthy uexhaust_thm case_thms selss inject_thmss distinct_thmsss)
 130.132 -          |> Thm.close_derivation
 130.133 -          |> singleton (Proof_Context.export names_lthy lthy);
 130.134 +          |> singleton (Proof_Context.export names_lthy lthy)
 130.135 +          |> Thm.close_derivation;
 130.136  
 130.137          fun prove_split_asm asm_goal split_thm =
 130.138            Goal.prove_sorry lthy [] [] asm_goal (fn {context = ctxt, ...} =>
 130.139              mk_split_asm_tac ctxt split_thm)
 130.140 -          |> Thm.close_derivation
 130.141 -          |> singleton (Proof_Context.export names_lthy lthy);
 130.142 +          |> singleton (Proof_Context.export names_lthy lthy)
 130.143 +          |> Thm.close_derivation;
 130.144  
 130.145          val (split_thm, split_asm_thm) =
 130.146            let
 130.147 @@ -697,8 +694,8 @@
 130.148                    val goal = mk_Trueprop_eq (mk_uu_eq (), the_single exist_xs_u_eq_ctrs);
 130.149                  in
 130.150                    Goal.prove_sorry lthy [] [] goal (fn _ => mk_unique_disc_def_tac m uexhaust_thm)
 130.151 +                  |> singleton (Proof_Context.export names_lthy lthy)
 130.152                    |> Thm.close_derivation
 130.153 -                  |> singleton (Proof_Context.export names_lthy lthy)
 130.154                  end;
 130.155  
 130.156                fun mk_alternate_disc_def k =
 130.157 @@ -710,8 +707,8 @@
 130.158                    Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, ...} =>
 130.159                      mk_alternate_disc_def_tac ctxt k (nth disc_defs (2 - k))
 130.160                        (nth distinct_thms (2 - k)) uexhaust_thm)
 130.161 +                  |> singleton (Proof_Context.export names_lthy lthy)
 130.162                    |> Thm.close_derivation
 130.163 -                  |> singleton (Proof_Context.export names_lthy lthy)
 130.164                  end;
 130.165  
 130.166                val has_alternate_disc_def =
 130.167 @@ -847,8 +844,8 @@
 130.168                      mk_expand_tac lthy n ms (inst_thm u disc_exhaust_thm)
 130.169                        (inst_thm v disc_exhaust_thm) uncollapse_thms disc_exclude_thmsss
 130.170                        disc_exclude_thmsss')
 130.171 +                  |> singleton (Proof_Context.export names_lthy lthy)
 130.172                    |> Thm.close_derivation
 130.173 -                  |> singleton (Proof_Context.export names_lthy lthy)
 130.174                  end;
 130.175  
 130.176                val (sel_split_thm, sel_split_asm_thm) =
 130.177 @@ -869,8 +866,8 @@
 130.178                  in
 130.179                    Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, ...} =>
 130.180                      mk_case_eq_if_tac ctxt n uexhaust_thm case_thms disc_thmss' sel_thmss)
 130.181 +                  |> singleton (Proof_Context.export names_lthy lthy)
 130.182                    |> Thm.close_derivation
 130.183 -                  |> singleton (Proof_Context.export names_lthy lthy)
 130.184                  end;
 130.185              in
 130.186                (all_sel_thms, sel_thmss, disc_thmss, nontriv_disc_thms, discI_thms,
 130.187 @@ -927,8 +924,7 @@
 130.188        in
 130.189          (ctr_sugar,
 130.190           lthy
 130.191 -         |> not rep_compat ?
 130.192 -            Local_Theory.declaration {syntax = false, pervasive = true}
 130.193 +         |> Local_Theory.declaration {syntax = false, pervasive = true}
 130.194                (fn phi => Case_Translation.register
 130.195                   (Morphism.term phi casex) (map (Morphism.term phi) ctrs))
 130.196           |> Local_Theory.background_theory (fold (fold Code.del_eqn) [disc_defs, sel_defs])
 130.197 @@ -965,10 +961,10 @@
 130.198  
 130.199  val parse_wrap_free_constructors_options =
 130.200    Scan.optional (@{keyword "("} |-- Parse.list1
 130.201 -        (Parse.reserved "no_discs_sels" >> K 0 || Parse.reserved "no_code" >> K 1 ||
 130.202 -         Parse.reserved "rep_compat" >> K 2) --| @{keyword ")"}
 130.203 -      >> (fn js => (member (op =) js 0, (member (op =) js 1, member (op =) js 2))))
 130.204 -    (false, (false, false));
 130.205 +        (Parse.reserved "no_discs_sels" >> K 0 || Parse.reserved "no_code" >> K 1) --|
 130.206 +      @{keyword ")"}
 130.207 +      >> (fn js => (member (op =) js 0, member (op =) js 1)))
 130.208 +    (false, false);
 130.209  
 130.210  val _ =
 130.211    Outer_Syntax.local_theory_to_proof @{command_spec "wrap_free_constructors"}
   131.1 --- a/src/HOL/Tools/Datatype/datatype.ML	Wed Feb 12 09:06:04 2014 +0100
   131.2 +++ b/src/HOL/Tools/Datatype/datatype.ML	Wed Feb 12 10:59:25 2014 +0100
   131.3 @@ -62,7 +62,7 @@
   131.4      val new_type_names = map (Binding.name_of o fst) types_syntax;
   131.5      val big_name = space_implode "_" new_type_names;
   131.6      val thy1 = Sign.add_path big_name thy;
   131.7 -    val big_rec_name = big_name ^ "_rep_set";
   131.8 +    val big_rec_name = "rep_set_" ^ big_name;
   131.9      val rep_set_names' =
  131.10        if length descr' = 1 then [big_rec_name]
  131.11        else map (prefix (big_rec_name ^ "_") o string_of_int) (1 upto length descr');
  131.12 @@ -283,11 +283,11 @@
  131.13      (* isomorphisms are defined using primrec-combinators:                 *)
  131.14      (* generate appropriate functions for instantiating primrec-combinator *)
  131.15      (*                                                                     *)
  131.16 -    (*   e.g.  dt_Rep_i = list_rec ... (%h t y. In1 (Scons (Leaf h) y))    *)
  131.17 +    (*   e.g.  Rep_dt_i = list_rec ... (%h t y. In1 (Scons (Leaf h) y))    *)
  131.18      (*                                                                     *)
  131.19      (* also generate characteristic equations for isomorphisms             *)
  131.20      (*                                                                     *)
  131.21 -    (*   e.g.  dt_Rep_i (cons h t) = In1 (Scons (dt_Rep_j h) (dt_Rep_i t)) *)
  131.22 +    (*   e.g.  Rep_dt_i (cons h t) = In1 (Scons (Rep_dt_j h) (Rep_dt_i t)) *)
  131.23      (*---------------------------------------------------------------------*)
  131.24  
  131.25      fun make_iso_def k ks n (cname, cargs) (fs, eqns, i) =
  131.26 @@ -387,7 +387,7 @@
  131.27            end
  131.28        in map (fn r => r RS subst) (thm :: map mk_thm arities) end;
  131.29  
  131.30 -    (* prove  inj dt_Rep_i  and  dt_Rep_i x : dt_rep_set_i *)
  131.31 +    (* prove  inj Rep_dt_i  and  Rep_dt_i x : rep_set_dt_i *)
  131.32  
  131.33      val fun_congs =
  131.34        map (fn T => make_elim (Drule.instantiate' [SOME (ctyp_of thy5 T)] [] fun_cong)) branchTs;
  131.35 @@ -457,7 +457,7 @@
  131.36      val iso_inj_thms =
  131.37        map snd newT_iso_inj_thms @ map (fn r => r RS @{thm injD}) iso_inj_thms_unfolded;
  131.38  
  131.39 -    (* prove  dt_rep_set_i x --> x : range dt_Rep_i *)
  131.40 +    (* prove  rep_set_dt_i x --> x : range Rep_dt_i *)
  131.41  
  131.42      fun mk_iso_t (((set_name, iso_name), i), T) =
  131.43        let val isoT = T --> Univ_elT in
   132.1 --- a/src/HOL/Tools/Datatype/datatype_codegen.ML	Wed Feb 12 09:06:04 2014 +0100
   132.2 +++ b/src/HOL/Tools/Datatype/datatype_codegen.ML	Wed Feb 12 10:59:25 2014 +0100
   132.3 @@ -13,15 +13,11 @@
   132.4  
   132.5  fun add_code_for_datatype fcT_name thy =
   132.6    let
   132.7 -    val (As', ctr_specs) = Datatype_Data.the_spec thy fcT_name;
   132.8 -    val {inject = inject_thms, distinct = distinct_thms, case_rewrites = case_thms, ...} =
   132.9 -      Datatype_Data.the_info thy fcT_name;
  132.10 -
  132.11 -    val As = map TFree As';
  132.12 -    val fcT = Type (fcT_name, As);
  132.13 -    val ctrs = map (fn (c, arg_Ts) => (c, arg_Ts ---> fcT)) ctr_specs;
  132.14 +    val ctxt = Proof_Context.init_global thy
  132.15 +    val SOME {ctrs, injects, distincts, case_thms, ...} = Ctr_Sugar.ctr_sugar_of ctxt fcT_name
  132.16 +    val Type (_, As) = body_type (fastype_of (hd ctrs))
  132.17    in
  132.18 -    Ctr_Sugar_Code.add_ctr_code fcT_name As ctrs inject_thms distinct_thms case_thms thy
  132.19 +    Ctr_Sugar_Code.add_ctr_code fcT_name As (map dest_Const ctrs) injects distincts case_thms thy
  132.20    end;
  132.21  
  132.22  val _ = Theory.setup (Datatype_Data.interpretation (K (fold add_code_for_datatype)));
   133.1 --- a/src/HOL/Tools/Datatype/rep_datatype.ML	Wed Feb 12 09:06:04 2014 +0100
   133.2 +++ b/src/HOL/Tools/Datatype/rep_datatype.ML	Wed Feb 12 10:59:25 2014 +0100
   133.3 @@ -87,7 +87,7 @@
   133.4  
   133.5      val induct_Ps = map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (concl_of induct)));
   133.6  
   133.7 -    val big_rec_name' = big_name ^ "_rec_set";
   133.8 +    val big_rec_name' = "rec_set_" ^ big_name;
   133.9      val rec_set_names' =
  133.10        if length descr' = 1 then [big_rec_name']
  133.11        else map (prefix (big_rec_name' ^ "_") o string_of_int) (1 upto length descr');
  133.12 @@ -215,7 +215,7 @@
  133.13  
  133.14      (* define primrec combinators *)
  133.15  
  133.16 -    val big_reccomb_name = space_implode "_" new_type_names ^ "_rec";
  133.17 +    val big_reccomb_name = "rec_" ^ space_implode "_" new_type_names;
  133.18      val reccomb_names =
  133.19        map (Sign.full_bname thy1)
  133.20          (if length descr' = 1 then [big_reccomb_name]
  133.21 @@ -271,6 +271,7 @@
  133.22    let
  133.23      val _ = Datatype_Aux.message config "Proving characteristic theorems for case combinators ...";
  133.24  
  133.25 +    val ctxt = Proof_Context.init_global thy;
  133.26      val thy1 = Sign.add_path (space_implode "_" new_type_names) thy;
  133.27  
  133.28      val descr' = flat descr;
  133.29 @@ -288,48 +289,62 @@
  133.30            val Ts' = map mk_dummyT (filter Datatype_Aux.is_rec_type cargs)
  133.31          in Const (@{const_name undefined}, Ts @ Ts' ---> T') end) constrs) descr';
  133.32  
  133.33 -    val case_names = map (fn s => Sign.full_bname thy1 (s ^ "_case")) new_type_names;
  133.34 +    val case_names0 = map (fn s => Sign.full_bname thy1 ("case_" ^ s)) new_type_names;
  133.35  
  133.36      (* define case combinators via primrec combinators *)
  133.37  
  133.38 -    val (case_defs, thy2) =
  133.39 -      fold (fn ((((i, (_, _, constrs)), T), name), recname) => fn (defs, thy) =>
  133.40 -          let
  133.41 -            val (fns1, fns2) = split_list (map (fn ((_, cargs), j) =>
  133.42 -              let
  133.43 -                val Ts = map (Datatype_Aux.typ_of_dtyp descr') cargs;
  133.44 -                val Ts' = Ts @ map mk_dummyT (filter Datatype_Aux.is_rec_type cargs);
  133.45 -                val frees' = map2 (Datatype_Aux.mk_Free "x") Ts' (1 upto length Ts');
  133.46 -                val frees = take (length cargs) frees';
  133.47 -                val free = Datatype_Aux.mk_Free "f" (Ts ---> T') j;
  133.48 -              in
  133.49 -                (free, fold_rev (absfree o dest_Free) frees' (list_comb (free, frees)))
  133.50 -              end) (constrs ~~ (1 upto length constrs)));
  133.51 +    fun def_case ((((i, (_, _, constrs)), T as Type (Tcon, _)), name), recname) (defs, thy) =
  133.52 +      if is_some (Ctr_Sugar.ctr_sugar_of ctxt Tcon) then
  133.53 +        (defs, thy)
  133.54 +      else
  133.55 +        let
  133.56 +          val (fns1, fns2) = split_list (map (fn ((_, cargs), j) =>
  133.57 +            let
  133.58 +              val Ts = map (Datatype_Aux.typ_of_dtyp descr') cargs;
  133.59 +              val Ts' = Ts @ map mk_dummyT (filter Datatype_Aux.is_rec_type cargs);
  133.60 +              val frees' = map2 (Datatype_Aux.mk_Free "x") Ts' (1 upto length Ts');
  133.61 +              val frees = take (length cargs) frees';
  133.62 +              val free = Datatype_Aux.mk_Free "f" (Ts ---> T') j;
  133.63 +            in
  133.64 +              (free, fold_rev (absfree o dest_Free) frees' (list_comb (free, frees)))
  133.65 +            end) (constrs ~~ (1 upto length constrs)));
  133.66  
  133.67 -            val caseT = map (snd o dest_Free) fns1 @ [T] ---> T';
  133.68 -            val fns = flat (take i case_dummy_fns) @ fns2 @ flat (drop (i + 1) case_dummy_fns);
  133.69 -            val reccomb = Const (recname, (map fastype_of fns) @ [T] ---> T');
  133.70 -            val decl = ((Binding.name (Long_Name.base_name name), caseT), NoSyn);
  133.71 -            val def =
  133.72 -              (Binding.name (Thm.def_name (Long_Name.base_name name)),
  133.73 -                Logic.mk_equals (Const (name, caseT),
  133.74 -                  fold_rev lambda fns1
  133.75 -                    (list_comb (reccomb,
  133.76 -                      flat (take i case_dummy_fns) @ fns2 @ flat (drop (i + 1) case_dummy_fns)))));
  133.77 -            val ([def_thm], thy') =
  133.78 -              thy
  133.79 -              |> Sign.declare_const_global decl |> snd
  133.80 -              |> (Global_Theory.add_defs false o map Thm.no_attributes) [def];
  133.81 +          val caseT = map (snd o dest_Free) fns1 @ [T] ---> T';
  133.82 +          val fns = flat (take i case_dummy_fns) @ fns2 @ flat (drop (i + 1) case_dummy_fns);
  133.83 +          val reccomb = Const (recname, (map fastype_of fns) @ [T] ---> T');
  133.84 +          val decl = ((Binding.name (Long_Name.base_name name), caseT), NoSyn);
  133.85 +          val def =
  133.86 +            (Binding.name (Thm.def_name (Long_Name.base_name name)),
  133.87 +              Logic.mk_equals (Const (name, caseT),
  133.88 +                fold_rev lambda fns1
  133.89 +                  (list_comb (reccomb,
  133.90 +                    flat (take i case_dummy_fns) @ fns2 @ flat (drop (i + 1) case_dummy_fns)))));
  133.91 +          val ([def_thm], thy') =
  133.92 +            thy
  133.93 +            |> Sign.declare_const_global decl |> snd
  133.94 +            |> (Global_Theory.add_defs false o map Thm.no_attributes) [def];
  133.95 +        in (defs @ [def_thm], thy') end;
  133.96  
  133.97 -          in (defs @ [def_thm], thy') end)
  133.98 -        (hd descr ~~ newTs ~~ case_names ~~ take (length newTs) reccomb_names) ([], thy1);
  133.99 +    val (case_defs, thy2) =
 133.100 +      fold def_case (hd descr ~~ newTs ~~ case_names0 ~~ take (length newTs) reccomb_names)
 133.101 +        ([], thy1);
 133.102 +
 133.103 +    fun prove_case t =
 133.104 +      Goal.prove_sorry_global thy2 [] [] t (fn {context = ctxt, ...} =>
 133.105 +        EVERY [rewrite_goals_tac ctxt (case_defs @ map mk_meta_eq primrec_thms), rtac refl 1]);
 133.106 +
 133.107 +    fun prove_cases (Type (Tcon, _)) ts =
 133.108 +      (case Ctr_Sugar.ctr_sugar_of ctxt Tcon of
 133.109 +        SOME {case_thms, ...} => case_thms
 133.110 +      | NONE => map prove_case ts);
 133.111  
 133.112      val case_thms =
 133.113 -      (map o map) (fn t =>
 133.114 -          Goal.prove_sorry_global thy2 [] [] t
 133.115 -            (fn {context = ctxt, ...} =>
 133.116 -              EVERY [rewrite_goals_tac ctxt (case_defs @ map mk_meta_eq primrec_thms), rtac refl 1]))
 133.117 -        (Datatype_Prop.make_cases case_names descr thy2);
 133.118 +      map2 prove_cases newTs (Datatype_Prop.make_cases case_names0 descr thy2);
 133.119 +
 133.120 +    fun case_name_of (th :: _) =
 133.121 +      fst (dest_Const (head_of (fst (HOLogic.dest_eq (HOLogic.dest_Trueprop (prop_of th))))));
 133.122 +
 133.123 +    val case_names = map case_name_of case_thms;
 133.124    in
 133.125      thy2
 133.126      |> Context.theory_map ((fold o fold) Nitpick_Simps.add_thm case_thms)
   134.1 --- a/src/HOL/Tools/Function/function.ML	Wed Feb 12 09:06:04 2014 +0100
   134.2 +++ b/src/HOL/Tools/Function/function.ML	Wed Feb 12 10:59:25 2014 +0100
   134.3 @@ -265,14 +265,14 @@
   134.4  
   134.5  fun add_case_cong n thy =
   134.6    let
   134.7 -    val cong = #case_cong (Datatype.the_info thy n)
   134.8 +    val cong = #case_cong (Datatype_Data.the_info thy n)
   134.9        |> safe_mk_meta_eq
  134.10    in
  134.11      Context.theory_map
  134.12        (Function_Ctx_Tree.map_function_congs (Thm.add_thm cong)) thy
  134.13    end
  134.14  
  134.15 -val setup_case_cong = Datatype.interpretation (K (fold add_case_cong))
  134.16 +val setup_case_cong = Datatype_Data.interpretation (K (fold add_case_cong))
  134.17  
  134.18  
  134.19  (* setup *)
   135.1 --- a/src/HOL/Tools/Function/function_core.ML	Wed Feb 12 09:06:04 2014 +0100
   135.2 +++ b/src/HOL/Tools/Function/function_core.ML	Wed Feb 12 10:59:25 2014 +0100
   135.3 @@ -829,7 +829,7 @@
   135.4    let
   135.5      val FunctionConfig {domintros, default=default_opt, ...} = config
   135.6  
   135.7 -    val default_str = the_default "%x. undefined" default_opt (*FIXME dynamic scoping*)
   135.8 +    val default_str = the_default "%x. HOL.undefined" default_opt
   135.9      val fvar = Free (fname, fT)
  135.10      val domT = domain_type fT
  135.11      val ranT = range_type fT
   136.1 --- a/src/HOL/Tools/Function/sum_tree.ML	Wed Feb 12 09:06:04 2014 +0100
   136.2 +++ b/src/HOL/Tools/Function/sum_tree.ML	Wed Feb 12 10:59:25 2014 +0100
   136.3 @@ -32,8 +32,7 @@
   136.4  (* Sum types *)
   136.5  fun mk_sumT LT RT = Type (@{type_name Sum_Type.sum}, [LT, RT])
   136.6  fun mk_sumcase TL TR T l r =
   136.7 -  Const (@{const_name sum.sum_case},
   136.8 -    (TL --> T) --> (TR --> T) --> mk_sumT TL TR --> T) $ l $ r
   136.9 +  Const (@{const_name sum.case_sum}, (TL --> T) --> (TR --> T) --> mk_sumT TL TR --> T) $ l $ r
  136.10  
  136.11  val App = curry op $
  136.12  
  136.13 @@ -50,9 +49,9 @@
  136.14    access_top_down
  136.15    { init = (ST, I : term -> term),
  136.16      left = (fn (T as Type (@{type_name Sum_Type.sum}, [LT, RT]), proj) =>
  136.17 -      (LT, App (Const (@{const_name Sum_Type.Projl}, T --> LT)) o proj)),
  136.18 +      (LT, App (Const (@{const_name Sum_Type.projl}, T --> LT)) o proj)),
  136.19      right =(fn (T as Type (@{type_name Sum_Type.sum}, [LT, RT]), proj) =>
  136.20 -      (RT, App (Const (@{const_name Sum_Type.Projr}, T --> RT)) o proj))} n i
  136.21 +      (RT, App (Const (@{const_name Sum_Type.projr}, T --> RT)) o proj))} n i
  136.22    |> snd
  136.23  
  136.24  fun mk_sumcases T fs =
   137.1 --- a/src/HOL/Tools/Nitpick/nitpick_hol.ML	Wed Feb 12 09:06:04 2014 +0100
   137.2 +++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML	Wed Feb 12 10:59:25 2014 +0100
   137.3 @@ -2267,7 +2267,7 @@
   137.4        HOLogic.Collect_const tuple_T $ list_comb (Const base_x, outer_bounds)
   137.5      val step_set =
   137.6        HOLogic.Collect_const prod_T
   137.7 -      $ (Const (@{const_name prod_case}, curried_T --> uncurried_T)
   137.8 +      $ (Const (@{const_name case_prod}, curried_T --> uncurried_T)
   137.9                  $ list_comb (Const step_x, outer_bounds))
  137.10      val image_set =
  137.11        image_const $ (rtrancl_const $ step_set) $ base_set
   138.1 --- a/src/HOL/Tools/Predicate_Compile/code_prolog.ML	Wed Feb 12 09:06:04 2014 +0100
   138.2 +++ b/src/HOL/Tools/Predicate_Compile/code_prolog.ML	Wed Feb 12 10:59:25 2014 +0100
   138.3 @@ -511,13 +511,6 @@
   138.4  
   138.5  fun mk_lim_relname T = "lim_" ^  mk_relname T
   138.6  
   138.7 -(* This is copied from "pat_completeness.ML" *)
   138.8 -fun inst_constrs_of thy (T as Type (name, _)) =
   138.9 -  map (fn (Cn,CT) =>
  138.10 -    Envir.subst_term_types (Sign.typ_match thy (body_type CT, T) Vartab.empty) (Const (Cn, CT)))
  138.11 -    (the (Datatype.get_constrs thy name))
  138.12 -  | inst_constrs_of thy T = raise TYPE ("inst_constrs_of", [T], [])
  138.13 -
  138.14  fun is_recursive_constr T (Const (constr_name, T')) = member (op =) (binder_types T') T
  138.15    
  138.16  fun mk_ground_impl ctxt limited_types (T as Type (Tcon, Targs)) (seen, constant_table) =
  138.17 @@ -549,7 +542,7 @@
  138.18          in
  138.19            (clause :: flat rec_clauses, (seen', constant_table''))
  138.20          end
  138.21 -      val constrs = inst_constrs_of (Proof_Context.theory_of ctxt) T
  138.22 +      val constrs = Function_Lib.inst_constrs_of (Proof_Context.theory_of ctxt) T
  138.23        val constrs' = (constrs ~~ map (is_recursive_constr T) constrs)
  138.24          |> (fn cs => filter_out snd cs @ filter snd cs)
  138.25        val (clauses, constant_table') =
   139.1 --- a/src/HOL/Tools/Predicate_Compile/mode_inference.ML	Wed Feb 12 09:06:04 2014 +0100
   139.2 +++ b/src/HOL/Tools/Predicate_Compile/mode_inference.ML	Wed Feb 12 10:59:25 2014 +0100
   139.3 @@ -183,19 +183,19 @@
   139.4    | collect_non_invertible_subterms ctxt t (names, eqs) =
   139.5      case (strip_comb t) of (f, args) =>
   139.6        if is_invertible_function ctxt f then
   139.7 -          let
   139.8 -            val (args', (names', eqs')) =
   139.9 -              fold_map (collect_non_invertible_subterms ctxt) args (names, eqs)
  139.10 -          in
  139.11 -            (list_comb (f, args'), (names', eqs'))
  139.12 -          end
  139.13 -        else
  139.14 -          let
  139.15 -            val s = singleton (Name.variant_list names) "x"
  139.16 -            val v = Free (s, fastype_of t)
  139.17 -          in
  139.18 -            (v, (s :: names, HOLogic.mk_eq (v, t) :: eqs))
  139.19 -          end
  139.20 +        let
  139.21 +          val (args', (names', eqs')) =
  139.22 +            fold_map (collect_non_invertible_subterms ctxt) args (names, eqs)
  139.23 +        in
  139.24 +          (list_comb (f, args'), (names', eqs'))
  139.25 +        end
  139.26 +      else
  139.27 +        let
  139.28 +          val s = singleton (Name.variant_list names) "x"
  139.29 +          val v = Free (s, fastype_of t)
  139.30 +        in
  139.31 +          (v, (s :: names, HOLogic.mk_eq (v, t) :: eqs))
  139.32 +        end
  139.33  (*
  139.34    if is_constrt thy t then (t, (names, eqs)) else
  139.35      let
   140.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML	Wed Feb 12 09:06:04 2014 +0100
   140.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML	Wed Feb 12 10:59:25 2014 +0100
   140.3 @@ -47,6 +47,7 @@
   140.4    val is_pred_equation : thm -> bool
   140.5    val is_intro : string -> thm -> bool
   140.6    val is_predT : typ -> bool
   140.7 +  val get_constrs : theory -> (string * (int * string)) list
   140.8    val is_constrt : theory -> term -> bool
   140.9    val is_constr : Proof.context -> string -> bool
  140.10    val strip_ex : term -> (string * typ) list * term
  140.11 @@ -477,15 +478,22 @@
  140.12  fun is_predT (T as Type("fun", [_, _])) = (body_type T = @{typ bool})
  140.13    | is_predT _ = false
  140.14  
  140.15 +fun get_constrs thy =
  140.16 +  let
  140.17 +    val ctxt = Proof_Context.init_global thy
  140.18 +  in
  140.19 +    Ctr_Sugar.ctr_sugars_of ctxt
  140.20 +    |> maps (map_filter (try dest_Const) o #ctrs)
  140.21 +    |> map (apsnd (fn T => (BNF_Util.num_binder_types T, fst (dest_Type (body_type T)))))
  140.22 +  end
  140.23 +
  140.24  (*** check if a term contains only constructor functions ***)
  140.25  (* TODO: another copy in the core! *)
  140.26  (* FIXME: constructor terms are supposed to be seen in the way the code generator
  140.27    sees constructors.*)
  140.28  fun is_constrt thy =
  140.29    let
  140.30 -    val cnstrs = flat (maps
  140.31 -      (map (fn (_, (Tname, _, cs)) => map (apsnd (rpair Tname o length)) cs) o #descr o snd)
  140.32 -      (Symtab.dest (Datatype.get_all thy)));
  140.33 +    val cnstrs = get_constrs thy
  140.34      fun check t = (case strip_comb t of
  140.35          (Var _, []) => true
  140.36        | (Free _, []) => true
  140.37 @@ -495,23 +503,6 @@
  140.38        | _ => false)
  140.39    in check end;
  140.40  
  140.41 -(* returns true if t is an application of an datatype constructor *)
  140.42 -(* which then consequently would be splitted *)
  140.43 -(* else false *)
  140.44 -(*
  140.45 -fun is_constructor thy t =
  140.46 -  if (is_Type (fastype_of t)) then
  140.47 -    (case DatatypePackage.get_datatype thy ((fst o dest_Type o fastype_of) t) of
  140.48 -      NONE => false
  140.49 -    | SOME info => (let
  140.50 -      val constr_consts = maps (fn (_, (_, _, constrs)) => map fst constrs) (#descr info)
  140.51 -      val (c, _) = strip_comb t
  140.52 -      in (case c of
  140.53 -        Const (name, _) => name mem_string constr_consts
  140.54 -        | _ => false) end))
  140.55 -  else false
  140.56 -*)
  140.57 -
  140.58  val is_constr = Code.is_constr o Proof_Context.theory_of;
  140.59  
  140.60  fun strip_all t = (Term.strip_all_vars t, Term.strip_all_body t)
  140.61 @@ -601,7 +592,8 @@
  140.62      |> Local_Defs.unfold ctxt [@{thm atomize_conjL[symmetric]},
  140.63        @{thm atomize_all[symmetric]}, @{thm atomize_imp[symmetric]}]
  140.64  
  140.65 -fun find_split_thm thy (Const (name, _)) = Option.map #split (Datatype.info_of_case thy name)
  140.66 +fun find_split_thm thy (Const (name, _)) =
  140.67 +    Option.map #split (Ctr_Sugar.ctr_sugar_of_case (Proof_Context.init_global thy) name)
  140.68    | find_split_thm thy _ = NONE
  140.69  
  140.70  (* lifting term operations to theorems *)
  140.71 @@ -880,76 +872,72 @@
  140.72  (** making case distributivity rules **)
  140.73  (*** this should be part of the datatype package ***)
  140.74  
  140.75 -fun datatype_names_of_case_name thy case_name =
  140.76 -  map (#1 o #2) (#descr (the (Datatype.info_of_case thy case_name)))
  140.77 +fun datatype_name_of_case_name thy =
  140.78 +  Ctr_Sugar.ctr_sugar_of_case (Proof_Context.init_global thy)
  140.79 +  #> the #> #ctrs #> hd #> fastype_of #> body_type #> dest_Type #> fst
  140.80  
  140.81 -fun make_case_distribs case_names descr thy =
  140.82 +fun make_case_comb thy Tcon =
  140.83    let
  140.84 -    val case_combs = Datatype_Prop.make_case_combs case_names descr thy "f";
  140.85 -    fun make comb =
  140.86 -      let
  140.87 -        val Type ("fun", [T, T']) = fastype_of comb;
  140.88 -        val (Const (case_name, _), fs) = strip_comb comb
  140.89 -        val used = Term.add_tfree_names comb []
  140.90 -        val U = TFree (singleton (Name.variant_list used) "'t", HOLogic.typeS)
  140.91 -        val x = Free ("x", T)
  140.92 -        val f = Free ("f", T' --> U)
  140.93 -        fun apply_f f' =
  140.94 -          let
  140.95 -            val Ts = binder_types (fastype_of f')
  140.96 -            val bs = map Bound ((length Ts - 1) downto 0)
  140.97 -          in
  140.98 -            fold_rev absdummy Ts (f $ (list_comb (f', bs)))
  140.99 -          end
 140.100 -        val fs' = map apply_f fs
 140.101 -        val case_c' = Const (case_name, (map fastype_of fs') @ [T] ---> U)
 140.102 -      in
 140.103 -        HOLogic.mk_eq (f $ (comb $ x), list_comb (case_c', fs') $ x)
 140.104 -      end
 140.105 +    val ctxt = Proof_Context.init_global thy
 140.106 +    val SOME {casex, ...} = Ctr_Sugar.ctr_sugar_of ctxt Tcon
 140.107 +    val casex' = Type.legacy_freeze casex
 140.108 +    val Ts = BNF_Util.binder_fun_types (fastype_of casex')
 140.109    in
 140.110 -    map make case_combs
 140.111 +    list_comb (casex', map_index (fn (j, T) => Free ("f" ^ string_of_int j,  T)) Ts)
 140.112    end
 140.113  
 140.114 -fun case_rewrites thy Tcon =
 140.115 +fun make_case_distrib thy Tcon =
 140.116    let
 140.117 -    val {descr, case_name, ...} = Datatype.the_info thy Tcon
 140.118 +    val comb = make_case_comb thy Tcon;
 140.119 +    val Type ("fun", [T, T']) = fastype_of comb;
 140.120 +    val (Const (case_name, _), fs) = strip_comb comb
 140.121 +    val used = Term.add_tfree_names comb []
 140.122 +    val U = TFree (singleton (Name.variant_list used) "'t", HOLogic.typeS)
 140.123 +    val x = Free ("x", T)
 140.124 +    val f = Free ("f", T' --> U)
 140.125 +    fun apply_f f' =
 140.126 +      let
 140.127 +        val Ts = binder_types (fastype_of f')
 140.128 +        val bs = map Bound ((length Ts - 1) downto 0)
 140.129 +      in
 140.130 +        fold_rev absdummy Ts (f $ (list_comb (f', bs)))
 140.131 +      end
 140.132 +    val fs' = map apply_f fs
 140.133 +    val case_c' = Const (case_name, (map fastype_of fs') @ [T] ---> U)
 140.134    in
 140.135 -    map (Drule.export_without_context o Skip_Proof.make_thm thy o HOLogic.mk_Trueprop)
 140.136 -      (make_case_distribs [case_name] [descr] thy)
 140.137 +    HOLogic.mk_eq (f $ (comb $ x), list_comb (case_c', fs') $ x)
 140.138    end
 140.139  
 140.140 -fun instantiated_case_rewrites thy Tcon =
 140.141 +fun case_rewrite thy Tcon =
 140.142 +  (Drule.export_without_context o Skip_Proof.make_thm thy o HOLogic.mk_Trueprop)
 140.143 +    (make_case_distrib thy Tcon)
 140.144 +
 140.145 +fun instantiated_case_rewrite thy Tcon =
 140.146    let
 140.147 -    val rew_ths = case_rewrites thy Tcon
 140.148 +    val th = case_rewrite thy Tcon
 140.149      val ctxt = Proof_Context.init_global thy
 140.150 -    fun instantiate th =
 140.151 -    let
 140.152 -      val f = (fst (strip_comb (fst (HOLogic.dest_eq (HOLogic.dest_Trueprop (prop_of th))))))
 140.153 -      val Type ("fun", [uninst_T, uninst_T']) = fastype_of f
 140.154 -      val ([_, tname', uname, yname], ctxt') = Variable.add_fixes ["'t", "'t'", "'u", "y"] ctxt
 140.155 -      val T' = TFree (tname', HOLogic.typeS)
 140.156 -      val U = TFree (uname, HOLogic.typeS)
 140.157 -      val y = Free (yname, U)
 140.158 -      val f' = absdummy (U --> T') (Bound 0 $ y)
 140.159 -      val th' = Thm.certify_instantiate
 140.160 -        ([(dest_TVar uninst_T, U --> T'), (dest_TVar uninst_T', T')],
 140.161 -         [((fst (dest_Var f), (U --> T') --> T'), f')]) th
 140.162 -      val [th'] = Variable.export ctxt' ctxt [th']
 140.163 -   in
 140.164 -     th'
 140.165 -   end
 140.166 - in
 140.167 -   map instantiate rew_ths
 140.168 - end
 140.169 +    val f = (fst (strip_comb (fst (HOLogic.dest_eq (HOLogic.dest_Trueprop (prop_of th))))))
 140.170 +    val Type ("fun", [uninst_T, uninst_T']) = fastype_of f
 140.171 +    val ([_, tname', uname, yname], ctxt') = Variable.add_fixes ["'t", "'t'", "'u", "y"] ctxt
 140.172 +    val T' = TFree (tname', HOLogic.typeS)
 140.173 +    val U = TFree (uname, HOLogic.typeS)
 140.174 +    val y = Free (yname, U)
 140.175 +    val f' = absdummy (U --> T') (Bound 0 $ y)
 140.176 +    val th' = Thm.certify_instantiate
 140.177 +      ([(dest_TVar uninst_T, U --> T'), (dest_TVar uninst_T', T')],
 140.178 +       [((fst (dest_Var f), (U --> T') --> T'), f')]) th
 140.179 +    val [th'] = Variable.export ctxt' ctxt [th']
 140.180 +  in
 140.181 +    th'
 140.182 +  end
 140.183  
 140.184  fun case_betapply thy t =
 140.185    let
 140.186      val case_name = fst (dest_Const (fst (strip_comb t)))
 140.187 -    val Tcons = datatype_names_of_case_name thy case_name
 140.188 -    val ths = maps (instantiated_case_rewrites thy) Tcons
 140.189 +    val Tcon = datatype_name_of_case_name thy case_name
 140.190 +    val th = instantiated_case_rewrite thy Tcon
 140.191    in
 140.192 -    Raw_Simplifier.rewrite_term thy
 140.193 -      (map (fn th => th RS @{thm eq_reflection}) ths) [] t
 140.194 +    Raw_Simplifier.rewrite_term thy [th RS @{thm eq_reflection}] [] t
 140.195    end
 140.196  
 140.197  (*** conversions ***)
   141.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Wed Feb 12 09:06:04 2014 +0100
   141.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Wed Feb 12 10:59:25 2014 +0100
   141.3 @@ -814,13 +814,14 @@
   141.4      case T of
   141.5        TFree _ => NONE
   141.6      | Type (Tcon, _) =>
   141.7 -      (case Datatype.get_constrs (Proof_Context.theory_of ctxt) Tcon of
   141.8 +      (case Ctr_Sugar.ctr_sugar_of ctxt Tcon of
   141.9          NONE => NONE
  141.10 -      | SOME cs =>
  141.11 +      | SOME {ctrs, ...} =>
  141.12          (case strip_comb t of
  141.13            (Var _, []) => NONE
  141.14          | (Free _, []) => NONE
  141.15 -        | (Const (c, T), _) => if AList.defined (op =) cs c then SOME (c, T) else NONE))
  141.16 +        | (Const (c, T), _) =>
  141.17 +          if AList.defined (op =) (map_filter (try dest_Const) ctrs) c then SOME (c, T) else NONE))
  141.18    end
  141.19  
  141.20  fun partition_clause ctxt pos moded_clauses =
  141.21 @@ -991,7 +992,7 @@
  141.22  
  141.23  (* Definition of executable functions and their intro and elim rules *)
  141.24  
  141.25 -fun strip_split_abs (Const (@{const_name prod_case}, _) $ t) = strip_split_abs t
  141.26 +fun strip_split_abs (Const (@{const_name case_prod}, _) $ t) = strip_split_abs t
  141.27    | strip_split_abs (Abs (_, _, t)) = strip_split_abs t
  141.28    | strip_split_abs t = t
  141.29  
   142.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML	Wed Feb 12 09:06:04 2014 +0100
   142.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML	Wed Feb 12 10:59:25 2014 +0100
   142.3 @@ -260,8 +260,11 @@
   142.4      val ctxt = Proof_Context.init_global thy
   142.5      fun is_nondefining_const (c, _) = member (op =) logic_operator_names c
   142.6      fun has_code_pred_intros (c, _) = can (Core_Data.intros_of ctxt) c
   142.7 -    fun case_consts (c, _) = is_some (Datatype.info_of_case thy c)
   142.8 -    fun is_datatype_constructor (c, T) = is_some (Datatype.info_of_constr thy (c, T))
   142.9 +    fun case_consts (c, _) = is_some (Ctr_Sugar.ctr_sugar_of_case ctxt c)
  142.10 +    fun is_datatype_constructor (x as (_, T)) =
  142.11 +      (case body_type T of
  142.12 +        Type (Tcon, _) => can (Ctr_Sugar.dest_ctr ctxt Tcon) (Const x)
  142.13 +      | _ => false)
  142.14      fun defiants_of specs =
  142.15        fold (Term.add_consts o prop_of) specs []
  142.16        |> filter_out is_datatype_constructor
   143.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML	Wed Feb 12 09:06:04 2014 +0100
   143.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML	Wed Feb 12 10:59:25 2014 +0100
   143.3 @@ -46,30 +46,19 @@
   143.4  
   143.5  (* auxillary functions *)
   143.6  
   143.7 -fun is_Type (Type _) = true
   143.8 -  | is_Type _ = false
   143.9 -
  143.10 -(* returns true if t is an application of an datatype constructor *)
  143.11 +(* returns true if t is an application of a datatype constructor *)
  143.12  (* which then consequently would be splitted *)
  143.13 -(* else false *)
  143.14 -fun is_constructor thy t =
  143.15 -  if (is_Type (fastype_of t)) then
  143.16 -    (case Datatype.get_info thy ((fst o dest_Type o fastype_of) t) of
  143.17 -      NONE => false
  143.18 -    | SOME info => (let
  143.19 -      val constr_consts = maps (fn (_, (_, _, constrs)) => map fst constrs) (#descr info)
  143.20 -      val (c, _) = strip_comb t
  143.21 -      in (case c of
  143.22 -        Const (name, _) => member (op =) constr_consts name
  143.23 -        | _ => false) end))
  143.24 -  else false
  143.25 +fun is_constructor ctxt t =
  143.26 +  (case fastype_of t of
  143.27 +    Type (s, _) => s <> @{type_name fun} andalso can (Ctr_Sugar.dest_ctr ctxt s) t
  143.28 +  | _ => false);
  143.29  
  143.30  (* MAJOR FIXME:  prove_params should be simple
  143.31   - different form of introrule for parameters ? *)
  143.32  
  143.33  fun prove_param options ctxt nargs t deriv =
  143.34    let
  143.35 -    val  (f, args) = strip_comb (Envir.eta_contract t)
  143.36 +    val (f, args) = strip_comb (Envir.eta_contract t)
  143.37      val mode = head_mode_of deriv
  143.38      val param_derivations = param_derivations_of deriv
  143.39      val ho_args = ho_args_of mode args
  143.40 @@ -139,15 +128,14 @@
  143.41  
  143.42  fun prove_match options ctxt nargs out_ts =
  143.43    let
  143.44 -    val thy = Proof_Context.theory_of ctxt
  143.45      val eval_if_P =
  143.46        @{lemma "P ==> Predicate.eval x z ==> Predicate.eval (if P then x else y) z" by simp} 
  143.47      fun get_case_rewrite t =
  143.48 -      if (is_constructor thy t) then
  143.49 +      if is_constructor ctxt t then
  143.50          let
  143.51 -          val {case_rewrites, ...} = Datatype.the_info thy (fst (dest_Type (fastype_of t)))
  143.52 +          val SOME {case_thms, ...} = Ctr_Sugar.ctr_sugar_of ctxt (fst (dest_Type (fastype_of t)))
  143.53          in
  143.54 -          fold (union Thm.eq_thm) (case_rewrites :: map get_case_rewrite (snd (strip_comb t))) []
  143.55 +          fold (union Thm.eq_thm) (case_thms :: map get_case_rewrite (snd (strip_comb t))) []
  143.56          end
  143.57        else []
  143.58      val simprules = insert Thm.eq_thm @{thm "unit.cases"} (insert Thm.eq_thm @{thm "prod.cases"}
  143.59 @@ -309,18 +297,17 @@
  143.60  
  143.61  fun prove_match2 options ctxt out_ts =
  143.62    let
  143.63 -    val thy = Proof_Context.theory_of ctxt
  143.64      fun split_term_tac (Free _) = all_tac
  143.65        | split_term_tac t =
  143.66 -        if (is_constructor thy t) then
  143.67 +        if is_constructor ctxt t then
  143.68            let
  143.69 -            val {case_rewrites, split_asm, ...} =
  143.70 -              Datatype.the_info thy (fst (dest_Type (fastype_of t)))
  143.71 -            val num_of_constrs = length case_rewrites
  143.72 +            val SOME {case_thms, split_asm, ...} =
  143.73 +              Ctr_Sugar.ctr_sugar_of ctxt (fst (dest_Type (fastype_of t)))
  143.74 +            val num_of_constrs = length case_thms
  143.75              val (_, ts) = strip_comb t
  143.76            in
  143.77              print_tac options ("Term " ^ (Syntax.string_of_term ctxt t) ^ 
  143.78 -              "splitting with rules \n" ^ Display.string_of_thm ctxt split_asm)
  143.79 +              " splitting with rules \n" ^ Display.string_of_thm ctxt split_asm)
  143.80              THEN TRY (Splitter.split_asm_tac [split_asm] 1
  143.81                THEN (print_tac options "after splitting with split_asm rules")
  143.82              (* THEN (Simplifier.asm_full_simp_tac (put_simpset HOL_basic_ss ctxt) 1)
   144.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_specialisation.ML	Wed Feb 12 09:06:04 2014 +0100
   144.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_specialisation.ML	Wed Feb 12 10:59:25 2014 +0100
   144.3 @@ -41,9 +41,7 @@
   144.4  (* patterns only constructed of variables and pairs/tuples are trivial constructor terms*)
   144.5  fun is_nontrivial_constrt thy t =
   144.6    let
   144.7 -    val cnstrs = flat (maps
   144.8 -      (map (fn (_, (Tname, _, cs)) => map (apsnd (rpair Tname o length)) cs) o #descr o snd)
   144.9 -      (Symtab.dest (Datatype.get_all thy)));
  144.10 +    val cnstrs = get_constrs thy
  144.11      fun check t = (case strip_comb t of
  144.12          (Var _, []) => (true, true)
  144.13        | (Free _, []) => (true, true)
  144.14 @@ -107,6 +105,7 @@
  144.15  
  144.16  and find_specialisations black_list specs thy =
  144.17    let
  144.18 +    val ctxt = Proof_Context.init_global thy
  144.19      val add_vars = fold_aterms (fn Var v => cons v | _ => I);
  144.20      fun fresh_free T free_names =
  144.21        let
  144.22 @@ -132,10 +131,11 @@
  144.23        | restrict_pattern' thy ((T as TFree _, t) :: Tts) free_names =
  144.24          replace_term_and_restrict thy T t Tts free_names
  144.25        | restrict_pattern' thy ((T as Type (Tcon, _), t) :: Tts) free_names =
  144.26 -        case Datatype.get_constrs thy Tcon of
  144.27 +        case Ctr_Sugar.ctr_sugar_of ctxt Tcon of
  144.28            NONE => replace_term_and_restrict thy T t Tts free_names
  144.29 -        | SOME constrs => (case strip_comb t of
  144.30 -          (Const (s, _), ats) => (case AList.lookup (op =) constrs s of
  144.31 +        | SOME {ctrs, ...} => (case strip_comb t of
  144.32 +          (Const (s, _), ats) =>
  144.33 +          (case AList.lookup (op =) (map_filter (try dest_Const) ctrs) s of
  144.34              SOME constr_T =>
  144.35                let
  144.36                  val (Ts', T') = strip_type constr_T
   145.1 --- a/src/HOL/Tools/Quickcheck/random_generators.ML	Wed Feb 12 09:06:04 2014 +0100
   145.2 +++ b/src/HOL/Tools/Quickcheck/random_generators.ML	Wed Feb 12 10:59:25 2014 +0100
   145.3 @@ -312,7 +312,7 @@
   145.4      fun mk_scomp T1 T2 sT f g = Const (@{const_name scomp},
   145.5        liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
   145.6      fun mk_split T = Sign.mk_const thy
   145.7 -      (@{const_name prod_case}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
   145.8 +      (@{const_name case_prod}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
   145.9      fun mk_scomp_split T t t' =
  145.10        mk_scomp (mk_termtyp T) resultT @{typ Random.seed} t
  145.11          (mk_split T $ Abs ("", T, Abs ("", @{typ "unit => term"}, t')));
  145.12 @@ -358,7 +358,7 @@
  145.13      fun mk_scomp T1 T2 sT f g = Const (@{const_name scomp},
  145.14        liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
  145.15      fun mk_split T = Sign.mk_const thy
  145.16 -      (@{const_name prod_case}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
  145.17 +      (@{const_name case_prod}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
  145.18      fun mk_scomp_split T t t' =
  145.19        mk_scomp (mk_termtyp T) resultT @{typ Random.seed} t
  145.20          (mk_split T $ Abs ("", T, Abs ("", @{typ "unit => term"}, t')));
   146.1 --- a/src/HOL/Tools/Quotient/quotient_term.ML	Wed Feb 12 09:06:04 2014 +0100
   146.2 +++ b/src/HOL/Tools/Quotient/quotient_term.ML	Wed Feb 12 10:59:25 2014 +0100
   146.3 @@ -635,12 +635,12 @@
   146.4            end
   146.5        end
   146.6  
   146.7 -  | (((t1 as Const (@{const_name prod_case}, _)) $ Abs (v1, ty, Abs(v1', ty', s1))),
   146.8 -     ((t2 as Const (@{const_name prod_case}, _)) $ Abs (v2, _ , Abs(v2', _  , s2)))) =>
   146.9 +  | (((t1 as Const (@{const_name case_prod}, _)) $ Abs (v1, ty, Abs(v1', ty', s1))),
  146.10 +     ((t2 as Const (@{const_name case_prod}, _)) $ Abs (v2, _ , Abs(v2', _  , s2)))) =>
  146.11         regularize_trm ctxt (t1, t2) $ Abs (v1, ty, Abs (v1', ty', regularize_trm ctxt (s1, s2)))
  146.12  
  146.13 -  | (((t1 as Const (@{const_name prod_case}, _)) $ Abs (v1, ty, s1)),
  146.14 -     ((t2 as Const (@{const_name prod_case}, _)) $ Abs (v2, _ , s2))) =>
  146.15 +  | (((t1 as Const (@{const_name case_prod}, _)) $ Abs (v1, ty, s1)),
  146.16 +     ((t2 as Const (@{const_name case_prod}, _)) $ Abs (v2, _ , s2))) =>
  146.17         regularize_trm ctxt (t1, t2) $ Abs (v1, ty, regularize_trm ctxt (s1, s2))
  146.18  
  146.19    | (t1 $ t2, t1' $ t2') =>
   147.1 --- a/src/HOL/Tools/SMT/smt_normalize.ML	Wed Feb 12 09:06:04 2014 +0100
   147.2 +++ b/src/HOL/Tools/SMT/smt_normalize.ML	Wed Feb 12 10:59:25 2014 +0100
   147.3 @@ -356,22 +356,22 @@
   147.4  (** rewrite bool case expressions as if expressions **)
   147.5  
   147.6  local
   147.7 -  fun is_bool_case (Const (@{const_name "bool.bool_case"}, _)) = true
   147.8 -    | is_bool_case _ = false
   147.9 +  fun is_case_bool (Const (@{const_name "bool.case_bool"}, _)) = true
  147.10 +    | is_case_bool _ = false
  147.11  
  147.12    val thm = mk_meta_eq @{lemma
  147.13 -    "bool_case = (%x y P. if P then x else y)" by (rule ext)+ simp}
  147.14 +    "case_bool = (%x y P. if P then x else y)" by (rule ext)+ simp}
  147.15  
  147.16    fun unfold_conv _ =
  147.17 -    SMT_Utils.if_true_conv (is_bool_case o Term.head_of)
  147.18 +    SMT_Utils.if_true_conv (is_case_bool o Term.head_of)
  147.19        (expand_head_conv (Conv.rewr_conv thm))
  147.20  in
  147.21  
  147.22 -fun rewrite_bool_case_conv ctxt =
  147.23 -  SMT_Utils.if_exists_conv is_bool_case (Conv.top_conv unfold_conv ctxt)
  147.24 +fun rewrite_case_bool_conv ctxt =
  147.25 +  SMT_Utils.if_exists_conv is_case_bool (Conv.top_conv unfold_conv ctxt)
  147.26  
  147.27 -val setup_bool_case =
  147.28 -  SMT_Builtin.add_builtin_fun_ext'' @{const_name "bool.bool_case"}
  147.29 +val setup_case_bool =
  147.30 +  SMT_Builtin.add_builtin_fun_ext'' @{const_name "bool.case_bool"}
  147.31  
  147.32  end
  147.33  
  147.34 @@ -558,7 +558,7 @@
  147.35  (** combined unfoldings and rewritings **)
  147.36  
  147.37  fun unfold_conv ctxt =
  147.38 -  rewrite_bool_case_conv ctxt then_conv
  147.39 +  rewrite_case_bool_conv ctxt then_conv
  147.40    unfold_abs_min_max_conv ctxt then_conv
  147.41    nat_as_int_conv ctxt then_conv
  147.42    Thm.beta_conversion true
  147.43 @@ -645,7 +645,7 @@
  147.44    setup_unfolded_quants #>
  147.45    setup_trigger #>
  147.46    setup_weight #>
  147.47 -  setup_bool_case #>
  147.48 +  setup_case_bool #>
  147.49    setup_abs_min_max #>
  147.50    setup_nat_as_int)
  147.51  
   148.1 --- a/src/HOL/Tools/TFL/rules.ML	Wed Feb 12 09:06:04 2014 +0100
   148.2 +++ b/src/HOL/Tools/TFL/rules.ML	Wed Feb 12 10:59:25 2014 +0100
   148.3 @@ -578,10 +578,10 @@
   148.4  local fun dest_pair M = let val {fst,snd} = USyntax.dest_pair M in (fst,snd) end
   148.5        fun mk_fst tm =
   148.6            let val ty as Type(@{type_name Product_Type.prod}, [fty,sty]) = type_of tm
   148.7 -          in  Const ("Product_Type.fst", ty --> fty) $ tm  end
   148.8 +          in  Const (@{const_name Product_Type.fst}, ty --> fty) $ tm  end
   148.9        fun mk_snd tm =
  148.10            let val ty as Type(@{type_name Product_Type.prod}, [fty,sty]) = type_of tm
  148.11 -          in  Const ("Product_Type.snd", ty --> sty) $ tm  end
  148.12 +          in  Const (@{const_name Product_Type.snd}, ty --> sty) $ tm  end
  148.13  in
  148.14  fun XFILL tych x vstruct =
  148.15    let fun traverse p xocc L =
   149.1 --- a/src/HOL/Tools/TFL/usyntax.ML	Wed Feb 12 09:06:04 2014 +0100
   149.2 +++ b/src/HOL/Tools/TFL/usyntax.ML	Wed Feb 12 10:59:25 2014 +0100
   149.3 @@ -196,7 +196,7 @@
   149.4  
   149.5  local
   149.6  fun mk_uncurry (xt, yt, zt) =
   149.7 -    Const(@{const_name prod_case}, (xt --> yt --> zt) --> prod_ty xt yt --> zt)
   149.8 +    Const(@{const_name case_prod}, (xt --> yt --> zt) --> prod_ty xt yt --> zt)
   149.9  fun dest_pair(Const(@{const_name Pair},_) $ M $ N) = {fst=M, snd=N}
  149.10    | dest_pair _ = raise USYN_ERR "dest_pair" "not a pair"
  149.11  fun is_var (Var _) = true | is_var (Free _) = true | is_var _ = false
  149.12 @@ -276,7 +276,7 @@
  149.13    | dest_pair _ = raise USYN_ERR "dest_pair" "not a pair";
  149.14  
  149.15  
  149.16 -local  fun ucheck t = (if #Name (dest_const t) = @{const_name prod_case} then t
  149.17 +local  fun ucheck t = (if #Name (dest_const t) = @{const_name case_prod} then t
  149.18                         else raise Match)
  149.19  in
  149.20  fun dest_pabs used tm =
   150.1 --- a/src/HOL/Tools/hologic.ML	Wed Feb 12 09:06:04 2014 +0100
   150.2 +++ b/src/HOL/Tools/hologic.ML	Wed Feb 12 10:59:25 2014 +0100
   150.3 @@ -348,21 +348,21 @@
   150.4  
   150.5  fun mk_fst p =
   150.6    let val pT = fastype_of p in
   150.7 -    Const ("Product_Type.fst", pT --> fst (dest_prodT pT)) $ p
   150.8 +    Const ("Product_Type.prod.fst", pT --> fst (dest_prodT pT)) $ p
   150.9    end;
  150.10  
  150.11  fun mk_snd p =
  150.12    let val pT = fastype_of p in
  150.13 -    Const ("Product_Type.snd", pT --> snd (dest_prodT pT)) $ p
  150.14 +    Const ("Product_Type.prod.snd", pT --> snd (dest_prodT pT)) $ p
  150.15    end;
  150.16  
  150.17  fun split_const (A, B, C) =
  150.18 -  Const ("Product_Type.prod.prod_case", (A --> B --> C) --> mk_prodT (A, B) --> C);
  150.19 +  Const ("Product_Type.prod.case_prod", (A --> B --> C) --> mk_prodT (A, B) --> C);
  150.20  
  150.21  fun mk_split t =
  150.22    (case Term.fastype_of t of
  150.23      T as (Type ("fun", [A, Type ("fun", [B, C])])) =>
  150.24 -      Const ("Product_Type.prod.prod_case", T --> mk_prodT (A, B) --> C) $ t
  150.25 +      Const ("Product_Type.prod.case_prod", T --> mk_prodT (A, B) --> C) $ t
  150.26    | _ => raise TERM ("mk_split: bad body type", [t]));
  150.27  
  150.28  (*Maps the type T1 * ... * Tn to [T1, ..., Tn], however nested*)
  150.29 @@ -478,7 +478,7 @@
  150.30  val strip_psplits =
  150.31    let
  150.32      fun strip [] qs Ts t = (t, rev Ts, qs)
  150.33 -      | strip (p :: ps) qs Ts (Const ("Product_Type.prod.prod_case", _) $ t) =
  150.34 +      | strip (p :: ps) qs Ts (Const ("Product_Type.prod.case_prod", _) $ t) =
  150.35            strip ((1 :: p) :: (2 :: p) :: ps) (p :: qs) Ts t
  150.36        | strip (p :: ps) qs Ts (Abs (s, T, t)) = strip ps qs (T :: Ts) t
  150.37        | strip (p :: ps) qs Ts t = strip ps qs
   151.1 --- a/src/HOL/Tools/set_comprehension_pointfree.ML	Wed Feb 12 09:06:04 2014 +0100
   151.2 +++ b/src/HOL/Tools/set_comprehension_pointfree.ML	Wed Feb 12 10:59:25 2014 +0100
   151.3 @@ -84,7 +84,7 @@
   151.4    end;
   151.5  
   151.6  fun mk_split_abs vs (Bound i) t = let val (x, T) = nth vs i in Abs (x, T, t) end
   151.7 -  | mk_split_abs vs (Const ("Product_Type.Pair", _) $ u $ v) t =
   151.8 +  | mk_split_abs vs (Const (@{const_name Product_Type.Pair}, _) $ u $ v) t =
   151.9        HOLogic.mk_split (mk_split_abs vs u (mk_split_abs vs v t))
  151.10    | mk_split_abs _ t _ = raise TERM ("mk_split_abs: bad term", [t]);
  151.11  
  151.12 @@ -92,7 +92,7 @@
  151.13  val strip_psplits =
  151.14    let
  151.15      fun strip [] qs vs t = (t, rev vs, qs)
  151.16 -      | strip (p :: ps) qs vs (Const ("Product_Type.prod.prod_case", _) $ t) =
  151.17 +      | strip (p :: ps) qs vs (Const (@{const_name Product_Type.prod.case_prod}, _) $ t) =
  151.18            strip ((1 :: p) :: (2 :: p) :: ps) (p :: qs) vs t
  151.19        | strip (_ :: ps) qs vs (Abs (s, T, t)) = strip ps qs ((s, T) :: vs) t
  151.20        | strip (_ :: ps) qs vs t = strip ps qs
  151.21 @@ -305,7 +305,7 @@
  151.22  
  151.23  (* proof tactic *)
  151.24  
  151.25 -val prod_case_distrib = @{lemma "(prod_case g x) z = prod_case (% x y. (g x y) z) x" by (simp add: prod_case_beta)}
  151.26 +val case_prod_distrib = @{lemma "(case_prod g x) z = case_prod (% x y. (g x y) z) x" by (simp add: case_prod_beta)}
  151.27  
  151.28  val vimageI2' = @{lemma "f a \<notin> A ==> a \<notin> f -` A" by simp}
  151.29  val vimageE' =
  151.30 @@ -326,7 +326,7 @@
  151.31          @{thm arg_cong2[OF refl, where f="op =", OF prod.cases, THEN iffD2]}
  151.32        ORELSE' CONVERSION (Conv.params_conv ~1 (K (Conv.concl_conv ~1
  151.33          (HOLogic.Trueprop_conv
  151.34 -          (HOLogic.eq_conv Conv.all_conv (Conv.rewr_conv (mk_meta_eq prod_case_distrib)))))) ctxt)))
  151.35 +          (HOLogic.eq_conv Conv.all_conv (Conv.rewr_conv (mk_meta_eq case_prod_distrib)))))) ctxt)))
  151.36  
  151.37  fun elim_image_tac ctxt = etac @{thm imageE}
  151.38    THEN' REPEAT_DETERM o CHANGED o
  151.39 @@ -521,4 +521,3 @@
  151.40    end;
  151.41  
  151.42  end;
  151.43 -
   152.1 --- a/src/HOL/Topological_Spaces.thy	Wed Feb 12 09:06:04 2014 +0100
   152.2 +++ b/src/HOL/Topological_Spaces.thy	Wed Feb 12 10:59:25 2014 +0100
   152.3 @@ -1296,9 +1296,9 @@
   152.4  proof cases
   152.5    let "?P p n" = "p > n \<and> (\<forall>m\<ge>p. s m \<le> s p)"
   152.6    assume *: "\<forall>n. \<exists>p. ?P p n"
   152.7 -  def f \<equiv> "nat_rec (SOME p. ?P p 0) (\<lambda>_ n. SOME p. ?P p n)"
   152.8 +  def f \<equiv> "rec_nat (SOME p. ?P p 0) (\<lambda>_ n. SOME p. ?P p n)"
   152.9    have f_0: "f 0 = (SOME p. ?P p 0)" unfolding f_def by simp
  152.10 -  have f_Suc: "\<And>i. f (Suc i) = (SOME p. ?P p (f i))" unfolding f_def nat_rec_Suc ..
  152.11 +  have f_Suc: "\<And>i. f (Suc i) = (SOME p. ?P p (f i))" unfolding f_def nat.recs(2) ..
  152.12    have P_0: "?P (f 0) 0" unfolding f_0 using *[rule_format] by (rule someI2_ex) auto
  152.13    have P_Suc: "\<And>i. ?P (f (Suc i)) (f i)" unfolding f_Suc using *[rule_format] by (rule someI2_ex) auto
  152.14    then have "subseq f" unfolding subseq_Suc_iff by auto
  152.15 @@ -1318,9 +1318,9 @@
  152.16    let "?P p m" = "m < p \<and> s m < s p"
  152.17    assume "\<not> (\<forall>n. \<exists>p>n. (\<forall>m\<ge>p. s m \<le> s p))"
  152.18    then obtain N where N: "\<And>p. p > N \<Longrightarrow> \<exists>m>p. s p < s m" by (force simp: not_le le_less)
  152.19 -  def f \<equiv> "nat_rec (SOME p. ?P p (Suc N)) (\<lambda>_ n. SOME p. ?P p n)"
  152.20 +  def f \<equiv> "rec_nat (SOME p. ?P p (Suc N)) (\<lambda>_ n. SOME p. ?P p n)"
  152.21    have f_0: "f 0 = (SOME p. ?P p (Suc N))" unfolding f_def by simp
  152.22 -  have f_Suc: "\<And>i. f (Suc i) = (SOME p. ?P p (f i))" unfolding f_def nat_rec_Suc ..
  152.23 +  have f_Suc: "\<And>i. f (Suc i) = (SOME p. ?P p (f i))" unfolding f_def nat.recs(2) ..
  152.24    have P_0: "?P (f 0) (Suc N)"
  152.25      unfolding f_0 some_eq_ex[of "\<lambda>p. ?P p (Suc N)"] using N[of "Suc N"] by auto
  152.26    { fix i have "N < f i \<Longrightarrow> ?P (f (Suc i)) (f i)"
   153.1 --- a/src/HOL/Transcendental.thy	Wed Feb 12 09:06:04 2014 +0100
   153.2 +++ b/src/HOL/Transcendental.thy	Wed Feb 12 10:59:25 2014 +0100
   153.3 @@ -624,6 +624,7 @@
   153.4         (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))"
   153.5        apply (rule ext)
   153.6        apply (case_tac "n", simp)
   153.7 +      apply (rename_tac nat)
   153.8        apply (case_tac "nat", simp)
   153.9        apply (simp add: r_neq_0)
  153.10        done
  153.11 @@ -2710,7 +2711,8 @@
  153.12  apply (subgoal_tac "x < real(LEAST m::nat. x < real m * y) * y")
  153.13   prefer 2 apply (erule LeastI)
  153.14  apply (case_tac "LEAST m::nat. x < real m * y", simp)
  153.15 -apply (subgoal_tac "~ x < real nat * y")
  153.16 +apply (rename_tac m)
  153.17 +apply (subgoal_tac "~ x < real m * y")
  153.18   prefer 2 apply (rule not_less_Least, simp, force)
  153.19  done
  153.20  
   154.1 --- a/src/HOL/Transfer.thy	Wed Feb 12 09:06:04 2014 +0100
   154.2 +++ b/src/HOL/Transfer.thy	Wed Feb 12 10:59:25 2014 +0100
   154.3 @@ -358,12 +358,12 @@
   154.4    shows "((A ===> B) ===> A ===> B ===> A ===> B) fun_upd fun_upd"
   154.5    unfolding fun_upd_def [abs_def] by transfer_prover
   154.6  
   154.7 -lemma nat_case_transfer [transfer_rule]:
   154.8 -  "(A ===> (op = ===> A) ===> op = ===> A) nat_case nat_case"
   154.9 +lemma case_nat_transfer [transfer_rule]:
  154.10 +  "(A ===> (op = ===> A) ===> op = ===> A) case_nat case_nat"
  154.11    unfolding fun_rel_def by (simp split: nat.split)
  154.12  
  154.13 -lemma nat_rec_transfer [transfer_rule]:
  154.14 -  "(A ===> (op = ===> A ===> A) ===> op = ===> A) nat_rec nat_rec"
  154.15 +lemma rec_nat_transfer [transfer_rule]:
  154.16 +  "(A ===> (op = ===> A ===> A) ===> op = ===> A) rec_nat rec_nat"
  154.17    unfolding fun_rel_def by (clarsimp, rename_tac n, induct_tac n, simp_all)
  154.18  
  154.19  lemma funpow_transfer [transfer_rule]:
   155.1 --- a/src/HOL/Transitive_Closure.thy	Wed Feb 12 09:06:04 2014 +0100
   155.2 +++ b/src/HOL/Transitive_Closure.thy	Wed Feb 12 10:59:25 2014 +0100
   155.3 @@ -846,6 +846,7 @@
   155.4       \<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> (x, y) \<in> R \<Longrightarrow> (y, z) \<in> R ^^ m \<Longrightarrow> P)
   155.5     \<Longrightarrow> P"
   155.6    apply (cases n, simp)
   155.7 +  apply (rename_tac nat)
   155.8    apply (cut_tac n=nat and R=R in relpow_Suc_D2', simp, blast)
   155.9    done
  155.10  
  155.11 @@ -1297,4 +1298,3 @@
  155.12    {* simple transitivity reasoner (predicate version) *}
  155.13  
  155.14  end
  155.15 -
   156.1 --- a/src/HOL/Word/Word.thy	Wed Feb 12 09:06:04 2014 +0100
   156.2 +++ b/src/HOL/Word/Word.thy	Wed Feb 12 10:59:25 2014 +0100
   156.3 @@ -4578,7 +4578,7 @@
   156.4  
   156.5  definition word_rec :: "'a \<Rightarrow> ('b::len word \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'b word \<Rightarrow> 'a"
   156.6  where
   156.7 -  "word_rec forZero forSuc n = nat_rec forZero (forSuc \<circ> of_nat) (unat n)"
   156.8 +  "word_rec forZero forSuc n = rec_nat forZero (forSuc \<circ> of_nat) (unat n)"
   156.9  
  156.10  lemma word_rec_0: "word_rec z s 0 = z"
  156.11    by (simp add: word_rec_def)
   157.1 --- a/src/HOL/Word/Word_Miscellaneous.thy	Wed Feb 12 09:06:04 2014 +0100
   157.2 +++ b/src/HOL/Word/Word_Miscellaneous.thy	Wed Feb 12 10:59:25 2014 +0100
   157.3 @@ -118,10 +118,6 @@
   157.4  
   157.5  lemmas seqr = eq_reflection [where x = "size w"] for w (* FIXME: delete *)
   157.6  
   157.7 -(* TODO: move name bindings to List.thy *)
   157.8 -lemmas tl_Nil = tl.simps (1)
   157.9 -lemmas tl_Cons = tl.simps (2)
  157.10 -
  157.11  lemma the_elemI: "y = {x} ==> the_elem y = x" 
  157.12    by simp
  157.13  
   158.1 --- a/src/HOL/ex/Primrec.thy	Wed Feb 12 09:06:04 2014 +0100
   158.2 +++ b/src/HOL/ex/Primrec.thy	Wed Feb 12 10:59:25 2014 +0100
   158.3 @@ -191,7 +191,7 @@
   158.4    "PREC f g l =
   158.5      (case l of
   158.6        [] => 0
   158.7 -    | x # l' => nat_rec (f l') (\<lambda>y r. g (r # y # l')) x)"
   158.8 +    | x # l' => rec_nat (f l') (\<lambda>y r. g (r # y # l')) x)"
   158.9    -- {* Note that @{term g} is applied first to @{term "PREC f g y"} and then to @{term y}! *}
  158.10  
  158.11  inductive PRIMREC :: "(nat list => nat) => bool" where
   159.1 --- a/src/HOL/ex/Refute_Examples.thy	Wed Feb 12 09:06:04 2014 +0100
   159.2 +++ b/src/HOL/ex/Refute_Examples.thy	Wed Feb 12 10:59:25 2014 +0100
   159.3 @@ -525,14 +525,6 @@
   159.4  refute [expect = genuine]
   159.5  oops
   159.6  
   159.7 -lemma "unit_rec u x = u"
   159.8 -refute [expect = none]
   159.9 -by simp
  159.10 -
  159.11 -lemma "P (unit_rec u x)"
  159.12 -refute [expect = genuine]
  159.13 -oops
  159.14 -
  159.15  lemma "P (case x of () \<Rightarrow> u)"
  159.16  refute [expect = genuine]
  159.17  oops
  159.18 @@ -555,15 +547,15 @@
  159.19  refute [expect = genuine]
  159.20  oops
  159.21  
  159.22 -lemma "option_rec n s None = n"
  159.23 +lemma "rec_option n s None = n"
  159.24  refute [expect = none]
  159.25  by simp
  159.26  
  159.27 -lemma "option_rec n s (Some x) = s x"
  159.28 +lemma "rec_option n s (Some x) = s x"
  159.29  refute [maxsize = 4, expect = none]
  159.30  by simp
  159.31  
  159.32 -lemma "P (option_rec n s x)"
  159.33 +lemma "P (rec_option n s x)"
  159.34  refute [expect = genuine]
  159.35  oops
  159.36  
  159.37 @@ -597,14 +589,6 @@
  159.38  refute [expect = genuine]
  159.39  oops
  159.40  
  159.41 -lemma "prod_rec p (a, b) = p a b"
  159.42 -refute [maxsize = 2, expect = none]
  159.43 -by simp
  159.44 -
  159.45 -lemma "P (prod_rec p x)"
  159.46 -refute [expect = genuine]
  159.47 -oops
  159.48 -
  159.49  lemma "P (case x of Pair a b \<Rightarrow> p a b)"
  159.50  refute [expect = genuine]
  159.51  oops
  159.52 @@ -631,18 +615,6 @@
  159.53  refute [expect = genuine]
  159.54  oops
  159.55  
  159.56 -lemma "sum_rec l r (Inl x) = l x"
  159.57 -refute [maxsize = 3, expect = none]
  159.58 -by simp
  159.59 -
  159.60 -lemma "sum_rec l r (Inr x) = r x"
  159.61 -refute [maxsize = 3, expect = none]
  159.62 -by simp
  159.63 -
  159.64 -lemma "P (sum_rec l r x)"
  159.65 -refute [expect = genuine]
  159.66 -oops
  159.67 -
  159.68  lemma "P (case x of Inl a \<Rightarrow> l a | Inr b \<Rightarrow> r b)"
  159.69  refute [expect = genuine]
  159.70  oops
  159.71 @@ -667,15 +639,15 @@
  159.72  refute [expect = genuine]
  159.73  oops
  159.74  
  159.75 -lemma "T1_rec a b A = a"
  159.76 +lemma "rec_T1 a b A = a"
  159.77  refute [expect = none]
  159.78  by simp
  159.79  
  159.80 -lemma "T1_rec a b B = b"
  159.81 +lemma "rec_T1 a b B = b"
  159.82  refute [expect = none]
  159.83  by simp
  159.84  
  159.85 -lemma "P (T1_rec a b x)"
  159.86 +lemma "P (rec_T1 a b x)"
  159.87  refute [expect = genuine]
  159.88  oops
  159.89  
  159.90 @@ -697,15 +669,15 @@
  159.91  refute [expect = genuine]
  159.92  oops
  159.93  
  159.94 -lemma "T2_rec c d (C x) = c x"
  159.95 +lemma "rec_T2 c d (C x) = c x"
  159.96  refute [maxsize = 4, expect = none]
  159.97  by simp
  159.98  
  159.99 -lemma "T2_rec c d (D x) = d x"
 159.100 +lemma "rec_T2 c d (D x) = d x"
 159.101  refute [maxsize = 4, expect = none]
 159.102  by simp
 159.103  
 159.104 -lemma "P (T2_rec c d x)"
 159.105 +lemma "P (rec_T2 c d x)"
 159.106  refute [expect = genuine]
 159.107  oops
 159.108  
 159.109 @@ -727,11 +699,11 @@
 159.110  refute [expect = genuine]
 159.111  oops
 159.112  
 159.113 -lemma "T3_rec e (E x) = e x"
 159.114 +lemma "rec_T3 e (E x) = e x"
 159.115  refute [maxsize = 2, expect = none]
 159.116  by simp
 159.117  
 159.118 -lemma "P (T3_rec e x)"
 159.119 +lemma "P (rec_T3 e x)"
 159.120  refute [expect = genuine]
 159.121  oops
 159.122  
 159.123 @@ -762,15 +734,15 @@
 159.124        model will be found *}
 159.125  oops
 159.126  
 159.127 -lemma "nat_rec zero suc 0 = zero"
 159.128 +lemma "rec_nat zero suc 0 = zero"
 159.129  refute [expect = none]
 159.130  by simp
 159.131  
 159.132 -lemma "nat_rec zero suc (Suc x) = suc x (nat_rec zero suc x)"
 159.133 +lemma "rec_nat zero suc (Suc x) = suc x (rec_nat zero suc x)"
 159.134  refute [maxsize = 2, expect = none]
 159.135  by simp
 159.136  
 159.137 -lemma "P (nat_rec zero suc x)"
 159.138 +lemma "P (rec_nat zero suc x)"
 159.139  refute [expect = potential]
 159.140  oops
 159.141  
 159.142 @@ -792,15 +764,15 @@
 159.143  refute [expect = potential]
 159.144  oops
 159.145  
 159.146 -lemma "list_rec nil cons [] = nil"
 159.147 +lemma "rec_list nil cons [] = nil"
 159.148  refute [maxsize = 3, expect = none]
 159.149  by simp
 159.150  
 159.151 -lemma "list_rec nil cons (x#xs) = cons x xs (list_rec nil cons xs)"
 159.152 +lemma "rec_list nil cons (x#xs) = cons x xs (rec_list nil cons xs)"
 159.153  refute [maxsize = 2, expect = none]
 159.154  by simp
 159.155  
 159.156 -lemma "P (list_rec nil cons xs)"
 159.157 +lemma "P (rec_list nil cons xs)"
 159.158  refute [expect = potential]
 159.159  oops
 159.160  
 159.161 @@ -830,19 +802,19 @@
 159.162  refute [expect = potential]
 159.163  oops
 159.164  
 159.165 -lemma "BitList_rec nil bit0 bit1 BitListNil = nil"
 159.166 +lemma "rec_BitList nil bit0 bit1 BitListNil = nil"
 159.167  refute [maxsize = 4, expect = none]
 159.168  by simp
 159.169  
 159.170 -lemma "BitList_rec nil bit0 bit1 (Bit0 xs) = bit0 xs (BitList_rec nil bit0 bit1 xs)"
 159.171 +lemma "rec_BitList nil bit0 bit1 (Bit0 xs) = bit0 xs (rec_BitList nil bit0 bit1 xs)"
 159.172  refute [maxsize = 2, expect = none]
 159.173  by simp
 159.174  
 159.175 -lemma "BitList_rec nil bit0 bit1 (Bit1 xs) = bit1 xs (BitList_rec nil bit0 bit1 xs)"
 159.176 +lemma "rec_BitList nil bit0 bit1 (Bit1 xs) = bit1 xs (rec_BitList nil bit0 bit1 xs)"
 159.177  refute [maxsize = 2, expect = none]
 159.178  by simp
 159.179  
 159.180 -lemma "P (BitList_rec nil bit0 bit1 x)"
 159.181 +lemma "P (rec_BitList nil bit0 bit1 x)"
 159.182  refute [expect = potential]
 159.183  oops
 159.184  
 159.185 @@ -860,7 +832,7 @@
 159.186  refute [expect = potential]
 159.187  oops
 159.188  
 159.189 -lemma "BinTree_rec l n (Leaf x) = l x"
 159.190 +lemma "rec_BinTree l n (Leaf x) = l x"
 159.191    refute [maxsize = 1, expect = none]
 159.192    (* The "maxsize = 1" tests are a bit pointless: for some formulae
 159.193       below, refute will find no countermodel simply because this
 159.194 @@ -868,11 +840,11 @@
 159.195       larger size already takes too long. *)
 159.196  by simp
 159.197  
 159.198 -lemma "BinTree_rec l n (Node x y) = n x y (BinTree_rec l n x) (BinTree_rec l n y)"
 159.199 +lemma "rec_BinTree l n (Node x y) = n x y (rec_BinTree l n x) (rec_BinTree l n y)"
 159.200  refute [maxsize = 1, expect = none]
 159.201  by simp
 159.202  
 159.203 -lemma "P (BinTree_rec l n x)"
 159.204 +lemma "P (rec_BinTree l n x)"
 159.205  refute [expect = potential]
 159.206  oops
 159.207  
 159.208 @@ -905,15 +877,15 @@
 159.209  refute [expect = potential]
 159.210  oops
 159.211  
 159.212 -lemma "aexp_bexp_rec_1 number ite equal (Number x) = number x"
 159.213 +lemma "rec_aexp_bexp_1 number ite equal (Number x) = number x"
 159.214  refute [maxsize = 1, expect = none]
 159.215  by simp
 159.216  
 159.217 -lemma "aexp_bexp_rec_1 number ite equal (ITE x y z) = ite x y z (aexp_bexp_rec_2 number ite equal x) (aexp_bexp_rec_1 number ite equal y) (aexp_bexp_rec_1 number ite equal z)"
 159.218 +lemma "rec_aexp_bexp_1 number ite equal (ITE x y z) = ite x y z (rec_aexp_bexp_2 number ite equal x) (rec_aexp_bexp_1 number ite equal y) (rec_aexp_bexp_1 number ite equal z)"
 159.219  refute [maxsize = 1, expect = none]
 159.220  by simp
 159.221  
 159.222 -lemma "P (aexp_bexp_rec_1 number ite equal x)"
 159.223 +lemma "P (rec_aexp_bexp_1 number ite equal x)"
 159.224  refute [expect = potential]
 159.225  oops
 159.226  
 159.227 @@ -921,11 +893,11 @@
 159.228  refute [expect = potential]
 159.229  oops
 159.230  
 159.231 -lemma "aexp_bexp_rec_2 number ite equal (Equal x y) = equal x y (aexp_bexp_rec_1 number ite equal x) (aexp_bexp_rec_1 number ite equal y)"
 159.232 +lemma "rec_aexp_bexp_2 number ite equal (Equal x y) = equal x y (rec_aexp_bexp_1 number ite equal x) (rec_aexp_bexp_1 number ite equal y)"
 159.233  refute [maxsize = 1, expect = none]
 159.234  by simp
 159.235  
 159.236 -lemma "P (aexp_bexp_rec_2 number ite equal x)"
 159.237 +lemma "P (rec_aexp_bexp_2 number ite equal x)"
 159.238  refute [expect = potential]
 159.239  oops
 159.240  
 159.241 @@ -980,35 +952,35 @@
 159.242  refute [expect = potential]
 159.243  oops
 159.244  
 159.245 -lemma "X_Y_rec_1 a b c d e f A = a"
 159.246 +lemma "rec_X_Y_1 a b c d e f A = a"
 159.247  refute [maxsize = 3, expect = none]
 159.248  by simp
 159.249  
 159.250 -lemma "X_Y_rec_1 a b c d e f (B x) = b x (X_Y_rec_1 a b c d e f x)"
 159.251 +lemma "rec_X_Y_1 a b c d e f (B x) = b x (rec_X_Y_1 a b c d e f x)"
 159.252  refute [maxsize = 1, expect = none]
 159.253  by simp
 159.254  
 159.255 -lemma "X_Y_rec_1 a b c d e f (C y) = c y (X_Y_rec_2 a b c d e f y)"
 159.256 +lemma "rec_X_Y_1 a b c d e f (C y) = c y (rec_X_Y_2 a b c d e f y)"
 159.257  refute [maxsize = 1, expect = none]
 159.258  by simp
 159.259  
 159.260 -lemma "X_Y_rec_2 a b c d e f (D x) = d x (X_Y_rec_1 a b c d e f x)"
 159.261 +lemma "rec_X_Y_2 a b c d e f (D x) = d x (rec_X_Y_1 a b c d e f x)"
 159.262  refute [maxsize = 1, expect = none]
 159.263  by simp
 159.264  
 159.265 -lemma "X_Y_rec_2 a b c d e f (E y) = e y (X_Y_rec_2 a b c d e f y)"
 159.266 +lemma "rec_X_Y_2 a b c d e f (E y) = e y (rec_X_Y_2 a b c d e f y)"
 159.267  refute [maxsize = 1, expect = none]
 159.268  by simp
 159.269  
 159.270 -lemma "X_Y_rec_2 a b c d e f F = f"
 159.271 +lemma "rec_X_Y_2 a b c d e f F = f"
 159.272  refute [maxsize = 3, expect = none]
 159.273  by simp
 159.274  
 159.275 -lemma "P (X_Y_rec_1 a b c d e f x)"
 159.276 +lemma "P (rec_X_Y_1 a b c d e f x)"
 159.277  refute [expect = potential]
 159.278  oops
 159.279  
 159.280 -lemma "P (X_Y_rec_2 a b c d e f y)"
 159.281 +lemma "P (rec_X_Y_2 a b c d e f y)"
 159.282  refute [expect = potential]
 159.283  oops
 159.284  
 159.285 @@ -1030,39 +1002,39 @@
 159.286  refute [expect = potential]
 159.287  oops
 159.288  
 159.289 -lemma "XOpt_rec_1 cx dx n1 s1 n2 s2 (CX x) = cx x (XOpt_rec_2 cx dx n1 s1 n2 s2 x)"
 159.290 +lemma "rec_XOpt_1 cx dx n1 s1 n2 s2 (CX x) = cx x (rec_XOpt_2 cx dx n1 s1 n2 s2 x)"
 159.291  refute [maxsize = 1, expect = none]
 159.292  by simp
 159.293  
 159.294 -lemma "XOpt_rec_1 cx dx n1 s1 n2 s2 (DX x) = dx x (\<lambda>b. XOpt_rec_3 cx dx n1 s1 n2 s2 (x b))"
 159.295 +lemma "rec_XOpt_1 cx dx n1 s1 n2 s2 (DX x) = dx x (\<lambda>b. rec_XOpt_3 cx dx n1 s1 n2 s2 (x b))"
 159.296  refute [maxsize = 1, expect = none]
 159.297  by simp
 159.298  
 159.299 -lemma "XOpt_rec_2 cx dx n1 s1 n2 s2 None = n1"
 159.300 +lemma "rec_XOpt_2 cx dx n1 s1 n2 s2 None = n1"
 159.301  refute [maxsize = 2, expect = none]
 159.302  by simp
 159.303  
 159.304 -lemma "XOpt_rec_2 cx dx n1 s1 n2 s2 (Some x) = s1 x (XOpt_rec_1 cx dx n1 s1 n2 s2 x)"
 159.305 +lemma "rec_XOpt_2 cx dx n1 s1 n2 s2 (Some x) = s1 x (rec_XOpt_1 cx dx n1 s1 n2 s2 x)"
 159.306  refute [maxsize = 1, expect = none]
 159.307  by simp
 159.308  
 159.309 -lemma "XOpt_rec_3 cx dx n1 s1 n2 s2 None = n2"
 159.310 +lemma "rec_XOpt_3 cx dx n1 s1 n2 s2 None = n2"
 159.311  refute [maxsize = 2, expect = none]
 159.312  by simp
 159.313  
 159.314 -lemma "XOpt_rec_3 cx dx n1 s1 n2 s2 (Some x) = s2 x (XOpt_rec_1 cx dx n1 s1 n2 s2 x)"
 159.315 +lemma "rec_XOpt_3 cx dx n1 s1 n2 s2 (Some x) = s2 x (rec_XOpt_1 cx dx n1 s1 n2 s2 x)"
 159.316  refute [maxsize = 1, expect = none]
 159.317  by simp
 159.318  
 159.319 -lemma "P (XOpt_rec_1 cx dx n1 s1 n2 s2 x)"
 159.320 +lemma "P (rec_XOpt_1 cx dx n1 s1 n2 s2 x)"
 159.321  refute [expect = potential]
 159.322  oops
 159.323  
 159.324 -lemma "P (XOpt_rec_2 cx dx n1 s1 n2 s2 x)"
 159.325 +lemma "P (rec_XOpt_2 cx dx n1 s1 n2 s2 x)"
 159.326  refute [expect = potential]
 159.327  oops
 159.328  
 159.329 -lemma "P (XOpt_rec_3 cx dx n1 s1 n2 s2 x)"
 159.330 +lemma "P (rec_XOpt_3 cx dx n1 s1 n2 s2 x)"
 159.331  refute [expect = potential]
 159.332  oops
 159.333  
 159.334 @@ -1080,23 +1052,23 @@
 159.335  refute [expect = potential]
 159.336  oops
 159.337  
 159.338 -lemma "YOpt_rec_1 cy n s (CY x) = cy x (YOpt_rec_2 cy n s x)"
 159.339 +lemma "rec_YOpt_1 cy n s (CY x) = cy x (rec_YOpt_2 cy n s x)"
 159.340  refute [maxsize = 1, expect = none]
 159.341  by simp
 159.342  
 159.343 -lemma "YOpt_rec_2 cy n s None = n"
 159.344 +lemma "rec_YOpt_2 cy n s None = n"
 159.345  refute [maxsize = 2, expect = none]
 159.346  by simp
 159.347  
 159.348 -lemma "YOpt_rec_2 cy n s (Some x) = s x (\<lambda>a. YOpt_rec_1 cy n s (x a))"
 159.349 +lemma "rec_YOpt_2 cy n s (Some x) = s x (\<lambda>a. rec_YOpt_1 cy n s (x a))"
 159.350  refute [maxsize = 1, expect = none]
 159.351  by simp
 159.352  
 159.353 -lemma "P (YOpt_rec_1 cy n s x)"
 159.354 +lemma "P (rec_YOpt_1 cy n s x)"
 159.355  refute [expect = potential]
 159.356  oops
 159.357  
 159.358 -lemma "P (YOpt_rec_2 cy n s x)"
 159.359 +lemma "P (rec_YOpt_2 cy n s x)"
 159.360  refute [expect = potential]
 159.361  oops
 159.362  
 159.363 @@ -1114,23 +1086,23 @@
 159.364  refute [expect = potential]
 159.365  oops
 159.366  
 159.367 -lemma "Trie_rec_1 tr nil cons (TR x) = tr x (Trie_rec_2 tr nil cons x)"
 159.368 +lemma "rec_Trie_1 tr nil cons (TR x) = tr x (rec_Trie_2 tr nil cons x)"
 159.369  refute [maxsize = 1, expect = none]
 159.370  by simp
 159.371  
 159.372 -lemma "Trie_rec_2 tr nil cons [] = nil"
 159.373 +lemma "rec_Trie_2 tr nil cons [] = nil"
 159.374  refute [maxsize = 3, expect = none]
 159.375  by simp
 159.376  
 159.377 -lemma "Trie_rec_2 tr nil cons (x#xs) = cons x xs (Trie_rec_1 tr nil cons x) (Trie_rec_2 tr nil cons xs)"
 159.378 +lemma "rec_Trie_2 tr nil cons (x#xs) = cons x xs (rec_Trie_1 tr nil cons x) (rec_Trie_2 tr nil cons xs)"
 159.379  refute [maxsize = 1, expect = none]
 159.380  by simp
 159.381  
 159.382 -lemma "P (Trie_rec_1 tr nil cons x)"
 159.383 +lemma "P (rec_Trie_1 tr nil cons x)"
 159.384  refute [expect = potential]
 159.385  oops
 159.386  
 159.387 -lemma "P (Trie_rec_2 tr nil cons x)"
 159.388 +lemma "P (rec_Trie_2 tr nil cons x)"
 159.389  refute [expect = potential]
 159.390  oops
 159.391  
 159.392 @@ -1148,15 +1120,15 @@
 159.393  refute [expect = potential]
 159.394  oops
 159.395  
 159.396 -lemma "InfTree_rec leaf node Leaf = leaf"
 159.397 +lemma "rec_InfTree leaf node Leaf = leaf"
 159.398  refute [maxsize = 2, expect = none]
 159.399  by simp
 159.400  
 159.401 -lemma "InfTree_rec leaf node (Node x) = node x (\<lambda>n. InfTree_rec leaf node (x n))"
 159.402 +lemma "rec_InfTree leaf node (Node x) = node x (\<lambda>n. rec_InfTree leaf node (x n))"
 159.403  refute [maxsize = 1, expect = none]
 159.404  by simp
 159.405  
 159.406 -lemma "P (InfTree_rec leaf node x)"
 159.407 +lemma "P (rec_InfTree leaf node x)"
 159.408  refute [expect = potential]
 159.409  oops
 159.410  
 159.411 @@ -1174,19 +1146,19 @@
 159.412  refute [expect = potential]
 159.413  oops
 159.414  
 159.415 -lemma "lambda_rec var app lam (Var x) = var x"
 159.416 +lemma "rec_lambda var app lam (Var x) = var x"
 159.417  refute [maxsize = 1, expect = none]
 159.418  by simp
 159.419  
 159.420 -lemma "lambda_rec var app lam (App x y) = app x y (lambda_rec var app lam x) (lambda_rec var app lam y)"
 159.421 +lemma "rec_lambda var app lam (App x y) = app x y (rec_lambda var app lam x) (rec_lambda var app lam y)"
 159.422  refute [maxsize = 1, expect = none]
 159.423  by simp
 159.424  
 159.425 -lemma "lambda_rec var app lam (Lam x) = lam x (\<lambda>a. lambda_rec var app lam (x a))"
 159.426 +lemma "rec_lambda var app lam (Lam x) = lam x (\<lambda>a. rec_lambda var app lam (x a))"
 159.427  refute [maxsize = 1, expect = none]
 159.428  by simp
 159.429  
 159.430 -lemma "P (lambda_rec v a l x)"
 159.431 +lemma "P (rec_lambda v a l x)"
 159.432  refute [expect = potential]
 159.433  oops
 159.434  
 159.435 @@ -1207,35 +1179,35 @@
 159.436  refute [expect = potential]
 159.437  oops
 159.438  
 159.439 -lemma "U_rec_1 e c d nil cons (E x) = e x (U_rec_2 e c d nil cons x)"
 159.440 +lemma "rec_U_1 e c d nil cons (E x) = e x (rec_U_2 e c d nil cons x)"
 159.441  refute [maxsize = 1, expect = none]
 159.442  by simp
 159.443  
 159.444 -lemma "U_rec_2 e c d nil cons (C x) = c x"
 159.445 +lemma "rec_U_2 e c d nil cons (C x) = c x"
 159.446  refute [maxsize = 1, expect = none]
 159.447  by simp
 159.448  
 159.449 -lemma "U_rec_2 e c d nil cons (D x) = d x (U_rec_3 e c d nil cons x)"
 159.450 +lemma "rec_U_2 e c d nil cons (D x) = d x (rec_U_3 e c d nil cons x)"
 159.451  refute [maxsize = 1, expect = none]
 159.452  by simp
 159.453  
 159.454 -lemma "U_rec_3 e c d nil cons [] = nil"
 159.455 +lemma "rec_U_3 e c d nil cons [] = nil"
 159.456  refute [maxsize = 2, expect = none]
 159.457  by simp
 159.458  
 159.459 -lemma "U_rec_3 e c d nil cons (x#xs) = cons x xs (U_rec_1 e c d nil cons x) (U_rec_3 e c d nil cons xs)"
 159.460 +lemma "rec_U_3 e c d nil cons (x#xs) = cons x xs (rec_U_1 e c d nil cons x) (rec_U_3 e c d nil cons xs)"
 159.461  refute [maxsize = 1, expect = none]
 159.462  by simp
 159.463  
 159.464 -lemma "P (U_rec_1 e c d nil cons x)"
 159.465 +lemma "P (rec_U_1 e c d nil cons x)"
 159.466  refute [expect = potential]
 159.467  oops
 159.468  
 159.469 -lemma "P (U_rec_2 e c d nil cons x)"
 159.470 +lemma "P (rec_U_2 e c d nil cons x)"
 159.471  refute [expect = potential]
 159.472  oops
 159.473  
 159.474 -lemma "P (U_rec_3 e c d nil cons x)"
 159.475 +lemma "P (rec_U_3 e c d nil cons x)"
 159.476  refute [expect = potential]
 159.477  oops
 159.478  
   160.1 --- a/src/HOL/ex/Tree23.thy	Wed Feb 12 09:06:04 2014 +0100
   160.2 +++ b/src/HOL/ex/Tree23.thy	Wed Feb 12 10:59:25 2014 +0100
   160.3 @@ -330,12 +330,12 @@
   160.4  "dfull n (Some (p, (False, t'))) \<longleftrightarrow> full (Suc n) t'"
   160.5  
   160.6  lemmas dfull_case_intros =
   160.7 -  ord.exhaust [where y=y and P="dfull a (ord_case b c d y)"]
   160.8 -  option.exhaust [where y=y and P="dfull a (option_case b c y)"]
   160.9 -  prod.exhaust [where y=y and P="dfull a (prod_case b y)"]
  160.10 -  bool.exhaust [where y=y and P="dfull a (bool_case b c y)"]
  160.11 -  tree23.exhaust [where y=y and P="dfull a (Some (b, tree23_case c d e y))"]
  160.12 -  tree23.exhaust [where y=y and P="full a (tree23_case b c d y)"]
  160.13 +  ord.exhaust [of y "dfull a (case_ord b c d y)"]
  160.14 +  option.exhaust [of y "dfull a (case_option b c y)"]
  160.15 +  prod.exhaust [of y "dfull a (case_prod b y)"]
  160.16 +  bool.exhaust [of y "dfull a (case_bool b c y)"]
  160.17 +  tree23.exhaust [of y "dfull a (Some (b, case_tree23 c d e y))"]
  160.18 +  tree23.exhaust [of y "full a (case_tree23 b c d y)"]
  160.19    for a b c d e y
  160.20  
  160.21  lemma dfull_del: "full (Suc n) t \<Longrightarrow> dfull n (del k t)"
  160.22 @@ -396,7 +396,7 @@
  160.23  apply (case_tac n, simp, simp)
  160.24  apply (frule dfull_del [where k="Some k"])
  160.25  apply (cases "del (Some k) t", force)
  160.26 -apply (case_tac "a", rename_tac p b t', case_tac "b", auto)
  160.27 +apply (rename_tac a, case_tac "a", rename_tac b t', case_tac "b", auto)
  160.28  done
  160.29  
  160.30  text{* This is a little test harness and should be commented out once the