merged
authorhoelzl
Thu Sep 02 17:28:00 2010 +0200 (2010-09-02)
changeset 39096111756225292
parent 39092 98de40859858
parent 39095 f92b7e2877c2
child 39097 943c7b348524
merged
src/HOL/Probability/Caratheodory.thy
src/HOL/Probability/Probability_Space.thy
src/HOL/Probability/Product_Measure.thy
src/Pure/ProofGeneral/proof_general_keywords.ML
     1.1 --- a/Admin/Benchmarks/HOL-datatype/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
     1.2 +++ b/Admin/Benchmarks/HOL-datatype/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
     1.3 @@ -5,11 +5,11 @@
     1.4  
     1.5  val tests = ["Brackin", "Instructions", "SML", "Verilog"];
     1.6  
     1.7 -Unsynchronized.set timing;
     1.8 +timing := true;
     1.9  
    1.10 -warning "\nset quick_and_dirty\n"; Unsynchronized.set quick_and_dirty;
    1.11 +warning "\nset quick_and_dirty\n"; quick_and_dirty := true;
    1.12  use_thys tests;
    1.13  
    1.14 -warning "\nreset quick_and_dirty\n"; Unsynchronized.reset quick_and_dirty;
    1.15 +warning "\nreset quick_and_dirty\n"; quick_and_dirty := false;
    1.16  List.app Thy_Info.remove_thy tests;
    1.17  use_thys tests;
     2.1 --- a/Admin/Benchmarks/HOL-record/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
     2.2 +++ b/Admin/Benchmarks/HOL-record/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
     2.3 @@ -5,10 +5,10 @@
     2.4  
     2.5  val tests = ["RecordBenchmark"];
     2.6  
     2.7 -Unsynchronized.set timing;
     2.8 +timing := true;
     2.9  
    2.10 -warning "\nset quick_and_dirty\n"; Unsynchronized.set quick_and_dirty;
    2.11 +warning "\nset quick_and_dirty\n"; quick_and_dirty := true;
    2.12  use_thys tests;
    2.13  
    2.14 -warning "\nreset quick_and_dirty\n"; Unsynchronized.reset quick_and_dirty;
    2.15 +warning "\nreset quick_and_dirty\n"; quick_and_dirty := false;
    2.16  use_thys tests;
     3.1 --- a/Admin/Benchmarks/HOL-record/RecordBenchmark.thy	Thu Sep 02 17:12:40 2010 +0200
     3.2 +++ b/Admin/Benchmarks/HOL-record/RecordBenchmark.thy	Thu Sep 02 17:28:00 2010 +0200
     3.3 @@ -8,7 +8,7 @@
     3.4  imports Main
     3.5  begin
     3.6  
     3.7 -ML {* Unsynchronized.set Record.timing *}
     3.8 +ML {* Record.timing := true *}
     3.9  
    3.10  record many_A =
    3.11  A000::nat
     4.1 --- a/Admin/update-keywords	Thu Sep 02 17:12:40 2010 +0200
     4.2 +++ b/Admin/update-keywords	Thu Sep 02 17:28:00 2010 +0200
     4.3 @@ -11,9 +11,9 @@
     4.4  cd "$ISABELLE_HOME/etc"
     4.5  
     4.6  isabelle keywords \
     4.7 -  "$LOG/Pure.gz" "$LOG/Pure-ProofGeneral.gz" "$LOG/HOL.gz" "$LOG/HOLCF.gz" \
     4.8 -  "$LOG/HOL-Boogie.gz" "$LOG/HOL-Nominal.gz" "$LOG/HOL-Statespace.gz"
     4.9 +  "$LOG/Pure.gz" "$LOG/HOL.gz" "$LOG/HOLCF.gz" "$LOG/HOL-Boogie.gz" \
    4.10 +  "$LOG/HOL-Nominal.gz" "$LOG/HOL-Statespace.gz"
    4.11  
    4.12  isabelle keywords -k ZF \
    4.13 -  "$LOG/Pure.gz" "$LOG/Pure-ProofGeneral.gz" "$LOG/FOL.gz" "$LOG/ZF.gz"
    4.14 +  "$LOG/Pure.gz" "$LOG/FOL.gz" "$LOG/ZF.gz"
    4.15  
     5.1 --- a/NEWS	Thu Sep 02 17:12:40 2010 +0200
     5.2 +++ b/NEWS	Thu Sep 02 17:28:00 2010 +0200
     5.3 @@ -23,6 +23,28 @@
     5.4  at the cost of clarity of file dependencies.  Recall that Isabelle/ML
     5.5  files exclusively use the .ML extension.  Minor INCOMPATIBILTY.
     5.6  
     5.7 +* Various options that affect document antiquotations are now properly
     5.8 +handled within the context via configuration options, instead of
     5.9 +unsynchronized references.  There are both ML Config.T entities and
    5.10 +Isar declaration attributes to access these.
    5.11 +
    5.12 +  ML:                       Isar:
    5.13 +
    5.14 +  Thy_Output.display        thy_output_display
    5.15 +  Thy_Output.quotes         thy_output_quotes
    5.16 +  Thy_Output.indent         thy_output_indent
    5.17 +  Thy_Output.source         thy_output_source
    5.18 +  Thy_Output.break          thy_output_break
    5.19 +
    5.20 +Note that the corresponding "..._default" references may be only
    5.21 +changed globally at the ROOT session setup, but *not* within a theory.
    5.22 +
    5.23 +* ML structure Unsynchronized never opened, not even in Isar
    5.24 +interaction mode as before.  Old Unsynchronized.set etc. have been
    5.25 +discontinued -- use plain := instead.  This should be *rare* anyway,
    5.26 +since modern tools always work via official context data, notably
    5.27 +configuration options.
    5.28 +
    5.29  
    5.30  *** Pure ***
    5.31  
    5.32 @@ -40,6 +62,13 @@
    5.33  
    5.34  *** HOL ***
    5.35  
    5.36 +* Renamed class eq and constant eq (for code generation) to class equal
    5.37 +and constant equal, plus renaming of related facts and various tuning.
    5.38 +INCOMPATIBILITY.
    5.39 +
    5.40 +* Scala (2.8 or higher) has been added to the target languages of
    5.41 +the code generator.
    5.42 +
    5.43  * Dropped type classes mult_mono and mult_mono1.  INCOMPATIBILITY.
    5.44  
    5.45  * Theory SetsAndFunctions has been split into Function_Algebras and Set_Algebras;
    5.46 @@ -104,6 +133,10 @@
    5.47      Trueprop ~> HOL.Trueprop
    5.48      True ~> HOL.True
    5.49      False ~> HOL.False
    5.50 +    op & ~> HOL.conj
    5.51 +    op | ~> HOL.disj
    5.52 +    op --> ~> HOL.implies
    5.53 +    op = ~> HOL.eq
    5.54      Not ~> HOL.Not
    5.55      The ~> HOL.The
    5.56      All ~> HOL.All
     6.1 --- a/doc-src/Classes/Thy/Classes.thy	Thu Sep 02 17:12:40 2010 +0200
     6.2 +++ b/doc-src/Classes/Thy/Classes.thy	Thu Sep 02 17:28:00 2010 +0200
     6.3 @@ -8,14 +8,14 @@
     6.4    Type classes were introduced by Wadler and Blott \cite{wadler89how}
     6.5    into the Haskell language to allow for a reasonable implementation
     6.6    of overloading\footnote{throughout this tutorial, we are referring
     6.7 -  to classical Haskell 1.0 type classes, not considering
     6.8 -  later additions in expressiveness}.
     6.9 -  As a canonical example, a polymorphic equality function
    6.10 -  @{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} which is overloaded on different
    6.11 -  types for @{text "\<alpha>"}, which is achieved by splitting introduction
    6.12 -  of the @{text eq} function from its overloaded definitions by means
    6.13 -  of @{text class} and @{text instance} declarations:
    6.14 -  \footnote{syntax here is a kind of isabellized Haskell}
    6.15 +  to classical Haskell 1.0 type classes, not considering later
    6.16 +  additions in expressiveness}.  As a canonical example, a polymorphic
    6.17 +  equality function @{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} which is overloaded on
    6.18 +  different types for @{text "\<alpha>"}, which is achieved by splitting
    6.19 +  introduction of the @{text eq} function from its overloaded
    6.20 +  definitions by means of @{text class} and @{text instance}
    6.21 +  declarations: \footnote{syntax here is a kind of isabellized
    6.22 +  Haskell}
    6.23  
    6.24    \begin{quote}
    6.25  
    6.26 @@ -41,14 +41,14 @@
    6.27    these annotations are assertions that a particular polymorphic type
    6.28    provides definitions for overloaded functions.
    6.29  
    6.30 -  Indeed, type classes not only allow for simple overloading
    6.31 -  but form a generic calculus, an instance of order-sorted
    6.32 -  algebra \cite{nipkow-sorts93,Nipkow-Prehofer:1993,Wenzel:1997:TPHOL}.
    6.33 +  Indeed, type classes not only allow for simple overloading but form
    6.34 +  a generic calculus, an instance of order-sorted algebra
    6.35 +  \cite{nipkow-sorts93,Nipkow-Prehofer:1993,Wenzel:1997:TPHOL}.
    6.36  
    6.37 -  From a software engineering point of view, type classes
    6.38 -  roughly correspond to interfaces in object-oriented languages like Java;
    6.39 -  so, it is naturally desirable that type classes do not only
    6.40 -  provide functions (class parameters) but also state specifications
    6.41 +  From a software engineering point of view, type classes roughly
    6.42 +  correspond to interfaces in object-oriented languages like Java; so,
    6.43 +  it is naturally desirable that type classes do not only provide
    6.44 +  functions (class parameters) but also state specifications
    6.45    implementations must obey.  For example, the @{text "class eq"}
    6.46    above could be given the following specification, demanding that
    6.47    @{text "class eq"} is an equivalence relation obeying reflexivity,
    6.48 @@ -65,11 +65,10 @@
    6.49  
    6.50    \end{quote}
    6.51  
    6.52 -  \noindent From a theoretical point of view, type classes are lightweight
    6.53 -  modules; Haskell type classes may be emulated by
    6.54 -  SML functors \cite{classes_modules}. 
    6.55 -  Isabelle/Isar offers a discipline of type classes which brings
    6.56 -  all those aspects together:
    6.57 +  \noindent From a theoretical point of view, type classes are
    6.58 +  lightweight modules; Haskell type classes may be emulated by SML
    6.59 +  functors \cite{classes_modules}.  Isabelle/Isar offers a discipline
    6.60 +  of type classes which brings all those aspects together:
    6.61  
    6.62    \begin{enumerate}
    6.63      \item specifying abstract parameters together with
    6.64 @@ -81,15 +80,15 @@
    6.65        locales \cite{kammueller-locales}.
    6.66    \end{enumerate}
    6.67  
    6.68 -  \noindent Isar type classes also directly support code generation
    6.69 -  in a Haskell like fashion. Internally, they are mapped to more primitive 
    6.70 -  Isabelle concepts \cite{Haftmann-Wenzel:2006:classes}.
    6.71 +  \noindent Isar type classes also directly support code generation in
    6.72 +  a Haskell like fashion. Internally, they are mapped to more
    6.73 +  primitive Isabelle concepts \cite{Haftmann-Wenzel:2006:classes}.
    6.74  
    6.75 -  This tutorial demonstrates common elements of structured specifications
    6.76 -  and abstract reasoning with type classes by the algebraic hierarchy of
    6.77 -  semigroups, monoids and groups.  Our background theory is that of
    6.78 -  Isabelle/HOL \cite{isa-tutorial}, for which some
    6.79 -  familiarity is assumed.
    6.80 +  This tutorial demonstrates common elements of structured
    6.81 +  specifications and abstract reasoning with type classes by the
    6.82 +  algebraic hierarchy of semigroups, monoids and groups.  Our
    6.83 +  background theory is that of Isabelle/HOL \cite{isa-tutorial}, for
    6.84 +  which some familiarity is assumed.
    6.85  *}
    6.86  
    6.87  section {* A simple algebra example \label{sec:example} *}
    6.88 @@ -107,25 +106,24 @@
    6.89    assumes assoc: "(x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"
    6.90  
    6.91  text {*
    6.92 -  \noindent This @{command class} specification consists of two
    6.93 -  parts: the \qn{operational} part names the class parameter
    6.94 -  (@{element "fixes"}), the \qn{logical} part specifies properties on them
    6.95 -  (@{element "assumes"}).  The local @{element "fixes"} and
    6.96 -  @{element "assumes"} are lifted to the theory toplevel,
    6.97 -  yielding the global
    6.98 +  \noindent This @{command class} specification consists of two parts:
    6.99 +  the \qn{operational} part names the class parameter (@{element
   6.100 +  "fixes"}), the \qn{logical} part specifies properties on them
   6.101 +  (@{element "assumes"}).  The local @{element "fixes"} and @{element
   6.102 +  "assumes"} are lifted to the theory toplevel, yielding the global
   6.103    parameter @{term [source] "mult \<Colon> \<alpha>\<Colon>semigroup \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>"} and the
   6.104 -  global theorem @{fact "semigroup.assoc:"}~@{prop [source] "\<And>x y
   6.105 -  z \<Colon> \<alpha>\<Colon>semigroup. (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"}.
   6.106 +  global theorem @{fact "semigroup.assoc:"}~@{prop [source] "\<And>x y z \<Colon>
   6.107 +  \<alpha>\<Colon>semigroup. (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"}.
   6.108  *}
   6.109  
   6.110  
   6.111  subsection {* Class instantiation \label{sec:class_inst} *}
   6.112  
   6.113  text {*
   6.114 -  The concrete type @{typ int} is made a @{class semigroup}
   6.115 -  instance by providing a suitable definition for the class parameter
   6.116 -  @{text "(\<otimes>)"} and a proof for the specification of @{fact assoc}.
   6.117 -  This is accomplished by the @{command instantiation} target:
   6.118 +  The concrete type @{typ int} is made a @{class semigroup} instance
   6.119 +  by providing a suitable definition for the class parameter @{text
   6.120 +  "(\<otimes>)"} and a proof for the specification of @{fact assoc}.  This is
   6.121 +  accomplished by the @{command instantiation} target:
   6.122  *}
   6.123  
   6.124  instantiation %quote int :: semigroup
   6.125 @@ -143,22 +141,22 @@
   6.126  end %quote
   6.127  
   6.128  text {*
   6.129 -  \noindent @{command instantiation} defines class parameters
   6.130 -  at a particular instance using common specification tools (here,
   6.131 -  @{command definition}).  The concluding @{command instance}
   6.132 -  opens a proof that the given parameters actually conform
   6.133 -  to the class specification.  Note that the first proof step
   6.134 -  is the @{method default} method,
   6.135 -  which for such instance proofs maps to the @{method intro_classes} method.
   6.136 -  This reduces an instance judgement to the relevant primitive
   6.137 -  proof goals; typically it is the first method applied
   6.138 -  in an instantiation proof.
   6.139 +  \noindent @{command instantiation} defines class parameters at a
   6.140 +  particular instance using common specification tools (here,
   6.141 +  @{command definition}).  The concluding @{command instance} opens a
   6.142 +  proof that the given parameters actually conform to the class
   6.143 +  specification.  Note that the first proof step is the @{method
   6.144 +  default} method, which for such instance proofs maps to the @{method
   6.145 +  intro_classes} method.  This reduces an instance judgement to the
   6.146 +  relevant primitive proof goals; typically it is the first method
   6.147 +  applied in an instantiation proof.
   6.148  
   6.149 -  From now on, the type-checker will consider @{typ int}
   6.150 -  as a @{class semigroup} automatically, i.e.\ any general results
   6.151 -  are immediately available on concrete instances.
   6.152 +  From now on, the type-checker will consider @{typ int} as a @{class
   6.153 +  semigroup} automatically, i.e.\ any general results are immediately
   6.154 +  available on concrete instances.
   6.155  
   6.156 -  \medskip Another instance of @{class semigroup} yields the natural numbers:
   6.157 +  \medskip Another instance of @{class semigroup} yields the natural
   6.158 +  numbers:
   6.159  *}
   6.160  
   6.161  instantiation %quote nat :: semigroup
   6.162 @@ -177,21 +175,20 @@
   6.163  end %quote
   6.164  
   6.165  text {*
   6.166 -  \noindent Note the occurence of the name @{text mult_nat}
   6.167 -  in the primrec declaration;  by default, the local name of
   6.168 -  a class operation @{text f} to be instantiated on type constructor
   6.169 -  @{text \<kappa>} is mangled as @{text f_\<kappa>}.  In case of uncertainty,
   6.170 -  these names may be inspected using the @{command "print_context"} command
   6.171 -  or the corresponding ProofGeneral button.
   6.172 +  \noindent Note the occurence of the name @{text mult_nat} in the
   6.173 +  primrec declaration; by default, the local name of a class operation
   6.174 +  @{text f} to be instantiated on type constructor @{text \<kappa>} is
   6.175 +  mangled as @{text f_\<kappa>}.  In case of uncertainty, these names may be
   6.176 +  inspected using the @{command "print_context"} command or the
   6.177 +  corresponding ProofGeneral button.
   6.178  *}
   6.179  
   6.180  subsection {* Lifting and parametric types *}
   6.181  
   6.182  text {*
   6.183 -  Overloaded definitions given at a class instantiation
   6.184 -  may include recursion over the syntactic structure of types.
   6.185 -  As a canonical example, we model product semigroups
   6.186 -  using our simple algebra:
   6.187 +  Overloaded definitions given at a class instantiation may include
   6.188 +  recursion over the syntactic structure of types.  As a canonical
   6.189 +  example, we model product semigroups using our simple algebra:
   6.190  *}
   6.191  
   6.192  instantiation %quote prod :: (semigroup, semigroup) semigroup
   6.193 @@ -211,21 +208,19 @@
   6.194  text {*
   6.195    \noindent Associativity of product semigroups is established using
   6.196    the definition of @{text "(\<otimes>)"} on products and the hypothetical
   6.197 -  associativity of the type components;  these hypotheses
   6.198 -  are legitimate due to the @{class semigroup} constraints imposed
   6.199 -  on the type components by the @{command instance} proposition.
   6.200 -  Indeed, this pattern often occurs with parametric types
   6.201 -  and type classes.
   6.202 +  associativity of the type components; these hypotheses are
   6.203 +  legitimate due to the @{class semigroup} constraints imposed on the
   6.204 +  type components by the @{command instance} proposition.  Indeed,
   6.205 +  this pattern often occurs with parametric types and type classes.
   6.206  *}
   6.207  
   6.208  
   6.209  subsection {* Subclassing *}
   6.210  
   6.211  text {*
   6.212 -  We define a subclass @{text monoidl} (a semigroup with a left-hand neutral)
   6.213 -  by extending @{class semigroup}
   6.214 -  with one additional parameter @{text neutral} together
   6.215 -  with its characteristic property:
   6.216 +  We define a subclass @{text monoidl} (a semigroup with a left-hand
   6.217 +  neutral) by extending @{class semigroup} with one additional
   6.218 +  parameter @{text neutral} together with its characteristic property:
   6.219  *}
   6.220  
   6.221  class %quote monoidl = semigroup +
   6.222 @@ -233,10 +228,10 @@
   6.223    assumes neutl: "\<one> \<otimes> x = x"
   6.224  
   6.225  text {*
   6.226 -  \noindent Again, we prove some instances, by
   6.227 -  providing suitable parameter definitions and proofs for the
   6.228 -  additional specifications.  Observe that instantiations
   6.229 -  for types with the same arity may be simultaneous:
   6.230 +  \noindent Again, we prove some instances, by providing suitable
   6.231 +  parameter definitions and proofs for the additional specifications.
   6.232 +  Observe that instantiations for types with the same arity may be
   6.233 +  simultaneous:
   6.234  *}
   6.235  
   6.236  instantiation %quote nat and int :: monoidl
   6.237 @@ -309,8 +304,8 @@
   6.238  end %quote
   6.239  
   6.240  text {*
   6.241 -  \noindent To finish our small algebra example, we add a @{text group} class
   6.242 -  with a corresponding instance:
   6.243 +  \noindent To finish our small algebra example, we add a @{text
   6.244 +  group} class with a corresponding instance:
   6.245  *}
   6.246  
   6.247  class %quote group = monoidl +
   6.248 @@ -338,9 +333,9 @@
   6.249  subsection {* A look behind the scenes *}
   6.250  
   6.251  text {*
   6.252 -  The example above gives an impression how Isar type classes work
   6.253 -  in practice.  As stated in the introduction, classes also provide
   6.254 -  a link to Isar's locale system.  Indeed, the logical core of a class
   6.255 +  The example above gives an impression how Isar type classes work in
   6.256 +  practice.  As stated in the introduction, classes also provide a
   6.257 +  link to Isar's locale system.  Indeed, the logical core of a class
   6.258    is nothing other than a locale:
   6.259  *}
   6.260  
   6.261 @@ -402,13 +397,14 @@
   6.262  qed
   6.263  
   6.264  text {*
   6.265 -  \noindent Here the \qt{@{keyword "in"} @{class group}} target specification
   6.266 -  indicates that the result is recorded within that context for later
   6.267 -  use.  This local theorem is also lifted to the global one @{fact
   6.268 -  "group.left_cancel:"} @{prop [source] "\<And>x y z \<Colon> \<alpha>\<Colon>group. x \<otimes> y = x \<otimes>
   6.269 -  z \<longleftrightarrow> y = z"}.  Since type @{text "int"} has been made an instance of
   6.270 -  @{text "group"} before, we may refer to that fact as well: @{prop
   6.271 -  [source] "\<And>x y z \<Colon> int. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y = z"}.
   6.272 +  \noindent Here the \qt{@{keyword "in"} @{class group}} target
   6.273 +  specification indicates that the result is recorded within that
   6.274 +  context for later use.  This local theorem is also lifted to the
   6.275 +  global one @{fact "group.left_cancel:"} @{prop [source] "\<And>x y z \<Colon>
   6.276 +  \<alpha>\<Colon>group. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y = z"}.  Since type @{text "int"} has been
   6.277 +  made an instance of @{text "group"} before, we may refer to that
   6.278 +  fact as well: @{prop [source] "\<And>x y z \<Colon> int. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y =
   6.279 +  z"}.
   6.280  *}
   6.281  
   6.282  
   6.283 @@ -424,15 +420,14 @@
   6.284  
   6.285  text {*
   6.286    \noindent If the locale @{text group} is also a class, this local
   6.287 -  definition is propagated onto a global definition of
   6.288 -  @{term [source] "pow_nat \<Colon> nat \<Rightarrow> \<alpha>\<Colon>monoid \<Rightarrow> \<alpha>\<Colon>monoid"}
   6.289 -  with corresponding theorems
   6.290 +  definition is propagated onto a global definition of @{term [source]
   6.291 +  "pow_nat \<Colon> nat \<Rightarrow> \<alpha>\<Colon>monoid \<Rightarrow> \<alpha>\<Colon>monoid"} with corresponding theorems
   6.292  
   6.293    @{thm pow_nat.simps [no_vars]}.
   6.294  
   6.295 -  \noindent As you can see from this example, for local
   6.296 -  definitions you may use any specification tool
   6.297 -  which works together with locales, such as Krauss's recursive function package
   6.298 +  \noindent As you can see from this example, for local definitions
   6.299 +  you may use any specification tool which works together with
   6.300 +  locales, such as Krauss's recursive function package
   6.301    \cite{krauss2006}.
   6.302  *}
   6.303  
   6.304 @@ -440,19 +435,17 @@
   6.305  subsection {* A functor analogy *}
   6.306  
   6.307  text {*
   6.308 -  We introduced Isar classes by analogy to type classes in
   6.309 -  functional programming;  if we reconsider this in the
   6.310 -  context of what has been said about type classes and locales,
   6.311 -  we can drive this analogy further by stating that type
   6.312 -  classes essentially correspond to functors that have
   6.313 -  a canonical interpretation as type classes.
   6.314 -  There is also the possibility of other interpretations.
   6.315 -  For example, @{text list}s also form a monoid with
   6.316 -  @{text append} and @{term "[]"} as operations, but it
   6.317 -  seems inappropriate to apply to lists
   6.318 -  the same operations as for genuinely algebraic types.
   6.319 -  In such a case, we can simply make a particular interpretation
   6.320 -  of monoids for lists:
   6.321 +  We introduced Isar classes by analogy to type classes in functional
   6.322 +  programming; if we reconsider this in the context of what has been
   6.323 +  said about type classes and locales, we can drive this analogy
   6.324 +  further by stating that type classes essentially correspond to
   6.325 +  functors that have a canonical interpretation as type classes.
   6.326 +  There is also the possibility of other interpretations.  For
   6.327 +  example, @{text list}s also form a monoid with @{text append} and
   6.328 +  @{term "[]"} as operations, but it seems inappropriate to apply to
   6.329 +  lists the same operations as for genuinely algebraic types.  In such
   6.330 +  a case, we can simply make a particular interpretation of monoids
   6.331 +  for lists:
   6.332  *}
   6.333  
   6.334  interpretation %quote list_monoid: monoid append "[]"
   6.335 @@ -510,12 +503,10 @@
   6.336  qed
   6.337  
   6.338  text {*
   6.339 -  The logical proof is carried out on the locale level.
   6.340 -  Afterwards it is propagated
   6.341 -  to the type system, making @{text group} an instance of
   6.342 -  @{text monoid} by adding an additional edge
   6.343 -  to the graph of subclass relations
   6.344 -  (\figref{fig:subclass}).
   6.345 +  The logical proof is carried out on the locale level.  Afterwards it
   6.346 +  is propagated to the type system, making @{text group} an instance
   6.347 +  of @{text monoid} by adding an additional edge to the graph of
   6.348 +  subclass relations (\figref{fig:subclass}).
   6.349  
   6.350    \begin{figure}[htbp]
   6.351     \begin{center}
   6.352 @@ -547,8 +538,8 @@
   6.353     \end{center}
   6.354    \end{figure}
   6.355  
   6.356 -  For illustration, a derived definition
   6.357 -  in @{text group} using @{text pow_nat}
   6.358 +  For illustration, a derived definition in @{text group} using @{text
   6.359 +  pow_nat}
   6.360  *}
   6.361  
   6.362  definition %quote (in group) pow_int :: "int \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>" where
   6.363 @@ -557,17 +548,17 @@
   6.364      else (pow_nat (nat (- k)) x)\<div>)"
   6.365  
   6.366  text {*
   6.367 -  \noindent yields the global definition of
   6.368 -  @{term [source] "pow_int \<Colon> int \<Rightarrow> \<alpha>\<Colon>group \<Rightarrow> \<alpha>\<Colon>group"}
   6.369 -  with the corresponding theorem @{thm pow_int_def [no_vars]}.
   6.370 +  \noindent yields the global definition of @{term [source] "pow_int \<Colon>
   6.371 +  int \<Rightarrow> \<alpha>\<Colon>group \<Rightarrow> \<alpha>\<Colon>group"} with the corresponding theorem @{thm
   6.372 +  pow_int_def [no_vars]}.
   6.373  *}
   6.374  
   6.375  subsection {* A note on syntax *}
   6.376  
   6.377  text {*
   6.378 -  As a convenience, class context syntax allows references
   6.379 -  to local class operations and their global counterparts
   6.380 -  uniformly;  type inference resolves ambiguities.  For example:
   6.381 +  As a convenience, class context syntax allows references to local
   6.382 +  class operations and their global counterparts uniformly; type
   6.383 +  inference resolves ambiguities.  For example:
   6.384  *}
   6.385  
   6.386  context %quote semigroup
   6.387 @@ -581,11 +572,11 @@
   6.388  term %quote "x \<otimes> y" -- {* example 3 *}
   6.389  
   6.390  text {*
   6.391 -  \noindent Here in example 1, the term refers to the local class operation
   6.392 -  @{text "mult [\<alpha>]"}, whereas in example 2 the type constraint
   6.393 -  enforces the global class operation @{text "mult [nat]"}.
   6.394 -  In the global context in example 3, the reference is
   6.395 -  to the polymorphic global class operation @{text "mult [?\<alpha> \<Colon> semigroup]"}.
   6.396 +  \noindent Here in example 1, the term refers to the local class
   6.397 +  operation @{text "mult [\<alpha>]"}, whereas in example 2 the type
   6.398 +  constraint enforces the global class operation @{text "mult [nat]"}.
   6.399 +  In the global context in example 3, the reference is to the
   6.400 +  polymorphic global class operation @{text "mult [?\<alpha> \<Colon> semigroup]"}.
   6.401  *}
   6.402  
   6.403  section {* Further issues *}
   6.404 @@ -593,16 +584,14 @@
   6.405  subsection {* Type classes and code generation *}
   6.406  
   6.407  text {*
   6.408 -  Turning back to the first motivation for type classes,
   6.409 -  namely overloading, it is obvious that overloading
   6.410 -  stemming from @{command class} statements and
   6.411 -  @{command instantiation}
   6.412 -  targets naturally maps to Haskell type classes.
   6.413 -  The code generator framework \cite{isabelle-codegen} 
   6.414 -  takes this into account.  If the target language (e.g.~SML)
   6.415 -  lacks type classes, then they
   6.416 -  are implemented by an explicit dictionary construction.
   6.417 -  As example, let's go back to the power function:
   6.418 +  Turning back to the first motivation for type classes, namely
   6.419 +  overloading, it is obvious that overloading stemming from @{command
   6.420 +  class} statements and @{command instantiation} targets naturally
   6.421 +  maps to Haskell type classes.  The code generator framework
   6.422 +  \cite{isabelle-codegen} takes this into account.  If the target
   6.423 +  language (e.g.~SML) lacks type classes, then they are implemented by
   6.424 +  an explicit dictionary construction.  As example, let's go back to
   6.425 +  the power function:
   6.426  *}
   6.427  
   6.428  definition %quote example :: int where
   6.429 @@ -619,11 +608,18 @@
   6.430  *}
   6.431  text %quote {*@{code_stmts example (SML)}*}
   6.432  
   6.433 +text {*
   6.434 +  \noindent In Scala, implicts are used as dictionaries:
   6.435 +*}
   6.436 +(*<*)code_include %invisible Scala "Natural" -(*>*)
   6.437 +text %quote {*@{code_stmts example (Scala)}*}
   6.438 +
   6.439 +
   6.440  subsection {* Inspecting the type class universe *}
   6.441  
   6.442  text {*
   6.443 -  To facilitate orientation in complex subclass structures,
   6.444 -  two diagnostics commands are provided:
   6.445 +  To facilitate orientation in complex subclass structures, two
   6.446 +  diagnostics commands are provided:
   6.447  
   6.448    \begin{description}
   6.449  
     7.1 --- a/doc-src/Classes/Thy/document/Classes.tex	Thu Sep 02 17:12:40 2010 +0200
     7.2 +++ b/doc-src/Classes/Thy/document/Classes.tex	Thu Sep 02 17:28:00 2010 +0200
     7.3 @@ -26,14 +26,14 @@
     7.4  Type classes were introduced by Wadler and Blott \cite{wadler89how}
     7.5    into the Haskell language to allow for a reasonable implementation
     7.6    of overloading\footnote{throughout this tutorial, we are referring
     7.7 -  to classical Haskell 1.0 type classes, not considering
     7.8 -  later additions in expressiveness}.
     7.9 -  As a canonical example, a polymorphic equality function
    7.10 -  \isa{eq\ {\isasymColon}\ {\isasymalpha}\ {\isasymRightarrow}\ {\isasymalpha}\ {\isasymRightarrow}\ bool} which is overloaded on different
    7.11 -  types for \isa{{\isasymalpha}}, which is achieved by splitting introduction
    7.12 -  of the \isa{eq} function from its overloaded definitions by means
    7.13 -  of \isa{class} and \isa{instance} declarations:
    7.14 -  \footnote{syntax here is a kind of isabellized Haskell}
    7.15 +  to classical Haskell 1.0 type classes, not considering later
    7.16 +  additions in expressiveness}.  As a canonical example, a polymorphic
    7.17 +  equality function \isa{eq\ {\isasymColon}\ {\isasymalpha}\ {\isasymRightarrow}\ {\isasymalpha}\ {\isasymRightarrow}\ bool} which is overloaded on
    7.18 +  different types for \isa{{\isasymalpha}}, which is achieved by splitting
    7.19 +  introduction of the \isa{eq} function from its overloaded
    7.20 +  definitions by means of \isa{class} and \isa{instance}
    7.21 +  declarations: \footnote{syntax here is a kind of isabellized
    7.22 +  Haskell}
    7.23  
    7.24    \begin{quote}
    7.25  
    7.26 @@ -59,14 +59,14 @@
    7.27    these annotations are assertions that a particular polymorphic type
    7.28    provides definitions for overloaded functions.
    7.29  
    7.30 -  Indeed, type classes not only allow for simple overloading
    7.31 -  but form a generic calculus, an instance of order-sorted
    7.32 -  algebra \cite{nipkow-sorts93,Nipkow-Prehofer:1993,Wenzel:1997:TPHOL}.
    7.33 +  Indeed, type classes not only allow for simple overloading but form
    7.34 +  a generic calculus, an instance of order-sorted algebra
    7.35 +  \cite{nipkow-sorts93,Nipkow-Prehofer:1993,Wenzel:1997:TPHOL}.
    7.36  
    7.37 -  From a software engineering point of view, type classes
    7.38 -  roughly correspond to interfaces in object-oriented languages like Java;
    7.39 -  so, it is naturally desirable that type classes do not only
    7.40 -  provide functions (class parameters) but also state specifications
    7.41 +  From a software engineering point of view, type classes roughly
    7.42 +  correspond to interfaces in object-oriented languages like Java; so,
    7.43 +  it is naturally desirable that type classes do not only provide
    7.44 +  functions (class parameters) but also state specifications
    7.45    implementations must obey.  For example, the \isa{class\ eq}
    7.46    above could be given the following specification, demanding that
    7.47    \isa{class\ eq} is an equivalence relation obeying reflexivity,
    7.48 @@ -83,11 +83,10 @@
    7.49  
    7.50    \end{quote}
    7.51  
    7.52 -  \noindent From a theoretical point of view, type classes are lightweight
    7.53 -  modules; Haskell type classes may be emulated by
    7.54 -  SML functors \cite{classes_modules}. 
    7.55 -  Isabelle/Isar offers a discipline of type classes which brings
    7.56 -  all those aspects together:
    7.57 +  \noindent From a theoretical point of view, type classes are
    7.58 +  lightweight modules; Haskell type classes may be emulated by SML
    7.59 +  functors \cite{classes_modules}.  Isabelle/Isar offers a discipline
    7.60 +  of type classes which brings all those aspects together:
    7.61  
    7.62    \begin{enumerate}
    7.63      \item specifying abstract parameters together with
    7.64 @@ -99,15 +98,15 @@
    7.65        locales \cite{kammueller-locales}.
    7.66    \end{enumerate}
    7.67  
    7.68 -  \noindent Isar type classes also directly support code generation
    7.69 -  in a Haskell like fashion. Internally, they are mapped to more primitive 
    7.70 -  Isabelle concepts \cite{Haftmann-Wenzel:2006:classes}.
    7.71 +  \noindent Isar type classes also directly support code generation in
    7.72 +  a Haskell like fashion. Internally, they are mapped to more
    7.73 +  primitive Isabelle concepts \cite{Haftmann-Wenzel:2006:classes}.
    7.74  
    7.75 -  This tutorial demonstrates common elements of structured specifications
    7.76 -  and abstract reasoning with type classes by the algebraic hierarchy of
    7.77 -  semigroups, monoids and groups.  Our background theory is that of
    7.78 -  Isabelle/HOL \cite{isa-tutorial}, for which some
    7.79 -  familiarity is assumed.%
    7.80 +  This tutorial demonstrates common elements of structured
    7.81 +  specifications and abstract reasoning with type classes by the
    7.82 +  algebraic hierarchy of semigroups, monoids and groups.  Our
    7.83 +  background theory is that of Isabelle/HOL \cite{isa-tutorial}, for
    7.84 +  which some familiarity is assumed.%
    7.85  \end{isamarkuptext}%
    7.86  \isamarkuptrue%
    7.87  %
    7.88 @@ -142,12 +141,9 @@
    7.89  \endisadelimquote
    7.90  %
    7.91  \begin{isamarkuptext}%
    7.92 -\noindent This \hyperlink{command.class}{\mbox{\isa{\isacommand{class}}}} specification consists of two
    7.93 -  parts: the \qn{operational} part names the class parameter
    7.94 -  (\hyperlink{element.fixes}{\mbox{\isa{\isakeyword{fixes}}}}), the \qn{logical} part specifies properties on them
    7.95 -  (\hyperlink{element.assumes}{\mbox{\isa{\isakeyword{assumes}}}}).  The local \hyperlink{element.fixes}{\mbox{\isa{\isakeyword{fixes}}}} and
    7.96 -  \hyperlink{element.assumes}{\mbox{\isa{\isakeyword{assumes}}}} are lifted to the theory toplevel,
    7.97 -  yielding the global
    7.98 +\noindent This \hyperlink{command.class}{\mbox{\isa{\isacommand{class}}}} specification consists of two parts:
    7.99 +  the \qn{operational} part names the class parameter (\hyperlink{element.fixes}{\mbox{\isa{\isakeyword{fixes}}}}), the \qn{logical} part specifies properties on them
   7.100 +  (\hyperlink{element.assumes}{\mbox{\isa{\isakeyword{assumes}}}}).  The local \hyperlink{element.fixes}{\mbox{\isa{\isakeyword{fixes}}}} and \hyperlink{element.assumes}{\mbox{\isa{\isakeyword{assumes}}}} are lifted to the theory toplevel, yielding the global
   7.101    parameter \isa{{\isachardoublequote}mult\ {\isasymColon}\ {\isasymalpha}{\isasymColon}semigroup\ {\isasymRightarrow}\ {\isasymalpha}\ {\isasymRightarrow}\ {\isasymalpha}{\isachardoublequote}} and the
   7.102    global theorem \hyperlink{fact.semigroup.assoc:}{\mbox{\isa{semigroup{\isachardot}assoc{\isacharcolon}}}}~\isa{{\isachardoublequote}{\isasymAnd}x\ y\ z\ {\isasymColon}\ {\isasymalpha}{\isasymColon}semigroup{\isachardot}\ {\isacharparenleft}x\ {\isasymotimes}\ y{\isacharparenright}\ {\isasymotimes}\ z\ {\isacharequal}\ x\ {\isasymotimes}\ {\isacharparenleft}y\ {\isasymotimes}\ z{\isacharparenright}{\isachardoublequote}}.%
   7.103  \end{isamarkuptext}%
   7.104 @@ -158,10 +154,9 @@
   7.105  \isamarkuptrue%
   7.106  %
   7.107  \begin{isamarkuptext}%
   7.108 -The concrete type \isa{int} is made a \isa{semigroup}
   7.109 -  instance by providing a suitable definition for the class parameter
   7.110 -  \isa{{\isacharparenleft}{\isasymotimes}{\isacharparenright}} and a proof for the specification of \hyperlink{fact.assoc}{\mbox{\isa{assoc}}}.
   7.111 -  This is accomplished by the \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}} target:%
   7.112 +The concrete type \isa{int} is made a \isa{semigroup} instance
   7.113 +  by providing a suitable definition for the class parameter \isa{{\isacharparenleft}{\isasymotimes}{\isacharparenright}} and a proof for the specification of \hyperlink{fact.assoc}{\mbox{\isa{assoc}}}.  This is
   7.114 +  accomplished by the \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}} target:%
   7.115  \end{isamarkuptext}%
   7.116  \isamarkuptrue%
   7.117  %
   7.118 @@ -204,22 +199,19 @@
   7.119  \endisadelimquote
   7.120  %
   7.121  \begin{isamarkuptext}%
   7.122 -\noindent \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}} defines class parameters
   7.123 -  at a particular instance using common specification tools (here,
   7.124 -  \hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}).  The concluding \hyperlink{command.instance}{\mbox{\isa{\isacommand{instance}}}}
   7.125 -  opens a proof that the given parameters actually conform
   7.126 -  to the class specification.  Note that the first proof step
   7.127 -  is the \hyperlink{method.default}{\mbox{\isa{default}}} method,
   7.128 -  which for such instance proofs maps to the \hyperlink{method.intro-classes}{\mbox{\isa{intro{\isacharunderscore}classes}}} method.
   7.129 -  This reduces an instance judgement to the relevant primitive
   7.130 -  proof goals; typically it is the first method applied
   7.131 -  in an instantiation proof.
   7.132 +\noindent \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}} defines class parameters at a
   7.133 +  particular instance using common specification tools (here,
   7.134 +  \hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}).  The concluding \hyperlink{command.instance}{\mbox{\isa{\isacommand{instance}}}} opens a
   7.135 +  proof that the given parameters actually conform to the class
   7.136 +  specification.  Note that the first proof step is the \hyperlink{method.default}{\mbox{\isa{default}}} method, which for such instance proofs maps to the \hyperlink{method.intro-classes}{\mbox{\isa{intro{\isacharunderscore}classes}}} method.  This reduces an instance judgement to the
   7.137 +  relevant primitive proof goals; typically it is the first method
   7.138 +  applied in an instantiation proof.
   7.139  
   7.140 -  From now on, the type-checker will consider \isa{int}
   7.141 -  as a \isa{semigroup} automatically, i.e.\ any general results
   7.142 -  are immediately available on concrete instances.
   7.143 +  From now on, the type-checker will consider \isa{int} as a \isa{semigroup} automatically, i.e.\ any general results are immediately
   7.144 +  available on concrete instances.
   7.145  
   7.146 -  \medskip Another instance of \isa{semigroup} yields the natural numbers:%
   7.147 +  \medskip Another instance of \isa{semigroup} yields the natural
   7.148 +  numbers:%
   7.149  \end{isamarkuptext}%
   7.150  \isamarkuptrue%
   7.151  %
   7.152 @@ -259,12 +251,12 @@
   7.153  \endisadelimquote
   7.154  %
   7.155  \begin{isamarkuptext}%
   7.156 -\noindent Note the occurence of the name \isa{mult{\isacharunderscore}nat}
   7.157 -  in the primrec declaration;  by default, the local name of
   7.158 -  a class operation \isa{f} to be instantiated on type constructor
   7.159 -  \isa{{\isasymkappa}} is mangled as \isa{f{\isacharunderscore}{\isasymkappa}}.  In case of uncertainty,
   7.160 -  these names may be inspected using the \hyperlink{command.print-context}{\mbox{\isa{\isacommand{print{\isacharunderscore}context}}}} command
   7.161 -  or the corresponding ProofGeneral button.%
   7.162 +\noindent Note the occurence of the name \isa{mult{\isacharunderscore}nat} in the
   7.163 +  primrec declaration; by default, the local name of a class operation
   7.164 +  \isa{f} to be instantiated on type constructor \isa{{\isasymkappa}} is
   7.165 +  mangled as \isa{f{\isacharunderscore}{\isasymkappa}}.  In case of uncertainty, these names may be
   7.166 +  inspected using the \hyperlink{command.print-context}{\mbox{\isa{\isacommand{print{\isacharunderscore}context}}}} command or the
   7.167 +  corresponding ProofGeneral button.%
   7.168  \end{isamarkuptext}%
   7.169  \isamarkuptrue%
   7.170  %
   7.171 @@ -273,10 +265,9 @@
   7.172  \isamarkuptrue%
   7.173  %
   7.174  \begin{isamarkuptext}%
   7.175 -Overloaded definitions given at a class instantiation
   7.176 -  may include recursion over the syntactic structure of types.
   7.177 -  As a canonical example, we model product semigroups
   7.178 -  using our simple algebra:%
   7.179 +Overloaded definitions given at a class instantiation may include
   7.180 +  recursion over the syntactic structure of types.  As a canonical
   7.181 +  example, we model product semigroups using our simple algebra:%
   7.182  \end{isamarkuptext}%
   7.183  \isamarkuptrue%
   7.184  %
   7.185 @@ -318,11 +309,10 @@
   7.186  \begin{isamarkuptext}%
   7.187  \noindent Associativity of product semigroups is established using
   7.188    the definition of \isa{{\isacharparenleft}{\isasymotimes}{\isacharparenright}} on products and the hypothetical
   7.189 -  associativity of the type components;  these hypotheses
   7.190 -  are legitimate due to the \isa{semigroup} constraints imposed
   7.191 -  on the type components by the \hyperlink{command.instance}{\mbox{\isa{\isacommand{instance}}}} proposition.
   7.192 -  Indeed, this pattern often occurs with parametric types
   7.193 -  and type classes.%
   7.194 +  associativity of the type components; these hypotheses are
   7.195 +  legitimate due to the \isa{semigroup} constraints imposed on the
   7.196 +  type components by the \hyperlink{command.instance}{\mbox{\isa{\isacommand{instance}}}} proposition.  Indeed,
   7.197 +  this pattern often occurs with parametric types and type classes.%
   7.198  \end{isamarkuptext}%
   7.199  \isamarkuptrue%
   7.200  %
   7.201 @@ -331,10 +321,9 @@
   7.202  \isamarkuptrue%
   7.203  %
   7.204  \begin{isamarkuptext}%
   7.205 -We define a subclass \isa{monoidl} (a semigroup with a left-hand neutral)
   7.206 -  by extending \isa{semigroup}
   7.207 -  with one additional parameter \isa{neutral} together
   7.208 -  with its characteristic property:%
   7.209 +We define a subclass \isa{monoidl} (a semigroup with a left-hand
   7.210 +  neutral) by extending \isa{semigroup} with one additional
   7.211 +  parameter \isa{neutral} together with its characteristic property:%
   7.212  \end{isamarkuptext}%
   7.213  \isamarkuptrue%
   7.214  %
   7.215 @@ -355,10 +344,10 @@
   7.216  \endisadelimquote
   7.217  %
   7.218  \begin{isamarkuptext}%
   7.219 -\noindent Again, we prove some instances, by
   7.220 -  providing suitable parameter definitions and proofs for the
   7.221 -  additional specifications.  Observe that instantiations
   7.222 -  for types with the same arity may be simultaneous:%
   7.223 +\noindent Again, we prove some instances, by providing suitable
   7.224 +  parameter definitions and proofs for the additional specifications.
   7.225 +  Observe that instantiations for types with the same arity may be
   7.226 +  simultaneous:%
   7.227  \end{isamarkuptext}%
   7.228  \isamarkuptrue%
   7.229  %
   7.230 @@ -505,8 +494,7 @@
   7.231  \endisadelimquote
   7.232  %
   7.233  \begin{isamarkuptext}%
   7.234 -\noindent To finish our small algebra example, we add a \isa{group} class
   7.235 -  with a corresponding instance:%
   7.236 +\noindent To finish our small algebra example, we add a \isa{group} class with a corresponding instance:%
   7.237  \end{isamarkuptext}%
   7.238  \isamarkuptrue%
   7.239  %
   7.240 @@ -563,9 +551,9 @@
   7.241  \isamarkuptrue%
   7.242  %
   7.243  \begin{isamarkuptext}%
   7.244 -The example above gives an impression how Isar type classes work
   7.245 -  in practice.  As stated in the introduction, classes also provide
   7.246 -  a link to Isar's locale system.  Indeed, the logical core of a class
   7.247 +The example above gives an impression how Isar type classes work in
   7.248 +  practice.  As stated in the introduction, classes also provide a
   7.249 +  link to Isar's locale system.  Indeed, the logical core of a class
   7.250    is nothing other than a locale:%
   7.251  \end{isamarkuptext}%
   7.252  \isamarkuptrue%
   7.253 @@ -780,10 +768,12 @@
   7.254  \endisadelimquote
   7.255  %
   7.256  \begin{isamarkuptext}%
   7.257 -\noindent Here the \qt{\hyperlink{keyword.in}{\mbox{\isa{\isakeyword{in}}}} \isa{group}} target specification
   7.258 -  indicates that the result is recorded within that context for later
   7.259 -  use.  This local theorem is also lifted to the global one \hyperlink{fact.group.left-cancel:}{\mbox{\isa{group{\isachardot}left{\isacharunderscore}cancel{\isacharcolon}}}} \isa{{\isachardoublequote}{\isasymAnd}x\ y\ z\ {\isasymColon}\ {\isasymalpha}{\isasymColon}group{\isachardot}\ x\ {\isasymotimes}\ y\ {\isacharequal}\ x\ {\isasymotimes}\ z\ {\isasymlongleftrightarrow}\ y\ {\isacharequal}\ z{\isachardoublequote}}.  Since type \isa{int} has been made an instance of
   7.260 -  \isa{group} before, we may refer to that fact as well: \isa{{\isachardoublequote}{\isasymAnd}x\ y\ z\ {\isasymColon}\ int{\isachardot}\ x\ {\isasymotimes}\ y\ {\isacharequal}\ x\ {\isasymotimes}\ z\ {\isasymlongleftrightarrow}\ y\ {\isacharequal}\ z{\isachardoublequote}}.%
   7.261 +\noindent Here the \qt{\hyperlink{keyword.in}{\mbox{\isa{\isakeyword{in}}}} \isa{group}} target
   7.262 +  specification indicates that the result is recorded within that
   7.263 +  context for later use.  This local theorem is also lifted to the
   7.264 +  global one \hyperlink{fact.group.left-cancel:}{\mbox{\isa{group{\isachardot}left{\isacharunderscore}cancel{\isacharcolon}}}} \isa{{\isachardoublequote}{\isasymAnd}x\ y\ z\ {\isasymColon}\ {\isasymalpha}{\isasymColon}group{\isachardot}\ x\ {\isasymotimes}\ y\ {\isacharequal}\ x\ {\isasymotimes}\ z\ {\isasymlongleftrightarrow}\ y\ {\isacharequal}\ z{\isachardoublequote}}.  Since type \isa{int} has been
   7.265 +  made an instance of \isa{group} before, we may refer to that
   7.266 +  fact as well: \isa{{\isachardoublequote}{\isasymAnd}x\ y\ z\ {\isasymColon}\ int{\isachardot}\ x\ {\isasymotimes}\ y\ {\isacharequal}\ x\ {\isasymotimes}\ z\ {\isasymlongleftrightarrow}\ y\ {\isacharequal}\ z{\isachardoublequote}}.%
   7.267  \end{isamarkuptext}%
   7.268  \isamarkuptrue%
   7.269  %
   7.270 @@ -814,16 +804,14 @@
   7.271  %
   7.272  \begin{isamarkuptext}%
   7.273  \noindent If the locale \isa{group} is also a class, this local
   7.274 -  definition is propagated onto a global definition of
   7.275 -  \isa{{\isachardoublequote}pow{\isacharunderscore}nat\ {\isasymColon}\ nat\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}monoid\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}monoid{\isachardoublequote}}
   7.276 -  with corresponding theorems
   7.277 +  definition is propagated onto a global definition of \isa{{\isachardoublequote}pow{\isacharunderscore}nat\ {\isasymColon}\ nat\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}monoid\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}monoid{\isachardoublequote}} with corresponding theorems
   7.278  
   7.279    \isa{pow{\isacharunderscore}nat\ {\isadigit{0}}\ x\ {\isacharequal}\ {\isasymone}\isasep\isanewline%
   7.280  pow{\isacharunderscore}nat\ {\isacharparenleft}Suc\ n{\isacharparenright}\ x\ {\isacharequal}\ x\ {\isasymotimes}\ pow{\isacharunderscore}nat\ n\ x}.
   7.281  
   7.282 -  \noindent As you can see from this example, for local
   7.283 -  definitions you may use any specification tool
   7.284 -  which works together with locales, such as Krauss's recursive function package
   7.285 +  \noindent As you can see from this example, for local definitions
   7.286 +  you may use any specification tool which works together with
   7.287 +  locales, such as Krauss's recursive function package
   7.288    \cite{krauss2006}.%
   7.289  \end{isamarkuptext}%
   7.290  \isamarkuptrue%
   7.291 @@ -833,19 +821,17 @@
   7.292  \isamarkuptrue%
   7.293  %
   7.294  \begin{isamarkuptext}%
   7.295 -We introduced Isar classes by analogy to type classes in
   7.296 -  functional programming;  if we reconsider this in the
   7.297 -  context of what has been said about type classes and locales,
   7.298 -  we can drive this analogy further by stating that type
   7.299 -  classes essentially correspond to functors that have
   7.300 -  a canonical interpretation as type classes.
   7.301 -  There is also the possibility of other interpretations.
   7.302 -  For example, \isa{list}s also form a monoid with
   7.303 -  \isa{append} and \isa{{\isacharbrackleft}{\isacharbrackright}} as operations, but it
   7.304 -  seems inappropriate to apply to lists
   7.305 -  the same operations as for genuinely algebraic types.
   7.306 -  In such a case, we can simply make a particular interpretation
   7.307 -  of monoids for lists:%
   7.308 +We introduced Isar classes by analogy to type classes in functional
   7.309 +  programming; if we reconsider this in the context of what has been
   7.310 +  said about type classes and locales, we can drive this analogy
   7.311 +  further by stating that type classes essentially correspond to
   7.312 +  functors that have a canonical interpretation as type classes.
   7.313 +  There is also the possibility of other interpretations.  For
   7.314 +  example, \isa{list}s also form a monoid with \isa{append} and
   7.315 +  \isa{{\isacharbrackleft}{\isacharbrackright}} as operations, but it seems inappropriate to apply to
   7.316 +  lists the same operations as for genuinely algebraic types.  In such
   7.317 +  a case, we can simply make a particular interpretation of monoids
   7.318 +  for lists:%
   7.319  \end{isamarkuptext}%
   7.320  \isamarkuptrue%
   7.321  %
   7.322 @@ -969,12 +955,10 @@
   7.323  \endisadelimquote
   7.324  %
   7.325  \begin{isamarkuptext}%
   7.326 -The logical proof is carried out on the locale level.
   7.327 -  Afterwards it is propagated
   7.328 -  to the type system, making \isa{group} an instance of
   7.329 -  \isa{monoid} by adding an additional edge
   7.330 -  to the graph of subclass relations
   7.331 -  (\figref{fig:subclass}).
   7.332 +The logical proof is carried out on the locale level.  Afterwards it
   7.333 +  is propagated to the type system, making \isa{group} an instance
   7.334 +  of \isa{monoid} by adding an additional edge to the graph of
   7.335 +  subclass relations (\figref{fig:subclass}).
   7.336  
   7.337    \begin{figure}[htbp]
   7.338     \begin{center}
   7.339 @@ -1006,8 +990,7 @@
   7.340     \end{center}
   7.341    \end{figure}
   7.342  
   7.343 -  For illustration, a derived definition
   7.344 -  in \isa{group} using \isa{pow{\isacharunderscore}nat}%
   7.345 +  For illustration, a derived definition in \isa{group} using \isa{pow{\isacharunderscore}nat}%
   7.346  \end{isamarkuptext}%
   7.347  \isamarkuptrue%
   7.348  %
   7.349 @@ -1029,9 +1012,7 @@
   7.350  \endisadelimquote
   7.351  %
   7.352  \begin{isamarkuptext}%
   7.353 -\noindent yields the global definition of
   7.354 -  \isa{{\isachardoublequote}pow{\isacharunderscore}int\ {\isasymColon}\ int\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}group\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}group{\isachardoublequote}}
   7.355 -  with the corresponding theorem \isa{pow{\isacharunderscore}int\ k\ x\ {\isacharequal}\ {\isacharparenleft}if\ {\isadigit{0}}\ {\isasymle}\ k\ then\ pow{\isacharunderscore}nat\ {\isacharparenleft}nat\ k{\isacharparenright}\ x\ else\ {\isacharparenleft}pow{\isacharunderscore}nat\ {\isacharparenleft}nat\ {\isacharparenleft}{\isacharminus}\ k{\isacharparenright}{\isacharparenright}\ x{\isacharparenright}{\isasymdiv}{\isacharparenright}}.%
   7.356 +\noindent yields the global definition of \isa{{\isachardoublequote}pow{\isacharunderscore}int\ {\isasymColon}\ int\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}group\ {\isasymRightarrow}\ {\isasymalpha}{\isasymColon}group{\isachardoublequote}} with the corresponding theorem \isa{pow{\isacharunderscore}int\ k\ x\ {\isacharequal}\ {\isacharparenleft}if\ {\isadigit{0}}\ {\isasymle}\ k\ then\ pow{\isacharunderscore}nat\ {\isacharparenleft}nat\ k{\isacharparenright}\ x\ else\ {\isacharparenleft}pow{\isacharunderscore}nat\ {\isacharparenleft}nat\ {\isacharparenleft}{\isacharminus}\ k{\isacharparenright}{\isacharparenright}\ x{\isacharparenright}{\isasymdiv}{\isacharparenright}}.%
   7.357  \end{isamarkuptext}%
   7.358  \isamarkuptrue%
   7.359  %
   7.360 @@ -1040,9 +1021,9 @@
   7.361  \isamarkuptrue%
   7.362  %
   7.363  \begin{isamarkuptext}%
   7.364 -As a convenience, class context syntax allows references
   7.365 -  to local class operations and their global counterparts
   7.366 -  uniformly;  type inference resolves ambiguities.  For example:%
   7.367 +As a convenience, class context syntax allows references to local
   7.368 +  class operations and their global counterparts uniformly; type
   7.369 +  inference resolves ambiguities.  For example:%
   7.370  \end{isamarkuptext}%
   7.371  \isamarkuptrue%
   7.372  %
   7.373 @@ -1082,11 +1063,11 @@
   7.374  \endisadelimquote
   7.375  %
   7.376  \begin{isamarkuptext}%
   7.377 -\noindent Here in example 1, the term refers to the local class operation
   7.378 -  \isa{mult\ {\isacharbrackleft}{\isasymalpha}{\isacharbrackright}}, whereas in example 2 the type constraint
   7.379 -  enforces the global class operation \isa{mult\ {\isacharbrackleft}nat{\isacharbrackright}}.
   7.380 -  In the global context in example 3, the reference is
   7.381 -  to the polymorphic global class operation \isa{mult\ {\isacharbrackleft}{\isacharquery}{\isasymalpha}\ {\isasymColon}\ semigroup{\isacharbrackright}}.%
   7.382 +\noindent Here in example 1, the term refers to the local class
   7.383 +  operation \isa{mult\ {\isacharbrackleft}{\isasymalpha}{\isacharbrackright}}, whereas in example 2 the type
   7.384 +  constraint enforces the global class operation \isa{mult\ {\isacharbrackleft}nat{\isacharbrackright}}.
   7.385 +  In the global context in example 3, the reference is to the
   7.386 +  polymorphic global class operation \isa{mult\ {\isacharbrackleft}{\isacharquery}{\isasymalpha}\ {\isasymColon}\ semigroup{\isacharbrackright}}.%
   7.387  \end{isamarkuptext}%
   7.388  \isamarkuptrue%
   7.389  %
   7.390 @@ -1099,16 +1080,13 @@
   7.391  \isamarkuptrue%
   7.392  %
   7.393  \begin{isamarkuptext}%
   7.394 -Turning back to the first motivation for type classes,
   7.395 -  namely overloading, it is obvious that overloading
   7.396 -  stemming from \hyperlink{command.class}{\mbox{\isa{\isacommand{class}}}} statements and
   7.397 -  \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}}
   7.398 -  targets naturally maps to Haskell type classes.
   7.399 -  The code generator framework \cite{isabelle-codegen} 
   7.400 -  takes this into account.  If the target language (e.g.~SML)
   7.401 -  lacks type classes, then they
   7.402 -  are implemented by an explicit dictionary construction.
   7.403 -  As example, let's go back to the power function:%
   7.404 +Turning back to the first motivation for type classes, namely
   7.405 +  overloading, it is obvious that overloading stemming from \hyperlink{command.class}{\mbox{\isa{\isacommand{class}}}} statements and \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}} targets naturally
   7.406 +  maps to Haskell type classes.  The code generator framework
   7.407 +  \cite{isabelle-codegen} takes this into account.  If the target
   7.408 +  language (e.g.~SML) lacks type classes, then they are implemented by
   7.409 +  an explicit dictionary construction.  As example, let's go back to
   7.410 +  the power function:%
   7.411  \end{isamarkuptext}%
   7.412  \isamarkuptrue%
   7.413  %
   7.414 @@ -1328,13 +1306,121 @@
   7.415  %
   7.416  \endisadelimquote
   7.417  %
   7.418 +\begin{isamarkuptext}%
   7.419 +\noindent In Scala, implicts are used as dictionaries:%
   7.420 +\end{isamarkuptext}%
   7.421 +\isamarkuptrue%
   7.422 +%
   7.423 +\isadeliminvisible
   7.424 +%
   7.425 +\endisadeliminvisible
   7.426 +%
   7.427 +\isataginvisible
   7.428 +%
   7.429 +\endisataginvisible
   7.430 +{\isafoldinvisible}%
   7.431 +%
   7.432 +\isadeliminvisible
   7.433 +%
   7.434 +\endisadeliminvisible
   7.435 +%
   7.436 +\isadelimquote
   7.437 +%
   7.438 +\endisadelimquote
   7.439 +%
   7.440 +\isatagquote
   7.441 +%
   7.442 +\begin{isamarkuptext}%
   7.443 +\isatypewriter%
   7.444 +\noindent%
   7.445 +\hspace*{0pt}object Example {\char123}\\
   7.446 +\hspace*{0pt}\\
   7.447 +\hspace*{0pt}import /*implicits*/ Example.semigroup{\char95}int,~Example.monoidl{\char95}int,\\
   7.448 +\hspace*{0pt} ~Example.monoid{\char95}int,~Example.group{\char95}int\\
   7.449 +\hspace*{0pt}\\
   7.450 +\hspace*{0pt}abstract sealed class nat\\
   7.451 +\hspace*{0pt}final case object Zero{\char95}nat extends nat\\
   7.452 +\hspace*{0pt}final case class Suc(a:~nat) extends nat\\
   7.453 +\hspace*{0pt}\\
   7.454 +\hspace*{0pt}def nat{\char95}aux(i:~BigInt,~n:~nat):~nat =\\
   7.455 +\hspace*{0pt} ~(if (i <= BigInt(0)) n else nat{\char95}aux(i - BigInt(1),~Suc(n)))\\
   7.456 +\hspace*{0pt}\\
   7.457 +\hspace*{0pt}def nat(i:~BigInt):~nat = nat{\char95}aux(i,~Zero{\char95}nat)\\
   7.458 +\hspace*{0pt}\\
   7.459 +\hspace*{0pt}trait semigroup[A] {\char123}\\
   7.460 +\hspace*{0pt} ~val `Example+mult`:~(A,~A) => A\\
   7.461 +\hspace*{0pt}{\char125}\\
   7.462 +\hspace*{0pt}def mult[A](a:~A,~b:~A)(implicit A:~semigroup[A]):~A =\\
   7.463 +\hspace*{0pt} ~A.`Example+mult`(a,~b)\\
   7.464 +\hspace*{0pt}\\
   7.465 +\hspace*{0pt}trait monoidl[A] extends semigroup[A] {\char123}\\
   7.466 +\hspace*{0pt} ~val `Example+neutral`:~A\\
   7.467 +\hspace*{0pt}{\char125}\\
   7.468 +\hspace*{0pt}def neutral[A](implicit A:~monoidl[A]):~A = A.`Example+neutral`\\
   7.469 +\hspace*{0pt}\\
   7.470 +\hspace*{0pt}trait monoid[A] extends monoidl[A] {\char123}\\
   7.471 +\hspace*{0pt}{\char125}\\
   7.472 +\hspace*{0pt}\\
   7.473 +\hspace*{0pt}trait group[A] extends monoid[A] {\char123}\\
   7.474 +\hspace*{0pt} ~val `Example+inverse`:~A => A\\
   7.475 +\hspace*{0pt}{\char125}\\
   7.476 +\hspace*{0pt}def inverse[A](a:~A)(implicit A:~group[A]):~A = A.`Example+inverse`(a)\\
   7.477 +\hspace*{0pt}\\
   7.478 +\hspace*{0pt}def pow{\char95}nat[A:~monoid](xa0:~nat,~x:~A):~A = (xa0,~x) match {\char123}\\
   7.479 +\hspace*{0pt} ~case (Zero{\char95}nat,~x) => neutral[A]\\
   7.480 +\hspace*{0pt} ~case (Suc(n),~x) => mult[A](x,~pow{\char95}nat[A](n,~x))\\
   7.481 +\hspace*{0pt}{\char125}\\
   7.482 +\hspace*{0pt}\\
   7.483 +\hspace*{0pt}def pow{\char95}int[A:~group](k:~BigInt,~x:~A):~A =\\
   7.484 +\hspace*{0pt} ~(if (BigInt(0) <= k) pow{\char95}nat[A](nat(k),~x)\\
   7.485 +\hspace*{0pt} ~~~else inverse[A](pow{\char95}nat[A](nat((- k)),~x)))\\
   7.486 +\hspace*{0pt}\\
   7.487 +\hspace*{0pt}def mult{\char95}int(i:~BigInt,~j:~BigInt):~BigInt = i + j\\
   7.488 +\hspace*{0pt}\\
   7.489 +\hspace*{0pt}implicit def semigroup{\char95}int:~semigroup[BigInt] = new semigroup[BigInt] {\char123}\\
   7.490 +\hspace*{0pt} ~val `Example+mult` = (a:~BigInt,~b:~BigInt) => mult{\char95}int(a,~b)\\
   7.491 +\hspace*{0pt}{\char125}\\
   7.492 +\hspace*{0pt}\\
   7.493 +\hspace*{0pt}def neutral{\char95}int:~BigInt = BigInt(0)\\
   7.494 +\hspace*{0pt}\\
   7.495 +\hspace*{0pt}implicit def monoidl{\char95}int:~monoidl[BigInt] = new monoidl[BigInt] {\char123}\\
   7.496 +\hspace*{0pt} ~val `Example+neutral` = neutral{\char95}int\\
   7.497 +\hspace*{0pt} ~val `Example+mult` = (a:~BigInt,~b:~BigInt) => mult{\char95}int(a,~b)\\
   7.498 +\hspace*{0pt}{\char125}\\
   7.499 +\hspace*{0pt}\\
   7.500 +\hspace*{0pt}implicit def monoid{\char95}int:~monoid[BigInt] = new monoid[BigInt] {\char123}\\
   7.501 +\hspace*{0pt} ~val `Example+neutral` = neutral{\char95}int\\
   7.502 +\hspace*{0pt} ~val `Example+mult` = (a:~BigInt,~b:~BigInt) => mult{\char95}int(a,~b)\\
   7.503 +\hspace*{0pt}{\char125}\\
   7.504 +\hspace*{0pt}\\
   7.505 +\hspace*{0pt}def inverse{\char95}int(i:~BigInt):~BigInt = (- i)\\
   7.506 +\hspace*{0pt}\\
   7.507 +\hspace*{0pt}implicit def group{\char95}int:~group[BigInt] = new group[BigInt] {\char123}\\
   7.508 +\hspace*{0pt} ~val `Example+inverse` = (a:~BigInt) => inverse{\char95}int(a)\\
   7.509 +\hspace*{0pt} ~val `Example+neutral` = neutral{\char95}int\\
   7.510 +\hspace*{0pt} ~val `Example+mult` = (a:~BigInt,~b:~BigInt) => mult{\char95}int(a,~b)\\
   7.511 +\hspace*{0pt}{\char125}\\
   7.512 +\hspace*{0pt}\\
   7.513 +\hspace*{0pt}def example:~BigInt = pow{\char95}int[BigInt](BigInt(10),~BigInt(- 2))\\
   7.514 +\hspace*{0pt}\\
   7.515 +\hspace*{0pt}{\char125}~/* object Example */%
   7.516 +\end{isamarkuptext}%
   7.517 +\isamarkuptrue%
   7.518 +%
   7.519 +\endisatagquote
   7.520 +{\isafoldquote}%
   7.521 +%
   7.522 +\isadelimquote
   7.523 +%
   7.524 +\endisadelimquote
   7.525 +%
   7.526  \isamarkupsubsection{Inspecting the type class universe%
   7.527  }
   7.528  \isamarkuptrue%
   7.529  %
   7.530  \begin{isamarkuptext}%
   7.531 -To facilitate orientation in complex subclass structures,
   7.532 -  two diagnostics commands are provided:
   7.533 +To facilitate orientation in complex subclass structures, two
   7.534 +  diagnostics commands are provided:
   7.535  
   7.536    \begin{description}
   7.537  
     8.1 --- a/doc-src/Codegen/Thy/Foundations.thy	Thu Sep 02 17:12:40 2010 +0200
     8.2 +++ b/doc-src/Codegen/Thy/Foundations.thy	Thu Sep 02 17:28:00 2010 +0200
     8.3 @@ -220,12 +220,12 @@
     8.4  text {*
     8.5    \noindent Obviously, polymorphic equality is implemented the Haskell
     8.6    way using a type class.  How is this achieved?  HOL introduces an
     8.7 -  explicit class @{class eq} with a corresponding operation @{const
     8.8 -  eq_class.eq} such that @{thm eq [no_vars]}.  The preprocessing
     8.9 -  framework does the rest by propagating the @{class eq} constraints
    8.10 +  explicit class @{class equal} with a corresponding operation @{const
    8.11 +  HOL.equal} such that @{thm equal [no_vars]}.  The preprocessing
    8.12 +  framework does the rest by propagating the @{class equal} constraints
    8.13    through all dependent code equations.  For datatypes, instances of
    8.14 -  @{class eq} are implicitly derived when possible.  For other types,
    8.15 -  you may instantiate @{text eq} manually like any other type class.
    8.16 +  @{class equal} are implicitly derived when possible.  For other types,
    8.17 +  you may instantiate @{text equal} manually like any other type class.
    8.18  *}
    8.19  
    8.20  
     9.1 --- a/doc-src/Codegen/Thy/Inductive_Predicate.thy	Thu Sep 02 17:12:40 2010 +0200
     9.2 +++ b/doc-src/Codegen/Thy/Inductive_Predicate.thy	Thu Sep 02 17:28:00 2010 +0200
     9.3 @@ -7,7 +7,7 @@
     9.4  
     9.5  inductive %invisible append where
     9.6    "append [] ys ys"
     9.7 -| "append xs ys zs ==> append (x # xs) ys (x # zs)"
     9.8 +| "append xs ys zs \<Longrightarrow> append (x # xs) ys (x # zs)"
     9.9  
    9.10  lemma %invisible append: "append xs ys zs = (xs @ ys = zs)"
    9.11    by (induct xs arbitrary: ys zs) (auto elim: append.cases intro: append.intros)
    9.12 @@ -95,9 +95,9 @@
    9.13    "append_i_i_o"}).  You can specify your own names as follows:
    9.14  *}
    9.15  
    9.16 -code_pred %quote (modes: i => i => o => bool as concat,
    9.17 -  o => o => i => bool as split,
    9.18 -  i => o => i => bool as suffix) append .
    9.19 +code_pred %quote (modes: i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool as concat,
    9.20 +  o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool as split,
    9.21 +  i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool as suffix) append .
    9.22  
    9.23  subsection {* Alternative introduction rules *}
    9.24  
    9.25 @@ -220,8 +220,8 @@
    9.26    "values"} and the number of elements.
    9.27  *}
    9.28  
    9.29 -values %quote [mode: i => o => bool] 20 "{n. tranclp succ 10 n}"
    9.30 -values %quote [mode: o => i => bool] 10 "{n. tranclp succ n 10}"
    9.31 +values %quote [mode: i \<Rightarrow> o \<Rightarrow> bool] 20 "{n. tranclp succ 10 n}"
    9.32 +values %quote [mode: o \<Rightarrow> i \<Rightarrow> bool] 10 "{n. tranclp succ n 10}"
    9.33  
    9.34  
    9.35  subsection {* Embedding into functional code within Isabelle/HOL *}
    10.1 --- a/doc-src/Codegen/Thy/Introduction.thy	Thu Sep 02 17:12:40 2010 +0200
    10.2 +++ b/doc-src/Codegen/Thy/Introduction.thy	Thu Sep 02 17:28:00 2010 +0200
    10.3 @@ -8,8 +8,9 @@
    10.4    This tutorial introduces the code generator facilities of @{text
    10.5    "Isabelle/HOL"}.  It allows to turn (a certain class of) HOL
    10.6    specifications into corresponding executable code in the programming
    10.7 -  languages @{text SML} \cite{SML}, @{text OCaml} \cite{OCaml} and
    10.8 -  @{text Haskell} \cite{haskell-revised-report}.
    10.9 +  languages @{text SML} \cite{SML}, @{text OCaml} \cite{OCaml},
   10.10 +  @{text Haskell} \cite{haskell-revised-report} and @{text Scala}
   10.11 +  \cite{scala-overview-tech-report}.
   10.12  
   10.13    To profit from this tutorial, some familiarity and experience with
   10.14    @{theory HOL} \cite{isa-tutorial} and its basic theories is assumed.
   10.15 @@ -78,8 +79,8 @@
   10.16    target language identifier and a freely chosen module name.  A file
   10.17    name denotes the destination to store the generated code.  Note that
   10.18    the semantics of the destination depends on the target language: for
   10.19 -  @{text SML} and @{text OCaml} it denotes a \emph{file}, for @{text
   10.20 -  Haskell} it denotes a \emph{directory} where a file named as the
   10.21 +  @{text SML}, @{text OCaml} and @{text Scala} it denotes a \emph{file},
   10.22 +  for @{text Haskell} it denotes a \emph{directory} where a file named as the
   10.23    module name (with extension @{text ".hs"}) is written:
   10.24  *}
   10.25  
    11.1 --- a/doc-src/Codegen/Thy/Setup.thy	Thu Sep 02 17:12:40 2010 +0200
    11.2 +++ b/doc-src/Codegen/Thy/Setup.thy	Thu Sep 02 17:28:00 2010 +0200
    11.3 @@ -27,6 +27,6 @@
    11.4  
    11.5  setup {* Code_Target.set_default_code_width 74 *}
    11.6  
    11.7 -ML_command {* Unsynchronized.reset unique_names *}
    11.8 +ML_command {* unique_names := false *}
    11.9  
   11.10  end
    12.1 --- a/doc-src/Codegen/Thy/document/Adaptation.tex	Thu Sep 02 17:12:40 2010 +0200
    12.2 +++ b/doc-src/Codegen/Thy/document/Adaptation.tex	Thu Sep 02 17:28:00 2010 +0200
    12.3 @@ -240,7 +240,7 @@
    12.4  \hspace*{0pt}structure Example :~sig\\
    12.5  \hspace*{0pt} ~datatype nat = Zero{\char95}nat | Suc of nat\\
    12.6  \hspace*{0pt} ~datatype boola = True | False\\
    12.7 -\hspace*{0pt} ~val anda :~boola -> boola -> boola\\
    12.8 +\hspace*{0pt} ~val conj :~boola -> boola -> boola\\
    12.9  \hspace*{0pt} ~val less{\char95}nat :~nat -> nat -> boola\\
   12.10  \hspace*{0pt} ~val less{\char95}eq{\char95}nat :~nat -> nat -> boola\\
   12.11  \hspace*{0pt} ~val in{\char95}interval :~nat * nat -> nat -> boola\\
   12.12 @@ -250,17 +250,17 @@
   12.13  \hspace*{0pt}\\
   12.14  \hspace*{0pt}datatype boola = True | False;\\
   12.15  \hspace*{0pt}\\
   12.16 -\hspace*{0pt}fun anda p True = p\\
   12.17 -\hspace*{0pt} ~| anda p False = False\\
   12.18 -\hspace*{0pt} ~| anda True p = p\\
   12.19 -\hspace*{0pt} ~| anda False p = False;\\
   12.20 +\hspace*{0pt}fun conj p True = p\\
   12.21 +\hspace*{0pt} ~| conj p False = False\\
   12.22 +\hspace*{0pt} ~| conj True p = p\\
   12.23 +\hspace*{0pt} ~| conj False p = False;\\
   12.24  \hspace*{0pt}\\
   12.25  \hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
   12.26  \hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = False\\
   12.27  \hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
   12.28  \hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = True;\\
   12.29  \hspace*{0pt}\\
   12.30 -\hspace*{0pt}fun in{\char95}interval (k,~l) n = anda (less{\char95}eq{\char95}nat k n) (less{\char95}eq{\char95}nat n l);\\
   12.31 +\hspace*{0pt}fun in{\char95}interval (k,~l) n = conj (less{\char95}eq{\char95}nat k n) (less{\char95}eq{\char95}nat n l);\\
   12.32  \hspace*{0pt}\\
   12.33  \hspace*{0pt}end;~(*struct Example*)%
   12.34  \end{isamarkuptext}%
    13.1 --- a/doc-src/Codegen/Thy/document/Inductive_Predicate.tex	Thu Sep 02 17:12:40 2010 +0200
    13.2 +++ b/doc-src/Codegen/Thy/document/Inductive_Predicate.tex	Thu Sep 02 17:28:00 2010 +0200
    13.3 @@ -212,9 +212,9 @@
    13.4  %
    13.5  \isatagquote
    13.6  \isacommand{code{\isacharunderscore}pred}\isamarkupfalse%
    13.7 -\ {\isacharparenleft}modes{\isacharcolon}\ i\ {\isacharequal}{\isachargreater}\ i\ {\isacharequal}{\isachargreater}\ o\ {\isacharequal}{\isachargreater}\ bool\ as\ concat{\isacharcomma}\isanewline
    13.8 -\ \ o\ {\isacharequal}{\isachargreater}\ o\ {\isacharequal}{\isachargreater}\ i\ {\isacharequal}{\isachargreater}\ bool\ as\ split{\isacharcomma}\isanewline
    13.9 -\ \ i\ {\isacharequal}{\isachargreater}\ o\ {\isacharequal}{\isachargreater}\ i\ {\isacharequal}{\isachargreater}\ bool\ as\ suffix{\isacharparenright}\ append\ \isacommand{{\isachardot}}\isamarkupfalse%
   13.10 +\ {\isacharparenleft}modes{\isacharcolon}\ i\ {\isasymRightarrow}\ i\ {\isasymRightarrow}\ o\ {\isasymRightarrow}\ bool\ as\ concat{\isacharcomma}\isanewline
   13.11 +\ \ o\ {\isasymRightarrow}\ o\ {\isasymRightarrow}\ i\ {\isasymRightarrow}\ bool\ as\ split{\isacharcomma}\isanewline
   13.12 +\ \ i\ {\isasymRightarrow}\ o\ {\isasymRightarrow}\ i\ {\isasymRightarrow}\ bool\ as\ suffix{\isacharparenright}\ append\ \isacommand{{\isachardot}}\isamarkupfalse%
   13.13  %
   13.14  \endisatagquote
   13.15  {\isafoldquote}%
   13.16 @@ -422,9 +422,9 @@
   13.17  %
   13.18  \isatagquote
   13.19  \isacommand{values}\isamarkupfalse%
   13.20 -\ {\isacharbrackleft}mode{\isacharcolon}\ i\ {\isacharequal}{\isachargreater}\ o\ {\isacharequal}{\isachargreater}\ bool{\isacharbrackright}\ {\isadigit{2}}{\isadigit{0}}\ {\isachardoublequoteopen}{\isacharbraceleft}n{\isachardot}\ tranclp\ succ\ {\isadigit{1}}{\isadigit{0}}\ n{\isacharbraceright}{\isachardoublequoteclose}\isanewline
   13.21 +\ {\isacharbrackleft}mode{\isacharcolon}\ i\ {\isasymRightarrow}\ o\ {\isasymRightarrow}\ bool{\isacharbrackright}\ {\isadigit{2}}{\isadigit{0}}\ {\isachardoublequoteopen}{\isacharbraceleft}n{\isachardot}\ tranclp\ succ\ {\isadigit{1}}{\isadigit{0}}\ n{\isacharbraceright}{\isachardoublequoteclose}\isanewline
   13.22  \isacommand{values}\isamarkupfalse%
   13.23 -\ {\isacharbrackleft}mode{\isacharcolon}\ o\ {\isacharequal}{\isachargreater}\ i\ {\isacharequal}{\isachargreater}\ bool{\isacharbrackright}\ {\isadigit{1}}{\isadigit{0}}\ {\isachardoublequoteopen}{\isacharbraceleft}n{\isachardot}\ tranclp\ succ\ n\ {\isadigit{1}}{\isadigit{0}}{\isacharbraceright}{\isachardoublequoteclose}%
   13.24 +\ {\isacharbrackleft}mode{\isacharcolon}\ o\ {\isasymRightarrow}\ i\ {\isasymRightarrow}\ bool{\isacharbrackright}\ {\isadigit{1}}{\isadigit{0}}\ {\isachardoublequoteopen}{\isacharbraceleft}n{\isachardot}\ tranclp\ succ\ n\ {\isadigit{1}}{\isadigit{0}}{\isacharbraceright}{\isachardoublequoteclose}%
   13.25  \endisatagquote
   13.26  {\isafoldquote}%
   13.27  %
    14.1 --- a/doc-src/Codegen/Thy/document/Introduction.tex	Thu Sep 02 17:12:40 2010 +0200
    14.2 +++ b/doc-src/Codegen/Thy/document/Introduction.tex	Thu Sep 02 17:28:00 2010 +0200
    14.3 @@ -25,8 +25,9 @@
    14.4  \begin{isamarkuptext}%
    14.5  This tutorial introduces the code generator facilities of \isa{Isabelle{\isacharslash}HOL}.  It allows to turn (a certain class of) HOL
    14.6    specifications into corresponding executable code in the programming
    14.7 -  languages \isa{SML} \cite{SML}, \isa{OCaml} \cite{OCaml} and
    14.8 -  \isa{Haskell} \cite{haskell-revised-report}.
    14.9 +  languages \isa{SML} \cite{SML}, \isa{OCaml} \cite{OCaml},
   14.10 +  \isa{Haskell} \cite{haskell-revised-report} and \isa{Scala}
   14.11 +  \cite{scala-overview-tech-report}.
   14.12  
   14.13    To profit from this tutorial, some familiarity and experience with
   14.14    \hyperlink{theory.HOL}{\mbox{\isa{HOL}}} \cite{isa-tutorial} and its basic theories is assumed.%
   14.15 @@ -191,7 +192,8 @@
   14.16    target language identifier and a freely chosen module name.  A file
   14.17    name denotes the destination to store the generated code.  Note that
   14.18    the semantics of the destination depends on the target language: for
   14.19 -  \isa{SML} and \isa{OCaml} it denotes a \emph{file}, for \isa{Haskell} it denotes a \emph{directory} where a file named as the
   14.20 +  \isa{SML}, \isa{OCaml} and \isa{Scala} it denotes a \emph{file},
   14.21 +  for \isa{Haskell} it denotes a \emph{directory} where a file named as the
   14.22    module name (with extension \isa{{\isachardot}hs}) is written:%
   14.23  \end{isamarkuptext}%
   14.24  \isamarkuptrue%
    15.1 --- a/doc-src/Codegen/Thy/pictures/architecture.tex	Thu Sep 02 17:12:40 2010 +0200
    15.2 +++ b/doc-src/Codegen/Thy/pictures/architecture.tex	Thu Sep 02 17:28:00 2010 +0200
    15.3 @@ -30,8 +30,8 @@
    15.4    \node (seri) at (1.5, 0) [process, positive] {serialisation};
    15.5    \node (SML) at (2.5, 3) [entity, positive] {\sys{SML}};
    15.6    \node (OCaml) at (2.5, 2) [entity, positive] {\sys{OCaml}};
    15.7 -  \node (further) at (2.5, 1) [entity, positive] {(\ldots)};
    15.8 -  \node (Haskell) at (2.5, 0) [entity, positive] {\sys{Haskell}};
    15.9 +  \node (Haskell) at (2.5, 1) [entity, positive] {\sys{Haskell}};
   15.10 +  \node (Scala) at (2.5, 0) [entity, positive] {\sys{Scala}};
   15.11    \draw [semithick] (spec) -- (spec_user_join);
   15.12    \draw [semithick] (user) -- (spec_user_join);
   15.13    \draw [-diamond, semithick] (spec_user_join) -- (raw);
   15.14 @@ -41,8 +41,8 @@
   15.15    \draw [arrow] (iml) -- (seri);
   15.16    \draw [arrow] (seri) -- (SML);
   15.17    \draw [arrow] (seri) -- (OCaml);
   15.18 -  \draw [arrow, dashed] (seri) -- (further);
   15.19    \draw [arrow] (seri) -- (Haskell);
   15.20 +  \draw [arrow] (seri) -- (Scala);
   15.21  \end{tikzpicture}
   15.22  
   15.23  }
    16.1 --- a/doc-src/Codegen/codegen.tex	Thu Sep 02 17:12:40 2010 +0200
    16.2 +++ b/doc-src/Codegen/codegen.tex	Thu Sep 02 17:28:00 2010 +0200
    16.3 @@ -22,7 +22,7 @@
    16.4  \begin{abstract}
    16.5    \noindent This tutorial introduces the code generator facilities of Isabelle/HOL.
    16.6      They empower the user to turn HOL specifications into corresponding executable
    16.7 -    programs in the languages SML, OCaml and Haskell.
    16.8 +    programs in the languages SML, OCaml, Haskell and Scala.
    16.9  \end{abstract}
   16.10  
   16.11  \thispagestyle{empty}\clearpage
    17.1 --- a/doc-src/IsarOverview/Isar/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
    17.2 +++ b/doc-src/IsarOverview/Isar/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
    17.3 @@ -1,3 +1,3 @@
    17.4 -Unsynchronized.set quick_and_dirty;
    17.5 +quick_and_dirty := true;
    17.6  
    17.7  use_thys ["Logic", "Induction"];
    18.1 --- a/doc-src/IsarRef/Thy/HOL_Specific.thy	Thu Sep 02 17:12:40 2010 +0200
    18.2 +++ b/doc-src/IsarRef/Thy/HOL_Specific.thy	Thu Sep 02 17:28:00 2010 +0200
    18.3 @@ -968,7 +968,8 @@
    18.4  
    18.5    \medskip One framework generates code from functional programs
    18.6    (including overloading using type classes) to SML \cite{SML}, OCaml
    18.7 -  \cite{OCaml} and Haskell \cite{haskell-revised-report}.
    18.8 +  \cite{OCaml}, Haskell \cite{haskell-revised-report} and Scala
    18.9 +  \cite{scala-overview-tech-report}.
   18.10    Conceptually, code generation is split up in three steps:
   18.11    \emph{selection} of code theorems, \emph{translation} into an
   18.12    abstract executable view and \emph{serialization} to a specific
   18.13 @@ -1015,7 +1016,7 @@
   18.14      class: nameref
   18.15      ;
   18.16  
   18.17 -    target: 'OCaml' | 'SML' | 'Haskell'
   18.18 +    target: 'SML' | 'OCaml' | 'Haskell' | 'Scala'
   18.19      ;
   18.20  
   18.21      'code' ( 'del' | 'abstype' | 'abstract' ) ?
   18.22 @@ -1088,7 +1089,7 @@
   18.23    after the @{keyword "module_name"} keyword; then \emph{all} code is
   18.24    placed in this module.
   18.25  
   18.26 -  For \emph{SML} and \emph{OCaml}, the file specification refers to a
   18.27 +  For \emph{SML}, \emph{OCaml} and \emph{Scala} the file specification refers to a
   18.28    single file; for \emph{Haskell}, it refers to a whole directory,
   18.29    where code is generated in multiple files reflecting the module
   18.30    hierarchy.  Omitting the file specification denotes standard
    19.1 --- a/doc-src/IsarRef/Thy/ROOT-HOLCF.ML	Thu Sep 02 17:12:40 2010 +0200
    19.2 +++ b/doc-src/IsarRef/Thy/ROOT-HOLCF.ML	Thu Sep 02 17:28:00 2010 +0200
    19.3 @@ -1,4 +1,4 @@
    19.4 -Unsynchronized.set Thy_Output.source;
    19.5 +Thy_Output.source_default := true;
    19.6  use "../../antiquote_setup.ML";
    19.7  
    19.8  use_thy "HOLCF_Specific";
    20.1 --- a/doc-src/IsarRef/Thy/ROOT-ZF.ML	Thu Sep 02 17:12:40 2010 +0200
    20.2 +++ b/doc-src/IsarRef/Thy/ROOT-ZF.ML	Thu Sep 02 17:28:00 2010 +0200
    20.3 @@ -1,4 +1,4 @@
    20.4 -Unsynchronized.set Thy_Output.source;
    20.5 +Thy_Output.source_default := true;
    20.6  use "../../antiquote_setup.ML";
    20.7  
    20.8  use_thy "ZF_Specific";
    21.1 --- a/doc-src/IsarRef/Thy/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
    21.2 +++ b/doc-src/IsarRef/Thy/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
    21.3 @@ -1,5 +1,5 @@
    21.4 -Unsynchronized.set quick_and_dirty;
    21.5 -Unsynchronized.set Thy_Output.source;
    21.6 +quick_and_dirty := true;
    21.7 +Thy_Output.source_default := true;
    21.8  use "../../antiquote_setup.ML";
    21.9  
   21.10  use_thys [
    22.1 --- a/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Thu Sep 02 17:12:40 2010 +0200
    22.2 +++ b/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Thu Sep 02 17:28:00 2010 +0200
    22.3 @@ -984,7 +984,8 @@
    22.4  
    22.5    \medskip One framework generates code from functional programs
    22.6    (including overloading using type classes) to SML \cite{SML}, OCaml
    22.7 -  \cite{OCaml} and Haskell \cite{haskell-revised-report}.
    22.8 +  \cite{OCaml}, Haskell \cite{haskell-revised-report} and Scala
    22.9 +  \cite{scala-overview-tech-report}.
   22.10    Conceptually, code generation is split up in three steps:
   22.11    \emph{selection} of code theorems, \emph{translation} into an
   22.12    abstract executable view and \emph{serialization} to a specific
   22.13 @@ -1031,7 +1032,7 @@
   22.14      class: nameref
   22.15      ;
   22.16  
   22.17 -    target: 'OCaml' | 'SML' | 'Haskell'
   22.18 +    target: 'SML' | 'OCaml' | 'Haskell' | 'Scala'
   22.19      ;
   22.20  
   22.21      'code' ( 'del' | 'abstype' | 'abstract' ) ?
   22.22 @@ -1103,7 +1104,7 @@
   22.23    after the \hyperlink{keyword.module-name}{\mbox{\isa{\isakeyword{module{\isacharunderscore}name}}}} keyword; then \emph{all} code is
   22.24    placed in this module.
   22.25  
   22.26 -  For \emph{SML} and \emph{OCaml}, the file specification refers to a
   22.27 +  For \emph{SML}, \emph{OCaml} and \emph{Scala} the file specification refers to a
   22.28    single file; for \emph{Haskell}, it refers to a whole directory,
   22.29    where code is generated in multiple files reflecting the module
   22.30    hierarchy.  Omitting the file specification denotes standard
    23.1 --- a/doc-src/LaTeXsugar/Sugar/Sugar.thy	Thu Sep 02 17:12:40 2010 +0200
    23.2 +++ b/doc-src/LaTeXsugar/Sugar/Sugar.thy	Thu Sep 02 17:28:00 2010 +0200
    23.3 @@ -132,7 +132,7 @@
    23.4  This \verb!no_vars! business can become a bit tedious.
    23.5  If you would rather never see question marks, simply put
    23.6  \begin{quote}
    23.7 -@{ML "Unsynchronized.reset show_question_marks"}\verb!;!
    23.8 +@{ML "show_question_marks := false"}\verb!;!
    23.9  \end{quote}
   23.10  at the beginning of your file \texttt{ROOT.ML}.
   23.11  The rest of this document is produced with this flag set to \texttt{false}.
   23.12 @@ -144,7 +144,7 @@
   23.13  turning the last digit into a subscript: write \verb!x\<^isub>1! and
   23.14  obtain the much nicer @{text"x\<^isub>1"}. *}
   23.15  
   23.16 -(*<*)ML "Unsynchronized.reset show_question_marks"(*>*)
   23.17 +(*<*)ML "show_question_marks := false"(*>*)
   23.18  
   23.19  subsection {*Qualified names*}
   23.20  
   23.21 @@ -155,7 +155,7 @@
   23.22  short names (no qualifiers) by setting \verb!short_names!, typically
   23.23  in \texttt{ROOT.ML}:
   23.24  \begin{quote}
   23.25 -@{ML "Unsynchronized.set short_names"}\verb!;!
   23.26 +@{ML "short_names := true"}\verb!;!
   23.27  \end{quote}
   23.28  *}
   23.29  
    24.1 --- a/doc-src/LaTeXsugar/Sugar/document/Sugar.tex	Thu Sep 02 17:12:40 2010 +0200
    24.2 +++ b/doc-src/LaTeXsugar/Sugar/document/Sugar.tex	Thu Sep 02 17:28:00 2010 +0200
    24.3 @@ -173,7 +173,7 @@
    24.4  This \verb!no_vars! business can become a bit tedious.
    24.5  If you would rather never see question marks, simply put
    24.6  \begin{quote}
    24.7 -\verb|Unsynchronized.reset show_question_marks|\verb!;!
    24.8 +\verb|show_question_marks := false|\verb!;!
    24.9  \end{quote}
   24.10  at the beginning of your file \texttt{ROOT.ML}.
   24.11  The rest of this document is produced with this flag set to \texttt{false}.
   24.12 @@ -211,7 +211,7 @@
   24.13  short names (no qualifiers) by setting \verb!short_names!, typically
   24.14  in \texttt{ROOT.ML}:
   24.15  \begin{quote}
   24.16 -\verb|Unsynchronized.set short_names|\verb!;!
   24.17 +\verb|short_names := true|\verb!;!
   24.18  \end{quote}%
   24.19  \end{isamarkuptext}%
   24.20  \isamarkuptrue%
    25.1 --- a/doc-src/Main/Docs/Main_Doc.thy	Thu Sep 02 17:12:40 2010 +0200
    25.2 +++ b/doc-src/Main/Docs/Main_Doc.thy	Thu Sep 02 17:28:00 2010 +0200
    25.3 @@ -10,9 +10,9 @@
    25.4     Syntax.pretty_typ ctxt T)
    25.5  
    25.6  val _ = Thy_Output.antiquotation "term_type_only" (Args.term -- Args.typ_abbrev)
    25.7 -  (fn {source, context, ...} => fn arg =>
    25.8 -    Thy_Output.output
    25.9 -      (Thy_Output.maybe_pretty_source (pretty_term_type_only context) source [arg]));
   25.10 +  (fn {source, context = ctxt, ...} => fn arg =>
   25.11 +    Thy_Output.output ctxt
   25.12 +      (Thy_Output.maybe_pretty_source pretty_term_type_only ctxt source [arg]));
   25.13  *}
   25.14  (*>*)
   25.15  text{*
    26.1 --- a/doc-src/Sledgehammer/sledgehammer.tex	Thu Sep 02 17:12:40 2010 +0200
    26.2 +++ b/doc-src/Sledgehammer/sledgehammer.tex	Thu Sep 02 17:28:00 2010 +0200
    26.3 @@ -447,7 +447,7 @@
    26.4  \label{relevance-filter}
    26.5  
    26.6  \begin{enum}
    26.7 -\opdefault{relevance\_thresholds}{int\_pair}{45~95}
    26.8 +\opdefault{relevance\_thresholds}{int\_pair}{45~85}
    26.9  Specifies the thresholds above which facts are considered relevant by the
   26.10  relevance filter. The first threshold is used for the first iteration of the
   26.11  relevance filter and the second threshold is used for the last iteration (if it
    27.1 --- a/doc-src/System/Thy/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
    27.2 +++ b/doc-src/System/Thy/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
    27.3 @@ -1,4 +1,4 @@
    27.4 -Unsynchronized.set Thy_Output.source;
    27.5 +Thy_Output.source_default := true;
    27.6  use "../../antiquote_setup.ML";
    27.7  
    27.8  use_thys ["Basics", "Interfaces", "Presentation", "Misc"];
    28.1 --- a/doc-src/TutorialI/Documents/Documents.thy	Thu Sep 02 17:12:40 2010 +0200
    28.2 +++ b/doc-src/TutorialI/Documents/Documents.thy	Thu Sep 02 17:28:00 2010 +0200
    28.3 @@ -144,7 +144,7 @@
    28.4  definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool"    (infixl "\<oplus>" 60)
    28.5  where "A \<oplus> B \<equiv> (A \<and> \<not> B) \<or> (\<not> A \<and> B)"
    28.6  (*<*)
    28.7 -local
    28.8 +setup {* Sign.local_path *}
    28.9  (*>*)
   28.10  
   28.11  text {*
   28.12 @@ -169,7 +169,7 @@
   28.13  
   28.14  notation (xsymbols) xor (infixl "\<oplus>\<ignore>" 60)
   28.15  (*<*)
   28.16 -local
   28.17 +setup {* Sign.local_path *}
   28.18  (*>*)
   28.19  
   28.20  text {*\noindent
    29.1 --- a/doc-src/TutorialI/Documents/document/Documents.tex	Thu Sep 02 17:12:40 2010 +0200
    29.2 +++ b/doc-src/TutorialI/Documents/document/Documents.tex	Thu Sep 02 17:28:00 2010 +0200
    29.3 @@ -168,6 +168,19 @@
    29.4  \isacommand{definition}\isamarkupfalse%
    29.5  \ xor\ {\isacharcolon}{\isacharcolon}\ {\isachardoublequoteopen}bool\ {\isasymRightarrow}\ bool\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\ \ \ \ {\isacharparenleft}\isakeyword{infixl}\ {\isachardoublequoteopen}{\isasymoplus}{\isachardoublequoteclose}\ {\isadigit{6}}{\isadigit{0}}{\isacharparenright}\isanewline
    29.6  \isakeyword{where}\ {\isachardoublequoteopen}A\ {\isasymoplus}\ B\ {\isasymequiv}\ {\isacharparenleft}A\ {\isasymand}\ {\isasymnot}\ B{\isacharparenright}\ {\isasymor}\ {\isacharparenleft}{\isasymnot}\ A\ {\isasymand}\ B{\isacharparenright}{\isachardoublequoteclose}%
    29.7 +\isadelimML
    29.8 +%
    29.9 +\endisadelimML
   29.10 +%
   29.11 +\isatagML
   29.12 +%
   29.13 +\endisatagML
   29.14 +{\isafoldML}%
   29.15 +%
   29.16 +\isadelimML
   29.17 +%
   29.18 +\endisadelimML
   29.19 +%
   29.20  \begin{isamarkuptext}%
   29.21  \noindent The X-Symbol package within Proof~General provides several
   29.22    input methods to enter \isa{{\isasymoplus}} in the text.  If all fails one may
   29.23 @@ -200,6 +213,19 @@
   29.24  \isanewline
   29.25  \isacommand{notation}\isamarkupfalse%
   29.26  \ {\isacharparenleft}xsymbols{\isacharparenright}\ xor\ {\isacharparenleft}\isakeyword{infixl}\ {\isachardoublequoteopen}{\isasymoplus}{\isasymignore}{\isachardoublequoteclose}\ {\isadigit{6}}{\isadigit{0}}{\isacharparenright}%
   29.27 +\isadelimML
   29.28 +%
   29.29 +\endisadelimML
   29.30 +%
   29.31 +\isatagML
   29.32 +%
   29.33 +\endisatagML
   29.34 +{\isafoldML}%
   29.35 +%
   29.36 +\isadelimML
   29.37 +%
   29.38 +\endisadelimML
   29.39 +%
   29.40  \begin{isamarkuptext}%
   29.41  \noindent
   29.42  The \commdx{notation} command associates a mixfix
    30.1 --- a/doc-src/TutorialI/Misc/Itrev.thy	Thu Sep 02 17:12:40 2010 +0200
    30.2 +++ b/doc-src/TutorialI/Misc/Itrev.thy	Thu Sep 02 17:28:00 2010 +0200
    30.3 @@ -2,7 +2,7 @@
    30.4  theory Itrev
    30.5  imports Main
    30.6  begin
    30.7 -ML"Unsynchronized.reset unique_names"
    30.8 +ML"unique_names := false"
    30.9  (*>*)
   30.10  
   30.11  section{*Induction Heuristics*}
   30.12 @@ -141,6 +141,6 @@
   30.13  \index{induction heuristics|)}
   30.14  *}
   30.15  (*<*)
   30.16 -ML"Unsynchronized.set unique_names"
   30.17 +ML"unique_names := true"
   30.18  end
   30.19  (*>*)
    31.1 --- a/doc-src/TutorialI/Rules/Basic.thy	Thu Sep 02 17:12:40 2010 +0200
    31.2 +++ b/doc-src/TutorialI/Rules/Basic.thy	Thu Sep 02 17:28:00 2010 +0200
    31.3 @@ -187,7 +187,7 @@
    31.4  
    31.5  text{*unification failure trace *}
    31.6  
    31.7 -ML "Unsynchronized.set trace_unify_fail"
    31.8 +ML "trace_unify_fail := true"
    31.9  
   31.10  lemma "P(a, f(b, g(e,a), b), a) \<Longrightarrow> P(a, f(b, g(c,a), b), a)"
   31.11  txt{*
   31.12 @@ -212,7 +212,7 @@
   31.13  *}
   31.14  oops
   31.15  
   31.16 -ML "Unsynchronized.reset trace_unify_fail"
   31.17 +ML "trace_unify_fail := false"
   31.18  
   31.19  
   31.20  text{*Quantifiers*}
    32.1 --- a/doc-src/TutorialI/Rules/Primes.thy	Thu Sep 02 17:12:40 2010 +0200
    32.2 +++ b/doc-src/TutorialI/Rules/Primes.thy	Thu Sep 02 17:28:00 2010 +0200
    32.3 @@ -1,4 +1,3 @@
    32.4 -(* ID:         $Id$ *)
    32.5  (* EXTRACT from HOL/ex/Primes.thy*)
    32.6  
    32.7  (*Euclid's algorithm 
    32.8 @@ -10,7 +9,7 @@
    32.9  
   32.10  
   32.11  ML "Pretty.margin_default := 64"
   32.12 -ML "Thy_Output.indent := 5"  (*that is, Doc/TutorialI/settings.ML*)
   32.13 +declare [[thy_output_indent = 5]]  (*that is, Doc/TutorialI/settings.ML*)
   32.14  
   32.15  
   32.16  text {*Now in Basic.thy!
    33.1 --- a/doc-src/TutorialI/Sets/Examples.thy	Thu Sep 02 17:12:40 2010 +0200
    33.2 +++ b/doc-src/TutorialI/Sets/Examples.thy	Thu Sep 02 17:28:00 2010 +0200
    33.3 @@ -1,7 +1,6 @@
    33.4 -(* ID:         $Id$ *)
    33.5  theory Examples imports Main Binomial begin
    33.6  
    33.7 -ML "Unsynchronized.reset eta_contract"
    33.8 +ML "eta_contract := false"
    33.9  ML "Pretty.margin_default := 64"
   33.10  
   33.11  text{*membership, intersection *}
    34.1 --- a/doc-src/TutorialI/Types/Numbers.thy	Thu Sep 02 17:12:40 2010 +0200
    34.2 +++ b/doc-src/TutorialI/Types/Numbers.thy	Thu Sep 02 17:28:00 2010 +0200
    34.3 @@ -3,7 +3,7 @@
    34.4  begin
    34.5  
    34.6  ML "Pretty.margin_default := 64"
    34.7 -ML "Thy_Output.indent := 0"  (*we don't want 5 for listing theorems*)
    34.8 +declare [[thy_output_indent = 0]]  (*we don't want 5 for listing theorems*)
    34.9  
   34.10  text{*
   34.11  
    35.1 --- a/doc-src/TutorialI/Types/document/Numbers.tex	Thu Sep 02 17:12:40 2010 +0200
    35.2 +++ b/doc-src/TutorialI/Types/document/Numbers.tex	Thu Sep 02 17:28:00 2010 +0200
    35.3 @@ -26,16 +26,16 @@
    35.4  %
    35.5  \isatagML
    35.6  \isacommand{ML}\isamarkupfalse%
    35.7 -\ {\isachardoublequoteopen}Pretty{\isachardot}margin{\isacharunderscore}default\ {\isacharcolon}{\isacharequal}\ {\isadigit{6}}{\isadigit{4}}{\isachardoublequoteclose}\isanewline
    35.8 -\isacommand{ML}\isamarkupfalse%
    35.9 -\ {\isachardoublequoteopen}Thy{\isacharunderscore}Output{\isachardot}indent\ {\isacharcolon}{\isacharequal}\ {\isadigit{0}}{\isachardoublequoteclose}%
   35.10 +\ {\isachardoublequoteopen}Pretty{\isachardot}margin{\isacharunderscore}default\ {\isacharcolon}{\isacharequal}\ {\isadigit{6}}{\isadigit{4}}{\isachardoublequoteclose}%
   35.11  \endisatagML
   35.12  {\isafoldML}%
   35.13  %
   35.14  \isadelimML
   35.15 +\isanewline
   35.16  %
   35.17  \endisadelimML
   35.18 -%
   35.19 +\isacommand{declare}\isamarkupfalse%
   35.20 +\ {\isacharbrackleft}{\isacharbrackleft}thy{\isacharunderscore}output{\isacharunderscore}indent\ {\isacharequal}\ {\isadigit{0}}{\isacharbrackright}{\isacharbrackright}%
   35.21  \begin{isamarkuptext}%
   35.22  numeric literals; default simprules; can re-orient%
   35.23  \end{isamarkuptext}%
    36.1 --- a/doc-src/TutorialI/settings.ML	Thu Sep 02 17:12:40 2010 +0200
    36.2 +++ b/doc-src/TutorialI/settings.ML	Thu Sep 02 17:28:00 2010 +0200
    36.3 @@ -1,3 +1,1 @@
    36.4 -(* $Id$ *)
    36.5 -
    36.6 -Thy_Output.indent := 5;
    36.7 +Thy_Output.indent_default := 5;
    37.1 --- a/doc-src/antiquote_setup.ML	Thu Sep 02 17:12:40 2010 +0200
    37.2 +++ b/doc-src/antiquote_setup.ML	Thu Sep 02 17:28:00 2010 +0200
    37.3 @@ -71,8 +71,8 @@
    37.4      in
    37.5        "\\indexdef{}{" ^ kind' ^ "}{" ^ clean_string txt1 ^ "}" ^
    37.6        (txt'
    37.7 -      |> (if ! Thy_Output.quotes then quote else I)
    37.8 -      |> (if ! Thy_Output.display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
    37.9 +      |> (if Config.get ctxt Thy_Output.quotes then quote else I)
   37.10 +      |> (if Config.get ctxt Thy_Output.display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
   37.11            else split_lines #> map verbatim #> space_implode "\\isasep\\isanewline%\n"))
   37.12      end);
   37.13  
   37.14 @@ -93,18 +93,18 @@
   37.15    (Scan.repeat (Attrib.thm -- Scan.lift (Args.parens Args.name)))
   37.16    (fn {context = ctxt, ...} =>
   37.17      map (apfst (Thy_Output.pretty_thm ctxt))
   37.18 -    #> (if ! Thy_Output.quotes then map (apfst Pretty.quote) else I)
   37.19 -    #> (if ! Thy_Output.display
   37.20 +    #> (if Config.get ctxt Thy_Output.quotes then map (apfst Pretty.quote) else I)
   37.21 +    #> (if Config.get ctxt Thy_Output.display
   37.22          then
   37.23            map (fn (p, name) =>
   37.24 -            Output.output (Pretty.string_of (Pretty.indent (! Thy_Output.indent) p)) ^
   37.25 -            "\\rulename{" ^ Output.output (Pretty.str_of (Thy_Output.pretty_text name)) ^ "}")
   37.26 +            Output.output (Pretty.string_of (Pretty.indent (Config.get ctxt Thy_Output.indent) p)) ^
   37.27 +            "\\rulename{" ^ Output.output (Pretty.str_of (Thy_Output.pretty_text ctxt name)) ^ "}")
   37.28            #> space_implode "\\par\\smallskip%\n"
   37.29            #> enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
   37.30          else
   37.31            map (fn (p, name) =>
   37.32              Output.output (Pretty.str_of p) ^
   37.33 -            "\\rulename{" ^ Output.output (Pretty.str_of (Thy_Output.pretty_text name)) ^ "}")
   37.34 +            "\\rulename{" ^ Output.output (Pretty.str_of (Thy_Output.pretty_text ctxt name)) ^ "}")
   37.35            #> space_implode "\\par\\smallskip%\n"
   37.36            #> enclose "\\isa{" "}"));
   37.37  
   37.38 @@ -112,7 +112,8 @@
   37.39  (* theory file *)
   37.40  
   37.41  val _ = Thy_Output.antiquotation "thy_file" (Scan.lift Args.name)
   37.42 -  (fn _ => fn name => (Thy_Load.check_thy Path.current name; Thy_Output.output [Pretty.str name]));
   37.43 +  (fn {context = ctxt, ...} =>
   37.44 +    fn name => (Thy_Load.check_thy Path.current name; Thy_Output.output ctxt [Pretty.str name]));
   37.45  
   37.46  
   37.47  (* Isabelle/Isar entities (with index) *)
   37.48 @@ -152,8 +153,9 @@
   37.49            idx ^
   37.50            (Output.output name
   37.51              |> (if markup = "" then I else enclose ("\\" ^ markup ^ "{") "}")
   37.52 -            |> (if ! Thy_Output.quotes then quote else I)
   37.53 -            |> (if ! Thy_Output.display then enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
   37.54 +            |> (if Config.get ctxt Thy_Output.quotes then quote else I)
   37.55 +            |> (if Config.get ctxt Thy_Output.display
   37.56 +                then enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
   37.57                  else hyper o enclose "\\mbox{\\isa{" "}}"))
   37.58          else error ("Bad " ^ kind ^ " " ^ quote name)
   37.59        end);
    38.1 --- a/doc-src/manual.bib	Thu Sep 02 17:12:40 2010 +0200
    38.2 +++ b/doc-src/manual.bib	Thu Sep 02 17:28:00 2010 +0200
    38.3 @@ -984,6 +984,14 @@
    38.4  
    38.5  %O
    38.6  
    38.7 +@TechReport{scala-overview-tech-report,
    38.8 +  author =       {Martin Odersky and al.},
    38.9 +  title =        {An Overview of the Scala Programming Language},
   38.10 +  institution =  {EPFL Lausanne, Switzerland},
   38.11 +  year =         2004,
   38.12 +  number =       {IC/2004/64}
   38.13 +}
   38.14 +
   38.15  @Manual{pvs-language,
   38.16    title		= {The {PVS} specification language},
   38.17    author	= {S. Owre and N. Shankar and J. M. Rushby},
    39.1 --- a/doc-src/more_antiquote.ML	Thu Sep 02 17:12:40 2010 +0200
    39.2 +++ b/doc-src/more_antiquote.ML	Thu Sep 02 17:28:00 2010 +0200
    39.3 @@ -95,7 +95,7 @@
    39.4        |> snd
    39.5        |> map_filter (fn (_, (some_thm, proper)) => if proper then some_thm else NONE)
    39.6        |> map (holize o no_vars ctxt o AxClass.overload thy);
    39.7 -  in Thy_Output.output (Thy_Output.maybe_pretty_source (pretty_thm ctxt) src thms) end;
    39.8 +  in Thy_Output.output ctxt (Thy_Output.maybe_pretty_source pretty_thm ctxt src thms) end;
    39.9  
   39.10  in
   39.11  
   39.12 @@ -124,12 +124,13 @@
   39.13  in
   39.14  
   39.15  val _ = Thy_Output.antiquotation "code_stmts"
   39.16 -  (parse_const_terms -- Scan.repeat parse_names -- Scan.lift (Args.parens Args.name))
   39.17 -  (fn {context = ctxt, ...} => fn ((mk_cs, mk_stmtss), target) =>
   39.18 +  (parse_const_terms -- Scan.repeat parse_names
   39.19 +    -- Scan.lift (Args.parens (Args.name -- Scan.option Parse.int)))
   39.20 +  (fn {context = ctxt, ...} => fn ((mk_cs, mk_stmtss), (target, some_width)) =>
   39.21      let val thy = ProofContext.theory_of ctxt in
   39.22 -      Code_Target.code_of thy
   39.23 -        target NONE "Example" (mk_cs thy)
   39.24 +      Code_Target.present_code thy (mk_cs thy)
   39.25          (fn naming => maps (fn f => f thy naming) mk_stmtss)
   39.26 +        target some_width "Example" []
   39.27        |> typewriter
   39.28      end);
   39.29  
    40.1 --- a/doc-src/rail.ML	Thu Sep 02 17:12:40 2010 +0200
    40.2 +++ b/doc-src/rail.ML	Thu Sep 02 17:28:00 2010 +0200
    40.3 @@ -97,8 +97,9 @@
    40.4      (idx ^
    40.5      (Output.output name
    40.6        |> (if markup = "" then I else enclose ("\\" ^ markup ^ "{") "}")
    40.7 -      |> (if ! Thy_Output.quotes then quote else I)
    40.8 -      |> (if ! Thy_Output.display then enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
    40.9 +      |> (if Config.get ctxt Thy_Output.quotes then quote else I)
   40.10 +      |> (if Config.get ctxt Thy_Output.display
   40.11 +          then enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
   40.12            else hyper o enclose "\\mbox{\\isa{" "}}")), style)
   40.13    else ("Bad " ^ kind ^ " " ^ name, false)
   40.14    end;
    41.1 --- a/etc/isar-keywords-ZF.el	Thu Sep 02 17:12:40 2010 +0200
    41.2 +++ b/etc/isar-keywords-ZF.el	Thu Sep 02 17:28:00 2010 +0200
    41.3 @@ -1,6 +1,6 @@
    41.4  ;;
    41.5  ;; Keyword classification tables for Isabelle/Isar.
    41.6 -;; Generated from Pure + Pure-ProofGeneral + FOL + ZF.
    41.7 +;; Generated from Pure + FOL + ZF.
    41.8  ;; *** DO NOT EDIT *** DO NOT EDIT *** DO NOT EDIT ***
    41.9  ;;
   41.10  
    42.1 --- a/etc/isar-keywords.el	Thu Sep 02 17:12:40 2010 +0200
    42.2 +++ b/etc/isar-keywords.el	Thu Sep 02 17:28:00 2010 +0200
    42.3 @@ -1,6 +1,6 @@
    42.4  ;;
    42.5  ;; Keyword classification tables for Isabelle/Isar.
    42.6 -;; Generated from Pure + Pure-ProofGeneral + HOL + HOLCF + HOL-Boogie + HOL-Nominal + HOL-Statespace.
    42.7 +;; Generated from Pure + HOL + HOLCF + HOL-Boogie + HOL-Nominal + HOL-Statespace.
    42.8  ;; *** DO NOT EDIT *** DO NOT EDIT *** DO NOT EDIT ***
    42.9  ;;
   42.10  
   42.11 @@ -245,6 +245,7 @@
   42.12      "thus"
   42.13      "thy_deps"
   42.14      "translations"
   42.15 +    "try"
   42.16      "txt"
   42.17      "txt_raw"
   42.18      "typ"
   42.19 @@ -398,6 +399,7 @@
   42.20      "thm"
   42.21      "thm_deps"
   42.22      "thy_deps"
   42.23 +    "try"
   42.24      "typ"
   42.25      "unused_thms"
   42.26      "value"
    43.1 --- a/src/CCL/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
    43.2 +++ b/src/CCL/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
    43.3 @@ -8,6 +8,6 @@
    43.4  evaluation to weak head-normal form.
    43.5  *)
    43.6  
    43.7 -Unsynchronized.set eta_contract;
    43.8 +eta_contract := true;
    43.9  
   43.10  use_thys ["Wfd", "Fix"];
    44.1 --- a/src/FOLP/IFOLP.thy	Thu Sep 02 17:12:40 2010 +0200
    44.2 +++ b/src/FOLP/IFOLP.thy	Thu Sep 02 17:28:00 2010 +0200
    44.3 @@ -63,20 +63,22 @@
    44.4  
    44.5  syntax "_Proof" :: "[p,o]=>prop"    ("(_ /: _)" [51, 10] 5)
    44.6  
    44.7 -ML {*
    44.8 -
    44.9 -(*show_proofs:=true displays the proof terms -- they are ENORMOUS*)
   44.10 -val show_proofs = Unsynchronized.ref false;
   44.11 -
   44.12 -fun proof_tr [p,P] = Const (@{const_name Proof}, dummyT) $ P $ p;
   44.13 -
   44.14 -fun proof_tr' [P,p] =
   44.15 -  if ! show_proofs then Const (@{syntax_const "_Proof"}, dummyT) $ p $ P
   44.16 -  else P  (*this case discards the proof term*);
   44.17 +parse_translation {*
   44.18 +  let fun proof_tr [p, P] = Const (@{const_syntax Proof}, dummyT) $ P $ p
   44.19 +  in [(@{syntax_const "_Proof"}, proof_tr)] end
   44.20  *}
   44.21  
   44.22 -parse_translation {* [(@{syntax_const "_Proof"}, proof_tr)] *}
   44.23 -print_translation {* [(@{const_syntax Proof}, proof_tr')] *}
   44.24 +(*show_proofs = true displays the proof terms -- they are ENORMOUS*)
   44.25 +ML {* val (show_proofs, setup_show_proofs) = Attrib.config_bool "show_proofs" (K false) *}
   44.26 +setup setup_show_proofs
   44.27 +
   44.28 +print_translation (advanced) {*
   44.29 +  let
   44.30 +    fun proof_tr' ctxt [P, p] =
   44.31 +      if Config.get ctxt show_proofs then Const (@{syntax_const "_Proof"}, dummyT) $ p $ P
   44.32 +      else P
   44.33 +  in [(@{const_syntax Proof}, proof_tr')] end
   44.34 +*}
   44.35  
   44.36  axioms
   44.37  
    45.1 --- a/src/HOL/Auth/Event.thy	Thu Sep 02 17:12:40 2010 +0200
    45.2 +++ b/src/HOL/Auth/Event.thy	Thu Sep 02 17:28:00 2010 +0200
    45.3 @@ -22,14 +22,6 @@
    45.4         
    45.5  consts 
    45.6    bad    :: "agent set"                         -- {* compromised agents *}
    45.7 -  knows  :: "agent => event list => msg set"
    45.8 -
    45.9 -
   45.10 -text{*The constant "spies" is retained for compatibility's sake*}
   45.11 -
   45.12 -abbreviation (input)
   45.13 -  spies  :: "event list => msg set" where
   45.14 -  "spies == knows Spy"
   45.15  
   45.16  text{*Spy has access to his own key for spoof messages, but Server is secure*}
   45.17  specification (bad)
   45.18 @@ -37,9 +29,10 @@
   45.19    Server_not_bad [iff]: "Server \<notin> bad"
   45.20      by (rule exI [of _ "{Spy}"], simp)
   45.21  
   45.22 -primrec
   45.23 +primrec knows :: "agent => event list => msg set"
   45.24 +where
   45.25    knows_Nil:   "knows A [] = initState A"
   45.26 -  knows_Cons:
   45.27 +| knows_Cons:
   45.28      "knows A (ev # evs) =
   45.29         (if A = Spy then 
   45.30          (case ev of
   45.31 @@ -62,14 +55,20 @@
   45.32    therefore the oops case must use Notes
   45.33  *)
   45.34  
   45.35 -consts
   45.36 -  (*Set of items that might be visible to somebody:
   45.37 +text{*The constant "spies" is retained for compatibility's sake*}
   45.38 +
   45.39 +abbreviation (input)
   45.40 +  spies  :: "event list => msg set" where
   45.41 +  "spies == knows Spy"
   45.42 +
   45.43 +
   45.44 +(*Set of items that might be visible to somebody:
   45.45      complement of the set of fresh items*)
   45.46 -  used :: "event list => msg set"
   45.47  
   45.48 -primrec
   45.49 +primrec used :: "event list => msg set"
   45.50 +where
   45.51    used_Nil:   "used []         = (UN B. parts (initState B))"
   45.52 -  used_Cons:  "used (ev # evs) =
   45.53 +| used_Cons:  "used (ev # evs) =
   45.54                       (case ev of
   45.55                          Says A B X => parts {X} \<union> used evs
   45.56                        | Gets A X   => used evs
    46.1 --- a/src/HOL/Auth/NS_Public_Bad.thy	Thu Sep 02 17:12:40 2010 +0200
    46.2 +++ b/src/HOL/Auth/NS_Public_Bad.thy	Thu Sep 02 17:28:00 2010 +0200
    46.3 @@ -203,7 +203,7 @@
    46.4  apply clarify
    46.5  apply (frule_tac A' = A in 
    46.6         Says_imp_knows_Spy [THEN parts.Inj, THEN unique_NB], auto)
    46.7 -apply (rename_tac C B' evs3)
    46.8 +apply (rename_tac evs3 B' C)
    46.9  txt{*This is the attack!
   46.10  @{subgoals[display,indent=0,margin=65]}
   46.11  *}
    47.1 --- a/src/HOL/Auth/Yahalom.thy	Thu Sep 02 17:12:40 2010 +0200
    47.2 +++ b/src/HOL/Auth/Yahalom.thy	Thu Sep 02 17:28:00 2010 +0200
    47.3 @@ -197,6 +197,7 @@
    47.4  apply (erule yahalom.induct,
    47.5         drule_tac [7] YM4_analz_knows_Spy, analz_freshK, spy_analz, blast)
    47.6  apply (simp only: Says_Server_not_range analz_image_freshK_simps)
    47.7 +apply safe
    47.8  done
    47.9  
   47.10  lemma analz_insert_freshK:
    48.1 --- a/src/HOL/Boogie/Tools/boogie_commands.ML	Thu Sep 02 17:12:40 2010 +0200
    48.2 +++ b/src/HOL/Boogie/Tools/boogie_commands.ML	Thu Sep 02 17:28:00 2010 +0200
    48.3 @@ -91,7 +91,7 @@
    48.4        | _ => (pair ts, K I))
    48.5  
    48.6      val discharge = fold (Boogie_VCs.discharge o pair vc_name)
    48.7 -    fun after_qed [thms] = ProofContext.theory (discharge (vcs ~~ thms))
    48.8 +    fun after_qed [thms] = ProofContext.background_theory (discharge (vcs ~~ thms))
    48.9        | after_qed _ = I
   48.10    in
   48.11      ProofContext.init_global thy
    49.1 --- a/src/HOL/Boogie/Tools/boogie_loader.ML	Thu Sep 02 17:12:40 2010 +0200
    49.2 +++ b/src/HOL/Boogie/Tools/boogie_loader.ML	Thu Sep 02 17:28:00 2010 +0200
    49.3 @@ -504,7 +504,7 @@
    49.4          in
    49.5            Const (@{const_name If}, [@{typ bool}, T, T] ---> T) $ c $ t1 $ t2
    49.6          end) ||
    49.7 -      binexp "implies" (binop @{term "op -->"}) ||
    49.8 +      binexp "implies" (binop @{term HOL.implies}) ||
    49.9        scan_line "distinct" num :|-- scan_count exp >>
   49.10          (fn [] => @{term True}
   49.11            | ts as (t :: _) => mk_distinct (Term.fastype_of t) ts) ||
    50.1 --- a/src/HOL/Boogie/Tools/boogie_tactics.ML	Thu Sep 02 17:12:40 2010 +0200
    50.2 +++ b/src/HOL/Boogie/Tools/boogie_tactics.ML	Thu Sep 02 17:28:00 2010 +0200
    50.3 @@ -50,11 +50,11 @@
    50.4  
    50.5  
    50.6  local
    50.7 -  fun explode_conj (@{term "op &"} $ t $ u) = explode_conj t @ explode_conj u
    50.8 +  fun explode_conj (@{term HOL.conj} $ t $ u) = explode_conj t @ explode_conj u
    50.9      | explode_conj t = [t] 
   50.10  
   50.11 -  fun splt (ts, @{term "op -->"} $ t $ u) = splt (ts @ explode_conj t, u)
   50.12 -    | splt (ts, @{term "op &"} $ t $ u) = splt (ts, t) @ splt (ts, u)
   50.13 +  fun splt (ts, @{term HOL.implies} $ t $ u) = splt (ts @ explode_conj t, u)
   50.14 +    | splt (ts, @{term HOL.conj} $ t $ u) = splt (ts, t) @ splt (ts, u)
   50.15      | splt (ts, @{term assert_at} $ _ $ t) = [(ts, t)]
   50.16      | splt (_, @{term True}) = []
   50.17      | splt tp = [tp]
    51.1 --- a/src/HOL/Boogie/Tools/boogie_vcs.ML	Thu Sep 02 17:12:40 2010 +0200
    51.2 +++ b/src/HOL/Boogie/Tools/boogie_vcs.ML	Thu Sep 02 17:28:00 2010 +0200
    51.3 @@ -59,12 +59,12 @@
    51.4      fun vc_of @{term True} = NONE
    51.5        | vc_of (@{term assert_at} $ Free (n, _) $ t) =
    51.6            SOME (Assert ((n, t), True))
    51.7 -      | vc_of (@{term "op -->"} $ @{term True} $ u) = vc_of u
    51.8 -      | vc_of (@{term "op -->"} $ t $ u) =
    51.9 +      | vc_of (@{term HOL.implies} $ @{term True} $ u) = vc_of u
   51.10 +      | vc_of (@{term HOL.implies} $ t $ u) =
   51.11            vc_of u |> Option.map (assume t)
   51.12 -      | vc_of (@{term "op &"} $ (@{term assert_at} $ Free (n, _) $ t) $ u) =
   51.13 +      | vc_of (@{term HOL.conj} $ (@{term assert_at} $ Free (n, _) $ t) $ u) =
   51.14            SOME (vc_of u |> the_default True |> assert (n, t))
   51.15 -      | vc_of (@{term "op &"} $ t $ u) =
   51.16 +      | vc_of (@{term HOL.conj} $ t $ u) =
   51.17            (case (vc_of t, vc_of u) of
   51.18              (NONE, r) => r
   51.19            | (l, NONE) => l
   51.20 @@ -74,9 +74,9 @@
   51.21  
   51.22  val prop_of_vc =
   51.23    let
   51.24 -    fun mk_conj t u = @{term "op &"} $ t $ u
   51.25 +    fun mk_conj t u = @{term HOL.conj} $ t $ u
   51.26  
   51.27 -    fun term_of (Assume (t, v)) = @{term "op -->"} $ t $ term_of v
   51.28 +    fun term_of (Assume (t, v)) = @{term HOL.implies} $ t $ term_of v
   51.29        | term_of (Assert ((n, t), v)) =
   51.30            mk_conj (@{term assert_at} $ Free (n, @{typ bool}) $ t) (term_of v)
   51.31        | term_of (Ignore v) = term_of v
    52.1 --- a/src/HOL/Code_Evaluation.thy	Thu Sep 02 17:12:40 2010 +0200
    52.2 +++ b/src/HOL/Code_Evaluation.thy	Thu Sep 02 17:28:00 2010 +0200
    52.3 @@ -162,7 +162,7 @@
    52.4  subsubsection {* Code generator setup *}
    52.5  
    52.6  lemmas [code del] = term.recs term.cases term.size
    52.7 -lemma [code, code del]: "eq_class.eq (t1\<Colon>term) t2 \<longleftrightarrow> eq_class.eq t1 t2" ..
    52.8 +lemma [code, code del]: "HOL.equal (t1\<Colon>term) t2 \<longleftrightarrow> HOL.equal t1 t2" ..
    52.9  
   52.10  lemma [code, code del]: "(term_of \<Colon> typerep \<Rightarrow> term) = term_of" ..
   52.11  lemma [code, code del]: "(term_of \<Colon> term \<Rightarrow> term) = term_of" ..
    53.1 --- a/src/HOL/Code_Numeral.thy	Thu Sep 02 17:12:40 2010 +0200
    53.2 +++ b/src/HOL/Code_Numeral.thy	Thu Sep 02 17:28:00 2010 +0200
    53.3 @@ -115,12 +115,12 @@
    53.4  lemmas [code del] = code_numeral.recs code_numeral.cases
    53.5  
    53.6  lemma [code]:
    53.7 -  "eq_class.eq k l \<longleftrightarrow> eq_class.eq (nat_of k) (nat_of l)"
    53.8 -  by (cases k, cases l) (simp add: eq)
    53.9 +  "HOL.equal k l \<longleftrightarrow> HOL.equal (nat_of k) (nat_of l)"
   53.10 +  by (cases k, cases l) (simp add: equal)
   53.11  
   53.12  lemma [code nbe]:
   53.13 -  "eq_class.eq (k::code_numeral) k \<longleftrightarrow> True"
   53.14 -  by (rule HOL.eq_refl)
   53.15 +  "HOL.equal (k::code_numeral) k \<longleftrightarrow> True"
   53.16 +  by (rule equal_refl)
   53.17  
   53.18  
   53.19  subsection {* Code numerals as datatype of ints *}
   53.20 @@ -301,7 +301,7 @@
   53.21    (Haskell "Integer")
   53.22    (Scala "BigInt")
   53.23  
   53.24 -code_instance code_numeral :: eq
   53.25 +code_instance code_numeral :: equal
   53.26    (Haskell -)
   53.27  
   53.28  setup {*
   53.29 @@ -342,7 +342,7 @@
   53.30    (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
   53.31    (Eval "!(fn n => fn m =>/ if m = 0/ then (0, n) else/ (n div m, n mod m))")
   53.32  
   53.33 -code_const "eq_class.eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   53.34 +code_const "HOL.equal \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   53.35    (SML "!((_ : Int.int) = _)")
   53.36    (OCaml "Big'_int.eq'_big'_int")
   53.37    (Haskell infixl 4 "==")
    54.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Thu Sep 02 17:12:40 2010 +0200
    54.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Thu Sep 02 17:28:00 2010 +0200
    54.3 @@ -3305,7 +3305,7 @@
    54.4                               (Const (@{const_name Set.member}, _) $
    54.5                                Free (name, _) $ _)) = name
    54.6          | variable_of_bound (Const (@{const_name Trueprop}, _) $
    54.7 -                             (Const (@{const_name "op ="}, _) $
    54.8 +                             (Const (@{const_name HOL.eq}, _) $
    54.9                                Free (name, _) $ _)) = name
   54.10          | variable_of_bound t = raise TERM ("variable_of_bound", [t])
   54.11  
   54.12 @@ -3422,7 +3422,7 @@
   54.13  
   54.14  ML {*
   54.15    fun calculated_subterms (@{const Trueprop} $ t) = calculated_subterms t
   54.16 -    | calculated_subterms (@{const "op -->"} $ _ $ t) = calculated_subterms t
   54.17 +    | calculated_subterms (@{const HOL.implies} $ _ $ t) = calculated_subterms t
   54.18      | calculated_subterms (@{term "op <= :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) = [t1, t2]
   54.19      | calculated_subterms (@{term "op < :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) = [t1, t2]
   54.20      | calculated_subterms (@{term "op : :: real \<Rightarrow> real set \<Rightarrow> bool"} $ t1 $ 
    55.1 --- a/src/HOL/Decision_Procs/Cooper.thy	Thu Sep 02 17:12:40 2010 +0200
    55.2 +++ b/src/HOL/Decision_Procs/Cooper.thy	Thu Sep 02 17:28:00 2010 +0200
    55.3 @@ -1952,11 +1952,11 @@
    55.4          | NONE => error "num_of_term: unsupported dvd")
    55.5    | fm_of_term ps vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
    55.6        @{code Iff} (fm_of_term ps vs t1, fm_of_term ps vs t2)
    55.7 -  | fm_of_term ps vs (@{term "op &"} $ t1 $ t2) =
    55.8 +  | fm_of_term ps vs (@{term HOL.conj} $ t1 $ t2) =
    55.9        @{code And} (fm_of_term ps vs t1, fm_of_term ps vs t2)
   55.10 -  | fm_of_term ps vs (@{term "op |"} $ t1 $ t2) =
   55.11 +  | fm_of_term ps vs (@{term HOL.disj} $ t1 $ t2) =
   55.12        @{code Or} (fm_of_term ps vs t1, fm_of_term ps vs t2)
   55.13 -  | fm_of_term ps vs (@{term "op -->"} $ t1 $ t2) =
   55.14 +  | fm_of_term ps vs (@{term HOL.implies} $ t1 $ t2) =
   55.15        @{code Imp} (fm_of_term ps vs t1, fm_of_term ps vs t2)
   55.16    | fm_of_term ps vs (@{term "Not"} $ t') =
   55.17        @{code NOT} (fm_of_term ps vs t')
   55.18 @@ -2016,7 +2016,7 @@
   55.19  
   55.20  fun term_bools acc t =
   55.21    let
   55.22 -    val is_op = member (op =) [@{term "op &"}, @{term "op |"}, @{term "op -->"}, @{term "op = :: bool => _"},
   55.23 +    val is_op = member (op =) [@{term HOL.conj}, @{term HOL.disj}, @{term HOL.implies}, @{term "op = :: bool => _"},
   55.24        @{term "op = :: int => _"}, @{term "op < :: int => _"},
   55.25        @{term "op <= :: int => _"}, @{term "Not"}, @{term "All :: (int => _) => _"},
   55.26        @{term "Ex :: (int => _) => _"}, @{term "True"}, @{term "False"}]
    56.1 --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Thu Sep 02 17:12:40 2010 +0200
    56.2 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Thu Sep 02 17:28:00 2010 +0200
    56.3 @@ -519,9 +519,9 @@
    56.4    val [lt, le] = map (Morphism.term phi) [@{term "op \<sqsubset>"}, @{term "op \<sqsubseteq>"}]
    56.5    fun h x t =
    56.6     case term_of t of
    56.7 -     Const(@{const_name "op ="}, _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
    56.8 +     Const(@{const_name HOL.eq}, _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
    56.9                              else Ferrante_Rackoff_Data.Nox
   56.10 -   | @{term "Not"}$(Const(@{const_name "op ="}, _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
   56.11 +   | @{term "Not"}$(Const(@{const_name HOL.eq}, _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
   56.12                              else Ferrante_Rackoff_Data.Nox
   56.13     | b$y$z => if Term.could_unify (b, lt) then
   56.14                   if term_of x aconv y then Ferrante_Rackoff_Data.Lt
   56.15 @@ -771,7 +771,7 @@
   56.16        in rth end
   56.17      | _ => Thm.reflexive ct)
   56.18  
   56.19 -|  Const(@{const_name "op ="},_)$_$Const(@{const_name Groups.zero},_) =>
   56.20 +|  Const(@{const_name HOL.eq},_)$_$Const(@{const_name Groups.zero},_) =>
   56.21     (case whatis x (Thm.dest_arg1 ct) of
   56.22      ("c*x+t",[c,t]) =>
   56.23         let
   56.24 @@ -835,7 +835,7 @@
   56.25         val rth = Thm.transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
   56.26     in rth end
   56.27  
   56.28 -| Const(@{const_name "op ="},_)$a$b =>
   56.29 +| Const(@{const_name HOL.eq},_)$a$b =>
   56.30     let val (ca,cb) = Thm.dest_binop ct
   56.31         val T = ctyp_of_term ca
   56.32         val th = instantiate' [SOME T] [SOME ca, SOME cb] eq_iff_diff_eq_0
   56.33 @@ -844,7 +844,7 @@
   56.34                (Semiring_Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
   56.35         val rth = Thm.transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
   56.36     in rth end
   56.37 -| @{term "Not"} $(Const(@{const_name "op ="},_)$a$b) => Conv.arg_conv (field_isolate_conv phi ctxt vs) ct
   56.38 +| @{term "Not"} $(Const(@{const_name HOL.eq},_)$a$b) => Conv.arg_conv (field_isolate_conv phi ctxt vs) ct
   56.39  | _ => Thm.reflexive ct
   56.40  end;
   56.41  
   56.42 @@ -852,9 +852,9 @@
   56.43   let
   56.44    fun h x t =
   56.45     case term_of t of
   56.46 -     Const(@{const_name "op ="}, _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
   56.47 +     Const(@{const_name HOL.eq}, _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
   56.48                              else Ferrante_Rackoff_Data.Nox
   56.49 -   | @{term "Not"}$(Const(@{const_name "op ="}, _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
   56.50 +   | @{term "Not"}$(Const(@{const_name HOL.eq}, _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
   56.51                              else Ferrante_Rackoff_Data.Nox
   56.52     | Const(@{const_name Orderings.less},_)$y$z =>
   56.53         if term_of x aconv y then Ferrante_Rackoff_Data.Lt
    57.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Thu Sep 02 17:12:40 2010 +0200
    57.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Thu Sep 02 17:28:00 2010 +0200
    57.3 @@ -1996,9 +1996,9 @@
    57.4        @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2)) 
    57.5    | fm_of_term vs (@{term "op \<longleftrightarrow> :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
    57.6        @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
    57.7 -  | fm_of_term vs (@{term "op &"} $ t1 $ t2) = @{code And} (fm_of_term vs t1, fm_of_term vs t2)
    57.8 -  | fm_of_term vs (@{term "op |"} $ t1 $ t2) = @{code Or} (fm_of_term vs t1, fm_of_term vs t2)
    57.9 -  | fm_of_term vs (@{term "op -->"} $ t1 $ t2) = @{code Imp} (fm_of_term vs t1, fm_of_term vs t2)
   57.10 +  | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) = @{code And} (fm_of_term vs t1, fm_of_term vs t2)
   57.11 +  | fm_of_term vs (@{term HOL.disj} $ t1 $ t2) = @{code Or} (fm_of_term vs t1, fm_of_term vs t2)
   57.12 +  | fm_of_term vs (@{term HOL.implies} $ t1 $ t2) = @{code Imp} (fm_of_term vs t1, fm_of_term vs t2)
   57.13    | fm_of_term vs (@{term "Not"} $ t') = @{code NOT} (fm_of_term vs t')
   57.14    | fm_of_term vs (Const (@{const_name Ex}, _) $ Abs (xn, xT, p)) =
   57.15        @{code E} (fm_of_term (("", dummyT) :: vs) p)
    58.1 --- a/src/HOL/Decision_Procs/MIR.thy	Thu Sep 02 17:12:40 2010 +0200
    58.2 +++ b/src/HOL/Decision_Procs/MIR.thy	Thu Sep 02 17:28:00 2010 +0200
    58.3 @@ -5837,11 +5837,11 @@
    58.4        @{code Dvd} (HOLogic.dest_numeral t1, num_of_term vs t2)
    58.5    | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
    58.6        @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
    58.7 -  | fm_of_term vs (@{term "op &"} $ t1 $ t2) =
    58.8 +  | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
    58.9        @{code And} (fm_of_term vs t1, fm_of_term vs t2)
   58.10 -  | fm_of_term vs (@{term "op |"} $ t1 $ t2) =
   58.11 +  | fm_of_term vs (@{term HOL.disj} $ t1 $ t2) =
   58.12        @{code Or} (fm_of_term vs t1, fm_of_term vs t2)
   58.13 -  | fm_of_term vs (@{term "op -->"} $ t1 $ t2) =
   58.14 +  | fm_of_term vs (@{term HOL.implies} $ t1 $ t2) =
   58.15        @{code Imp} (fm_of_term vs t1, fm_of_term vs t2)
   58.16    | fm_of_term vs (@{term "Not"} $ t') =
   58.17        @{code NOT} (fm_of_term vs t')
    59.1 --- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Thu Sep 02 17:12:40 2010 +0200
    59.2 +++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Thu Sep 02 17:28:00 2010 +0200
    59.3 @@ -912,7 +912,7 @@
    59.4  
    59.5  definition "lt p = (case p of CP (C c) \<Rightarrow> if 0>\<^sub>N c then T else F| _ \<Rightarrow> Lt p)"
    59.6  definition "le p = (case p of CP (C c) \<Rightarrow> if 0\<ge>\<^sub>N c then T else F | _ \<Rightarrow> Le p)"
    59.7 -definition "eq p = (case p of CP (C c) \<Rightarrow> if c = 0\<^sub>N then T else F | _ \<Rightarrow> Eq p)"
    59.8 +definition eq where "eq p = (case p of CP (C c) \<Rightarrow> if c = 0\<^sub>N then T else F | _ \<Rightarrow> Eq p)"
    59.9  definition "neq p = not (eq p)"
   59.10  
   59.11  lemma lt: "allpolys isnpoly p \<Longrightarrow> Ifm vs bs (lt p) = Ifm vs bs (Lt p)"
   59.12 @@ -2954,13 +2954,13 @@
   59.13  fun powt rT = Const(@{const_name "power"}, [rT,@{typ "nat"}] ---> rT);
   59.14  val brT = [bT, bT] ---> bT;
   59.15  val nott = @{term "Not"};
   59.16 -val conjt = @{term "op &"};
   59.17 -val disjt = @{term "op |"};
   59.18 -val impt = @{term "op -->"};
   59.19 +val conjt = @{term HOL.conj};
   59.20 +val disjt = @{term HOL.disj};
   59.21 +val impt = @{term HOL.implies};
   59.22  val ifft = @{term "op = :: bool => _"}
   59.23  fun llt rT = Const(@{const_name Orderings.less},rrT rT);
   59.24  fun lle rT = Const(@{const_name Orderings.less},rrT rT);
   59.25 -fun eqt rT = Const(@{const_name "op ="},rrT rT);
   59.26 +fun eqt rT = Const(@{const_name HOL.eq},rrT rT);
   59.27  fun rz rT = Const(@{const_name Groups.zero},rT);
   59.28  
   59.29  fun dest_nat t = case t of
   59.30 @@ -3018,10 +3018,10 @@
   59.31      Const(@{const_name True},_) => @{code T}
   59.32    | Const(@{const_name False},_) => @{code F}
   59.33    | Const(@{const_name Not},_)$p => @{code NOT} (fm_of_term m m' p)
   59.34 -  | Const(@{const_name "op &"},_)$p$q => @{code And} (fm_of_term m m' p, fm_of_term m m' q)
   59.35 -  | Const(@{const_name "op |"},_)$p$q => @{code Or} (fm_of_term m m' p, fm_of_term m m' q)
   59.36 -  | Const(@{const_name "op -->"},_)$p$q => @{code Imp} (fm_of_term m m' p, fm_of_term m m' q)
   59.37 -  | Const(@{const_name "op ="},ty)$p$q => 
   59.38 +  | Const(@{const_name HOL.conj},_)$p$q => @{code And} (fm_of_term m m' p, fm_of_term m m' q)
   59.39 +  | Const(@{const_name HOL.disj},_)$p$q => @{code Or} (fm_of_term m m' p, fm_of_term m m' q)
   59.40 +  | Const(@{const_name HOL.implies},_)$p$q => @{code Imp} (fm_of_term m m' p, fm_of_term m m' q)
   59.41 +  | Const(@{const_name HOL.eq},ty)$p$q => 
   59.42         if domain_type ty = bT then @{code Iff} (fm_of_term m m' p, fm_of_term m m' q)
   59.43         else @{code Eq} (@{code Sub} (tm_of_term m m' p, tm_of_term m m' q))
   59.44    | Const(@{const_name Orderings.less},_)$p$q => 
    60.1 --- a/src/HOL/Decision_Procs/commutative_ring_tac.ML	Thu Sep 02 17:12:40 2010 +0200
    60.2 +++ b/src/HOL/Decision_Procs/commutative_ring_tac.ML	Thu Sep 02 17:28:00 2010 +0200
    60.3 @@ -65,7 +65,7 @@
    60.4  (* reification of the equation *)
    60.5  val cr_sort = @{sort "comm_ring_1"};
    60.6  
    60.7 -fun reif_eq thy (eq as Const(@{const_name "op ="}, Type("fun", [T, _])) $ lhs $ rhs) =
    60.8 +fun reif_eq thy (eq as Const(@{const_name HOL.eq}, Type("fun", [T, _])) $ lhs $ rhs) =
    60.9        if Sign.of_sort thy (T, cr_sort) then
   60.10          let
   60.11            val fs = OldTerm.term_frees eq;
    61.1 --- a/src/HOL/Decision_Procs/ferrante_rackoff.ML	Thu Sep 02 17:12:40 2010 +0200
    61.2 +++ b/src/HOL/Decision_Procs/ferrante_rackoff.ML	Thu Sep 02 17:28:00 2010 +0200
    61.3 @@ -33,12 +33,12 @@
    61.4               {isolate_conv = icv, whatis = wi, simpset = simpset}):entry) =
    61.5  let
    61.6   fun uset (vars as (x::vs)) p = case term_of p of
    61.7 -   Const(@{const_name "op &"}, _)$ _ $ _ =>
    61.8 +   Const(@{const_name HOL.conj}, _)$ _ $ _ =>
    61.9       let
   61.10         val ((b,l),r) = Thm.dest_comb p |>> Thm.dest_comb
   61.11         val (lS,lth) = uset vars l  val (rS, rth) = uset vars r
   61.12       in (lS@rS, Drule.binop_cong_rule b lth rth) end
   61.13 - |  Const(@{const_name "op |"}, _)$ _ $ _ =>
   61.14 + |  Const(@{const_name HOL.disj}, _)$ _ $ _ =>
   61.15       let
   61.16         val ((b,l),r) = Thm.dest_comb p |>> Thm.dest_comb
   61.17         val (lS,lth) = uset vars l  val (rS, rth) = uset vars r
   61.18 @@ -122,12 +122,12 @@
   61.19  
   61.20     fun decomp_mpinf fm =
   61.21       case term_of fm of
   61.22 -       Const(@{const_name "op &"},_)$_$_ =>
   61.23 +       Const(@{const_name HOL.conj},_)$_$_ =>
   61.24          let val (p,q) = Thm.dest_binop fm
   61.25          in ([p,q], myfwd (minf_conj,pinf_conj, nmi_conj, npi_conj,ld_conj)
   61.26                           (Thm.cabs x p) (Thm.cabs x q))
   61.27          end
   61.28 -     | Const(@{const_name "op |"},_)$_$_ =>
   61.29 +     | Const(@{const_name HOL.disj},_)$_$_ =>
   61.30          let val (p,q) = Thm.dest_binop fm
   61.31          in ([p,q],myfwd (minf_disj, pinf_disj, nmi_disj, npi_disj,ld_disj)
   61.32                           (Thm.cabs x p) (Thm.cabs x q))
   61.33 @@ -175,15 +175,15 @@
   61.34   let
   61.35    fun h bounds tm =
   61.36     (case term_of tm of
   61.37 -     Const (@{const_name "op ="}, T) $ _ $ _ =>
   61.38 +     Const (@{const_name HOL.eq}, T) $ _ $ _ =>
   61.39         if domain_type T = HOLogic.boolT then find_args bounds tm
   61.40         else Thm.dest_fun2 tm
   61.41     | Const (@{const_name Not}, _) $ _ => h bounds (Thm.dest_arg tm)
   61.42     | Const (@{const_name All}, _) $ _ => find_body bounds (Thm.dest_arg tm)
   61.43     | Const (@{const_name Ex}, _) $ _ => find_body bounds (Thm.dest_arg tm)
   61.44 -   | Const (@{const_name "op &"}, _) $ _ $ _ => find_args bounds tm
   61.45 -   | Const (@{const_name "op |"}, _) $ _ $ _ => find_args bounds tm
   61.46 -   | Const (@{const_name "op -->"}, _) $ _ $ _ => find_args bounds tm
   61.47 +   | Const (@{const_name HOL.conj}, _) $ _ $ _ => find_args bounds tm
   61.48 +   | Const (@{const_name HOL.disj}, _) $ _ $ _ => find_args bounds tm
   61.49 +   | Const (@{const_name HOL.implies}, _) $ _ $ _ => find_args bounds tm
   61.50     | Const ("==>", _) $ _ $ _ => find_args bounds tm
   61.51     | Const ("==", _) $ _ $ _ => find_args bounds tm
   61.52     | Const ("all", _) $ _ => find_body bounds (Thm.dest_arg tm)
    62.1 --- a/src/HOL/Decision_Procs/langford.ML	Thu Sep 02 17:12:40 2010 +0200
    62.2 +++ b/src/HOL/Decision_Procs/langford.ML	Thu Sep 02 17:28:00 2010 +0200
    62.3 @@ -69,28 +69,28 @@
    62.4  val all_conjuncts = 
    62.5   let fun h acc ct = 
    62.6    case term_of ct of
    62.7 -   @{term "op &"}$_$_ => h (h acc (Thm.dest_arg ct)) (Thm.dest_arg1 ct)
    62.8 +   @{term HOL.conj}$_$_ => h (h acc (Thm.dest_arg ct)) (Thm.dest_arg1 ct)
    62.9    | _ => ct::acc
   62.10  in h [] end;
   62.11  
   62.12  fun conjuncts ct =
   62.13   case term_of ct of
   62.14 -  @{term "op &"}$_$_ => (Thm.dest_arg1 ct)::(conjuncts (Thm.dest_arg ct))
   62.15 +  @{term HOL.conj}$_$_ => (Thm.dest_arg1 ct)::(conjuncts (Thm.dest_arg ct))
   62.16  | _ => [ct];
   62.17  
   62.18  fun fold1 f = foldr1 (uncurry f);
   62.19  
   62.20 -val list_conj = fold1 (fn c => fn c' => Thm.capply (Thm.capply @{cterm "op &"} c) c') ;
   62.21 +val list_conj = fold1 (fn c => fn c' => Thm.capply (Thm.capply @{cterm HOL.conj} c) c') ;
   62.22  
   62.23  fun mk_conj_tab th = 
   62.24   let fun h acc th = 
   62.25     case prop_of th of
   62.26 -   @{term "Trueprop"}$(@{term "op &"}$p$q) => 
   62.27 +   @{term "Trueprop"}$(@{term HOL.conj}$p$q) => 
   62.28       h (h acc (th RS conjunct2)) (th RS conjunct1)
   62.29    | @{term "Trueprop"}$p => (p,th)::acc
   62.30  in fold (Termtab.insert Thm.eq_thm) (h [] th) Termtab.empty end;
   62.31  
   62.32 -fun is_conj (@{term "op &"}$_$_) = true
   62.33 +fun is_conj (@{term HOL.conj}$_$_) = true
   62.34    | is_conj _ = false;
   62.35  
   62.36  fun prove_conj tab cjs = 
   62.37 @@ -116,7 +116,7 @@
   62.38  fun contains x ct = member (op aconv) (OldTerm.term_frees (term_of ct)) (term_of x);
   62.39  
   62.40  fun is_eqx x eq = case term_of eq of
   62.41 -   Const(@{const_name "op ="},_)$l$r => l aconv term_of x orelse r aconv term_of x
   62.42 +   Const(@{const_name HOL.eq},_)$l$r => l aconv term_of x orelse r aconv term_of x
   62.43   | _ => false ;
   62.44  
   62.45  local 
   62.46 @@ -176,16 +176,16 @@
   62.47   let
   62.48    fun h bounds tm =
   62.49     (case term_of tm of
   62.50 -     Const (@{const_name "op ="}, T) $ _ $ _ =>
   62.51 +     Const (@{const_name HOL.eq}, T) $ _ $ _ =>
   62.52         if domain_type T = HOLogic.boolT then find_args bounds tm
   62.53         else Thm.dest_fun2 tm
   62.54     | Const (@{const_name Not}, _) $ _ => h bounds (Thm.dest_arg tm)
   62.55     | Const (@{const_name All}, _) $ _ => find_body bounds (Thm.dest_arg tm)
   62.56     | Const ("all", _) $ _ => find_body bounds (Thm.dest_arg tm)
   62.57     | Const (@{const_name Ex}, _) $ _ => find_body bounds (Thm.dest_arg tm)
   62.58 -   | Const (@{const_name "op &"}, _) $ _ $ _ => find_args bounds tm
   62.59 -   | Const (@{const_name "op |"}, _) $ _ $ _ => find_args bounds tm
   62.60 -   | Const (@{const_name "op -->"}, _) $ _ $ _ => find_args bounds tm
   62.61 +   | Const (@{const_name HOL.conj}, _) $ _ $ _ => find_args bounds tm
   62.62 +   | Const (@{const_name HOL.disj}, _) $ _ $ _ => find_args bounds tm
   62.63 +   | Const (@{const_name HOL.implies}, _) $ _ $ _ => find_args bounds tm
   62.64     | Const ("==>", _) $ _ $ _ => find_args bounds tm
   62.65     | Const ("==", _) $ _ $ _ => find_args bounds tm
   62.66     | Const (@{const_name Trueprop}, _) $ _ => h bounds (Thm.dest_arg tm)
    63.1 --- a/src/HOL/HOL.thy	Thu Sep 02 17:12:40 2010 +0200
    63.2 +++ b/src/HOL/HOL.thy	Thu Sep 02 17:28:00 2010 +0200
    63.3 @@ -30,6 +30,7 @@
    63.4    "~~/src/Tools/induct.ML"
    63.5    ("~~/src/Tools/induct_tacs.ML")
    63.6    ("Tools/recfun_codegen.ML")
    63.7 +  "Tools/try.ML"
    63.8  begin
    63.9  
   63.10  setup {* Intuitionistic.method_setup @{binding iprover} *}
   63.11 @@ -57,18 +58,12 @@
   63.12    False         :: bool
   63.13    Not           :: "bool => bool"                   ("~ _" [40] 40)
   63.14  
   63.15 -setup Sign.root_path
   63.16 +  conj          :: "[bool, bool] => bool"           (infixr "&" 35)
   63.17 +  disj          :: "[bool, bool] => bool"           (infixr "|" 30)
   63.18 +  implies       :: "[bool, bool] => bool"           (infixr "-->" 25)
   63.19  
   63.20 -consts
   63.21 -  "op &"        :: "[bool, bool] => bool"           (infixr "&" 35)
   63.22 -  "op |"        :: "[bool, bool] => bool"           (infixr "|" 30)
   63.23 -  "op -->"      :: "[bool, bool] => bool"           (infixr "-->" 25)
   63.24 +  eq            :: "['a, 'a] => bool"               (infixl "=" 50)
   63.25  
   63.26 -  "op ="        :: "['a, 'a] => bool"               (infixl "=" 50)
   63.27 -
   63.28 -setup Sign.local_path
   63.29 -
   63.30 -consts
   63.31    The           :: "('a => bool) => 'a"
   63.32    All           :: "('a => bool) => bool"           (binder "ALL " 10)
   63.33    Ex            :: "('a => bool) => bool"           (binder "EX " 10)
   63.34 @@ -78,7 +73,7 @@
   63.35  subsubsection {* Additional concrete syntax *}
   63.36  
   63.37  notation (output)
   63.38 -  "op ="  (infix "=" 50)
   63.39 +  eq  (infix "=" 50)
   63.40  
   63.41  abbreviation
   63.42    not_equal :: "['a, 'a] => bool"  (infixl "~=" 50) where
   63.43 @@ -89,15 +84,15 @@
   63.44  
   63.45  notation (xsymbols)
   63.46    Not  ("\<not> _" [40] 40) and
   63.47 -  "op &"  (infixr "\<and>" 35) and
   63.48 -  "op |"  (infixr "\<or>" 30) and
   63.49 -  "op -->"  (infixr "\<longrightarrow>" 25) and
   63.50 +  conj  (infixr "\<and>" 35) and
   63.51 +  disj  (infixr "\<or>" 30) and
   63.52 +  implies  (infixr "\<longrightarrow>" 25) and
   63.53    not_equal  (infix "\<noteq>" 50)
   63.54  
   63.55  notation (HTML output)
   63.56    Not  ("\<not> _" [40] 40) and
   63.57 -  "op &"  (infixr "\<and>" 35) and
   63.58 -  "op |"  (infixr "\<or>" 30) and
   63.59 +  conj  (infixr "\<and>" 35) and
   63.60 +  disj  (infixr "\<or>" 30) and
   63.61    not_equal  (infix "\<noteq>" 50)
   63.62  
   63.63  abbreviation (iff)
   63.64 @@ -183,8 +178,8 @@
   63.65    True_or_False:  "(P=True) | (P=False)"
   63.66  
   63.67  finalconsts
   63.68 -  "op ="
   63.69 -  "op -->"
   63.70 +  eq
   63.71 +  implies
   63.72    The
   63.73  
   63.74  definition If :: "bool \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" ("(if (_)/ then (_)/ else (_))" [0, 0, 10] 10) where
   63.75 @@ -864,7 +859,7 @@
   63.76  
   63.77  setup {*
   63.78  let
   63.79 -  fun non_bool_eq (@{const_name "op ="}, Type (_, [T, _])) = T <> @{typ bool}
   63.80 +  fun non_bool_eq (@{const_name HOL.eq}, Type (_, [T, _])) = T <> @{typ bool}
   63.81      | non_bool_eq _ = false;
   63.82    val hyp_subst_tac' =
   63.83      SUBGOAL (fn (goal, i) =>
   63.84 @@ -930,7 +925,7 @@
   63.85  (
   63.86    val thy = @{theory}
   63.87    type claset = Classical.claset
   63.88 -  val equality_name = @{const_name "op ="}
   63.89 +  val equality_name = @{const_name HOL.eq}
   63.90    val not_name = @{const_name Not}
   63.91    val notE = @{thm notE}
   63.92    val ccontr = @{thm ccontr}
   63.93 @@ -1578,7 +1573,7 @@
   63.94    val atomize_conjL = @{thm atomize_conjL}
   63.95    val atomize_disjL = @{thm atomize_disjL}
   63.96    val operator_names =
   63.97 -    [@{const_name "op |"}, @{const_name "op &"}, @{const_name Ex}]
   63.98 +    [@{const_name HOL.disj}, @{const_name HOL.conj}, @{const_name Ex}]
   63.99  );
  63.100  *}
  63.101  
  63.102 @@ -1737,8 +1732,8 @@
  63.103    "True"    ("true")
  63.104    "False"   ("false")
  63.105    "Not"     ("Bool.not")
  63.106 -  "op |"    ("(_ orelse/ _)")
  63.107 -  "op &"    ("(_ andalso/ _)")
  63.108 +  HOL.disj    ("(_ orelse/ _)")
  63.109 +  HOL.conj    ("(_ andalso/ _)")
  63.110    "If"      ("(if _/ then _/ else _)")
  63.111  
  63.112  setup {*
  63.113 @@ -1746,8 +1741,8 @@
  63.114  
  63.115  fun eq_codegen thy defs dep thyname b t gr =
  63.116      (case strip_comb t of
  63.117 -       (Const (@{const_name "op ="}, Type (_, [Type ("fun", _), _])), _) => NONE
  63.118 -     | (Const (@{const_name "op ="}, _), [t, u]) =>
  63.119 +       (Const (@{const_name HOL.eq}, Type (_, [Type ("fun", _), _])), _) => NONE
  63.120 +     | (Const (@{const_name HOL.eq}, _), [t, u]) =>
  63.121            let
  63.122              val (pt, gr') = Codegen.invoke_codegen thy defs dep thyname false t gr;
  63.123              val (pu, gr'') = Codegen.invoke_codegen thy defs dep thyname false u gr';
  63.124 @@ -1756,7 +1751,7 @@
  63.125              SOME (Codegen.parens
  63.126                (Pretty.block [pt, Codegen.str " =", Pretty.brk 1, pu]), gr''')
  63.127            end
  63.128 -     | (t as Const (@{const_name "op ="}, _), ts) => SOME (Codegen.invoke_codegen
  63.129 +     | (t as Const (@{const_name HOL.eq}, _), ts) => SOME (Codegen.invoke_codegen
  63.130           thy defs dep thyname b (Codegen.eta_expand t ts 2) gr)
  63.131       | _ => NONE);
  63.132  
  63.133 @@ -1775,31 +1770,30 @@
  63.134  
  63.135  subsubsection {* Equality *}
  63.136  
  63.137 -class eq =
  63.138 -  fixes eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  63.139 -  assumes eq_equals: "eq x y \<longleftrightarrow> x = y"
  63.140 +class equal =
  63.141 +  fixes equal :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  63.142 +  assumes equal_eq: "equal x y \<longleftrightarrow> x = y"
  63.143  begin
  63.144  
  63.145 -lemma eq [code_unfold, code_inline del]: "eq = (op =)"
  63.146 -  by (rule ext eq_equals)+
  63.147 +lemma equal [code_unfold, code_inline del]: "equal = (op =)"
  63.148 +  by (rule ext equal_eq)+
  63.149  
  63.150 -lemma eq_refl: "eq x x \<longleftrightarrow> True"
  63.151 -  unfolding eq by rule+
  63.152 +lemma equal_refl: "equal x x \<longleftrightarrow> True"
  63.153 +  unfolding equal by rule+
  63.154  
  63.155 -lemma equals_eq: "(op =) \<equiv> eq"
  63.156 -  by (rule eq_reflection) (rule ext, rule ext, rule sym, rule eq_equals)
  63.157 -
  63.158 -declare equals_eq [symmetric, code_post]
  63.159 +lemma eq_equal: "(op =) \<equiv> equal"
  63.160 +  by (rule eq_reflection) (rule ext, rule ext, rule sym, rule equal_eq)
  63.161  
  63.162  end
  63.163  
  63.164 -declare equals_eq [code]
  63.165 +declare eq_equal [symmetric, code_post]
  63.166 +declare eq_equal [code]
  63.167  
  63.168  setup {*
  63.169    Code_Preproc.map_pre (fn simpset =>
  63.170 -    simpset addsimprocs [Simplifier.simproc_global_i @{theory} "eq" [@{term "op ="}]
  63.171 +    simpset addsimprocs [Simplifier.simproc_global_i @{theory} "equal" [@{term HOL.eq}]
  63.172        (fn thy => fn _ => fn Const (_, T) => case strip_type T
  63.173 -        of (Type _ :: _, _) => SOME @{thm equals_eq}
  63.174 +        of (Type _ :: _, _) => SOME @{thm eq_equal}
  63.175           | _ => NONE)])
  63.176  *}
  63.177  
  63.178 @@ -1839,51 +1833,49 @@
  63.179      and "(P \<longrightarrow> False) \<longleftrightarrow> \<not> P"
  63.180      and "(P \<longrightarrow> True) \<longleftrightarrow> True" by simp_all
  63.181  
  63.182 -instantiation itself :: (type) eq
  63.183 +instantiation itself :: (type) equal
  63.184  begin
  63.185  
  63.186 -definition eq_itself :: "'a itself \<Rightarrow> 'a itself \<Rightarrow> bool" where
  63.187 -  "eq_itself x y \<longleftrightarrow> x = y"
  63.188 +definition equal_itself :: "'a itself \<Rightarrow> 'a itself \<Rightarrow> bool" where
  63.189 +  "equal_itself x y \<longleftrightarrow> x = y"
  63.190  
  63.191  instance proof
  63.192 -qed (fact eq_itself_def)
  63.193 +qed (fact equal_itself_def)
  63.194  
  63.195  end
  63.196  
  63.197 -lemma eq_itself_code [code]:
  63.198 -  "eq_class.eq TYPE('a) TYPE('a) \<longleftrightarrow> True"
  63.199 -  by (simp add: eq)
  63.200 +lemma equal_itself_code [code]:
  63.201 +  "equal TYPE('a) TYPE('a) \<longleftrightarrow> True"
  63.202 +  by (simp add: equal)
  63.203  
  63.204  text {* Equality *}
  63.205  
  63.206  declare simp_thms(6) [code nbe]
  63.207  
  63.208  setup {*
  63.209 -  Sign.add_const_constraint (@{const_name eq}, SOME @{typ "'a\<Colon>type \<Rightarrow> 'a \<Rightarrow> bool"})
  63.210 +  Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a\<Colon>type \<Rightarrow> 'a \<Rightarrow> bool"})
  63.211  *}
  63.212  
  63.213 -lemma equals_alias_cert: "OFCLASS('a, eq_class) \<equiv> ((op = :: 'a \<Rightarrow> 'a \<Rightarrow> bool) \<equiv> eq)" (is "?ofclass \<equiv> ?eq")
  63.214 +lemma equal_alias_cert: "OFCLASS('a, equal_class) \<equiv> ((op = :: 'a \<Rightarrow> 'a \<Rightarrow> bool) \<equiv> equal)" (is "?ofclass \<equiv> ?equal")
  63.215  proof
  63.216    assume "PROP ?ofclass"
  63.217 -  show "PROP ?eq"
  63.218 -    by (tactic {* ALLGOALS (rtac (Thm.unconstrainT @{thm equals_eq})) *})
  63.219 +  show "PROP ?equal"
  63.220 +    by (tactic {* ALLGOALS (rtac (Thm.unconstrainT @{thm eq_equal})) *})
  63.221        (fact `PROP ?ofclass`)
  63.222  next
  63.223 -  assume "PROP ?eq"
  63.224 +  assume "PROP ?equal"
  63.225    show "PROP ?ofclass" proof
  63.226 -  qed (simp add: `PROP ?eq`)
  63.227 +  qed (simp add: `PROP ?equal`)
  63.228  qed
  63.229    
  63.230  setup {*
  63.231 -  Sign.add_const_constraint (@{const_name eq}, SOME @{typ "'a\<Colon>eq \<Rightarrow> 'a \<Rightarrow> bool"})
  63.232 +  Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a\<Colon>equal \<Rightarrow> 'a \<Rightarrow> bool"})
  63.233  *}
  63.234  
  63.235  setup {*
  63.236 -  Nbe.add_const_alias @{thm equals_alias_cert}
  63.237 +  Nbe.add_const_alias @{thm equal_alias_cert}
  63.238  *}
  63.239  
  63.240 -hide_const (open) eq
  63.241 -
  63.242  text {* Cases *}
  63.243  
  63.244  lemma Let_case_cert:
  63.245 @@ -1904,9 +1896,10 @@
  63.246  
  63.247  code_abort undefined
  63.248  
  63.249 +
  63.250  subsubsection {* Generic code generator target languages *}
  63.251  
  63.252 -text {* type bool *}
  63.253 +text {* type @{typ bool} *}
  63.254  
  63.255  code_type bool
  63.256    (SML "bool")
  63.257 @@ -1914,7 +1907,7 @@
  63.258    (Haskell "Bool")
  63.259    (Scala "Boolean")
  63.260  
  63.261 -code_const True and False and Not and "op &" and "op |" and If
  63.262 +code_const True and False and Not and HOL.conj and HOL.disj and If
  63.263    (SML "true" and "false" and "not"
  63.264      and infixl 1 "andalso" and infixl 0 "orelse"
  63.265      and "!(if (_)/ then (_)/ else (_))")
  63.266 @@ -1924,7 +1917,7 @@
  63.267    (Haskell "True" and "False" and "not"
  63.268      and infixl 3 "&&" and infixl 2 "||"
  63.269      and "!(if (_)/ then (_)/ else (_))")
  63.270 -  (Scala "true" and "false" and "'!/ _"
  63.271 +  (Scala "true" and "false" and "'! _"
  63.272      and infixl 3 "&&" and infixl 1 "||"
  63.273      and "!(if ((_))/ (_)/ else (_))")
  63.274  
  63.275 @@ -1939,13 +1932,13 @@
  63.276  
  63.277  text {* using built-in Haskell equality *}
  63.278  
  63.279 -code_class eq
  63.280 +code_class equal
  63.281    (Haskell "Eq")
  63.282  
  63.283 -code_const "eq_class.eq"
  63.284 +code_const "HOL.equal"
  63.285    (Haskell infixl 4 "==")
  63.286  
  63.287 -code_const "op ="
  63.288 +code_const HOL.eq
  63.289    (Haskell infixl 4 "==")
  63.290  
  63.291  text {* undefined *}
  63.292 @@ -2134,4 +2127,6 @@
  63.293  
  63.294  *}
  63.295  
  63.296 +hide_const (open) eq equal
  63.297 +
  63.298  end
    65.1 --- a/src/HOL/Imperative_HOL/Heap_Monad.thy	Thu Sep 02 17:12:40 2010 +0200
    65.2 +++ b/src/HOL/Imperative_HOL/Heap_Monad.thy	Thu Sep 02 17:28:00 2010 +0200
    65.3 @@ -477,34 +477,44 @@
    65.4  subsubsection {* Scala *}
    65.5  
    65.6  code_include Scala "Heap"
    65.7 -{*import collection.mutable.ArraySeq
    65.8 -import Natural._
    65.9 -
   65.10 -def bind[A, B](f: Unit => A, g: A => Unit => B): Unit => B = (_: Unit) => g (f ()) ()
   65.11 +{*object Heap {
   65.12 +  def bind[A, B](f: Unit => A, g: A => Unit => B): Unit => B = (_: Unit) => g (f ()) ()
   65.13 +}
   65.14  
   65.15  class Ref[A](x: A) {
   65.16    var value = x
   65.17  }
   65.18  
   65.19  object Ref {
   65.20 -  def apply[A](x: A): Ref[A] = new Ref[A](x)
   65.21 -  def lookup[A](r: Ref[A]): A = r.value
   65.22 -  def update[A](r: Ref[A], x: A): Unit = { r.value = x }
   65.23 +  def apply[A](x: A): Ref[A] =
   65.24 +    new Ref[A](x)
   65.25 +  def lookup[A](r: Ref[A]): A =
   65.26 +    r.value
   65.27 +  def update[A](r: Ref[A], x: A): Unit =
   65.28 +    { r.value = x }
   65.29  }
   65.30  
   65.31  object Array {
   65.32 -  def alloc[A](n: Natural)(x: A): ArraySeq[A] = ArraySeq.fill(n.as_Int)(x)
   65.33 -  def make[A](n: Natural)(f: Natural => A): ArraySeq[A] = ArraySeq.tabulate(n.as_Int)((k: Int) => f(Natural(k)))
   65.34 -  def len[A](a: ArraySeq[A]): Natural = Natural(a.length)
   65.35 -  def nth[A](a: ArraySeq[A], n: Natural): A = a(n.as_Int)
   65.36 -  def upd[A](a: ArraySeq[A], n: Natural, x: A): Unit = a.update(n.as_Int, x)
   65.37 -  def freeze[A](a: ArraySeq[A]): List[A] = a.toList
   65.38 -}*}
   65.39 +  import collection.mutable.ArraySeq
   65.40 +  def alloc[A](n: Natural)(x: A): ArraySeq[A] =
   65.41 +    ArraySeq.fill(n.as_Int)(x)
   65.42 +  def make[A](n: Natural)(f: Natural => A): ArraySeq[A] =
   65.43 +    ArraySeq.tabulate(n.as_Int)((k: Int) => f(Natural(k)))
   65.44 +  def len[A](a: ArraySeq[A]): Natural =
   65.45 +    Natural(a.length)
   65.46 +  def nth[A](a: ArraySeq[A], n: Natural): A =
   65.47 +    a(n.as_Int)
   65.48 +  def upd[A](a: ArraySeq[A], n: Natural, x: A): Unit =
   65.49 +    a.update(n.as_Int, x)
   65.50 +  def freeze[A](a: ArraySeq[A]): List[A] =
   65.51 +    a.toList
   65.52 +}
   65.53 +*}
   65.54  
   65.55 -code_reserved Scala bind Ref Array
   65.56 +code_reserved Scala Heap Ref Array
   65.57  
   65.58  code_type Heap (Scala "Unit/ =>/ _")
   65.59 -code_const bind (Scala "bind")
   65.60 +code_const bind (Scala "Heap.bind")
   65.61  code_const return (Scala "('_: Unit)/ =>/ _")
   65.62  code_const Heap_Monad.raise' (Scala "!error((_))")
   65.63  
    67.1 --- a/src/HOL/Import/Generate-HOL/GenHOL4Base.thy	Thu Sep 02 17:12:40 2010 +0200
    67.2 +++ b/src/HOL/Import/Generate-HOL/GenHOL4Base.thy	Thu Sep 02 17:28:00 2010 +0200
    67.3 @@ -17,8 +17,8 @@
    67.4    T               > True
    67.5    F               > False
    67.6    "!"             > All
    67.7 -  "/\\"           > "op &"
    67.8 -  "\\/"           > "op |"
    67.9 +  "/\\"           > HOL.conj
   67.10 +  "\\/"           > HOL.disj
   67.11    "?"             > Ex
   67.12    "?!"            > Ex1
   67.13    "~"             > Not
    68.1 --- a/src/HOL/Import/Generate-HOLLight/GenHOLLight.thy	Thu Sep 02 17:12:40 2010 +0200
    68.2 +++ b/src/HOL/Import/Generate-HOLLight/GenHOLLight.thy	Thu Sep 02 17:28:00 2010 +0200
    68.3 @@ -53,10 +53,10 @@
    68.4    F > False
    68.5    ONE_ONE > HOL4Setup.ONE_ONE
    68.6    ONTO    > Fun.surj
    68.7 -  "=" > "op ="
    68.8 -  "==>" > "op -->"
    68.9 -  "/\\" > "op &"
   68.10 -  "\\/" > "op |"
   68.11 +  "=" > HOL.eq
   68.12 +  "==>" > HOL.implies
   68.13 +  "/\\" > HOL.conj
   68.14 +  "\\/" > HOL.disj
   68.15    "!" > All
   68.16    "?" > Ex
   68.17    "?!" > Ex1
    69.1 --- a/src/HOL/Import/HOL/bool.imp	Thu Sep 02 17:12:40 2010 +0200
    69.2 +++ b/src/HOL/Import/HOL/bool.imp	Thu Sep 02 17:28:00 2010 +0200
    69.3 @@ -14,7 +14,7 @@
    69.4  const_maps
    69.5    "~" > "HOL.Not"
    69.6    "bool_case" > "Datatype.bool.bool_case"
    69.7 -  "\\/" > "op |"
    69.8 +  "\\/" > HOL.disj
    69.9    "TYPE_DEFINITION" > "HOL4Setup.TYPE_DEFINITION"
   69.10    "T" > "HOL.True"
   69.11    "RES_SELECT" > "HOL4Base.bool.RES_SELECT"
   69.12 @@ -30,7 +30,7 @@
   69.13    "ARB" > "HOL4Base.bool.ARB"
   69.14    "?!" > "HOL.Ex1"
   69.15    "?" > "HOL.Ex"
   69.16 -  "/\\" > "op &"
   69.17 +  "/\\" > HOL.conj
   69.18    "!" > "HOL.All"
   69.19  
   69.20  thm_maps
    70.1 --- a/src/HOL/Import/HOLLight/hollight.imp	Thu Sep 02 17:12:40 2010 +0200
    70.2 +++ b/src/HOL/Import/HOLLight/hollight.imp	Thu Sep 02 17:28:00 2010 +0200
    70.3 @@ -115,7 +115,7 @@
    70.4    "_10303" > "HOLLight.hollight._10303"
    70.5    "_10302" > "HOLLight.hollight._10302"
    70.6    "_0" > "0" :: "nat"
    70.7 -  "\\/" > "op |"
    70.8 +  "\\/" > HOL.disj
    70.9    "ZRECSPACE" > "HOLLight.hollight.ZRECSPACE"
   70.10    "ZIP" > "HOLLight.hollight.ZIP"
   70.11    "ZCONSTR" > "HOLLight.hollight.ZCONSTR"
   70.12 @@ -233,11 +233,11 @@
   70.13    "?" > "HOL.Ex"
   70.14    ">=" > "HOLLight.hollight.>="
   70.15    ">" > "HOLLight.hollight.>"
   70.16 -  "==>" > "op -->"
   70.17 -  "=" > "op ="
   70.18 +  "==>" > HOL.implies
   70.19 +  "=" > HOL.eq
   70.20    "<=" > "HOLLight.hollight.<="
   70.21    "<" > "HOLLight.hollight.<"
   70.22 -  "/\\" > "op &"
   70.23 +  "/\\" > HOL.conj
   70.24    "-" > "Groups.minus" :: "nat => nat => nat"
   70.25    "," > "Product_Type.Pair"
   70.26    "+" > "Groups.plus" :: "nat => nat => nat"
    71.1 --- a/src/HOL/Import/hol4rews.ML	Thu Sep 02 17:12:40 2010 +0200
    71.2 +++ b/src/HOL/Import/hol4rews.ML	Thu Sep 02 17:28:00 2010 +0200
    71.3 @@ -627,8 +627,8 @@
    71.4          thy |> add_hol4_type_mapping "min" "bool" false @{type_name bool}
    71.5              |> add_hol4_type_mapping "min" "fun" false "fun"
    71.6              |> add_hol4_type_mapping "min" "ind" false @{type_name ind}
    71.7 -            |> add_hol4_const_mapping "min" "=" false @{const_name "op ="}
    71.8 -            |> add_hol4_const_mapping "min" "==>" false @{const_name "op -->"}
    71.9 +            |> add_hol4_const_mapping "min" "=" false @{const_name HOL.eq}
   71.10 +            |> add_hol4_const_mapping "min" "==>" false @{const_name HOL.implies}
   71.11              |> add_hol4_const_mapping "min" "@" false @{const_name "Eps"}
   71.12  in
   71.13  val hol4_setup =
    72.1 --- a/src/HOL/Import/import_syntax.ML	Thu Sep 02 17:12:40 2010 +0200
    72.2 +++ b/src/HOL/Import/import_syntax.ML	Thu Sep 02 17:28:00 2010 +0200
    72.3 @@ -148,11 +148,11 @@
    72.4          val _ = TextIO.closeIn is
    72.5          val orig_source = Source.of_string inp
    72.6          val symb_source = Symbol.source {do_recover = false} orig_source
    72.7 -        val lexes = Unsynchronized.ref
    72.8 -          (Scan.make_lexicon (map Symbol.explode ["import_segment","ignore_thms","import","end",">","::","const_maps","const_moves","thm_maps","const_renames","type_maps","def_maps"]),
    72.9 +        val lexes =
   72.10 +          (Scan.make_lexicon
   72.11 +            (map Symbol.explode ["import_segment","ignore_thms","import","end",">","::","const_maps","const_moves","thm_maps","const_renames","type_maps","def_maps"]),
   72.12                    Scan.empty_lexicon)
   72.13 -        val get_lexes = fn () => !lexes
   72.14 -        val token_source = Token.source {do_recover = NONE} get_lexes Position.start symb_source
   72.15 +        val token_source = Token.source {do_recover = NONE} (K lexes) Position.start symb_source
   72.16          val token_list = filter_out (Token.is_kind Token.Space) (Source.exhaust token_source)
   72.17          val import_segmentP = Parse.$$$ "import_segment" |-- import_segment
   72.18          val type_mapsP = Parse.$$$ "type_maps" |-- type_maps
    73.1 --- a/src/HOL/Import/proof_kernel.ML	Thu Sep 02 17:12:40 2010 +0200
    73.2 +++ b/src/HOL/Import/proof_kernel.ML	Thu Sep 02 17:28:00 2010 +0200
    73.3 @@ -1205,7 +1205,7 @@
    73.4  fun non_trivial_term_consts t = fold_aterms
    73.5    (fn Const (c, _) =>
    73.6        if c = @{const_name Trueprop} orelse c = @{const_name All}
    73.7 -        orelse c = @{const_name "op -->"} orelse c = @{const_name "op &"} orelse c = @{const_name "op ="}
    73.8 +        orelse c = @{const_name HOL.implies} orelse c = @{const_name HOL.conj} orelse c = @{const_name HOL.eq}
    73.9        then I else insert (op =) c
   73.10      | _ => I) t [];
   73.11  
   73.12 @@ -1213,11 +1213,11 @@
   73.13      let
   73.14          fun add_consts (Const (c, _), cs) =
   73.15              (case c of
   73.16 -                 @{const_name "op ="} => insert (op =) "==" cs
   73.17 -               | @{const_name "op -->"} => insert (op =) "==>" cs
   73.18 +                 @{const_name HOL.eq} => insert (op =) "==" cs
   73.19 +               | @{const_name HOL.implies} => insert (op =) "==>" cs
   73.20                 | @{const_name All} => cs
   73.21                 | "all" => cs
   73.22 -               | @{const_name "op &"} => cs
   73.23 +               | @{const_name HOL.conj} => cs
   73.24                 | @{const_name Trueprop} => cs
   73.25                 | _ => insert (op =) c cs)
   73.26            | add_consts (t $ u, cs) = add_consts (t, add_consts (u, cs))
   73.27 @@ -1476,10 +1476,10 @@
   73.28  fun mk_COMB th1 th2 thy =
   73.29      let
   73.30          val (f,g) = case concl_of th1 of
   73.31 -                        _ $ (Const(@{const_name "op ="},_) $ f $ g) => (f,g)
   73.32 +                        _ $ (Const(@{const_name HOL.eq},_) $ f $ g) => (f,g)
   73.33                        | _ => raise ERR "mk_COMB" "First theorem not an equality"
   73.34          val (x,y) = case concl_of th2 of
   73.35 -                        _ $ (Const(@{const_name "op ="},_) $ x $ y) => (x,y)
   73.36 +                        _ $ (Const(@{const_name HOL.eq},_) $ x $ y) => (x,y)
   73.37                        | _ => raise ERR "mk_COMB" "Second theorem not an equality"
   73.38          val fty = type_of f
   73.39          val (fd,fr) = dom_rng fty
   73.40 @@ -1521,7 +1521,7 @@
   73.41          val th1 = norm_hyps th1
   73.42          val th2 = norm_hyps th2
   73.43          val (l,r) = case concl_of th of
   73.44 -                        _ $ (Const(@{const_name "op |"},_) $ l $ r) => (l,r)
   73.45 +                        _ $ (Const(@{const_name HOL.disj},_) $ l $ r) => (l,r)
   73.46                        | _ => raise ERR "DISJ_CASES" "Conclusion not a disjunction"
   73.47          val th1' = rearrange thy (HOLogic.mk_Trueprop l) th1
   73.48          val th2' = rearrange thy (HOLogic.mk_Trueprop r) th2
   73.49 @@ -1788,7 +1788,7 @@
   73.50          val cv = cterm_of thy v
   73.51          val th1 = implies_elim_all (beta_eta_thm th)
   73.52          val (f,g) = case concl_of th1 of
   73.53 -                        _ $ (Const(@{const_name "op ="},_) $ f $ g) => (Term.lambda v f,Term.lambda v g)
   73.54 +                        _ $ (Const(@{const_name HOL.eq},_) $ f $ g) => (Term.lambda v f,Term.lambda v g)
   73.55                        | _ => raise ERR "mk_ABS" "Bad conclusion"
   73.56          val (fd,fr) = dom_rng (type_of f)
   73.57          val abs_thm' = Drule.instantiate' [SOME (ctyp_of thy fd), SOME (ctyp_of thy fr)] [SOME (cterm_of thy f), SOME (cterm_of thy g)] abs_thm
   73.58 @@ -1860,7 +1860,7 @@
   73.59          val _ = if_debug pth hth
   73.60          val th1 = implies_elim_all (beta_eta_thm th)
   73.61          val a = case concl_of th1 of
   73.62 -                    _ $ (Const(@{const_name "op -->"},_) $ a $ Const(@{const_name False},_)) => a
   73.63 +                    _ $ (Const(@{const_name HOL.implies},_) $ a $ Const(@{const_name False},_)) => a
   73.64                    | _ => raise ERR "NOT_INTRO" "Conclusion of bad form"
   73.65          val ca = cterm_of thy a
   73.66          val th2 = Thm.equal_elim (Drule.instantiate' [] [SOME ca] not_intro_thm) th1
    74.1 --- a/src/HOL/Import/shuffler.ML	Thu Sep 02 17:12:40 2010 +0200
    74.2 +++ b/src/HOL/Import/shuffler.ML	Thu Sep 02 17:28:00 2010 +0200
    74.3 @@ -60,14 +60,14 @@
    74.4  
    74.5  fun mk_meta_eq th =
    74.6      (case concl_of th of
    74.7 -         Const(@{const_name Trueprop},_) $ (Const(@{const_name "op ="},_) $ _ $ _) => th RS eq_reflection
    74.8 +         Const(@{const_name Trueprop},_) $ (Const(@{const_name HOL.eq},_) $ _ $ _) => th RS eq_reflection
    74.9         | Const("==",_) $ _ $ _ => th
   74.10         | _ => raise THM("Not an equality",0,[th]))
   74.11      handle _ => raise THM("Couldn't make meta equality",0,[th])  (* FIXME avoid handle _ *)
   74.12  
   74.13  fun mk_obj_eq th =
   74.14      (case concl_of th of
   74.15 -         Const(@{const_name Trueprop},_) $ (Const(@{const_name "op ="},_) $ _ $ _) => th
   74.16 +         Const(@{const_name Trueprop},_) $ (Const(@{const_name HOL.eq},_) $ _ $ _) => th
   74.17         | Const("==",_) $ _ $ _ => th RS meta_eq_to_obj_eq
   74.18         | _ => raise THM("Not an equality",0,[th]))
   74.19      handle _ => raise THM("Couldn't make object equality",0,[th])  (* FIXME avoid handle _ *)
    75.1 --- a/src/HOL/Int.thy	Thu Sep 02 17:12:40 2010 +0200
    75.2 +++ b/src/HOL/Int.thy	Thu Sep 02 17:28:00 2010 +0200
    75.3 @@ -2222,42 +2222,42 @@
    75.4    mult_bin_simps
    75.5    arith_extra_simps(4) [where 'a = int]
    75.6  
    75.7 -instantiation int :: eq
    75.8 +instantiation int :: equal
    75.9  begin
   75.10  
   75.11  definition
   75.12 -  "eq_class.eq k l \<longleftrightarrow> k - l = (0\<Colon>int)"
   75.13 -
   75.14 -instance by default (simp add: eq_int_def)
   75.15 +  "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
   75.16 +
   75.17 +instance by default (simp add: equal_int_def)
   75.18  
   75.19  end
   75.20  
   75.21  lemma eq_number_of_int_code [code]:
   75.22 -  "eq_class.eq (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> eq_class.eq k l"
   75.23 -  unfolding eq_int_def number_of_is_id ..
   75.24 +  "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
   75.25 +  unfolding equal_int_def number_of_is_id ..
   75.26  
   75.27  lemma eq_int_code [code]:
   75.28 -  "eq_class.eq Int.Pls Int.Pls \<longleftrightarrow> True"
   75.29 -  "eq_class.eq Int.Pls Int.Min \<longleftrightarrow> False"
   75.30 -  "eq_class.eq Int.Pls (Int.Bit0 k2) \<longleftrightarrow> eq_class.eq Int.Pls k2"
   75.31 -  "eq_class.eq Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
   75.32 -  "eq_class.eq Int.Min Int.Pls \<longleftrightarrow> False"
   75.33 -  "eq_class.eq Int.Min Int.Min \<longleftrightarrow> True"
   75.34 -  "eq_class.eq Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
   75.35 -  "eq_class.eq Int.Min (Int.Bit1 k2) \<longleftrightarrow> eq_class.eq Int.Min k2"
   75.36 -  "eq_class.eq (Int.Bit0 k1) Int.Pls \<longleftrightarrow> eq_class.eq k1 Int.Pls"
   75.37 -  "eq_class.eq (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
   75.38 -  "eq_class.eq (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
   75.39 -  "eq_class.eq (Int.Bit1 k1) Int.Min \<longleftrightarrow> eq_class.eq k1 Int.Min"
   75.40 -  "eq_class.eq (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> eq_class.eq k1 k2"
   75.41 -  "eq_class.eq (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
   75.42 -  "eq_class.eq (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
   75.43 -  "eq_class.eq (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> eq_class.eq k1 k2"
   75.44 -  unfolding eq_equals by simp_all
   75.45 +  "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
   75.46 +  "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
   75.47 +  "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
   75.48 +  "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
   75.49 +  "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
   75.50 +  "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
   75.51 +  "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
   75.52 +  "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
   75.53 +  "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
   75.54 +  "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
   75.55 +  "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
   75.56 +  "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
   75.57 +  "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
   75.58 +  "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
   75.59 +  "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
   75.60 +  "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
   75.61 +  unfolding equal_eq by simp_all
   75.62  
   75.63  lemma eq_int_refl [code nbe]:
   75.64 -  "eq_class.eq (k::int) k \<longleftrightarrow> True"
   75.65 -  by (rule HOL.eq_refl)
   75.66 +  "HOL.equal (k::int) k \<longleftrightarrow> True"
   75.67 +  by (rule equal_refl)
   75.68  
   75.69  lemma less_eq_number_of_int_code [code]:
   75.70    "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
    76.1 --- a/src/HOL/IsaMakefile	Thu Sep 02 17:12:40 2010 +0200
    76.2 +++ b/src/HOL/IsaMakefile	Thu Sep 02 17:28:00 2010 +0200
    76.3 @@ -110,6 +110,7 @@
    76.4    $(SRC)/Tools/Code/code_eval.ML \
    76.5    $(SRC)/Tools/Code/code_haskell.ML \
    76.6    $(SRC)/Tools/Code/code_ml.ML \
    76.7 +  $(SRC)/Tools/Code/code_namespace.ML \
    76.8    $(SRC)/Tools/Code/code_preproc.ML \
    76.9    $(SRC)/Tools/Code/code_printer.ML \
   76.10    $(SRC)/Tools/Code/code_scala.ML \
   76.11 @@ -213,6 +214,7 @@
   76.12    Tools/sat_funcs.ML \
   76.13    Tools/sat_solver.ML \
   76.14    Tools/split_rule.ML \
   76.15 +  Tools/try.ML \
   76.16    Tools/typedef.ML \
   76.17    Transitive_Closure.thy \
   76.18    Typedef.thy \
   76.19 @@ -1322,7 +1324,8 @@
   76.20    Predicate_Compile_Examples/Predicate_Compile_Examples.thy		\
   76.21    Predicate_Compile_Examples/Predicate_Compile_Quickcheck_Examples.thy  \
   76.22    Predicate_Compile_Examples/Code_Prolog_Examples.thy 			\
   76.23 -  Predicate_Compile_Examples/Hotel_Example.thy
   76.24 +  Predicate_Compile_Examples/Hotel_Example.thy 				\
   76.25 +  Predicate_Compile_Examples/Lambda_Example.thy 
   76.26  	@$(ISABELLE_TOOL) usedir $(OUT)/HOL Predicate_Compile_Examples
   76.27  
   76.28  
    77.1 --- a/src/HOL/Lazy_Sequence.thy	Thu Sep 02 17:12:40 2010 +0200
    77.2 +++ b/src/HOL/Lazy_Sequence.thy	Thu Sep 02 17:28:00 2010 +0200
    77.3 @@ -39,10 +39,14 @@
    77.4    "size xq = (case yield xq of None => 0 | Some (x, xq') => size xq' + 1)"
    77.5  by (cases xq) auto
    77.6  
    77.7 -lemma [code]: "eq_class.eq xq yq = (case (yield xq, yield yq) of
    77.8 -  (None, None) => True | (Some (x, xq'), Some (y, yq')) => (HOL.eq x y) \<and> (eq_class.eq xq yq) | _ => False)"
    77.9 -apply (cases xq) apply (cases yq) apply (auto simp add: eq_class.eq_equals) 
   77.10 -apply (cases yq) apply (auto simp add: eq_class.eq_equals) done
   77.11 +lemma [code]: "HOL.equal xq yq = (case (yield xq, yield yq) of
   77.12 +  (None, None) => True | (Some (x, xq'), Some (y, yq')) => (HOL.equal x y) \<and> (HOL.equal xq yq) | _ => False)"
   77.13 +apply (cases xq) apply (cases yq) apply (auto simp add: equal_eq) 
   77.14 +apply (cases yq) apply (auto simp add: equal_eq) done
   77.15 +
   77.16 +lemma [code nbe]:
   77.17 +  "HOL.equal (x :: 'a lazy_sequence) x \<longleftrightarrow> True"
   77.18 +  by (fact equal_refl)
   77.19  
   77.20  lemma seq_case [code]:
   77.21    "lazy_sequence_case f g xq = (case (yield xq) of None => f | Some (x, xq') => g x xq')"
    78.1 --- a/src/HOL/Library/AssocList.thy	Thu Sep 02 17:12:40 2010 +0200
    78.2 +++ b/src/HOL/Library/AssocList.thy	Thu Sep 02 17:28:00 2010 +0200
    78.3 @@ -701,7 +701,44 @@
    78.4    "Mapping.bulkload vs = Mapping (map (\<lambda>n. (n, vs ! n)) [0..<length vs])"
    78.5    by (rule mapping_eqI) (simp add: map_of_map_restrict expand_fun_eq)
    78.6  
    78.7 -lemma [code, code del]:
    78.8 -  "HOL.eq (x :: (_, _) mapping) y \<longleftrightarrow> x = y" by (fact eq_equals) (*FIXME*)
    78.9 +lemma map_of_eqI: (*FIXME move to Map.thy*)
   78.10 +  assumes set_eq: "set (map fst xs) = set (map fst ys)"
   78.11 +  assumes map_eq: "\<forall>k\<in>set (map fst xs). map_of xs k = map_of ys k"
   78.12 +  shows "map_of xs = map_of ys"
   78.13 +proof (rule ext)
   78.14 +  fix k show "map_of xs k = map_of ys k"
   78.15 +  proof (cases "map_of xs k")
   78.16 +    case None then have "k \<notin> set (map fst xs)" by (simp add: map_of_eq_None_iff)
   78.17 +    with set_eq have "k \<notin> set (map fst ys)" by simp
   78.18 +    then have "map_of ys k = None" by (simp add: map_of_eq_None_iff)
   78.19 +    with None show ?thesis by simp
   78.20 +  next
   78.21 +    case (Some v) then have "k \<in> set (map fst xs)" by (auto simp add: dom_map_of_conv_image_fst [symmetric])
   78.22 +    with map_eq show ?thesis by auto
   78.23 +  qed
   78.24 +qed
   78.25 +
   78.26 +lemma map_of_eq_dom: (*FIXME move to Map.thy*)
   78.27 +  assumes "map_of xs = map_of ys"
   78.28 +  shows "fst ` set xs = fst ` set ys"
   78.29 +proof -
   78.30 +  from assms have "dom (map_of xs) = dom (map_of ys)" by simp
   78.31 +  then show ?thesis by (simp add: dom_map_of_conv_image_fst)
   78.32 +qed
   78.33 +
   78.34 +lemma equal_Mapping [code]:
   78.35 +  "HOL.equal (Mapping xs) (Mapping ys) \<longleftrightarrow>
   78.36 +    (let ks = map fst xs; ls = map fst ys
   78.37 +    in (\<forall>l\<in>set ls. l \<in> set ks) \<and> (\<forall>k\<in>set ks. k \<in> set ls \<and> map_of xs k = map_of ys k))"
   78.38 +proof -
   78.39 +  have aux: "\<And>a b xs. (a, b) \<in> set xs \<Longrightarrow> a \<in> fst ` set xs" by (auto simp add: image_def intro!: bexI)
   78.40 +  show ?thesis
   78.41 +    by (auto intro!: map_of_eqI simp add: Let_def equal Mapping_def)
   78.42 +      (auto dest!: map_of_eq_dom intro: aux)
   78.43 +qed
   78.44 +
   78.45 +lemma [code nbe]:
   78.46 +  "HOL.equal (x :: ('a, 'b) mapping) x \<longleftrightarrow> True"
   78.47 +  by (fact equal_refl)
   78.48  
   78.49  end
    79.1 --- a/src/HOL/Library/Code_Char.thy	Thu Sep 02 17:12:40 2010 +0200
    79.2 +++ b/src/HOL/Library/Code_Char.thy	Thu Sep 02 17:28:00 2010 +0200
    79.3 @@ -19,7 +19,7 @@
    79.4    #> String_Code.add_literal_list_string "Haskell"
    79.5  *}
    79.6  
    79.7 -code_instance char :: eq
    79.8 +code_instance char :: equal
    79.9    (Haskell -)
   79.10  
   79.11  code_reserved SML
   79.12 @@ -31,7 +31,7 @@
   79.13  code_reserved Scala
   79.14    char
   79.15  
   79.16 -code_const "eq_class.eq \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
   79.17 +code_const "HOL.equal \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
   79.18    (SML "!((_ : char) = _)")
   79.19    (OCaml "!((_ : char) = _)")
   79.20    (Haskell infixl 4 "==")
    80.1 --- a/src/HOL/Library/Code_Integer.thy	Thu Sep 02 17:12:40 2010 +0200
    80.2 +++ b/src/HOL/Library/Code_Integer.thy	Thu Sep 02 17:28:00 2010 +0200
    80.3 @@ -21,7 +21,7 @@
    80.4    (Scala "BigInt")
    80.5    (Eval "int")
    80.6  
    80.7 -code_instance int :: eq
    80.8 +code_instance int :: equal
    80.9    (Haskell -)
   80.10  
   80.11  setup {*
   80.12 @@ -51,14 +51,14 @@
   80.13    (SML "IntInf.- ((_), 1)")
   80.14    (OCaml "Big'_int.pred'_big'_int")
   80.15    (Haskell "!(_/ -/ 1)")
   80.16 -  (Scala "!(_/ -/ 1)")
   80.17 +  (Scala "!(_ -/ 1)")
   80.18    (Eval "!(_/ -/ 1)")
   80.19  
   80.20  code_const Int.succ
   80.21    (SML "IntInf.+ ((_), 1)")
   80.22    (OCaml "Big'_int.succ'_big'_int")
   80.23    (Haskell "!(_/ +/ 1)")
   80.24 -  (Scala "!(_/ +/ 1)")
   80.25 +  (Scala "!(_ +/ 1)")
   80.26    (Eval "!(_/ +/ 1)")
   80.27  
   80.28  code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
   80.29 @@ -96,7 +96,7 @@
   80.30    (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
   80.31    (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
   80.32  
   80.33 -code_const "eq_class.eq \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
   80.34 +code_const "HOL.equal \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
   80.35    (SML "!((_ : IntInf.int) = _)")
   80.36    (OCaml "Big'_int.eq'_big'_int")
   80.37    (Haskell infixl 4 "==")
    81.1 --- a/src/HOL/Library/Code_Natural.thy	Thu Sep 02 17:12:40 2010 +0200
    81.2 +++ b/src/HOL/Library/Code_Natural.thy	Thu Sep 02 17:28:00 2010 +0200
    81.3 @@ -52,12 +52,11 @@
    81.4      | otherwise = (Natural k, Natural l) where (k, l) = quotRem n m;
    81.5  };*}
    81.6  
    81.7 +
    81.8  code_reserved Haskell Natural
    81.9  
   81.10 -code_include Scala "Natural" {*
   81.11 -import scala.Math
   81.12 -
   81.13 -object Natural {
   81.14 +code_include Scala "Natural"
   81.15 +{*object Natural {
   81.16  
   81.17    def apply(numeral: BigInt): Natural = new Natural(numeral max 0)
   81.18    def apply(numeral: Int): Natural = Natural(BigInt(numeral))
   81.19 @@ -111,7 +110,7 @@
   81.20      false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
   81.21  *}
   81.22  
   81.23 -code_instance code_numeral :: eq
   81.24 +code_instance code_numeral :: equal
   81.25    (Haskell -)
   81.26  
   81.27  code_const "op + \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   81.28 @@ -130,7 +129,7 @@
   81.29    (Haskell "divMod")
   81.30    (Scala infixl 8 "/%")
   81.31  
   81.32 -code_const "eq_class.eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   81.33 +code_const "HOL.equal \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   81.34    (Haskell infixl 4 "==")
   81.35    (Scala infixl 5 "==")
   81.36  
    82.1 --- a/src/HOL/Library/Dlist.thy	Thu Sep 02 17:12:40 2010 +0200
    82.2 +++ b/src/HOL/Library/Dlist.thy	Thu Sep 02 17:28:00 2010 +0200
    82.3 @@ -109,16 +109,20 @@
    82.4  
    82.5  text {* Equality *}
    82.6  
    82.7 -instantiation dlist :: (eq) eq
    82.8 +instantiation dlist :: (equal) equal
    82.9  begin
   82.10  
   82.11 -definition "HOL.eq dxs dys \<longleftrightarrow> HOL.eq (list_of_dlist dxs) (list_of_dlist dys)"
   82.12 +definition "HOL.equal dxs dys \<longleftrightarrow> HOL.equal (list_of_dlist dxs) (list_of_dlist dys)"
   82.13  
   82.14  instance proof
   82.15 -qed (simp add: eq_dlist_def eq list_of_dlist_inject)
   82.16 +qed (simp add: equal_dlist_def equal list_of_dlist_inject)
   82.17  
   82.18  end
   82.19  
   82.20 +lemma [code nbe]:
   82.21 +  "HOL.equal (dxs :: 'a::equal dlist) dxs \<longleftrightarrow> True"
   82.22 +  by (fact equal_refl)
   82.23 +
   82.24  
   82.25  section {* Induction principle and case distinction *}
   82.26  
    83.1 --- a/src/HOL/Library/Efficient_Nat.thy	Thu Sep 02 17:12:40 2010 +0200
    83.2 +++ b/src/HOL/Library/Efficient_Nat.thy	Thu Sep 02 17:28:00 2010 +0200
    83.3 @@ -55,12 +55,12 @@
    83.4    by (simp add: prod_fun_def split_def pdivmod_def nat_div_distrib nat_mod_distrib divmod_nat_div_mod)
    83.5  
    83.6  lemma eq_nat_code [code]:
    83.7 -  "eq_class.eq n m \<longleftrightarrow> eq_class.eq (of_nat n \<Colon> int) (of_nat m)"
    83.8 -  by (simp add: eq)
    83.9 +  "HOL.equal n m \<longleftrightarrow> HOL.equal (of_nat n \<Colon> int) (of_nat m)"
   83.10 +  by (simp add: equal)
   83.11  
   83.12  lemma eq_nat_refl [code nbe]:
   83.13 -  "eq_class.eq (n::nat) n \<longleftrightarrow> True"
   83.14 -  by (rule HOL.eq_refl)
   83.15 +  "HOL.equal (n::nat) n \<longleftrightarrow> True"
   83.16 +  by (rule equal_refl)
   83.17  
   83.18  lemma less_eq_nat_code [code]:
   83.19    "n \<le> m \<longleftrightarrow> (of_nat n \<Colon> int) \<le> of_nat m"
   83.20 @@ -242,8 +242,8 @@
   83.21    and @{typ int}.
   83.22  *}
   83.23  
   83.24 -code_include Haskell "Nat" {*
   83.25 -newtype Nat = Nat Integer deriving (Eq, Show, Read);
   83.26 +code_include Haskell "Nat"
   83.27 +{*newtype Nat = Nat Integer deriving (Eq, Show, Read);
   83.28  
   83.29  instance Num Nat where {
   83.30    fromInteger k = Nat (if k >= 0 then k else 0);
   83.31 @@ -280,10 +280,8 @@
   83.32  
   83.33  code_reserved Haskell Nat
   83.34  
   83.35 -code_include Scala "Nat" {*
   83.36 -import scala.Math
   83.37 -
   83.38 -object Nat {
   83.39 +code_include Scala "Nat"
   83.40 +{*object Nat {
   83.41  
   83.42    def apply(numeral: BigInt): Nat = new Nat(numeral max 0)
   83.43    def apply(numeral: Int): Nat = Nat(BigInt(numeral))
   83.44 @@ -332,7 +330,7 @@
   83.45    (Haskell "Nat.Nat")
   83.46    (Scala "Nat")
   83.47  
   83.48 -code_instance nat :: eq
   83.49 +code_instance nat :: equal
   83.50    (Haskell -)
   83.51  
   83.52  text {*
   83.53 @@ -442,7 +440,7 @@
   83.54    (Scala infixl 8 "/%")
   83.55    (Eval "Integer.div'_mod")
   83.56  
   83.57 -code_const "eq_class.eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
   83.58 +code_const "HOL.equal \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
   83.59    (SML "!((_ : IntInf.int) = _)")
   83.60    (OCaml "Big'_int.eq'_big'_int")
   83.61    (Haskell infixl 4 "==")
    84.1 --- a/src/HOL/Library/Enum.thy	Thu Sep 02 17:12:40 2010 +0200
    84.2 +++ b/src/HOL/Library/Enum.thy	Thu Sep 02 17:28:00 2010 +0200
    84.3 @@ -35,17 +35,21 @@
    84.4  
    84.5  subsection {* Equality and order on functions *}
    84.6  
    84.7 -instantiation "fun" :: (enum, eq) eq
    84.8 +instantiation "fun" :: (enum, equal) equal
    84.9  begin
   84.10  
   84.11  definition
   84.12 -  "eq_class.eq f g \<longleftrightarrow> (\<forall>x \<in> set enum. f x = g x)"
   84.13 +  "HOL.equal f g \<longleftrightarrow> (\<forall>x \<in> set enum. f x = g x)"
   84.14  
   84.15  instance proof
   84.16 -qed (simp_all add: eq_fun_def enum_all expand_fun_eq)
   84.17 +qed (simp_all add: equal_fun_def enum_all expand_fun_eq)
   84.18  
   84.19  end
   84.20  
   84.21 +lemma [code nbe]:
   84.22 +  "HOL.equal (f :: _ \<Rightarrow> _) f \<longleftrightarrow> True"
   84.23 +  by (fact equal_refl)
   84.24 +
   84.25  lemma order_fun [code]:
   84.26    fixes f g :: "'a\<Colon>enum \<Rightarrow> 'b\<Colon>order"
   84.27    shows "f \<le> g \<longleftrightarrow> list_all (\<lambda>x. f x \<le> g x) enum"
   84.28 @@ -169,7 +173,7 @@
   84.29  
   84.30  end
   84.31  
   84.32 -lemma enum_fun_code [code]: "enum = (let enum_a = (enum \<Colon> 'a\<Colon>{enum, eq} list)
   84.33 +lemma enum_fun_code [code]: "enum = (let enum_a = (enum \<Colon> 'a\<Colon>{enum, equal} list)
   84.34    in map (\<lambda>ys. the o map_of (zip enum_a ys)) (n_lists (length enum_a) enum))"
   84.35    by (simp add: enum_fun_def Let_def)
   84.36  
    85.1 --- a/src/HOL/Library/Fset.thy	Thu Sep 02 17:12:40 2010 +0200
    85.2 +++ b/src/HOL/Library/Fset.thy	Thu Sep 02 17:28:00 2010 +0200
    85.3 @@ -227,17 +227,21 @@
    85.4    "A < B \<longleftrightarrow> A \<le> B \<and> \<not> B \<le> (A :: 'a fset)"
    85.5    by (fact less_le_not_le)
    85.6  
    85.7 -instantiation fset :: (type) eq
    85.8 +instantiation fset :: (type) equal
    85.9  begin
   85.10  
   85.11  definition
   85.12 -  "eq_fset A B \<longleftrightarrow> A \<le> B \<and> B \<le> (A :: 'a fset)"
   85.13 +  "HOL.equal A B \<longleftrightarrow> A \<le> B \<and> B \<le> (A :: 'a fset)"
   85.14  
   85.15  instance proof
   85.16 -qed (simp add: eq_fset_def set_eq [symmetric])
   85.17 +qed (simp add: equal_fset_def set_eq [symmetric])
   85.18  
   85.19  end
   85.20  
   85.21 +lemma [code nbe]:
   85.22 +  "HOL.equal (A :: 'a fset) A \<longleftrightarrow> True"
   85.23 +  by (fact equal_refl)
   85.24 +
   85.25  
   85.26  subsection {* Functorial operations *}
   85.27  
    86.1 --- a/src/HOL/Library/List_Prefix.thy	Thu Sep 02 17:12:40 2010 +0200
    86.2 +++ b/src/HOL/Library/List_Prefix.thy	Thu Sep 02 17:28:00 2010 +0200
    86.3 @@ -81,9 +81,9 @@
    86.4    by (auto simp add: prefix_def)
    86.5  
    86.6  lemma less_eq_list_code [code]:
    86.7 -  "([]\<Colon>'a\<Colon>{eq, ord} list) \<le> xs \<longleftrightarrow> True"
    86.8 -  "(x\<Colon>'a\<Colon>{eq, ord}) # xs \<le> [] \<longleftrightarrow> False"
    86.9 -  "(x\<Colon>'a\<Colon>{eq, ord}) # xs \<le> y # ys \<longleftrightarrow> x = y \<and> xs \<le> ys"
   86.10 +  "([]\<Colon>'a\<Colon>{equal, ord} list) \<le> xs \<longleftrightarrow> True"
   86.11 +  "(x\<Colon>'a\<Colon>{equal, ord}) # xs \<le> [] \<longleftrightarrow> False"
   86.12 +  "(x\<Colon>'a\<Colon>{equal, ord}) # xs \<le> y # ys \<longleftrightarrow> x = y \<and> xs \<le> ys"
   86.13    by simp_all
   86.14  
   86.15  lemma same_prefix_prefix [simp]: "(xs @ ys \<le> xs @ zs) = (ys \<le> zs)"
    87.1 --- a/src/HOL/Library/List_lexord.thy	Thu Sep 02 17:12:40 2010 +0200
    87.2 +++ b/src/HOL/Library/List_lexord.thy	Thu Sep 02 17:28:00 2010 +0200
    87.3 @@ -103,15 +103,15 @@
    87.4  end
    87.5  
    87.6  lemma less_list_code [code]:
    87.7 -  "xs < ([]\<Colon>'a\<Colon>{eq, order} list) \<longleftrightarrow> False"
    87.8 -  "[] < (x\<Colon>'a\<Colon>{eq, order}) # xs \<longleftrightarrow> True"
    87.9 -  "(x\<Colon>'a\<Colon>{eq, order}) # xs < y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs < ys"
   87.10 +  "xs < ([]\<Colon>'a\<Colon>{equal, order} list) \<longleftrightarrow> False"
   87.11 +  "[] < (x\<Colon>'a\<Colon>{equal, order}) # xs \<longleftrightarrow> True"
   87.12 +  "(x\<Colon>'a\<Colon>{equal, order}) # xs < y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs < ys"
   87.13    by simp_all
   87.14  
   87.15  lemma less_eq_list_code [code]:
   87.16 -  "x # xs \<le> ([]\<Colon>'a\<Colon>{eq, order} list) \<longleftrightarrow> False"
   87.17 -  "[] \<le> (xs\<Colon>'a\<Colon>{eq, order} list) \<longleftrightarrow> True"
   87.18 -  "(x\<Colon>'a\<Colon>{eq, order}) # xs \<le> y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs \<le> ys"
   87.19 +  "x # xs \<le> ([]\<Colon>'a\<Colon>{equal, order} list) \<longleftrightarrow> False"
   87.20 +  "[] \<le> (xs\<Colon>'a\<Colon>{equal, order} list) \<longleftrightarrow> True"
   87.21 +  "(x\<Colon>'a\<Colon>{equal, order}) # xs \<le> y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs \<le> ys"
   87.22    by simp_all
   87.23  
   87.24  end
    88.1 --- a/src/HOL/Library/Mapping.thy	Thu Sep 02 17:12:40 2010 +0200
    88.2 +++ b/src/HOL/Library/Mapping.thy	Thu Sep 02 17:28:00 2010 +0200
    88.3 @@ -280,14 +280,14 @@
    88.4  
    88.5  code_datatype empty update
    88.6  
    88.7 -instantiation mapping :: (type, type) eq
    88.8 +instantiation mapping :: (type, type) equal
    88.9  begin
   88.10  
   88.11  definition [code del]:
   88.12 -  "HOL.eq m n \<longleftrightarrow> lookup m = lookup n"
   88.13 +  "HOL.equal m n \<longleftrightarrow> lookup m = lookup n"
   88.14  
   88.15  instance proof
   88.16 -qed (simp add: eq_mapping_def)
   88.17 +qed (simp add: equal_mapping_def)
   88.18  
   88.19  end
   88.20  
    89.1 --- a/src/HOL/Library/Multiset.thy	Thu Sep 02 17:12:40 2010 +0200
    89.2 +++ b/src/HOL/Library/Multiset.thy	Thu Sep 02 17:28:00 2010 +0200
    89.3 @@ -938,17 +938,21 @@
    89.4    qed
    89.5  qed
    89.6  
    89.7 -instantiation multiset :: (eq) eq
    89.8 +instantiation multiset :: (equal) equal
    89.9  begin
   89.10  
   89.11  definition
   89.12 -  "HOL.eq A B \<longleftrightarrow> (A::'a multiset) \<le> B \<and> B \<le> A"
   89.13 +  "HOL.equal A B \<longleftrightarrow> (A::'a multiset) \<le> B \<and> B \<le> A"
   89.14  
   89.15  instance proof
   89.16 -qed (simp add: eq_multiset_def eq_iff)
   89.17 +qed (simp add: equal_multiset_def eq_iff)
   89.18  
   89.19  end
   89.20  
   89.21 +lemma [code nbe]:
   89.22 +  "HOL.equal (A :: 'a::equal multiset) A \<longleftrightarrow> True"
   89.23 +  by (fact equal_refl)
   89.24 +
   89.25  definition (in term_syntax)
   89.26    bagify :: "('a\<Colon>typerep \<times> nat) list \<times> (unit \<Rightarrow> Code_Evaluation.term)
   89.27      \<Rightarrow> 'a multiset \<times> (unit \<Rightarrow> Code_Evaluation.term)" where
    90.1 --- a/src/HOL/Library/Nested_Environment.thy	Thu Sep 02 17:12:40 2010 +0200
    90.2 +++ b/src/HOL/Library/Nested_Environment.thy	Thu Sep 02 17:28:00 2010 +0200
    90.3 @@ -521,22 +521,21 @@
    90.4  text {* Environments and code generation *}
    90.5  
    90.6  lemma [code, code del]:
    90.7 -  fixes e1 e2 :: "('b\<Colon>eq, 'a\<Colon>eq, 'c\<Colon>eq) env"
    90.8 -  shows "eq_class.eq e1 e2 \<longleftrightarrow> eq_class.eq e1 e2" ..
    90.9 +  "(HOL.equal :: (_, _, _) env \<Rightarrow> _) = HOL.equal" ..
   90.10  
   90.11 -lemma eq_env_code [code]:
   90.12 -  fixes x y :: "'a\<Colon>eq"
   90.13 -    and f g :: "'c\<Colon>{eq, finite} \<Rightarrow> ('b\<Colon>eq, 'a, 'c) env option"
   90.14 -  shows "eq_class.eq (Env x f) (Env y g) \<longleftrightarrow>
   90.15 -  eq_class.eq x y \<and> (\<forall>z\<in>UNIV. case f z
   90.16 +lemma equal_env_code [code]:
   90.17 +  fixes x y :: "'a\<Colon>equal"
   90.18 +    and f g :: "'c\<Colon>{equal, finite} \<Rightarrow> ('b\<Colon>equal, 'a, 'c) env option"
   90.19 +  shows "HOL.equal (Env x f) (Env y g) \<longleftrightarrow>
   90.20 +  HOL.equal x y \<and> (\<forall>z\<in>UNIV. case f z
   90.21     of None \<Rightarrow> (case g z
   90.22          of None \<Rightarrow> True | Some _ \<Rightarrow> False)
   90.23      | Some a \<Rightarrow> (case g z
   90.24 -        of None \<Rightarrow> False | Some b \<Rightarrow> eq_class.eq a b))" (is ?env)
   90.25 -    and "eq_class.eq (Val a) (Val b) \<longleftrightarrow> eq_class.eq a b"
   90.26 -    and "eq_class.eq (Val a) (Env y g) \<longleftrightarrow> False"
   90.27 -    and "eq_class.eq (Env x f) (Val b) \<longleftrightarrow> False"
   90.28 -proof (unfold eq)
   90.29 +        of None \<Rightarrow> False | Some b \<Rightarrow> HOL.equal a b))" (is ?env)
   90.30 +    and "HOL.equal (Val a) (Val b) \<longleftrightarrow> HOL.equal a b"
   90.31 +    and "HOL.equal (Val a) (Env y g) \<longleftrightarrow> False"
   90.32 +    and "HOL.equal (Env x f) (Val b) \<longleftrightarrow> False"
   90.33 +proof (unfold equal)
   90.34    have "f = g \<longleftrightarrow> (\<forall>z. case f z
   90.35     of None \<Rightarrow> (case g z
   90.36          of None \<Rightarrow> True | Some _ \<Rightarrow> False)
   90.37 @@ -562,6 +561,10 @@
   90.38            of None \<Rightarrow> False | Some b \<Rightarrow> a = b))" by simp
   90.39  qed simp_all
   90.40  
   90.41 +lemma [code nbe]:
   90.42 +  "HOL.equal (x :: (_, _, _) env) x \<longleftrightarrow> True"
   90.43 +  by (fact equal_refl)
   90.44 +
   90.45  lemma [code, code del]:
   90.46    "(Code_Evaluation.term_of :: ('a::{term_of, type}, 'b::{term_of, type}, 'c::{term_of, type}) env \<Rightarrow> term) = Code_Evaluation.term_of" ..
   90.47  
    91.1 --- a/src/HOL/Library/OptionalSugar.thy	Thu Sep 02 17:12:40 2010 +0200
    91.2 +++ b/src/HOL/Library/OptionalSugar.thy	Thu Sep 02 17:28:00 2010 +0200
    91.3 @@ -32,7 +32,7 @@
    91.4  (* deprecated, use thm with style instead, will be removed *)
    91.5  (* aligning equations *)
    91.6  notation (tab output)
    91.7 -  "op ="  ("(_) \<^raw:}\putisatab\isa{\ >=\<^raw:}\putisatab\isa{> (_)" [50,49] 50) and
    91.8 +  "HOL.eq"  ("(_) \<^raw:}\putisatab\isa{\ >=\<^raw:}\putisatab\isa{> (_)" [50,49] 50) and
    91.9    "=="  ("(_) \<^raw:}\putisatab\isa{\ >\<equiv>\<^raw:}\putisatab\isa{> (_)")
   91.10  
   91.11  (* Let *)
    92.1 --- a/src/HOL/Library/Polynomial.thy	Thu Sep 02 17:12:40 2010 +0200
    92.2 +++ b/src/HOL/Library/Polynomial.thy	Thu Sep 02 17:28:00 2010 +0200
    92.3 @@ -1505,23 +1505,27 @@
    92.4  
    92.5  declare pCons_0_0 [code_post]
    92.6  
    92.7 -instantiation poly :: ("{zero,eq}") eq
    92.8 +instantiation poly :: ("{zero, equal}") equal
    92.9  begin
   92.10  
   92.11  definition
   92.12 -  "eq_class.eq (p::'a poly) q \<longleftrightarrow> p = q"
   92.13 +  "HOL.equal (p::'a poly) q \<longleftrightarrow> p = q"
   92.14  
   92.15 -instance
   92.16 -  by default (rule eq_poly_def)
   92.17 +instance proof
   92.18 +qed (rule equal_poly_def)
   92.19  
   92.20  end
   92.21  
   92.22  lemma eq_poly_code [code]:
   92.23 -  "eq_class.eq (0::_ poly) (0::_ poly) \<longleftrightarrow> True"
   92.24 -  "eq_class.eq (0::_ poly) (pCons b q) \<longleftrightarrow> eq_class.eq 0 b \<and> eq_class.eq 0 q"
   92.25 -  "eq_class.eq (pCons a p) (0::_ poly) \<longleftrightarrow> eq_class.eq a 0 \<and> eq_class.eq p 0"
   92.26 -  "eq_class.eq (pCons a p) (pCons b q) \<longleftrightarrow> eq_class.eq a b \<and> eq_class.eq p q"
   92.27 -unfolding eq by simp_all
   92.28 +  "HOL.equal (0::_ poly) (0::_ poly) \<longleftrightarrow> True"
   92.29 +  "HOL.equal (0::_ poly) (pCons b q) \<longleftrightarrow> HOL.equal 0 b \<and> HOL.equal 0 q"
   92.30 +  "HOL.equal (pCons a p) (0::_ poly) \<longleftrightarrow> HOL.equal a 0 \<and> HOL.equal p 0"
   92.31 +  "HOL.equal (pCons a p) (pCons b q) \<longleftrightarrow> HOL.equal a b \<and> HOL.equal p q"
   92.32 +  by (simp_all add: equal)
   92.33 +
   92.34 +lemma [code nbe]:
   92.35 +  "HOL.equal (p :: _ poly) p \<longleftrightarrow> True"
   92.36 +  by (fact equal_refl)
   92.37  
   92.38  lemmas coeff_code [code] =
   92.39    coeff_0 coeff_pCons_0 coeff_pCons_Suc
    93.1 --- a/src/HOL/Library/Product_ord.thy	Thu Sep 02 17:12:40 2010 +0200
    93.2 +++ b/src/HOL/Library/Product_ord.thy	Thu Sep 02 17:28:00 2010 +0200
    93.3 @@ -22,8 +22,8 @@
    93.4  end
    93.5  
    93.6  lemma [code]:
    93.7 -  "(x1\<Colon>'a\<Colon>{ord, eq}, y1) \<le> (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 \<le> x2 \<and> y1 \<le> y2"
    93.8 -  "(x1\<Colon>'a\<Colon>{ord, eq}, y1) < (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 \<le> x2 \<and> y1 < y2"
    93.9 +  "(x1\<Colon>'a\<Colon>{ord, equal}, y1) \<le> (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 \<le> x2 \<and> y1 \<le> y2"
   93.10 +  "(x1\<Colon>'a\<Colon>{ord, equal}, y1) < (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 \<le> x2 \<and> y1 < y2"
   93.11    unfolding prod_le_def prod_less_def by simp_all
   93.12  
   93.13  instance prod :: (preorder, preorder) preorder proof
    94.1 --- a/src/HOL/Library/RBT.thy	Thu Sep 02 17:12:40 2010 +0200
    94.2 +++ b/src/HOL/Library/RBT.thy	Thu Sep 02 17:28:00 2010 +0200
    94.3 @@ -222,12 +222,14 @@
    94.4    "Mapping.bulkload vs = Mapping (bulkload (List.map (\<lambda>n. (n, vs ! n)) [0..<length vs]))"
    94.5    by (rule mapping_eqI) (simp add: map_of_map_restrict expand_fun_eq)
    94.6  
    94.7 -lemma [code, code del]:
    94.8 -  "HOL.eq (x :: (_, _) mapping) y \<longleftrightarrow> x = y" by (fact eq_equals) (*FIXME*)
    94.9 +lemma equal_Mapping [code]:
   94.10 +  "HOL.equal (Mapping t1) (Mapping t2) \<longleftrightarrow> entries t1 = entries t2"
   94.11 +  by (simp add: equal Mapping_def entries_lookup)
   94.12  
   94.13 -lemma eq_Mapping [code]:
   94.14 -  "HOL.eq (Mapping t1) (Mapping t2) \<longleftrightarrow> entries t1 = entries t2"
   94.15 -  by (simp add: eq Mapping_def entries_lookup)
   94.16 +lemma [code nbe]:
   94.17 +  "HOL.equal (x :: (_, _) mapping) x \<longleftrightarrow> True"
   94.18 +  by (fact equal_refl)
   94.19 +
   94.20  
   94.21  hide_const (open) impl_of lookup empty insert delete
   94.22    entries keys bulkload map_entry map fold
    95.1 --- a/src/HOL/Library/Sum_Of_Squares.thy	Thu Sep 02 17:12:40 2010 +0200
    95.2 +++ b/src/HOL/Library/Sum_Of_Squares.thy	Thu Sep 02 17:28:00 2010 +0200
    95.3 @@ -28,6 +28,7 @@
    95.4    without calling an external prover.
    95.5  *}
    95.6  
    95.7 +setup Sum_Of_Squares.setup
    95.8  setup SOS_Wrapper.setup
    95.9  
   95.10  text {* Tests *}
    96.1 --- a/src/HOL/Library/Sum_Of_Squares/sos_wrapper.ML	Thu Sep 02 17:12:40 2010 +0200
    96.2 +++ b/src/HOL/Library/Sum_Of_Squares/sos_wrapper.ML	Thu Sep 02 17:28:00 2010 +0200
    96.3 @@ -8,8 +8,8 @@
    96.4  sig
    96.5    datatype prover_result = Success | Failure | Error
    96.6    val setup: theory -> theory
    96.7 -  val destdir: string Unsynchronized.ref
    96.8 -  val prover_name: string Unsynchronized.ref
    96.9 +  val dest_dir: string Config.T
   96.10 +  val prover_name: string Config.T
   96.11  end
   96.12  
   96.13  structure SOS_Wrapper: SOS_WRAPPER =
   96.14 @@ -22,14 +22,9 @@
   96.15    | str_of_result Error = "Error"
   96.16  
   96.17  
   96.18 -(*** output control ***)
   96.19 -
   96.20 -fun debug s = if ! Sum_Of_Squares.debugging then writeln s else ()
   96.21 -
   96.22 -
   96.23  (*** calling provers ***)
   96.24  
   96.25 -val destdir = Unsynchronized.ref ""
   96.26 +val (dest_dir, setup_dest_dir) = Attrib.config_string "sos_dest_dir" (K "")
   96.27  
   96.28  fun filename dir name =
   96.29    let
   96.30 @@ -43,12 +38,12 @@
   96.31      else error ("No such directory: " ^ dir)
   96.32    end
   96.33  
   96.34 -fun run_solver name cmd find_failure input =
   96.35 +fun run_solver ctxt name cmd find_failure input =
   96.36    let
   96.37      val _ = warning ("Calling solver: " ^ name)
   96.38  
   96.39      (* create input file *)
   96.40 -    val dir = ! destdir
   96.41 +    val dir = Config.get ctxt dest_dir
   96.42      val input_file = filename dir "sos_in"
   96.43      val _ = File.write input_file input
   96.44  
   96.45 @@ -71,7 +66,10 @@
   96.46          (File.rm input_file; if File.exists output_file then File.rm output_file else ())
   96.47        else ()
   96.48  
   96.49 -    val _ = debug ("Solver output:\n" ^ output)
   96.50 +    val _ =
   96.51 +      if Config.get ctxt Sum_Of_Squares.trace
   96.52 +      then writeln ("Solver output:\n" ^ output)
   96.53 +      else ()
   96.54  
   96.55      val _ = warning (str_of_result res ^ ": " ^ res_msg)
   96.56    in
   96.57 @@ -120,13 +118,13 @@
   96.58    | prover "csdp" = csdp
   96.59    | prover name = error ("Unknown prover: " ^ name)
   96.60  
   96.61 -val prover_name = Unsynchronized.ref "remote_csdp"
   96.62 +val (prover_name, setup_prover_name) = Attrib.config_string "sos_prover_name" (K "remote_csdp")
   96.63  
   96.64 -fun call_solver opt_name =
   96.65 +fun call_solver ctxt opt_name =
   96.66    let
   96.67 -    val name = the_default (! prover_name) opt_name
   96.68 +    val name = the_default (Config.get ctxt prover_name) opt_name
   96.69      val (cmd, find_failure) = prover name
   96.70 -  in run_solver name (Path.explode cmd) find_failure end
   96.71 +  in run_solver ctxt name (Path.explode cmd) find_failure end
   96.72  
   96.73  
   96.74  (* certificate output *)
   96.75 @@ -143,9 +141,13 @@
   96.76  fun sos_solver print method = SIMPLE_METHOD' o Sum_Of_Squares.sos_tac print method
   96.77  
   96.78  val setup =
   96.79 +  setup_dest_dir #>
   96.80 +  setup_prover_name #>
   96.81    Method.setup @{binding sos}
   96.82      (Scan.lift (Scan.option Parse.xname)
   96.83 -      >> (sos_solver print_cert o Sum_Of_Squares.Prover o call_solver))
   96.84 +      >> (fn opt_name => fn ctxt =>
   96.85 +        sos_solver print_cert
   96.86 +          (Sum_Of_Squares.Prover (call_solver ctxt opt_name)) ctxt))
   96.87      "prove universal problems over the reals using sums of squares" #>
   96.88    Method.setup @{binding sos_cert}
   96.89      (Scan.lift Parse.string
    97.1 --- a/src/HOL/Library/Sum_Of_Squares/sum_of_squares.ML	Thu Sep 02 17:12:40 2010 +0200
    97.2 +++ b/src/HOL/Library/Sum_Of_Squares/sum_of_squares.ML	Thu Sep 02 17:28:00 2010 +0200
    97.3 @@ -9,7 +9,8 @@
    97.4  sig
    97.5    datatype proof_method = Certificate of RealArith.pss_tree | Prover of string -> string
    97.6    val sos_tac: (RealArith.pss_tree -> unit) -> proof_method -> Proof.context -> int -> tactic
    97.7 -  val debugging: bool Unsynchronized.ref
    97.8 +  val trace: bool Config.T
    97.9 +  val setup: theory -> theory
   97.10    exception Failure of string;
   97.11  end
   97.12  
   97.13 @@ -49,7 +50,8 @@
   97.14  val pow2 = rat_pow rat_2;
   97.15  val pow10 = rat_pow rat_10;
   97.16  
   97.17 -val debugging = Unsynchronized.ref false;
   97.18 +val (trace, setup_trace) = Attrib.config_bool "sos_trace" (K false);
   97.19 +val setup = setup_trace;
   97.20  
   97.21  exception Sanity;
   97.22  
   97.23 @@ -1059,7 +1061,7 @@
   97.24  (* Positiv- and Nullstellensatz. Flag "linf" forces a linear representation. *)
   97.25  
   97.26  
   97.27 -fun real_positivnullstellensatz_general prover linf d eqs leqs pol =
   97.28 +fun real_positivnullstellensatz_general ctxt prover linf d eqs leqs pol =
   97.29  let
   97.30   val vars = fold_rev (union (op aconvc) o poly_variables)
   97.31     (pol :: eqs @ map fst leqs) []
   97.32 @@ -1129,7 +1131,7 @@
   97.33    fun find_rounding d =
   97.34     let
   97.35      val _ =
   97.36 -      if !debugging
   97.37 +      if Config.get ctxt trace
   97.38        then writeln ("Trying rounding with limit "^Rat.string_of_rat d ^ "\n")
   97.39        else ()
   97.40      val vec = nice_vector d raw_vec
   97.41 @@ -1245,7 +1247,7 @@
   97.42             let val e = multidegree pol
   97.43                 val k = if e = 0 then 0 else d div e
   97.44                 val eq' = map fst eq
   97.45 -           in tryfind (fn i => (d,i,real_positivnullstellensatz_general prover false d eq' leq
   97.46 +           in tryfind (fn i => (d,i,real_positivnullstellensatz_general ctxt prover false d eq' leq
   97.47                                   (poly_neg(poly_pow pol i))))
   97.48                     (0 upto k)
   97.49             end
   97.50 @@ -1356,7 +1358,7 @@
   97.51  
   97.52  val known_sos_constants =
   97.53    [@{term "op ==>"}, @{term "Trueprop"},
   97.54 -   @{term "op -->"}, @{term "op &"}, @{term "op |"},
   97.55 +   @{term HOL.implies}, @{term HOL.conj}, @{term HOL.disj},
   97.56     @{term "Not"}, @{term "op = :: bool => _"},
   97.57     @{term "All :: (real => _) => _"}, @{term "Ex :: (real => _) => _"},
   97.58     @{term "op = :: real => _"}, @{term "op < :: real => _"},
    98.1 --- a/src/HOL/Library/positivstellensatz.ML	Thu Sep 02 17:12:40 2010 +0200
    98.2 +++ b/src/HOL/Library/positivstellensatz.ML	Thu Sep 02 17:28:00 2010 +0200
    98.3 @@ -164,21 +164,6 @@
    98.4    thm list * thm list * thm list -> thm * pss_tree
    98.5  type cert_conv = cterm -> thm * pss_tree
    98.6  
    98.7 -val my_eqs = Unsynchronized.ref ([] : thm list);
    98.8 -val my_les = Unsynchronized.ref ([] : thm list);
    98.9 -val my_lts = Unsynchronized.ref ([] : thm list);
   98.10 -val my_proof = Unsynchronized.ref (Axiom_eq 0);
   98.11 -val my_context = Unsynchronized.ref @{context};
   98.12 -
   98.13 -val my_mk_numeric = Unsynchronized.ref ((K @{cterm True}) :Rat.rat -> cterm);
   98.14 -val my_numeric_eq_conv = Unsynchronized.ref no_conv;
   98.15 -val my_numeric_ge_conv = Unsynchronized.ref no_conv;
   98.16 -val my_numeric_gt_conv = Unsynchronized.ref no_conv;
   98.17 -val my_poly_conv = Unsynchronized.ref no_conv;
   98.18 -val my_poly_neg_conv = Unsynchronized.ref no_conv;
   98.19 -val my_poly_add_conv = Unsynchronized.ref no_conv;
   98.20 -val my_poly_mul_conv = Unsynchronized.ref no_conv;
   98.21 -
   98.22  
   98.23      (* Some useful derived rules *)
   98.24  fun deduct_antisym_rule tha thb = 
   98.25 @@ -362,11 +347,6 @@
   98.26         poly_conv,poly_neg_conv,poly_add_conv,poly_mul_conv,
   98.27         absconv1,absconv2,prover) = 
   98.28  let
   98.29 - val _ = my_context := ctxt 
   98.30 - val _ = (my_mk_numeric := mk_numeric ; my_numeric_eq_conv := numeric_eq_conv ; 
   98.31 -          my_numeric_ge_conv := numeric_ge_conv; my_numeric_gt_conv := numeric_gt_conv ;
   98.32 -          my_poly_conv := poly_conv; my_poly_neg_conv := poly_neg_conv; 
   98.33 -          my_poly_add_conv := poly_add_conv; my_poly_mul_conv := poly_mul_conv)
   98.34   val pre_ss = HOL_basic_ss addsimps simp_thms@ ex_simps@ all_simps@[@{thm not_all},@{thm not_ex},ex_disj_distrib, all_conj_distrib, @{thm if_bool_eq_disj}]
   98.35   val prenex_ss = HOL_basic_ss addsimps prenex_simps
   98.36   val skolemize_ss = HOL_basic_ss addsimps [choice_iff]
   98.37 @@ -408,7 +388,6 @@
   98.38  
   98.39    fun hol_of_positivstellensatz(eqs,les,lts) proof =
   98.40     let 
   98.41 -    val _ = (my_eqs := eqs ; my_les := les ; my_lts := lts ; my_proof := proof)
   98.42      fun translate prf = case prf of
   98.43          Axiom_eq n => nth eqs n
   98.44        | Axiom_le n => nth les n
   98.45 @@ -439,8 +418,8 @@
   98.46    val is_req = is_binop @{cterm "op =:: real => _"}
   98.47    val is_ge = is_binop @{cterm "op <=:: real => _"}
   98.48    val is_gt = is_binop @{cterm "op <:: real => _"}
   98.49 -  val is_conj = is_binop @{cterm "op &"}
   98.50 -  val is_disj = is_binop @{cterm "op |"}
   98.51 +  val is_conj = is_binop @{cterm HOL.conj}
   98.52 +  val is_disj = is_binop @{cterm HOL.disj}
   98.53    fun conj_pair th = (th RS @{thm conjunct1}, th RS @{thm conjunct2})
   98.54    fun disj_cases th th1 th2 = 
   98.55     let val (p,q) = Thm.dest_binop (concl th)
   98.56 @@ -484,7 +463,7 @@
   98.57      val th_p = poly_conv(Thm.dest_arg(Thm.dest_arg1(Thm.rhs_of th)))
   98.58      val th_x = Drule.arg_cong_rule @{cterm "uminus :: real => _"} th_p
   98.59      val th_n = fconv_rule (arg_conv poly_neg_conv) th_x
   98.60 -    val th' = Drule.binop_cong_rule @{cterm "op |"} 
   98.61 +    val th' = Drule.binop_cong_rule @{cterm HOL.disj} 
   98.62       (Drule.arg_cong_rule (Thm.capply @{cterm "op <::real=>_"} @{cterm "0::real"}) th_p)
   98.63       (Drule.arg_cong_rule (Thm.capply @{cterm "op <::real=>_"} @{cterm "0::real"}) th_n)
   98.64      in Thm.transitive th th' 
   98.65 @@ -542,12 +521,12 @@
   98.66    let 
   98.67     val nnf_norm_conv' = 
   98.68       nnf_conv then_conv 
   98.69 -     literals_conv [@{term "op &"}, @{term "op |"}] [] 
   98.70 +     literals_conv [@{term HOL.conj}, @{term HOL.disj}] [] 
   98.71       (Conv.cache_conv 
   98.72         (first_conv [real_lt_conv, real_le_conv, 
   98.73                      real_eq_conv, real_not_lt_conv, 
   98.74                      real_not_le_conv, real_not_eq_conv, all_conv]))
   98.75 -  fun absremover ct = (literals_conv [@{term "op &"}, @{term "op |"}] [] 
   98.76 +  fun absremover ct = (literals_conv [@{term HOL.conj}, @{term HOL.disj}] [] 
   98.77                    (try_conv (absconv1 then_conv binop_conv (arg_conv poly_conv))) then_conv 
   98.78          try_conv (absconv2 then_conv nnf_norm_conv' then_conv binop_conv absremover)) ct
   98.79    val nct = Thm.capply @{cterm Trueprop} (Thm.capply @{cterm "Not"} ct)
    99.1 --- a/src/HOL/Library/reflection.ML	Thu Sep 02 17:12:40 2010 +0200
    99.2 +++ b/src/HOL/Library/reflection.ML	Thu Sep 02 17:28:00 2010 +0200
    99.3 @@ -82,7 +82,7 @@
    99.4  fun rearrange congs =
    99.5    let
    99.6      fun P (_, th) =
    99.7 -      let val @{term "Trueprop"}$(Const (@{const_name "op ="},_) $l$_) = concl_of th
    99.8 +      let val @{term "Trueprop"}$(Const (@{const_name HOL.eq},_) $l$_) = concl_of th
    99.9        in can dest_Var l end
   99.10      val (yes,no) = List.partition P congs
   99.11    in no @ yes end
   100.1 --- a/src/HOL/List.thy	Thu Sep 02 17:12:40 2010 +0200
   100.2 +++ b/src/HOL/List.thy	Thu Sep 02 17:28:00 2010 +0200
   100.3 @@ -4721,8 +4721,8 @@
   100.4    by (simp add: null_def)
   100.5  
   100.6  lemma equal_Nil_null [code_unfold]:
   100.7 -  "eq_class.eq xs [] \<longleftrightarrow> null xs"
   100.8 -  by (simp add: eq eq_Nil_null)
   100.9 +  "HOL.equal xs [] \<longleftrightarrow> null xs"
  100.10 +  by (simp add: equal eq_Nil_null)
  100.11  
  100.12  definition maps :: "('a \<Rightarrow> 'b list) \<Rightarrow> 'a list \<Rightarrow> 'b list" where
  100.13    [code_post]: "maps f xs = concat (map f xs)"
  100.14 @@ -4821,10 +4821,10 @@
  100.15    (Haskell "[]")
  100.16    (Scala "!Nil")
  100.17  
  100.18 -code_instance list :: eq
  100.19 +code_instance list :: equal
  100.20    (Haskell -)
  100.21  
  100.22 -code_const "eq_class.eq \<Colon> 'a\<Colon>eq list \<Rightarrow> 'a list \<Rightarrow> bool"
  100.23 +code_const "HOL.equal \<Colon> 'a list \<Rightarrow> 'a list \<Rightarrow> bool"
  100.24    (Haskell infixl 4 "==")
  100.25  
  100.26  code_reserved SML
   101.1 --- a/src/HOL/Matrix/Compute_Oracle/compute.ML	Thu Sep 02 17:12:40 2010 +0200
   101.2 +++ b/src/HOL/Matrix/Compute_Oracle/compute.ML	Thu Sep 02 17:28:00 2010 +0200
   101.3 @@ -371,7 +371,7 @@
   101.4  fun merge_shyps shyps1 shyps2 = Sorttab.keys (add_shyps shyps2 (add_shyps shyps1 Sorttab.empty))
   101.5  
   101.6  val (_, export_oracle) = Context.>>> (Context.map_theory_result
   101.7 -  (Thm.add_oracle (Binding.name "compute", fn (thy, hyps, shyps, prop) =>
   101.8 +  (Thm.add_oracle (@{binding compute}, fn (thy, hyps, shyps, prop) =>
   101.9      let
  101.10          val shyptab = add_shyps shyps Sorttab.empty
  101.11          fun delete s shyptab = Sorttab.delete s shyptab handle Sorttab.UNDEF _ => shyptab
   102.1 --- a/src/HOL/Mirabelle/Mirabelle_Test.thy	Thu Sep 02 17:12:40 2010 +0200
   102.2 +++ b/src/HOL/Mirabelle/Mirabelle_Test.thy	Thu Sep 02 17:28:00 2010 +0200
   102.3 @@ -12,6 +12,7 @@
   102.4    "Tools/mirabelle_quickcheck.ML"
   102.5    "Tools/mirabelle_refute.ML"
   102.6    "Tools/mirabelle_sledgehammer.ML"
   102.7 +  "Tools/mirabelle_sledgehammer_filter.ML"
   102.8  begin
   102.9  
  102.10  text {*
   103.1 --- a/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Thu Sep 02 17:12:40 2010 +0200
   103.2 +++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Thu Sep 02 17:28:00 2010 +0200
   103.3 @@ -357,15 +357,16 @@
   103.4      case result of
   103.5        SH_OK (time_isa, time_atp, names) =>
   103.6          let
   103.7 -          fun get_thms (name, loc) =
   103.8 -            ((name, loc), thms_of_name (Proof.context_of st) name)
   103.9 +          fun get_thms (name, Sledgehammer_Fact_Filter.Chained) = NONE
  103.10 +            | get_thms (name, loc) =
  103.11 +              SOME ((name, loc), thms_of_name (Proof.context_of st) name)
  103.12          in
  103.13            change_data id inc_sh_success;
  103.14            change_data id (inc_sh_lemmas (length names));
  103.15            change_data id (inc_sh_max_lems (length names));
  103.16            change_data id (inc_sh_time_isa time_isa);
  103.17            change_data id (inc_sh_time_atp time_atp);
  103.18 -          named_thms := SOME (map get_thms names);
  103.19 +          named_thms := SOME (map_filter get_thms names);
  103.20            log (sh_tag id ^ "succeeded (" ^ string_of_int time_isa ^ "+" ^
  103.21              string_of_int time_atp ^ ") [" ^ prover_name ^ "]:\n" ^ msg)
  103.22          end
   104.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   104.2 +++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML	Thu Sep 02 17:28:00 2010 +0200
   104.3 @@ -0,0 +1,169 @@
   104.4 +(*  Title:      HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML
   104.5 +    Author:     Jasmin Blanchette, TU Munich
   104.6 +*)
   104.7 +
   104.8 +structure Mirabelle_Sledgehammer_Filter : MIRABELLE_ACTION =
   104.9 +struct
  104.10 +
  104.11 +val relevance_filter_args =
  104.12 +  [("worse_irrel_freq", Sledgehammer_Fact_Filter.worse_irrel_freq),
  104.13 +   ("higher_order_irrel_weight",
  104.14 +    Sledgehammer_Fact_Filter.higher_order_irrel_weight),
  104.15 +   ("abs_rel_weight", Sledgehammer_Fact_Filter.abs_rel_weight),
  104.16 +   ("abs_irrel_weight", Sledgehammer_Fact_Filter.abs_irrel_weight),
  104.17 +   ("skolem_irrel_weight", Sledgehammer_Fact_Filter.skolem_irrel_weight),
  104.18 +   ("intro_bonus", Sledgehammer_Fact_Filter.intro_bonus),
  104.19 +   ("elim_bonus", Sledgehammer_Fact_Filter.elim_bonus),
  104.20 +   ("simp_bonus", Sledgehammer_Fact_Filter.simp_bonus),
  104.21 +   ("local_bonus", Sledgehammer_Fact_Filter.local_bonus),
  104.22 +   ("chained_bonus", Sledgehammer_Fact_Filter.chained_bonus),
  104.23 +   ("max_imperfect", Sledgehammer_Fact_Filter.max_imperfect),
  104.24 +   ("max_imperfect_exp", Sledgehammer_Fact_Filter.max_imperfect_exp),
  104.25 +   ("threshold_divisor", Sledgehammer_Fact_Filter.threshold_divisor),
  104.26 +   ("ridiculous_threshold", Sledgehammer_Fact_Filter.ridiculous_threshold)]
  104.27 +
  104.28 +structure Prooftab =
  104.29 +  Table(type key = int * int val ord = prod_ord int_ord int_ord);
  104.30 +
  104.31 +val proof_table = Unsynchronized.ref Prooftab.empty
  104.32 +
  104.33 +val num_successes = Unsynchronized.ref ([] : (int * int) list)
  104.34 +val num_failures = Unsynchronized.ref ([] : (int * int) list)
  104.35 +val num_found_proofs = Unsynchronized.ref ([] : (int * int) list)
  104.36 +val num_lost_proofs = Unsynchronized.ref ([] : (int * int) list)
  104.37 +val num_found_facts = Unsynchronized.ref ([] : (int * int) list)
  104.38 +val num_lost_facts = Unsynchronized.ref ([] : (int * int) list)
  104.39 +
  104.40 +fun get id c = the_default 0 (AList.lookup (op =) (!c) id)
  104.41 +fun add id c n =
  104.42 +  c := (case AList.lookup (op =) (!c) id of
  104.43 +          SOME m => AList.update (op =) (id, m + n) (!c)
  104.44 +        | NONE => (id, n) :: !c)
  104.45 +
  104.46 +fun init proof_file _ thy =
  104.47 +  let
  104.48 +    fun do_line line =
  104.49 +      case line |> space_explode ":" of
  104.50 +        [line_num, col_num, proof] =>
  104.51 +        SOME (pairself (the o Int.fromString) (line_num, col_num),
  104.52 +              proof |> space_explode " " |> filter_out (curry (op =) ""))
  104.53 +       | _ => NONE
  104.54 +    val proofs = File.read (Path.explode proof_file)
  104.55 +    val proof_tab =
  104.56 +      proofs |> space_explode "\n"
  104.57 +             |> map_filter do_line
  104.58 +             |> AList.coalesce (op =)
  104.59 +             |> Prooftab.make
  104.60 +  in proof_table := proof_tab; thy end
  104.61 +
  104.62 +fun percentage a b = if b = 0 then "N/A" else string_of_int (a * 100 div b)
  104.63 +fun percentage_alt a b = percentage a (a + b)
  104.64 +
  104.65 +fun done id ({log, ...} : Mirabelle.done_args) =
  104.66 +  if get id num_successes + get id num_failures > 0 then
  104.67 +    (log "";
  104.68 +     log ("Number of overall successes: " ^
  104.69 +          string_of_int (get id num_successes));
  104.70 +     log ("Number of overall failures: " ^ string_of_int (get id num_failures));
  104.71 +     log ("Overall success rate: " ^
  104.72 +          percentage_alt (get id num_successes) (get id num_failures) ^ "%");
  104.73 +     log ("Number of found proofs: " ^ string_of_int (get id num_found_proofs));
  104.74 +     log ("Number of lost proofs: " ^ string_of_int (get id num_lost_proofs));
  104.75 +     log ("Proof found rate: " ^
  104.76 +          percentage_alt (get id num_found_proofs) (get id num_lost_proofs) ^
  104.77 +          "%");
  104.78 +     log ("Number of found facts: " ^ string_of_int (get id num_found_facts));
  104.79 +     log ("Number of lost facts: " ^ string_of_int (get id num_lost_facts));
  104.80 +     log ("Fact found rate: " ^
  104.81 +          percentage_alt (get id num_found_facts) (get id num_lost_facts) ^
  104.82 +          "%"))
  104.83 +  else
  104.84 +    ()
  104.85 +
  104.86 +val default_max_relevant = 300
  104.87 +
  104.88 +fun with_index (i, s) = s ^ "@" ^ string_of_int i
  104.89 +
  104.90 +fun action args id ({pre, pos, log, ...} : Mirabelle.run_args) =
  104.91 +  case (Position.line_of pos, Position.column_of pos) of
  104.92 +    (SOME line_num, SOME col_num) =>
  104.93 +    (case Prooftab.lookup (!proof_table) (line_num, col_num) of
  104.94 +       SOME proofs =>
  104.95 +       let
  104.96 +         val {context = ctxt, facts, goal} = Proof.goal pre
  104.97 +         val thy = ProofContext.theory_of ctxt
  104.98 +         val args =
  104.99 +           args
 104.100 +           |> filter (fn (key, value) =>
 104.101 +                         case AList.lookup (op =) relevance_filter_args key of
 104.102 +                           SOME rf => (rf := the (Real.fromString value); false)
 104.103 +                         | NONE => true)
 104.104 +
 104.105 +         val {relevance_thresholds, full_types, max_relevant, theory_relevant,
 104.106 +              ...} = Sledgehammer_Isar.default_params thy args
 104.107 +         val subgoal = 1
 104.108 +         val (_, hyp_ts, concl_t) = Sledgehammer_Util.strip_subgoal goal subgoal
 104.109 +         val facts =
 104.110 +           Sledgehammer_Fact_Filter.relevant_facts ctxt full_types
 104.111 +               relevance_thresholds
 104.112 +               (the_default default_max_relevant max_relevant)
 104.113 +               (the_default false theory_relevant)
 104.114 +               {add = [], del = [], only = false} facts hyp_ts concl_t
 104.115 +           |> map (fst o fst)
 104.116 +         val (found_facts, lost_facts) =
 104.117 +           List.concat proofs |> sort_distinct string_ord
 104.118 +           |> map (fn fact => (find_index (curry (op =) fact) facts, fact))
 104.119 +           |> List.partition (curry (op <=) 0 o fst)
 104.120 +           |>> sort (prod_ord int_ord string_ord) ||> map snd
 104.121 +         val found_proofs = filter (forall (member (op =) facts)) proofs
 104.122 +         val n = length found_proofs
 104.123 +         val _ =
 104.124 +           if n = 0 then
 104.125 +             (add id num_failures 1; log "Failure")
 104.126 +           else
 104.127 +             (add id num_successes 1;
 104.128 +              add id num_found_proofs n;
 104.129 +              log ("Success (" ^ string_of_int n ^ " of " ^
 104.130 +                   string_of_int (length proofs) ^ " proofs)"))
 104.131 +         val _ = add id num_lost_proofs (length proofs - n)
 104.132 +         val _ = add id num_found_facts (length found_facts)
 104.133 +         val _ = add id num_lost_facts (length lost_facts)
 104.134 +         val _ =
 104.135 +           if null found_facts then
 104.136 +             ()
 104.137 +           else
 104.138 +             let
 104.139 +               val found_weight =
 104.140 +                 Real.fromInt (fold (fn (n, _) =>
 104.141 +                                        Integer.add (n * n)) found_facts 0)
 104.142 +                   / Real.fromInt (length found_facts)
 104.143 +                 |> Math.sqrt |> Real.ceil
 104.144 +             in
 104.145 +               log ("Found facts (among " ^ string_of_int (length facts) ^
 104.146 +                    ", weight " ^ string_of_int found_weight ^ "): " ^
 104.147 +                    commas (map with_index found_facts))
 104.148 +             end
 104.149 +         val _ = if null lost_facts then
 104.150 +                   ()
 104.151 +                 else
 104.152 +                   log ("Lost facts (among " ^ string_of_int (length facts) ^
 104.153 +                        "): " ^ commas lost_facts)
 104.154 +       in () end
 104.155 +     | NONE => log "No known proof")
 104.156 +  | _ => ()
 104.157 +
 104.158 +val proof_fileK = "proof_file"
 104.159 +
 104.160 +fun invoke args =
 104.161 +  let
 104.162 +    val (pf_args, other_args) =
 104.163 +      args |> List.partition (curry (op =) proof_fileK o fst)
 104.164 +    val proof_file = case pf_args of
 104.165 +                       [] => error "No \"proof_file\" specified"
 104.166 +                     | (_, s) :: _ => s
 104.167 +  in Mirabelle.register (init proof_file, action other_args, done) end
 104.168 +
 104.169 +end;
 104.170 +
 104.171 +(* Workaround to keep the "mirabelle.pl" script happy *)
 104.172 +structure Mirabelle_Sledgehammer_filter = Mirabelle_Sledgehammer_Filter;
   105.1 --- a/src/HOL/Mirabelle/lib/scripts/mirabelle.pl	Thu Sep 02 17:12:40 2010 +0200
   105.2 +++ b/src/HOL/Mirabelle/lib/scripts/mirabelle.pl	Thu Sep 02 17:28:00 2010 +0200
   105.3 @@ -51,7 +51,11 @@
   105.4  }
   105.5  my $tools = "";
   105.6  if ($#action_files >= 0) {
   105.7 -  $tools = "uses " . join(" ", @action_files);
   105.8 +  # uniquify
   105.9 +  my $s = join ("\n", @action_files);
  105.10 +  my @action_files = split(/\n/, $s . "\n" . $s);
  105.11 +  %action_files = sort(@action_files);
  105.12 +  $tools = "uses " . join(" ", sort(keys(%action_files)));
  105.13  }
  105.14  
  105.15  open(SETUP_FILE, ">$setup_file") || die "Could not create file '$setup_file'";
  105.16 @@ -71,7 +75,7 @@
  105.17  
  105.18  END
  105.19  
  105.20 -foreach (split(/:/, $actions)) {
  105.21 +foreach (reverse(split(/:/, $actions))) {
  105.22    if (m/([^[]*)(?:\[(.*)\])?/) {
  105.23      my ($name, $settings_str) = ($1, $2 || "");
  105.24      $name =~ s/^([a-z])/\U$1/;
   106.1 --- a/src/HOL/Multivariate_Analysis/Gauge_Measure.thy	Thu Sep 02 17:12:40 2010 +0200
   106.2 +++ b/src/HOL/Multivariate_Analysis/Gauge_Measure.thy	Thu Sep 02 17:28:00 2010 +0200
   106.3 @@ -311,7 +311,7 @@
   106.4    shows "(\<Union> f) has_gmeasure (setsum m f)" using assms
   106.5  proof induct case (insert x s)
   106.6    have *:"(x \<inter> \<Union>s) = \<Union>{x \<inter> y| y. y\<in>s}"by auto
   106.7 -  show ?case unfolding Union_insert ring_class.setsum.insert[OF insert(1-2)] 
   106.8 +  show ?case unfolding Union_insert setsum.insert [OF insert(1-2)] 
   106.9      apply(rule has_gmeasure_negligible_union) unfolding *
  106.10      apply(rule insert) defer apply(rule insert) apply(rule insert) defer
  106.11      apply(rule insert) prefer 4 apply(rule negligible_unions)
   107.1 --- a/src/HOL/Mutabelle/Mutabelle.thy	Thu Sep 02 17:12:40 2010 +0200
   107.2 +++ b/src/HOL/Mutabelle/Mutabelle.thy	Thu Sep 02 17:28:00 2010 +0200
   107.3 @@ -4,7 +4,7 @@
   107.4  begin
   107.5  
   107.6  ML {*
   107.7 -val comms = [@{const_name "op ="}, @{const_name "op |"}, @{const_name "op &"}];
   107.8 +val comms = [@{const_name HOL.eq}, @{const_name HOL.disj}, @{const_name HOL.conj}];
   107.9  
  107.10  val forbidden =
  107.11   [(@{const_name Power.power}, "'a"),
   108.1 --- a/src/HOL/Mutabelle/mutabelle_extra.ML	Thu Sep 02 17:12:40 2010 +0200
   108.2 +++ b/src/HOL/Mutabelle/mutabelle_extra.ML	Thu Sep 02 17:28:00 2010 +0200
   108.3 @@ -187,7 +187,7 @@
   108.4  val nitpick_mtd = ("nitpick", invoke_nitpick)
   108.5  *)
   108.6  
   108.7 -val comms = [@{const_name "op ="}, @{const_name "op |"}, @{const_name "op &"}]
   108.8 +val comms = [@{const_name HOL.eq}, @{const_name HOL.disj}, @{const_name HOL.conj}]
   108.9  
  108.10  val forbidden =
  108.11   [(* (@{const_name "power"}, "'a"), *)
  108.12 @@ -202,7 +202,7 @@
  108.13    (@{const_name "top_fun_inst.top_fun"}, "'a"),
  108.14    (@{const_name "Pure.term"}, "'a"),
  108.15    (@{const_name "top_class.top"}, "'a"),
  108.16 -  (@{const_name "eq_class.eq"}, "'a"),
  108.17 +  (@{const_name "HOL.equal"}, "'a"),
  108.18    (@{const_name "Quotient.Quot_True"}, "'a")(*,
  108.19    (@{const_name "uminus"}, "'a"),
  108.20    (@{const_name "Nat.size"}, "'a"),
  108.21 @@ -237,7 +237,7 @@
  108.22   @{const_name "top_fun_inst.top_fun"},
  108.23   @{const_name "Pure.term"},
  108.24   @{const_name "top_class.top"},
  108.25 - @{const_name "eq_class.eq"},
  108.26 + @{const_name "HOL.equal"},
  108.27   @{const_name "Quotient.Quot_True"}]
  108.28  
  108.29  fun is_forbidden_mutant t =
   109.1 --- a/src/HOL/Nominal/nominal_datatype.ML	Thu Sep 02 17:12:40 2010 +0200
   109.2 +++ b/src/HOL/Nominal/nominal_datatype.ML	Thu Sep 02 17:28:00 2010 +0200
   109.3 @@ -183,7 +183,7 @@
   109.4    end;
   109.5  
   109.6  fun mk_not_sym ths = maps (fn th => case prop_of th of
   109.7 -    _ $ (Const (@{const_name Not}, _) $ (Const (@{const_name "op ="}, _) $ _ $ _)) => [th, th RS not_sym]
   109.8 +    _ $ (Const (@{const_name Not}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ _)) => [th, th RS not_sym]
   109.9    | _ => [th]) ths;
  109.10  
  109.11  fun fresh_const T U = Const ("Nominal.fresh", T --> U --> HOLogic.boolT);
  109.12 @@ -1200,7 +1200,7 @@
  109.13            (constrs ~~ idxss)) (descr'' ~~ ndescr ~~ recTs);
  109.14      val tnames = Datatype_Prop.make_tnames recTs;
  109.15      val zs = Name.variant_list tnames (replicate (length descr'') "z");
  109.16 -    val ind_concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop "op &")
  109.17 +    val ind_concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
  109.18        (map (fn ((((i, _), T), tname), z) =>
  109.19          make_pred fsT i T $ Free (z, fsT) $ Free (tname, T))
  109.20          (descr'' ~~ recTs ~~ tnames ~~ zs)));
  109.21 @@ -1215,7 +1215,7 @@
  109.22          map (make_ind_prem fsT' (fn T => fn t => fn u => HOLogic.Not $
  109.23            HOLogic.mk_mem (t, the (AList.lookup op = fresh_fs T) $ u)) i T)
  109.24              (constrs ~~ idxss)) (descr'' ~~ ndescr ~~ recTs);
  109.25 -    val ind_concl' = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop "op &")
  109.26 +    val ind_concl' = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
  109.27        (map (fn ((((i, _), T), tname), z) =>
  109.28          make_pred fsT' i T $ Free (z, fsT') $ Free (tname, T))
  109.29          (descr'' ~~ recTs ~~ tnames ~~ zs)));
  109.30 @@ -1225,7 +1225,7 @@
  109.31        (Datatype_Prop.indexify_names (replicate (length dt_atomTs) "pi") ~~
  109.32         map mk_permT dt_atomTs) @ [("z", fsT')];
  109.33      val aux_ind_Ts = rev (map snd aux_ind_vars);
  109.34 -    val aux_ind_concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop "op &")
  109.35 +    val aux_ind_concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
  109.36        (map (fn (((i, _), T), tname) =>
  109.37          HOLogic.list_all (aux_ind_vars, make_pred fsT' i T $ Bound 0 $
  109.38            fold_rev (mk_perm aux_ind_Ts) (map Bound (length dt_atomTs downto 1))
   110.1 --- a/src/HOL/Nominal/nominal_inductive.ML	Thu Sep 02 17:12:40 2010 +0200
   110.2 +++ b/src/HOL/Nominal/nominal_inductive.ML	Thu Sep 02 17:28:00 2010 +0200
   110.3 @@ -71,7 +71,7 @@
   110.4    | add_binders thy i (Abs (_, _, t)) bs = add_binders thy (i + 1) t bs
   110.5    | add_binders thy i _ bs = bs;
   110.6  
   110.7 -fun split_conj f names (Const (@{const_name "op &"}, _) $ p $ q) _ = (case head_of p of
   110.8 +fun split_conj f names (Const (@{const_name HOL.conj}, _) $ p $ q) _ = (case head_of p of
   110.9        Const (name, _) =>
  110.10          if member (op =) names name then SOME (f p q) else NONE
  110.11      | _ => NONE)
  110.12 @@ -89,7 +89,7 @@
  110.13  (* where "id" protects the subformula from simplification            *)
  110.14  (*********************************************************************)
  110.15  
  110.16 -fun inst_conj_all names ps pis (Const (@{const_name "op &"}, _) $ p $ q) _ =
  110.17 +fun inst_conj_all names ps pis (Const (@{const_name HOL.conj}, _) $ p $ q) _ =
  110.18        (case head_of p of
  110.19           Const (name, _) =>
  110.20             if member (op =) names name then SOME (HOLogic.mk_conj (p,
   111.1 --- a/src/HOL/Nominal/nominal_inductive2.ML	Thu Sep 02 17:12:40 2010 +0200
   111.2 +++ b/src/HOL/Nominal/nominal_inductive2.ML	Thu Sep 02 17:28:00 2010 +0200
   111.3 @@ -76,7 +76,7 @@
   111.4    | add_binders thy i (Abs (_, _, t)) bs = add_binders thy (i + 1) t bs
   111.5    | add_binders thy i _ bs = bs;
   111.6  
   111.7 -fun split_conj f names (Const (@{const_name "op &"}, _) $ p $ q) _ = (case head_of p of
   111.8 +fun split_conj f names (Const (@{const_name HOL.conj}, _) $ p $ q) _ = (case head_of p of
   111.9        Const (name, _) =>
  111.10          if member (op =) names name then SOME (f p q) else NONE
  111.11      | _ => NONE)
  111.12 @@ -94,7 +94,7 @@
  111.13  (* where "id" protects the subformula from simplification            *)
  111.14  (*********************************************************************)
  111.15  
  111.16 -fun inst_conj_all names ps pis (Const (@{const_name "op &"}, _) $ p $ q) _ =
  111.17 +fun inst_conj_all names ps pis (Const (@{const_name HOL.conj}, _) $ p $ q) _ =
  111.18        (case head_of p of
  111.19           Const (name, _) =>
  111.20             if member (op =) names name then SOME (HOLogic.mk_conj (p,
   112.1 --- a/src/HOL/Nominal/nominal_thmdecls.ML	Thu Sep 02 17:12:40 2010 +0200
   112.2 +++ b/src/HOL/Nominal/nominal_thmdecls.ML	Thu Sep 02 17:28:00 2010 +0200
   112.3 @@ -18,8 +18,6 @@
   112.4    val eqvt_force_del: attribute
   112.5    val setup: theory -> theory
   112.6    val get_eqvt_thms: Proof.context -> thm list
   112.7 -
   112.8 -  val NOMINAL_EQVT_DEBUG : bool Unsynchronized.ref
   112.9  end;
  112.10  
  112.11  structure NominalThmDecls: NOMINAL_THMDECLS =
  112.12 @@ -44,29 +42,31 @@
  112.13  (* equality-lemma can be derived. *)
  112.14  exception EQVT_FORM of string
  112.15  
  112.16 -val NOMINAL_EQVT_DEBUG = Unsynchronized.ref false
  112.17 +val (nominal_eqvt_debug, setup_nominal_eqvt_debug) =
  112.18 +  Attrib.config_bool "nominal_eqvt_debug" (K false);
  112.19  
  112.20 -fun tactic (msg, tac) =
  112.21 -  if !NOMINAL_EQVT_DEBUG
  112.22 +fun tactic ctxt (msg, tac) =
  112.23 +  if Config.get ctxt nominal_eqvt_debug
  112.24    then tac THEN' (K (print_tac ("after " ^ msg)))
  112.25    else tac
  112.26  
  112.27  fun prove_eqvt_tac ctxt orig_thm pi pi' =
  112.28 -let
  112.29 -  val mypi = Thm.cterm_of ctxt pi
  112.30 -  val T = fastype_of pi'
  112.31 -  val mypifree = Thm.cterm_of ctxt (Const (@{const_name "rev"}, T --> T) $ pi')
  112.32 -  val perm_pi_simp = PureThy.get_thms ctxt "perm_pi_simp"
  112.33 -in
  112.34 -  EVERY1 [tactic ("iffI applied", rtac @{thm iffI}),
  112.35 -          tactic ("remove pi with perm_boolE", dtac @{thm perm_boolE}),
  112.36 -          tactic ("solve with orig_thm", etac orig_thm),
  112.37 -          tactic ("applies orig_thm instantiated with rev pi",
  112.38 -                     dtac (Drule.cterm_instantiate [(mypi,mypifree)] orig_thm)),
  112.39 -          tactic ("getting rid of the pi on the right", rtac @{thm perm_boolI}),
  112.40 -          tactic ("getting rid of all remaining perms",
  112.41 -                     full_simp_tac (HOL_basic_ss addsimps perm_pi_simp))]
  112.42 -end;
  112.43 +  let
  112.44 +    val thy = ProofContext.theory_of ctxt
  112.45 +    val mypi = Thm.cterm_of thy pi
  112.46 +    val T = fastype_of pi'
  112.47 +    val mypifree = Thm.cterm_of thy (Const (@{const_name "rev"}, T --> T) $ pi')
  112.48 +    val perm_pi_simp = PureThy.get_thms thy "perm_pi_simp"
  112.49 +  in
  112.50 +    EVERY1 [tactic ctxt ("iffI applied", rtac @{thm iffI}),
  112.51 +            tactic ctxt ("remove pi with perm_boolE", dtac @{thm perm_boolE}),
  112.52 +            tactic ctxt ("solve with orig_thm", etac orig_thm),
  112.53 +            tactic ctxt ("applies orig_thm instantiated with rev pi",
  112.54 +                       dtac (Drule.cterm_instantiate [(mypi,mypifree)] orig_thm)),
  112.55 +            tactic ctxt ("getting rid of the pi on the right", rtac @{thm perm_boolI}),
  112.56 +            tactic ctxt ("getting rid of all remaining perms",
  112.57 +                       full_simp_tac (HOL_basic_ss addsimps perm_pi_simp))]
  112.58 +  end;
  112.59  
  112.60  fun get_derived_thm ctxt hyp concl orig_thm pi typi =
  112.61    let
  112.62 @@ -78,7 +78,7 @@
  112.63      val _ = writeln (Syntax.string_of_term ctxt' goal_term);
  112.64    in
  112.65      Goal.prove ctxt' [] [] goal_term
  112.66 -      (fn _ => prove_eqvt_tac thy orig_thm pi' pi'') |>
  112.67 +      (fn _ => prove_eqvt_tac ctxt' orig_thm pi' pi'') |>
  112.68      singleton (ProofContext.export ctxt' ctxt)
  112.69    end
  112.70  
  112.71 @@ -147,7 +147,7 @@
  112.72               else raise EQVT_FORM "Type Implication"
  112.73            end
  112.74         (* case: eqvt-lemma is of the equational form *)
  112.75 -      | (Const (@{const_name Trueprop}, _) $ (Const (@{const_name "op ="}, _) $
  112.76 +      | (Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $
  112.77              (Const (@{const_name "perm"},typrm) $ Var (pi,typi) $ lhs) $ rhs)) =>
  112.78             (if (apply_pi lhs (pi,typi)) = rhs
  112.79                 then [orig_thm]
  112.80 @@ -170,11 +170,12 @@
  112.81  val get_eqvt_thms = Context.Proof #> Data.get;
  112.82  
  112.83  val setup =
  112.84 -    Attrib.setup @{binding eqvt} (Attrib.add_del eqvt_add eqvt_del) 
  112.85 -     "equivariance theorem declaration" 
  112.86 - #> Attrib.setup @{binding eqvt_force} (Attrib.add_del eqvt_force_add eqvt_force_del)
  112.87 -     "equivariance theorem declaration (without checking the form of the lemma)" 
  112.88 - #> PureThy.add_thms_dynamic (Binding.name "eqvts", Data.get) 
  112.89 +  setup_nominal_eqvt_debug #>
  112.90 +  Attrib.setup @{binding eqvt} (Attrib.add_del eqvt_add eqvt_del) 
  112.91 +   "equivariance theorem declaration" #>
  112.92 +  Attrib.setup @{binding eqvt_force} (Attrib.add_del eqvt_force_add eqvt_force_del)
  112.93 +    "equivariance theorem declaration (without checking the form of the lemma)" #>
  112.94 +  PureThy.add_thms_dynamic (@{binding eqvts}, Data.get);
  112.95  
  112.96  
  112.97  end;
   113.1 --- a/src/HOL/Option.thy	Thu Sep 02 17:12:40 2010 +0200
   113.2 +++ b/src/HOL/Option.thy	Thu Sep 02 17:28:00 2010 +0200
   113.3 @@ -99,8 +99,8 @@
   113.4    by (simp add: is_none_def)
   113.5  
   113.6  lemma [code_unfold]:
   113.7 -  "eq_class.eq x None \<longleftrightarrow> is_none x"
   113.8 -  by (simp add: eq is_none_none)
   113.9 +  "HOL.equal x None \<longleftrightarrow> is_none x"
  113.10 +  by (simp add: equal is_none_none)
  113.11  
  113.12  hide_const (open) is_none
  113.13  
  113.14 @@ -116,10 +116,10 @@
  113.15    (Haskell "Nothing" and "Just")
  113.16    (Scala "!None" and "Some")
  113.17  
  113.18 -code_instance option :: eq
  113.19 +code_instance option :: equal
  113.20    (Haskell -)
  113.21  
  113.22 -code_const "eq_class.eq \<Colon> 'a\<Colon>eq option \<Rightarrow> 'a option \<Rightarrow> bool"
  113.23 +code_const "HOL.equal \<Colon> 'a option \<Rightarrow> 'a option \<Rightarrow> bool"
  113.24    (Haskell infixl 4 "==")
  113.25  
  113.26  code_reserved SML
   114.1 --- a/src/HOL/Orderings.thy	Thu Sep 02 17:12:40 2010 +0200
   114.2 +++ b/src/HOL/Orderings.thy	Thu Sep 02 17:28:00 2010 +0200
   114.3 @@ -640,8 +640,8 @@
   114.4  let
   114.5    val All_binder = Syntax.binder_name @{const_syntax All};
   114.6    val Ex_binder = Syntax.binder_name @{const_syntax Ex};
   114.7 -  val impl = @{const_syntax "op -->"};
   114.8 -  val conj = @{const_syntax "op &"};
   114.9 +  val impl = @{const_syntax HOL.implies};
  114.10 +  val conj = @{const_syntax HOL.conj};
  114.11    val less = @{const_syntax less};
  114.12    val less_eq = @{const_syntax less_eq};
  114.13  
   115.1 --- a/src/HOL/Predicate.thy	Thu Sep 02 17:12:40 2010 +0200
   115.2 +++ b/src/HOL/Predicate.thy	Thu Sep 02 17:28:00 2010 +0200
   115.3 @@ -808,8 +808,12 @@
   115.4  
   115.5  lemma eq_pred_code [code]:
   115.6    fixes P Q :: "'a pred"
   115.7 -  shows "eq_class.eq P Q \<longleftrightarrow> P \<le> Q \<and> Q \<le> P"
   115.8 -  unfolding eq by auto
   115.9 +  shows "HOL.equal P Q \<longleftrightarrow> P \<le> Q \<and> Q \<le> P"
  115.10 +  by (auto simp add: equal)
  115.11 +
  115.12 +lemma [code nbe]:
  115.13 +  "HOL.equal (x :: 'a pred) x \<longleftrightarrow> True"
  115.14 +  by (fact equal_refl)
  115.15  
  115.16  lemma [code]:
  115.17    "pred_case f P = f (eval P)"
   116.1 --- a/src/HOL/Predicate_Compile_Examples/Code_Prolog_Examples.thy	Thu Sep 02 17:12:40 2010 +0200
   116.2 +++ b/src/HOL/Predicate_Compile_Examples/Code_Prolog_Examples.thy	Thu Sep 02 17:28:00 2010 +0200
   116.3 @@ -4,13 +4,42 @@
   116.4  
   116.5  section {* Example append *}
   116.6  
   116.7 +
   116.8  inductive append
   116.9  where
  116.10    "append [] ys ys"
  116.11  | "append xs ys zs ==> append (x # xs) ys (x # zs)"
  116.12  
  116.13 +setup {* Code_Prolog.map_code_options (K
  116.14 +  {ensure_groundness = false,
  116.15 +   limited_types = [],
  116.16 +   limited_predicates = [],
  116.17 +   replacing = [],
  116.18 +   manual_reorder = [],
  116.19 +   prolog_system = Code_Prolog.SWI_PROLOG}) *}
  116.20 +
  116.21 +values "{(x, y, z). append x y z}"
  116.22 +
  116.23  values 3 "{(x, y, z). append x y z}"
  116.24  
  116.25 +setup {* Code_Prolog.map_code_options (K
  116.26 +  {ensure_groundness = false,
  116.27 +   limited_types = [],
  116.28 +   limited_predicates = [],
  116.29 +   replacing = [],
  116.30 +   manual_reorder = [],
  116.31 +   prolog_system = Code_Prolog.YAP}) *}
  116.32 +
  116.33 +values "{(x, y, z). append x y z}"
  116.34 +
  116.35 +setup {* Code_Prolog.map_code_options (K
  116.36 +  {ensure_groundness = false,
  116.37 +   limited_types = [],
  116.38 +   limited_predicates = [],
  116.39 +   replacing = [],
  116.40 +   manual_reorder = [],
  116.41 +   prolog_system = Code_Prolog.SWI_PROLOG}) *}
  116.42 +
  116.43  
  116.44  section {* Example queens *}
  116.45  
  116.46 @@ -172,7 +201,13 @@
  116.47  where
  116.48    "y \<noteq> B \<Longrightarrow> notB y"
  116.49  
  116.50 -ML {* Code_Prolog.options := {ensure_groundness = true} *}
  116.51 +setup {* Code_Prolog.map_code_options (K
  116.52 +  {ensure_groundness = true,
  116.53 +   limited_types = [],
  116.54 +   limited_predicates = [],
  116.55 +   replacing = [],
  116.56 +   manual_reorder = [], 
  116.57 +   prolog_system = Code_Prolog.SWI_PROLOG}) *}
  116.58  
  116.59  values 2 "{y. notB y}"
  116.60  
  116.61 @@ -187,7 +222,7 @@
  116.62  inductive equals :: "abc => abc => bool"
  116.63  where
  116.64    "equals y' y'"
  116.65 -ML {* set Code_Prolog.trace *}
  116.66 +
  116.67  values 1 "{(y, z). equals y z}"
  116.68  
  116.69  end
   117.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   117.2 +++ b/src/HOL/Predicate_Compile_Examples/Context_Free_Grammar_Example.thy	Thu Sep 02 17:28:00 2010 +0200
   117.3 @@ -0,0 +1,169 @@
   117.4 +theory Context_Free_Grammar_Example
   117.5 +imports Code_Prolog
   117.6 +begin
   117.7 +
   117.8 +declare mem_def[code_pred_inline]
   117.9 +
  117.10 +
  117.11 +subsection {* Alternative rules for length *}
  117.12 +
  117.13 +definition size_list :: "'a list => nat"
  117.14 +where "size_list = size"
  117.15 +
  117.16 +lemma size_list_simps:
  117.17 +  "size_list [] = 0"
  117.18 +  "size_list (x # xs) = Suc (size_list xs)"
  117.19 +by (auto simp add: size_list_def)
  117.20 +
  117.21 +declare size_list_simps[code_pred_def]
  117.22 +declare size_list_def[symmetric, code_pred_inline]
  117.23 +
  117.24 +
  117.25 +setup {* Quickcheck.add_generator ("prolog", Code_Prolog.quickcheck) *}
  117.26 +
  117.27 +datatype alphabet = a | b
  117.28 +
  117.29 +inductive_set S\<^isub>1 and A\<^isub>1 and B\<^isub>1 where
  117.30 +  "[] \<in> S\<^isub>1"
  117.31 +| "w \<in> A\<^isub>1 \<Longrightarrow> b # w \<in> S\<^isub>1"
  117.32 +| "w \<in> B\<^isub>1 \<Longrightarrow> a # w \<in> S\<^isub>1"
  117.33 +| "w \<in> S\<^isub>1 \<Longrightarrow> a # w \<in> A\<^isub>1"
  117.34 +| "w \<in> S\<^isub>1 \<Longrightarrow> b # w \<in> S\<^isub>1"
  117.35 +| "\<lbrakk>v \<in> B\<^isub>1; v \<in> B\<^isub>1\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^isub>1"
  117.36 +
  117.37 +lemma
  117.38 +  "w \<in> S\<^isub>1 \<Longrightarrow> w = []"
  117.39 +quickcheck[generator = prolog, iterations=1, expect = counterexample]
  117.40 +oops
  117.41 +
  117.42 +definition "filter_a = filter (\<lambda>x. x = a)"
  117.43 +
  117.44 +lemma [code_pred_def]: "filter_a [] = []"
  117.45 +unfolding filter_a_def by simp
  117.46 +
  117.47 +lemma [code_pred_def]: "filter_a (x#xs) = (if x = a then x # filter_a xs else filter_a xs)"
  117.48 +unfolding filter_a_def by simp
  117.49 +
  117.50 +declare filter_a_def[symmetric, code_pred_inline]
  117.51 +
  117.52 +definition "filter_b = filter (\<lambda>x. x = b)"
  117.53 +
  117.54 +lemma [code_pred_def]: "filter_b [] = []"
  117.55 +unfolding filter_b_def by simp
  117.56 +
  117.57 +lemma [code_pred_def]: "filter_b (x#xs) = (if x = b then x # filter_b xs else filter_b xs)"
  117.58 +unfolding filter_b_def by simp
  117.59 +
  117.60 +declare filter_b_def[symmetric, code_pred_inline]
  117.61 +
  117.62 +setup {* Code_Prolog.map_code_options (K
  117.63 +  {ensure_groundness = true,
  117.64 +  limited_types = [],
  117.65 +  limited_predicates = [(["s1", "a1", "b1"], 2)],
  117.66 +  replacing = [(("s1", "limited_s1"), "quickcheck")],
  117.67 +  manual_reorder = [(("quickcheck", 1), [0,2,1,4,3,5])],
  117.68 +  prolog_system = Code_Prolog.SWI_PROLOG}) *}
  117.69 +
  117.70 +
  117.71 +theorem S\<^isub>1_sound:
  117.72 +"w \<in> S\<^isub>1 \<Longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
  117.73 +quickcheck[generator = prolog, iterations=1, expect = counterexample]
  117.74 +oops
  117.75 +
  117.76 +
  117.77 +inductive_set S\<^isub>2 and A\<^isub>2 and B\<^isub>2 where
  117.78 +  "[] \<in> S\<^isub>2"
  117.79 +| "w \<in> A\<^isub>2 \<Longrightarrow> b # w \<in> S\<^isub>2"
  117.80 +| "w \<in> B\<^isub>2 \<Longrightarrow> a # w \<in> S\<^isub>2"
  117.81 +| "w \<in> S\<^isub>2 \<Longrightarrow> a # w \<in> A\<^isub>2"
  117.82 +| "w \<in> S\<^isub>2 \<Longrightarrow> b # w \<in> B\<^isub>2"
  117.83 +| "\<lbrakk>v \<in> B\<^isub>2; v \<in> B\<^isub>2\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^isub>2"
  117.84 +
  117.85 +
  117.86 +setup {* Code_Prolog.map_code_options (K
  117.87 +  {ensure_groundness = true,
  117.88 +  limited_types = [],
  117.89 +  limited_predicates = [(["s2", "a2", "b2"], 3)],
  117.90 +  replacing = [(("s2", "limited_s2"), "quickcheck")],
  117.91 +  manual_reorder = [(("quickcheck", 1), [0,2,1,4,3,5])],
  117.92 +  prolog_system = Code_Prolog.SWI_PROLOG}) *}
  117.93 +
  117.94 +
  117.95 +theorem S\<^isub>2_sound:
  117.96 +"w \<in> S\<^isub>2 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
  117.97 +quickcheck[generator=prolog, iterations=1, expect = counterexample]
  117.98 +oops
  117.99 +
 117.100 +inductive_set S\<^isub>3 and A\<^isub>3 and B\<^isub>3 where
 117.101 +  "[] \<in> S\<^isub>3"
 117.102 +| "w \<in> A\<^isub>3 \<Longrightarrow> b # w \<in> S\<^isub>3"
 117.103 +| "w \<in> B\<^isub>3 \<Longrightarrow> a # w \<in> S\<^isub>3"
 117.104 +| "w \<in> S\<^isub>3 \<Longrightarrow> a # w \<in> A\<^isub>3"
 117.105 +| "w \<in> S\<^isub>3 \<Longrightarrow> b # w \<in> B\<^isub>3"
 117.106 +| "\<lbrakk>v \<in> B\<^isub>3; w \<in> B\<^isub>3\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^isub>3"
 117.107 +
 117.108 +
 117.109 +setup {* Code_Prolog.map_code_options (K
 117.110 +  {ensure_groundness = true,
 117.111 +  limited_types = [],
 117.112 +  limited_predicates = [(["s3", "a3", "b3"], 6)],
 117.113 +  replacing = [(("s3", "limited_s3"), "quickcheck")],
 117.114 +  manual_reorder = [(("quickcheck", 1), [0,2,1,4,3,5])],
 117.115 +  prolog_system = Code_Prolog.SWI_PROLOG}) *}
 117.116 +
 117.117 +lemma S\<^isub>3_sound:
 117.118 +"w \<in> S\<^isub>3 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
 117.119 +quickcheck[generator=prolog, iterations=1, size=1, expect = no_counterexample]
 117.120 +oops
 117.121 +
 117.122 +
 117.123 +(*
 117.124 +setup {* Code_Prolog.map_code_options (K
 117.125 +  {ensure_groundness = true,
 117.126 +  limited_types = [],
 117.127 +  limited_predicates = [],
 117.128 +  replacing = [],
 117.129 +  manual_reorder = [],
 117.130 +  prolog_system = Code_Prolog.SWI_PROLOG}) *}
 117.131 +
 117.132 +
 117.133 +theorem S\<^isub>3_complete:
 117.134 +"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> w \<in> S\<^isub>3"
 117.135 +quickcheck[generator = prolog, size=1, iterations=1]
 117.136 +oops
 117.137 +*)
 117.138 +
 117.139 +inductive_set S\<^isub>4 and A\<^isub>4 and B\<^isub>4 where
 117.140 +  "[] \<in> S\<^isub>4"
 117.141 +| "w \<in> A\<^isub>4 \<Longrightarrow> b # w \<in> S\<^isub>4"
 117.142 +| "w \<in> B\<^isub>4 \<Longrightarrow> a # w \<in> S\<^isub>4"
 117.143 +| "w \<in> S\<^isub>4 \<Longrightarrow> a # w \<in> A\<^isub>4"
 117.144 +| "\<lbrakk>v \<in> A\<^isub>4; w \<in> A\<^isub>4\<rbrakk> \<Longrightarrow> b # v @ w \<in> A\<^isub>4"
 117.145 +| "w \<in> S\<^isub>4 \<Longrightarrow> b # w \<in> B\<^isub>4"
 117.146 +| "\<lbrakk>v \<in> B\<^isub>4; w \<in> B\<^isub>4\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^isub>4"
 117.147 +
 117.148 +
 117.149 +setup {* Code_Prolog.map_code_options (K
 117.150 +  {ensure_groundness = true,
 117.151 +  limited_types = [],
 117.152 +  limited_predicates = [(["s4", "a4", "b4"], 6)],
 117.153 +  replacing = [(("s4", "limited_s4"), "quickcheck")],
 117.154 +  manual_reorder = [(("quickcheck", 1), [0,2,1,4,3,5])],
 117.155 +  prolog_system = Code_Prolog.SWI_PROLOG}) *}
 117.156 +
 117.157 +
 117.158 +theorem S\<^isub>4_sound:
 117.159 +"w \<in> S\<^isub>4 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
 117.160 +quickcheck[generator = prolog, size=1, iterations=1, expect = no_counterexample]
 117.161 +oops
 117.162 +
 117.163 +(*
 117.164 +theorem S\<^isub>4_complete:
 117.165 +"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> w \<in> S\<^isub>4"
 117.166 +oops
 117.167 +*)
 117.168 +
 117.169 +hide_const a b
 117.170 +
 117.171 +
 117.172 +end
 117.173 \ No newline at end of file
   118.1 --- a/src/HOL/Predicate_Compile_Examples/Hotel_Example.thy	Thu Sep 02 17:12:40 2010 +0200
   118.2 +++ b/src/HOL/Predicate_Compile_Examples/Hotel_Example.thy	Thu Sep 02 17:28:00 2010 +0200
   118.3 @@ -84,18 +84,46 @@
   118.4  lemma [code_pred_inline]: "(op -) == (%A B x. A x \<and> \<not> B x)"
   118.5  by (auto simp add: Diff_iff[unfolded mem_def] expand_fun_eq intro!: eq_reflection)
   118.6  
   118.7 -ML {* Code_Prolog.options := {ensure_groundness = true} *}
   118.8 +setup {* Code_Prolog.map_code_options (K
   118.9 +  {ensure_groundness = true,
  118.10 +  limited_types = [],
  118.11 +  limited_predicates = [],
  118.12 +  replacing = [],
  118.13 +  manual_reorder = [],
  118.14 +  prolog_system = Code_Prolog.SWI_PROLOG}) *}
  118.15  
  118.16  values 40 "{s. hotel s}"
  118.17  
  118.18  
  118.19  setup {* Quickcheck.add_generator ("prolog", Code_Prolog.quickcheck) *}
  118.20 -ML {* set Code_Prolog.trace *}
  118.21  
  118.22  lemma "\<lbrakk> hotel s; g \<in> isin s r \<rbrakk> \<Longrightarrow> owns s r = Some g"
  118.23  quickcheck[generator = code, iterations = 100000, report]
  118.24 -quickcheck[generator = prolog, iterations = 1]
  118.25 +quickcheck[generator = prolog, iterations = 1, expect = counterexample]
  118.26  oops
  118.27  
  118.28  
  118.29 +definition no_Check_in :: "event list \<Rightarrow> room \<Rightarrow> bool" where(*>*)
  118.30 +[code del]: "no_Check_in s r \<equiv> \<not>(\<exists>g c. Check_in g r c \<in> set s)"
  118.31 +
  118.32 +
  118.33 +definition feels_safe :: "event list \<Rightarrow> room \<Rightarrow> bool"
  118.34 +where
  118.35 +  "feels_safe s r = (\<exists>s\<^isub>1 s\<^isub>2 s\<^isub>3 g c c'.
  118.36 +   s = s\<^isub>3 @ [Enter g r c] @ s\<^isub>2 @ [Check_in g r c'] @ s\<^isub>1 \<and>
  118.37 +   no_Check_in (s\<^isub>3 @ s\<^isub>2) r \<and> isin (s\<^isub>2 @ [Check_in g r c] @ s\<^isub>1) r = {})"
  118.38 +
  118.39 +setup {* Code_Prolog.map_code_options (K 
  118.40 +  {ensure_groundness = true,
  118.41 +   limited_types = [],
  118.42 +   limited_predicates = [(["hotel"], 5)],
  118.43 +   replacing = [(("hotel", "limited_hotel"), "quickcheck")],
  118.44 +   manual_reorder = [],
  118.45 +   prolog_system = Code_Prolog.SWI_PROLOG}) *}
  118.46 +
  118.47 +lemma
  118.48 +  "hotel s ==> feels_safe s r ==> g \<in> isin s r ==> owns s r = Some g"
  118.49 +quickcheck[generator = prolog, iterations = 1, expect = counterexample]
  118.50 +oops
  118.51 +
  118.52  end
  118.53 \ No newline at end of file
   119.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   119.2 +++ b/src/HOL/Predicate_Compile_Examples/Lambda_Example.thy	Thu Sep 02 17:28:00 2010 +0200
   119.3 @@ -0,0 +1,126 @@
   119.4 +theory Lambda_Example
   119.5 +imports Code_Prolog
   119.6 +begin
   119.7 +
   119.8 +subsection {* Lambda *}
   119.9 +
  119.10 +datatype type =
  119.11 +    Atom nat
  119.12 +  | Fun type type    (infixr "\<Rightarrow>" 200)
  119.13 +
  119.14 +datatype dB =
  119.15 +    Var nat
  119.16 +  | App dB dB (infixl "\<degree>" 200)
  119.17 +  | Abs type dB
  119.18 +
  119.19 +primrec
  119.20 +  nth_el :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" ("_\<langle>_\<rangle>" [90, 0] 91)
  119.21 +where
  119.22 +  "[]\<langle>i\<rangle> = None"
  119.23 +| "(x # xs)\<langle>i\<rangle> = (case i of 0 \<Rightarrow> Some x | Suc j \<Rightarrow> xs \<langle>j\<rangle>)"
  119.24 +
  119.25 +inductive nth_el1 :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
  119.26 +where
  119.27 +  "nth_el1 (x # xs) 0 x"
  119.28 +| "nth_el1 xs i y \<Longrightarrow> nth_el1 (x # xs) (Suc i) y"
  119.29 +
  119.30 +inductive typing :: "type list \<Rightarrow> dB \<Rightarrow> type \<Rightarrow> bool"  ("_ \<turnstile> _ : _" [50, 50, 50] 50)
  119.31 +  where
  119.32 +    Var [intro!]: "nth_el1 env x T \<Longrightarrow> env \<turnstile> Var x : T"
  119.33 +  | Abs [intro!]: "T # env \<turnstile> t : U \<Longrightarrow> env \<turnstile> Abs T t : (T \<Rightarrow> U)"
  119.34 +  | App [intro!]: "env \<turnstile> s : U \<Rightarrow> T \<Longrightarrow> env \<turnstile> t : T \<Longrightarrow> env \<turnstile> (s \<degree> t) : U"
  119.35 +
  119.36 +primrec
  119.37 +  lift :: "[dB, nat] => dB"
  119.38 +where
  119.39 +    "lift (Var i) k = (if i < k then Var i else Var (i + 1))"
  119.40 +  | "lift (s \<degree> t) k = lift s k \<degree> lift t k"
  119.41 +  | "lift (Abs T s) k = Abs T (lift s (k + 1))"
  119.42 +
  119.43 +primrec pred :: "nat => nat"
  119.44 +where
  119.45 +  "pred (Suc i) = i"
  119.46 +
  119.47 +primrec
  119.48 +  subst :: "[dB, dB, nat] => dB"  ("_[_'/_]" [300, 0, 0] 300)
  119.49 +where
  119.50 +    subst_Var: "(Var i)[s/k] =
  119.51 +      (if k < i then Var (pred i) else if i = k then s else Var i)"
  119.52 +  | subst_App: "(t \<degree> u)[s/k] = t[s/k] \<degree> u[s/k]"
  119.53 +  | subst_Abs: "(Abs T t)[s/k] = Abs T (t[lift s 0 / k+1])"
  119.54 +
  119.55 +inductive beta :: "[dB, dB] => bool"  (infixl "\<rightarrow>\<^sub>\<beta>" 50)
  119.56 +  where
  119.57 +    beta [simp, intro!]: "Abs T s \<degree> t \<rightarrow>\<^sub>\<beta> s[t/0]"
  119.58 +  | appL [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> s \<degree> u \<rightarrow>\<^sub>\<beta> t \<degree> u"
  119.59 +  | appR [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> u \<degree> s \<rightarrow>\<^sub>\<beta> u \<degree> t"
  119.60 +  | abs [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> Abs T s \<rightarrow>\<^sub>\<beta> Abs T t"
  119.61 +
  119.62 +subsection {* Inductive definitions for ordering on naturals *}
  119.63 +
  119.64 +inductive less_nat
  119.65 +where
  119.66 +  "less_nat 0 (Suc y)"
  119.67 +| "less_nat x y ==> less_nat (Suc x) (Suc y)"
  119.68 +
  119.69 +lemma less_nat[code_pred_inline]:
  119.70 +  "x < y = less_nat x y"
  119.71 +apply (rule iffI)
  119.72 +apply (induct x arbitrary: y)
  119.73 +apply (case_tac y) apply (auto intro: less_nat.intros)
  119.74 +apply (case_tac y)
  119.75 +apply (auto intro: less_nat.intros)
  119.76 +apply (induct rule: less_nat.induct)
  119.77 +apply auto
  119.78 +done
  119.79 +
  119.80 +lemma [code_pred_inline]: "(x::nat) + 1 = Suc x"
  119.81 +by simp
  119.82 +
  119.83 +section {* Manual setup to find counterexample *}
  119.84 +
  119.85 +setup {* Quickcheck.add_generator ("prolog", Code_Prolog.quickcheck) *}
  119.86 +
  119.87 +setup {* Code_Prolog.map_code_options (K 
  119.88 +  { ensure_groundness = true,
  119.89 +    limited_types = [(@{typ nat}, 1), (@{typ "type"}, 1), (@{typ dB}, 1), (@{typ "type list"}, 1)],
  119.90 +    limited_predicates = [(["typing"], 2), (["nthel1"], 2)],
  119.91 +    replacing = [(("typing", "limited_typing"), "quickcheck"),
  119.92 +                 (("nthel1", "limited_nthel1"), "lim_typing")],
  119.93 +    manual_reorder = [],
  119.94 +    prolog_system = Code_Prolog.SWI_PROLOG}) *}
  119.95 +
  119.96 +lemma
  119.97 +  "\<Gamma> \<turnstile> t : U \<Longrightarrow> t \<rightarrow>\<^sub>\<beta> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : U"
  119.98 +quickcheck[generator = prolog, iterations = 1, expect = counterexample]
  119.99 +oops
 119.100 +
 119.101 +text {* Verifying that the found counterexample really is one by means of a proof *}
 119.102 +
 119.103 +lemma
 119.104 +assumes
 119.105 +  "t' = Var 0"
 119.106 +  "U = Atom 0"
 119.107 +  "\<Gamma> = [Atom 1]"
 119.108 +  "t = App (Abs (Atom 0) (Var 1)) (Var 0)"
 119.109 +shows
 119.110 +  "\<Gamma> \<turnstile> t : U"
 119.111 +  "t \<rightarrow>\<^sub>\<beta> t'"
 119.112 +  "\<not> \<Gamma> \<turnstile> t' : U"
 119.113 +proof -
 119.114 +  from assms show "\<Gamma> \<turnstile> t : U"
 119.115 +    by (auto intro!: typing.intros nth_el1.intros)
 119.116 +next
 119.117 +  from assms have "t \<rightarrow>\<^sub>\<beta> (Var 1)[Var 0/0]"
 119.118 +    by (auto simp only: intro: beta.intros)
 119.119 +  moreover
 119.120 +  from assms have "(Var 1)[Var 0/0] = t'" by simp
 119.121 +  ultimately show "t \<rightarrow>\<^sub>\<beta> t'" by simp
 119.122 +next
 119.123 +  from assms show "\<not> \<Gamma> \<turnstile> t' : U"
 119.124 +    by (auto elim: typing.cases nth_el1.cases)
 119.125 +qed
 119.126 +
 119.127 +
 119.128 +end
 119.129 +
   120.1 --- a/src/HOL/Predicate_Compile_Examples/ROOT.ML	Thu Sep 02 17:12:40 2010 +0200
   120.2 +++ b/src/HOL/Predicate_Compile_Examples/ROOT.ML	Thu Sep 02 17:28:00 2010 +0200
   120.3 @@ -1,2 +1,2 @@
   120.4  use_thys ["Predicate_Compile_Examples", "Predicate_Compile_Quickcheck_Examples", "Specialisation_Examples"];
   120.5 -if getenv "PROLOG_HOME" = "" then () else use_thys ["Code_Prolog_Examples", "Hotel_Example"];
   120.6 +if getenv "PROLOG_HOME" = "" then () else use_thys ["Code_Prolog_Examples", "Hotel_Example", "Lambda_Example"];
   121.1 --- a/src/HOL/Probability/Caratheodory.thy	Thu Sep 02 17:12:40 2010 +0200
   121.2 +++ b/src/HOL/Probability/Caratheodory.thy	Thu Sep 02 17:28:00 2010 +0200
   121.3 @@ -445,21 +445,6 @@
   121.4      by intro_locales (auto simp add: sigma_algebra_def)
   121.5  qed
   121.6  
   121.7 -
   121.8 -lemma (in algebra) inf_measure_nonempty:
   121.9 -  assumes f: "positive f" and b: "b \<in> sets M" and a: "a \<subseteq> b"
  121.10 -  shows "f b \<in> measure_set M f a"
  121.11 -proof -
  121.12 -  have "psuminf (f \<circ> (\<lambda>i. {})(0 := b)) = setsum (f \<circ> (\<lambda>i. {})(0 := b)) {..<1::nat}"
  121.13 -    by (rule psuminf_finite) (simp add: f[unfolded positive_def])
  121.14 -  also have "... = f b"
  121.15 -    by simp
  121.16 -  finally have "psuminf (f \<circ> (\<lambda>i. {})(0 := b)) = f b" .
  121.17 -  thus ?thesis using a b
  121.18 -    by (auto intro!: exI [of _ "(\<lambda>i. {})(0 := b)"]
  121.19 -             simp: measure_set_def disjoint_family_on_def split_if_mem2 comp_def)
  121.20 -qed
  121.21 -
  121.22  lemma (in algebra) additive_increasing:
  121.23    assumes posf: "positive f" and addf: "additive M f"
  121.24    shows "increasing M f"
  121.25 @@ -494,6 +479,20 @@
  121.26      by (auto simp add: Un binaryset_psuminf positive_def)
  121.27  qed
  121.28  
  121.29 +lemma inf_measure_nonempty:
  121.30 +  assumes f: "positive f" and b: "b \<in> sets M" and a: "a \<subseteq> b" "{} \<in> sets M"
  121.31 +  shows "f b \<in> measure_set M f a"
  121.32 +proof -
  121.33 +  have "psuminf (f \<circ> (\<lambda>i. {})(0 := b)) = setsum (f \<circ> (\<lambda>i. {})(0 := b)) {..<1::nat}"
  121.34 +    by (rule psuminf_finite) (simp add: f[unfolded positive_def])
  121.35 +  also have "... = f b"
  121.36 +    by simp
  121.37 +  finally have "psuminf (f \<circ> (\<lambda>i. {})(0 := b)) = f b" .
  121.38 +  thus ?thesis using assms
  121.39 +    by (auto intro!: exI [of _ "(\<lambda>i. {})(0 := b)"]
  121.40 +             simp: measure_set_def disjoint_family_on_def split_if_mem2 comp_def)
  121.41 +qed
  121.42 +
  121.43  lemma (in algebra) inf_measure_agrees:
  121.44    assumes posf: "positive f" and ca: "countably_additive M f"
  121.45        and s: "s \<in> sets M"
  121.46 @@ -535,11 +534,11 @@
  121.47  qed
  121.48  
  121.49  lemma (in algebra) inf_measure_empty:
  121.50 -  assumes posf: "positive f"
  121.51 +  assumes posf: "positive f"  "{} \<in> sets M"
  121.52    shows "Inf (measure_set M f {}) = 0"
  121.53  proof (rule antisym)
  121.54    show "Inf (measure_set M f {}) \<le> 0"
  121.55 -    by (metis complete_lattice_class.Inf_lower empty_sets inf_measure_nonempty[OF posf] subset_refl posf[unfolded positive_def])
  121.56 +    by (metis complete_lattice_class.Inf_lower `{} \<in> sets M` inf_measure_nonempty[OF posf] subset_refl posf[unfolded positive_def])
  121.57  qed simp
  121.58  
  121.59  lemma (in algebra) inf_measure_positive:
  121.60 @@ -597,7 +596,7 @@
  121.61  next
  121.62    case True
  121.63    have "measure_set M f s \<noteq> {}"
  121.64 -    by (metis emptyE ss inf_measure_nonempty [of f, OF posf top])
  121.65 +    by (metis emptyE ss inf_measure_nonempty [of f, OF posf top _ empty_sets])
  121.66    then obtain l where "l \<in> measure_set M f s" by auto
  121.67    moreover from True have "l \<le> Inf (measure_set M f s) + e" by simp
  121.68    ultimately show ?thesis
   122.1 --- a/src/HOL/Probability/Probability_Space.thy	Thu Sep 02 17:12:40 2010 +0200
   122.2 +++ b/src/HOL/Probability/Probability_Space.thy	Thu Sep 02 17:28:00 2010 +0200
   122.3 @@ -2,6 +2,8 @@
   122.4  imports Lebesgue_Integration Radon_Nikodym
   122.5  begin
   122.6  
   122.7 +
   122.8 +
   122.9  locale prob_space = measure_space +
  122.10    assumes measure_space_1: "\<mu> (space M) = 1"
  122.11  
  122.12 @@ -408,6 +410,47 @@
  122.13      unfolding distribution_def by (auto intro!: finite_measure simp: sets_eq_Pow) }
  122.14  qed
  122.15  
  122.16 +lemma (in finite_prob_space) finite_product_measure_space:
  122.17 +  assumes "finite s1" "finite s2"
  122.18 +  shows "finite_measure_space \<lparr> space = s1 \<times> s2, sets = Pow (s1 \<times> s2)\<rparr> (joint_distribution X Y)"
  122.19 +    (is "finite_measure_space ?M ?D")
  122.20 +proof (rule finite_Pow_additivity_sufficient)
  122.21 +  show "positive ?D"
  122.22 +    unfolding positive_def using assms sets_eq_Pow
  122.23 +    by (simp add: distribution_def)
  122.24 +
  122.25 +  show "additive ?M ?D" unfolding additive_def
  122.26 +  proof safe
  122.27 +    fix x y
  122.28 +    have A: "((\<lambda>x. (X x, Y x)) -` x) \<inter> space M \<in> sets M" using assms sets_eq_Pow by auto
  122.29 +    have B: "((\<lambda>x. (X x, Y x)) -` y) \<inter> space M \<in> sets M" using assms sets_eq_Pow by auto
  122.30 +    assume "x \<inter> y = {}"
  122.31 +    hence "(\<lambda>x. (X x, Y x)) -` x \<inter> space M \<inter> ((\<lambda>x. (X x, Y x)) -` y \<inter> space M) = {}"
  122.32 +      by auto
  122.33 +    from additive[unfolded additive_def, rule_format, OF A B] this
  122.34 +      finite_measure[OF A] finite_measure[OF B]
  122.35 +    show "?D (x \<union> y) = ?D x + ?D y"
  122.36 +      apply (simp add: distribution_def)
  122.37 +      apply (subst Int_Un_distrib2)
  122.38 +      by (auto simp: real_of_pinfreal_add)
  122.39 +  qed
  122.40 +
  122.41 +  show "finite (space ?M)"
  122.42 +    using assms by auto
  122.43 +
  122.44 +  show "sets ?M = Pow (space ?M)"
  122.45 +    by simp
  122.46 +
  122.47 +  { fix x assume "x \<in> space ?M" thus "?D {x} \<noteq> \<omega>"
  122.48 +    unfolding distribution_def by (auto intro!: finite_measure simp: sets_eq_Pow) }
  122.49 +qed
  122.50 +
  122.51 +lemma (in finite_measure_space) finite_product_measure_space_of_images:
  122.52 +  shows "finite_measure_space \<lparr> space = X ` space M \<times> Y ` space M,
  122.53 +                                sets = Pow (X ` space M \<times> Y ` space M) \<rparr>
  122.54 +                              (joint_distribution X Y)"
  122.55 +  using finite_space by (auto intro!: finite_product_measure_space)
  122.56 +
  122.57  section "Conditional Expectation and Probability"
  122.58  
  122.59  lemma (in prob_space) conditional_expectation_exists:
   123.1 --- a/src/HOL/Probability/Product_Measure.thy	Thu Sep 02 17:12:40 2010 +0200
   123.2 +++ b/src/HOL/Probability/Product_Measure.thy	Thu Sep 02 17:28:00 2010 +0200
   123.3 @@ -10,7 +10,7 @@
   123.4  
   123.5  lemma dynkinI:
   123.6    assumes "\<And> A. A \<in> sets M \<Longrightarrow> A \<subseteq> space M"
   123.7 -  assumes "space M \<in> sets M" and "\<forall> a \<in> sets M. \<forall> b \<in> sets M. b - a \<in> sets M"
   123.8 +  assumes "space M \<in> sets M" and "\<forall> b \<in> sets M. \<forall> a \<in> sets M. a \<subseteq> b \<longrightarrow> b - a \<in> sets M"
   123.9    assumes "\<And> a. (\<And> i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {})
  123.10            \<Longrightarrow> (\<And> i :: nat. a i \<in> sets M) \<Longrightarrow> UNION UNIV a \<in> sets M"
  123.11    shows "dynkin M"
  123.12 @@ -28,13 +28,18 @@
  123.13  
  123.14  lemma dynkin_diff:
  123.15    assumes "dynkin M"
  123.16 -  shows "\<And> a b. \<lbrakk> a \<in> sets M ; b \<in> sets M \<rbrakk> \<Longrightarrow> b - a \<in> sets M"
  123.17 +  shows "\<And> a b. \<lbrakk> a \<in> sets M ; b \<in> sets M ; a \<subseteq> b \<rbrakk> \<Longrightarrow> b - a \<in> sets M"
  123.18  using assms unfolding dynkin_def by auto
  123.19  
  123.20 +lemma dynkin_empty:
  123.21 +  assumes "dynkin M"
  123.22 +  shows "{} \<in> sets M"
  123.23 +using dynkin_diff[OF assms dynkin_space[OF assms] dynkin_space[OF assms]] by auto
  123.24 +
  123.25  lemma dynkin_UN:
  123.26    assumes "dynkin M"
  123.27    assumes "\<And> i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}"
  123.28 -  assumes "\<forall> i :: nat. a i \<in> sets M"
  123.29 +  assumes "\<And> i :: nat. a i \<in> sets M"
  123.30    shows "UNION UNIV a \<in> sets M"
  123.31  using assms unfolding dynkin_def sorry
  123.32  
  123.33 @@ -44,7 +49,7 @@
  123.34    shows "dynkin \<lparr> space = A, sets = Pow A \<rparr>"
  123.35  by (rule dynkinI) auto
  123.36  
  123.37 -lemma
  123.38 +lemma dynkin_lemma:
  123.39    fixes D :: "'a algebra"
  123.40    assumes stab: "Int_stable E"
  123.41    and spac: "space E = space D"
  123.42 @@ -60,10 +65,8 @@
  123.43    hence not_empty: "{sets (d :: 'a algebra) | d. dynkin d \<and> space d = space E \<and> sets E \<subseteq> sets d} \<noteq> {}"
  123.44      using exI[of "\<lambda> x. space x = space E \<and> dynkin x \<and> sets E \<subseteq> sets x" "\<lparr> space = space E, sets = Pow (space E) \<rparr>", simplified]
  123.45      by auto
  123.46 -
  123.47 -  have "sets_\<delta>E \<subseteq> sets D"
  123.48 +  have \<delta>E_D: "sets_\<delta>E \<subseteq> sets D"
  123.49      unfolding sets_\<delta>E_def using assms by auto
  123.50 -
  123.51    have \<delta>ynkin: "dynkin \<delta>E"
  123.52    proof (rule dynkinI, safe)
  123.53      fix A x assume asm: "A \<in> sets \<delta>E" "x \<in> A"
  123.54 @@ -76,7 +79,7 @@
  123.55        unfolding \<delta>E_def sets_\<delta>E_def
  123.56        using dynkin_space by fastsimp
  123.57    next
  123.58 -    fix a b assume "a \<in> sets \<delta>E" "b \<in> sets \<delta>E"
  123.59 +    fix a b assume "a \<in> sets \<delta>E" "b \<in> sets \<delta>E" "a \<subseteq> b"
  123.60      thus "b - a \<in> sets \<delta>E"
  123.61        unfolding \<delta>E_def sets_\<delta>E_def by (auto intro:dynkin_diff)
  123.62    next
  123.63 @@ -113,21 +116,21 @@
  123.64            unfolding \<delta>E_def by auto
  123.65        qed
  123.66      next
  123.67 -      fix a b assume absm: "a \<in> Dy d" "b \<in> Dy d"
  123.68 +      fix a b assume absm: "a \<in> Dy d" "b \<in> Dy d" "a \<subseteq> b"
  123.69        hence "a \<in> sets \<delta>E" "b \<in> sets \<delta>E"
  123.70          unfolding Dy_def \<delta>E_def by auto
  123.71        hence *: "b - a \<in> sets \<delta>E"
  123.72 -        using dynkin_diff[OF \<delta>ynkin] by auto
  123.73 +        using dynkin_diff[OF \<delta>ynkin] `a \<subseteq> b` by auto
  123.74        have "a \<inter> d \<in> sets \<delta>E" "b \<inter> d \<in> sets \<delta>E"
  123.75          using absm unfolding Dy_def \<delta>E_def by auto
  123.76        hence "(b \<inter> d) - (a \<inter> d) \<in> sets \<delta>E"
  123.77 -        using dynkin_diff[OF \<delta>ynkin] by auto
  123.78 +        using dynkin_diff[OF \<delta>ynkin] `a \<subseteq> b` by auto
  123.79        hence **: "(b - a) \<inter> d \<in> sets \<delta>E" by (auto simp add:Diff_Int_distrib2)
  123.80        thus "b - a \<in> Dy d"
  123.81          using * ** unfolding Dy_def \<delta>E_def by auto
  123.82      next
  123.83        fix a assume aasm: "\<And>i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}" "\<And>i. a i \<in> Dy d"
  123.84 -      hence "\<forall> i. a i \<in> sets \<delta>E"
  123.85 +      hence "\<And> i. a i \<in> sets \<delta>E"
  123.86          unfolding Dy_def \<delta>E_def by auto
  123.87        from dynkin_UN[OF \<delta>ynkin aasm(1) this]
  123.88        have *: "UNION UNIV a \<in> sets \<delta>E" by auto
  123.89 @@ -176,26 +179,171 @@
  123.90      fix a assume aasm: "a \<in> sets \<delta>E"
  123.91      hence "a \<inter> d \<in> sets \<delta>E"
  123.92        using * dasm unfolding Dy_def \<delta>E_def by auto } note \<delta>E_stab = this
  123.93 -  have "sigma_algebra D"
  123.94 +  { fix A :: "nat \<Rightarrow> 'a set" assume Asm: "range A \<subseteq> sets \<delta>E" "\<And>A. A \<in> sets \<delta>E \<Longrightarrow> A \<subseteq> space \<delta>E"
  123.95 +      "\<And>a. a \<in> sets \<delta>E \<Longrightarrow> space \<delta>E - a \<in> sets \<delta>E"
  123.96 +    "{} \<in> sets \<delta>E" "space \<delta>E \<in> sets \<delta>E"
  123.97 +    let "?A i" = "A i \<inter> (\<Inter> j \<in> {..< i}. space \<delta>E - A j)"
  123.98 +    { fix i :: nat
  123.99 +      have *: "(\<Inter> j \<in> {..< i}. space \<delta>E - A j) \<inter> space \<delta>E \<in> sets \<delta>E"
 123.100 +        apply (induct i)
 123.101 +        using lessThan_Suc Asm \<delta>E_stab apply fastsimp
 123.102 +        apply (subst lessThan_Suc)
 123.103 +        apply (subst INT_insert)
 123.104 +        apply (subst Int_assoc)
 123.105 +        apply (subst \<delta>E_stab)
 123.106 +        using lessThan_Suc Asm \<delta>E_stab Asm
 123.107 +        apply (fastsimp simp add:Int_assoc dynkin_diff[OF \<delta>ynkin])
 123.108 +        prefer 2 apply simp
 123.109 +        apply (rule dynkin_diff[OF \<delta>ynkin, of _ "space \<delta>E", OF _ dynkin_space[OF \<delta>ynkin]])
 123.110 +        using Asm by auto
 123.111 +      have **: "\<And> i. A i \<subseteq> space \<delta>E" using Asm by auto
 123.112 +      have "(\<Inter> j \<in> {..< i}. space \<delta>E - A j) \<subseteq> space \<delta>E \<or> (\<Inter> j \<in> {..< i}. A j) = UNIV \<and> i = 0"
 123.113 +        apply (cases i)
 123.114 +        using Asm ** dynkin_subset[OF \<delta>ynkin, of "A (i - 1)"]
 123.115 +        by auto
 123.116 +      hence Aisets: "?A i \<in> sets \<delta>E"
 123.117 +        apply (cases i)
 123.118 +        using Asm * apply fastsimp
 123.119 +        apply (rule \<delta>E_stab)
 123.120 +        using Asm * **
 123.121 +        by (auto simp add:Int_absorb2)
 123.122 +      have "?A i = disjointed A i" unfolding disjointed_def
 123.123 +      atLeast0LessThan using Asm by auto
 123.124 +      hence "?A i = disjointed A i" "?A i \<in> sets \<delta>E"
 123.125 +        using Aisets by auto
 123.126 +    } note Ai = this
 123.127 +    from dynkin_UN[OF \<delta>ynkin _ this(2)] this disjoint_family_disjointed[of A]
 123.128 +    have "(\<Union> i. ?A i) \<in> sets \<delta>E"
 123.129 +      by (auto simp add:disjoint_family_on_def disjointed_def)
 123.130 +    hence "(\<Union> i. A i) \<in> sets \<delta>E"
 123.131 +      using Ai(1) UN_disjointed_eq[of A] by auto } note \<delta>E_UN = this
 123.132 +  { fix a b assume asm: "a \<in> sets \<delta>E" "b \<in> sets \<delta>E"
 123.133 +    let ?ab = "\<lambda> i. if (i::nat) = 0 then a else if i = 1 then b else {}"
 123.134 +    have *: "(\<Union> i. ?ab i) \<in> sets \<delta>E"
 123.135 +      apply (rule \<delta>E_UN)
 123.136 +      using asm \<delta>E_UN dynkin_empty[OF \<delta>ynkin] 
 123.137 +      dynkin_subset[OF \<delta>ynkin] 
 123.138 +      dynkin_space[OF \<delta>ynkin]
 123.139 +      dynkin_diff[OF \<delta>ynkin] by auto
 123.140 +    have "(\<Union> i. ?ab i) = a \<union> b" apply auto
 123.141 +      apply (case_tac "i = 0")
 123.142 +      apply auto
 123.143 +      apply (case_tac "i = 1")
 123.144 +      by auto
 123.145 +    hence "a \<union> b \<in> sets \<delta>E" using * by auto} note \<delta>E_Un = this
 123.146 +  have "sigma_algebra \<delta>E"
 123.147      apply unfold_locales
 123.148 -    using dynkin_subset[OF dyn]
 123.149 -    using dynkin_diff[OF dyn, of _ "space D", OF _ dynkin_space[OF dyn]]
 123.150 -    using dynkin_diff[OF dyn, of "space D" "space D", OF dynkin_space[OF dyn] dynkin_space[OF dyn]]
 123.151 -    using dynkin_space[OF dyn]
 123.152 -    sorry
 123.153 -(*
 123.154 -  proof auto
 123.155 -    fix A :: "nat \<Rightarrow> 'a set" assume Asm: "range A \<subseteq> sets D" "\<And>A. A \<in> sets D \<Longrightarrow> A \<subseteq> space D"
 123.156 -      "\<And>a. a \<in> sets D \<Longrightarrow> space D - a \<in> sets D"
 123.157 -    "{} \<in> sets D" "space D \<in> sets D"
 123.158 -    let "?A i" = "A i - (\<Inter> j \<in> {..< i}. A j)"
 123.159 -    { fix i :: nat assume "i > 0"
 123.160 -      have "(\<Inter> j \<in> {..< i}. A j) \<in> sets \<delta>E" sorry }
 123.161 -      oops
 123.162 +    using dynkin_subset[OF \<delta>ynkin]
 123.163 +    using dynkin_diff[OF \<delta>ynkin, of _ "space \<delta>E", OF _ dynkin_space[OF \<delta>ynkin]]
 123.164 +    using dynkin_diff[OF \<delta>ynkin, of "space \<delta>E" "space \<delta>E", OF dynkin_space[OF \<delta>ynkin] dynkin_space[OF \<delta>ynkin]]
 123.165 +    using dynkin_space[OF \<delta>ynkin]
 123.166 +    using \<delta>E_UN \<delta>E_Un
 123.167 +    by auto
 123.168 +  from sigma_algebra.sigma_subset[OF this E_\<delta>E] \<delta>E_D subsDE spac
 123.169 +  show ?thesis by (auto simp add:\<delta>E_def sigma_def)
 123.170 +qed
 123.171 +
 123.172 +lemma measure_eq:
 123.173 +  assumes fin: "\<mu> (space M) = \<nu> (space M)" "\<nu> (space M) < \<omega>"
 123.174 +  assumes E: "M = sigma (space E) (sets E)" "Int_stable E"
 123.175 +  assumes eq: "\<And> e. e \<in> sets E \<Longrightarrow> \<mu> e = \<nu> e"
 123.176 +  assumes ms: "measure_space M \<mu>" "measure_space M \<nu>"
 123.177 +  assumes A: "A \<in> sets M"
 123.178 +  shows "\<mu> A = \<nu> A"
 123.179 +proof -
 123.180 +  interpret M: measure_space M \<mu>
 123.181 +    using ms by simp
 123.182 +  interpret M': measure_space M \<nu>
 123.183 +    using ms by simp
 123.184 +
 123.185 +  let ?D_sets = "{A. A \<in> sets M \<and> \<mu> A = \<nu> A}"
 123.186 +  have \<delta>: "dynkin \<lparr> space = space M , sets = ?D_sets \<rparr>"
 123.187 +  proof (rule dynkinI, safe, simp_all)
 123.188 +    fix A x assume "A \<in> sets M \<and> \<mu> A = \<nu> A" "x \<in> A"
 123.189 +    thus "x \<in> space M" using assms M.sets_into_space by auto
 123.190 +  next
 123.191 +    show "\<mu> (space M) = \<nu> (space M)"
 123.192 +      using fin by auto
 123.193 +  next
 123.194 +    fix a b
 123.195 +    assume asm: "a \<in> sets M \<and> \<mu> a = \<nu> a"
 123.196 +      "b \<in> sets M \<and> \<mu> b = \<nu> b" "a \<subseteq> b"
 123.197 +    hence "a \<subseteq> space M"
 123.198 +      using M.sets_into_space by auto
 123.199 +    from M.measure_mono[OF this]
 123.200 +    have "\<mu> a \<le> \<mu> (space M)"
 123.201 +      using asm by auto
 123.202 +    hence afin: "\<mu> a < \<omega>"
 123.203 +      using fin by auto
 123.204 +    have *: "b = b - a \<union> a" using asm by auto
 123.205 +    have **: "(b - a) \<inter> a = {}" using asm by auto
 123.206 +    have iv: "\<mu> (b - a) + \<mu> a = \<mu> b"
 123.207 +      using M.measure_additive[of "b - a" a]
 123.208 +        conjunct1[OF asm(1)] conjunct1[OF asm(2)] * **
 123.209 +      by auto
 123.210 +    have v: "\<nu> (b - a) + \<nu> a = \<nu> b"
 123.211 +      using M'.measure_additive[of "b - a" a]
 123.212 +        conjunct1[OF asm(1)] conjunct1[OF asm(2)] * **
 123.213 +      by auto
 123.214 +    from iv v have "\<mu> (b - a) = \<nu> (b - a)" using asm afin
 123.215 +      pinfreal_add_cancel_right[of "\<mu> (b - a)" "\<nu> a" "\<nu> (b - a)"]
 123.216 +      by auto
 123.217 +    thus "b - a \<in> sets M \<and> \<mu> (b - a) = \<nu> (b - a)"
 123.218 +      using asm by auto
 123.219 +  next
 123.220 +    fix a assume "\<And>i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}"
 123.221 +      "\<And>i. a i \<in> sets M \<and> \<mu> (a i) = \<nu> (a i)"
 123.222 +    thus "(\<Union>x. a x) \<in> sets M \<and> \<mu> (\<Union>x. a x) = \<nu> (\<Union>x. a x)"
 123.223 +      using M.measure_countably_additive
 123.224 +        M'.measure_countably_additive
 123.225 +        M.countable_UN
 123.226 +      apply (auto simp add:disjoint_family_on_def image_def)
 123.227 +      apply (subst M.measure_countably_additive[symmetric])
 123.228 +      apply (auto simp add:disjoint_family_on_def)
 123.229 +      apply (subst M'.measure_countably_additive[symmetric])
 123.230 +      by (auto simp add:disjoint_family_on_def)
 123.231    qed
 123.232 -*)
 123.233 +  have *: "sets E \<subseteq> ?D_sets"
 123.234 +    using eq E sigma_sets.Basic[of _ "sets E"]
 123.235 +    by (auto simp add:sigma_def)
 123.236 +  have **: "?D_sets \<subseteq> sets M" by auto
 123.237 +  have "M = \<lparr> space = space M , sets = ?D_sets \<rparr>"
 123.238 +    unfolding E(1)
 123.239 +    apply (rule dynkin_lemma[OF E(2)])
 123.240 +    using eq E space_sigma \<delta> sigma_sets.Basic
 123.241 +    by (auto simp add:sigma_def)
 123.242 +  from subst[OF this, of "\<lambda> M. A \<in> sets M", OF A]
 123.243 +  show ?thesis by auto
 123.244 +qed
 123.245  
 123.246 -  show ?thesis sorry
 123.247 +lemma
 123.248 +  assumes sfin: "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And> i :: nat. \<nu> (A i) < \<omega>"
 123.249 +  assumes A: "\<And>  i. \<mu> (A i) = \<nu> (A i)" "\<And> i. A i \<subseteq> A (Suc i)"
 123.250 +  assumes E: "M = sigma (space E) (sets E)" "Int_stable E"
 123.251 +  assumes eq: "\<And> e. e \<in> sets E \<Longrightarrow> \<mu> e = \<nu> e"
 123.252 +  assumes ms: "measure_space (M :: 'a algebra) \<mu>" "measure_space M \<nu>"
 123.253 +  assumes B: "B \<in> sets M"
 123.254 +  shows "\<mu> B = \<nu> B"
 123.255 +proof -
 123.256 +  interpret M: measure_space M \<mu> by (rule ms)
 123.257 +  interpret M': measure_space M \<nu> by (rule ms)
 123.258 +  have *: "M = \<lparr> space = space M, sets = sets M \<rparr>" by auto
 123.259 +  { fix i :: nat
 123.260 +    have **: "M\<lparr> space := A i, sets := op \<inter> (A i) ` sets M \<rparr> =
 123.261 +      \<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr>"
 123.262 +      by auto
 123.263 +    have mu_i: "measure_space \<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr> \<mu>"
 123.264 +      using M.restricted_measure_space[of "A i", simplified **]
 123.265 +        sfin by auto
 123.266 +    have nu_i: "measure_space \<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr> \<nu>"
 123.267 +      using M'.restricted_measure_space[of "A i", simplified **]
 123.268 +        sfin by auto
 123.269 +    let ?M = "\<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr>"
 123.270 +    have "\<mu> (A i \<inter> B) = \<nu> (A i \<inter> B)"
 123.271 +      apply (rule measure_eq[of \<mu> ?M \<nu> "\<lparr> space = space E \<inter> A i, sets = op \<inter> (A i) ` sets E\<rparr>" "A i \<inter> B", simplified])
 123.272 +      using assms nu_i mu_i
 123.273 +      apply (auto simp add:image_def) (* TODO *) sorry
 123.274 +    show ?thesis sorry
 123.275  qed
 123.276  
 123.277  definition prod_sets where
 123.278 @@ -403,45 +551,4 @@
 123.279    unfolding finite_prod_measure_space[OF N, symmetric]
 123.280    using finite_measure_space_finite_prod_measure[OF N] .
 123.281  
 123.282 -lemma (in finite_prob_space) finite_product_measure_space:
 123.283 -  assumes "finite s1" "finite s2"
 123.284 -  shows "finite_measure_space \<lparr> space = s1 \<times> s2, sets = Pow (s1 \<times> s2)\<rparr> (joint_distribution X Y)"
 123.285 -    (is "finite_measure_space ?M ?D")
 123.286 -proof (rule finite_Pow_additivity_sufficient)
 123.287 -  show "positive ?D"
 123.288 -    unfolding positive_def using assms sets_eq_Pow
 123.289 -    by (simp add: distribution_def)
 123.290 -
 123.291 -  show "additive ?M ?D" unfolding additive_def
 123.292 -  proof safe
 123.293 -    fix x y
 123.294 -    have A: "((\<lambda>x. (X x, Y x)) -` x) \<inter> space M \<in> sets M" using assms sets_eq_Pow by auto
 123.295 -    have B: "((\<lambda>x. (X x, Y x)) -` y) \<inter> space M \<in> sets M" using assms sets_eq_Pow by auto
 123.296 -    assume "x \<inter> y = {}"
 123.297 -    hence "(\<lambda>x. (X x, Y x)) -` x \<inter> space M \<inter> ((\<lambda>x. (X x, Y x)) -` y \<inter> space M) = {}"
 123.298 -      by auto
 123.299 -    from additive[unfolded additive_def, rule_format, OF A B] this
 123.300 -      finite_measure[OF A] finite_measure[OF B]
 123.301 -    show "?D (x \<union> y) = ?D x + ?D y"
 123.302 -      apply (simp add: distribution_def)
 123.303 -      apply (subst Int_Un_distrib2)
 123.304 -      by (auto simp: real_of_pinfreal_add)
 123.305 -  qed
 123.306 -
 123.307 -  show "finite (space ?M)"
 123.308 -    using assms by auto
 123.309 -
 123.310 -  show "sets ?M = Pow (space ?M)"
 123.311 -    by simp
 123.312 -
 123.313 -  { fix x assume "x \<in> space ?M" thus "?D {x} \<noteq> \<omega>"
 123.314 -    unfolding distribution_def by (auto intro!: finite_measure simp: sets_eq_Pow) }
 123.315 -qed
 123.316 -
 123.317 -lemma (in finite_measure_space) finite_product_measure_space_of_images:
 123.318 -  shows "finite_measure_space \<lparr> space = X ` space M \<times> Y ` space M,
 123.319 -                                sets = Pow (X ` space M \<times> Y ` space M) \<rparr>
 123.320 -                              (joint_distribution X Y)"
 123.321 -  using finite_space by (auto intro!: finite_product_measure_space)
 123.322 -
 123.323 -end
 123.324 \ No newline at end of file
 123.325 +end
   124.1 --- a/src/HOL/Product_Type.thy	Thu Sep 02 17:12:40 2010 +0200
   124.2 +++ b/src/HOL/Product_Type.thy	Thu Sep 02 17:28:00 2010 +0200
   124.3 @@ -21,17 +21,17 @@
   124.4    -- "prefer plain propositional version"
   124.5  
   124.6  lemma
   124.7 -  shows [code]: "eq_class.eq False P \<longleftrightarrow> \<not> P"
   124.8 -    and [code]: "eq_class.eq True P \<longleftrightarrow> P" 
   124.9 -    and [code]: "eq_class.eq P False \<longleftrightarrow> \<not> P" 
  124.10 -    and [code]: "eq_class.eq P True \<longleftrightarrow> P"
  124.11 -    and [code nbe]: "eq_class.eq P P \<longleftrightarrow> True"
  124.12 -  by (simp_all add: eq)
  124.13 +  shows [code]: "HOL.equal False P \<longleftrightarrow> \<not> P"
  124.14 +    and [code]: "HOL.equal True P \<longleftrightarrow> P" 
  124.15 +    and [code]: "HOL.equal P False \<longleftrightarrow> \<not> P" 
  124.16 +    and [code]: "HOL.equal P True \<longleftrightarrow> P"
  124.17 +    and [code nbe]: "HOL.equal P P \<longleftrightarrow> True"
  124.18 +  by (simp_all add: equal)
  124.19  
  124.20 -code_const "eq_class.eq \<Colon> bool \<Rightarrow> bool \<Rightarrow> bool"
  124.21 +code_const "HOL.equal \<Colon> bool \<Rightarrow> bool \<Rightarrow> bool"
  124.22    (Haskell infixl 4 "==")
  124.23  
  124.24 -code_instance bool :: eq
  124.25 +code_instance bool :: equal
  124.26    (Haskell -)
  124.27  
  124.28  
  124.29 @@ -92,7 +92,7 @@
  124.30  end
  124.31  
  124.32  lemma [code]:
  124.33 -  "eq_class.eq (u\<Colon>unit) v \<longleftrightarrow> True" unfolding eq unit_eq [of u] unit_eq [of v] by rule+
  124.34 +  "HOL.equal (u\<Colon>unit) v \<longleftrightarrow> True" unfolding equal unit_eq [of u] unit_eq [of v] by rule+
  124.35  
  124.36  code_type unit
  124.37    (SML "unit")
  124.38 @@ -106,10 +106,10 @@
  124.39    (Haskell "()")
  124.40    (Scala "()")
  124.41  
  124.42 -code_instance unit :: eq
  124.43 +code_instance unit :: equal
  124.44    (Haskell -)
  124.45  
  124.46 -code_const "eq_class.eq \<Colon> unit \<Rightarrow> unit \<Rightarrow> bool"
  124.47 +code_const "HOL.equal \<Colon> unit \<Rightarrow> unit \<Rightarrow> bool"
  124.48    (Haskell infixl 4 "==")
  124.49  
  124.50  code_reserved SML
  124.51 @@ -277,10 +277,10 @@
  124.52    (Haskell "!((_),/ (_))")
  124.53    (Scala "!((_),/ (_))")
  124.54  
  124.55 -code_instance prod :: eq
  124.56 +code_instance prod :: equal
  124.57    (Haskell -)
  124.58  
  124.59 -code_const "eq_class.eq \<Colon> 'a\<Colon>eq \<times> 'b\<Colon>eq \<Rightarrow> 'a \<times> 'b \<Rightarrow> bool"
  124.60 +code_const "HOL.equal \<Colon> 'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> bool"
  124.61    (Haskell infixl 4 "==")
  124.62  
  124.63  types_code
   125.1 --- a/src/HOL/Prolog/prolog.ML	Thu Sep 02 17:12:40 2010 +0200
   125.2 +++ b/src/HOL/Prolog/prolog.ML	Thu Sep 02 17:28:00 2010 +0200
   125.3 @@ -2,7 +2,7 @@
   125.4      Author:   David von Oheimb (based on a lecture on Lambda Prolog by Nadathur)
   125.5  *)
   125.6  
   125.7 -Unsynchronized.set Proof.show_main_goal;
   125.8 +Proof.show_main_goal := true;
   125.9  
  125.10  structure Prolog =
  125.11  struct
  125.12 @@ -11,12 +11,12 @@
  125.13  
  125.14  fun isD t = case t of
  125.15      Const(@{const_name Trueprop},_)$t     => isD t
  125.16 -  | Const(@{const_name "op &"}  ,_)$l$r     => isD l andalso isD r
  125.17 -  | Const(@{const_name "op -->"},_)$l$r     => isG l andalso isD r
  125.18 +  | Const(@{const_name HOL.conj}  ,_)$l$r     => isD l andalso isD r
  125.19 +  | Const(@{const_name HOL.implies},_)$l$r     => isG l andalso isD r
  125.20    | Const(   "==>",_)$l$r     => isG l andalso isD r
  125.21    | Const(@{const_name All},_)$Abs(s,_,t) => isD t
  125.22    | Const("all",_)$Abs(s,_,t) => isD t
  125.23 -  | Const(@{const_name "op |"},_)$_$_       => false
  125.24 +  | Const(@{const_name HOL.disj},_)$_$_       => false
  125.25    | Const(@{const_name Ex} ,_)$_          => false
  125.26    | Const(@{const_name Not},_)$_          => false
  125.27    | Const(@{const_name True},_)           => false
  125.28 @@ -30,9 +30,9 @@
  125.29  and
  125.30      isG t = case t of
  125.31      Const(@{const_name Trueprop},_)$t     => isG t
  125.32 -  | Const(@{const_name "op &"}  ,_)$l$r     => isG l andalso isG r
  125.33 -  | Const(@{const_name "op |"}  ,_)$l$r     => isG l andalso isG r
  125.34 -  | Const(@{const_name "op -->"},_)$l$r     => isD l andalso isG r
  125.35 +  | Const(@{const_name HOL.conj}  ,_)$l$r     => isG l andalso isG r
  125.36 +  | Const(@{const_name HOL.disj}  ,_)$l$r     => isG l andalso isG r
  125.37 +  | Const(@{const_name HOL.implies},_)$l$r     => isD l andalso isG r
  125.38    | Const(   "==>",_)$l$r     => isD l andalso isG r
  125.39    | Const(@{const_name All},_)$Abs(_,_,t) => isG t
  125.40    | Const("all",_)$Abs(_,_,t) => isG t
  125.41 @@ -53,8 +53,8 @@
  125.42      fun at  thm = case concl_of thm of
  125.43        _$(Const(@{const_name All} ,_)$Abs(s,_,_))=> at(thm RS
  125.44          (read_instantiate ctxt [(("x", 0), "?" ^ (if s="P" then "PP" else s))] spec))
  125.45 -    | _$(Const(@{const_name "op &"},_)$_$_)       => at(thm RS conjunct1)@at(thm RS conjunct2)
  125.46 -    | _$(Const(@{const_name "op -->"},_)$_$_)     => at(thm RS mp)
  125.47 +    | _$(Const(@{const_name HOL.conj},_)$_$_)       => at(thm RS conjunct1)@at(thm RS conjunct2)
  125.48 +    | _$(Const(@{const_name HOL.implies},_)$_$_)     => at(thm RS mp)
  125.49      | _                             => [thm]
  125.50  in map zero_var_indexes (at thm) end;
  125.51  
  125.52 @@ -72,7 +72,7 @@
  125.53    -- is nice, but cannot instantiate unknowns in the assumptions *)
  125.54  fun hyp_resolve_tac i st = let
  125.55          fun ap (Const(@{const_name All},_)$Abs(_,_,t))=(case ap t of (k,a,t) => (k+1,a  ,t))
  125.56 -        |   ap (Const(@{const_name "op -->"},_)$_$t)    =(case ap t of (k,_,t) => (k,true ,t))
  125.57 +        |   ap (Const(@{const_name HOL.implies},_)$_$t)    =(case ap t of (k,_,t) => (k,true ,t))
  125.58          |   ap t                          =                         (0,false,t);
  125.59  (*
  125.60          fun rep_goal (Const ("all",_)$Abs (_,_,t)) = rep_goal t
   126.1 --- a/src/HOL/Quickcheck.thy	Thu Sep 02 17:12:40 2010 +0200
   126.2 +++ b/src/HOL/Quickcheck.thy	Thu Sep 02 17:28:00 2010 +0200
   126.3 @@ -97,7 +97,7 @@
   126.4    \<Rightarrow> Random.seed \<Rightarrow> (('a\<Colon>term_of \<Rightarrow> 'b\<Colon>typerep) \<times> (unit \<Rightarrow> term)) \<times> Random.seed" where
   126.5    "random_fun_lift f = random_fun_aux TYPEREP('a) TYPEREP('b) (op =) Code_Evaluation.term_of f Random.split_seed"
   126.6  
   126.7 -instantiation "fun" :: ("{eq, term_of}", random) random
   126.8 +instantiation "fun" :: ("{equal, term_of}", random) random
   126.9  begin
  126.10  
  126.11  definition random_fun :: "code_numeral \<Rightarrow> Random.seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> Random.seed" where
   127.1 --- a/src/HOL/Quotient.thy	Thu Sep 02 17:12:40 2010 +0200
   127.2 +++ b/src/HOL/Quotient.thy	Thu Sep 02 17:28:00 2010 +0200
   127.3 @@ -651,6 +651,16 @@
   127.4    shows "(R1 ===> (R1 ===> R2) ===> R2) Let Let"
   127.5    by auto
   127.6  
   127.7 +lemma mem_rsp:
   127.8 +  shows "(R1 ===> (R1 ===> R2) ===> R2) op \<in> op \<in>"
   127.9 +  by (simp add: mem_def)
  127.10 +
  127.11 +lemma mem_prs:
  127.12 +  assumes a1: "Quotient R1 Abs1 Rep1"
  127.13 +  and     a2: "Quotient R2 Abs2 Rep2"
  127.14 +  shows "(Rep1 ---> (Abs1 ---> Rep2) ---> Abs2) op \<in> = op \<in>"
  127.15 +  by (simp add: expand_fun_eq mem_def Quotient_abs_rep[OF a1] Quotient_abs_rep[OF a2])
  127.16 +
  127.17  locale quot_type =
  127.18    fixes R :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  127.19    and   Abs :: "('a \<Rightarrow> bool) \<Rightarrow> 'b"
  127.20 @@ -721,8 +731,8 @@
  127.21  declare [[map "fun" = (fun_map, fun_rel)]]
  127.22  
  127.23  lemmas [quot_thm] = fun_quotient
  127.24 -lemmas [quot_respect] = quot_rel_rsp if_rsp o_rsp let_rsp
  127.25 -lemmas [quot_preserve] = if_prs o_prs let_prs
  127.26 +lemmas [quot_respect] = quot_rel_rsp if_rsp o_rsp let_rsp mem_rsp
  127.27 +lemmas [quot_preserve] = if_prs o_prs let_prs mem_prs
  127.28  lemmas [quot_equiv] = identity_equivp
  127.29  
  127.30  
  127.31 @@ -773,20 +783,20 @@
  127.32  
  127.33  method_setup lifting =
  127.34    {* Attrib.thms >> (fn thms => fn ctxt => 
  127.35 -       SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.lift_tac ctxt thms))) *}
  127.36 +       SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.lift_tac ctxt [] thms))) *}
  127.37    {* lifts theorems to quotient types *}
  127.38  
  127.39  method_setup lifting_setup =
  127.40    {* Attrib.thm >> (fn thm => fn ctxt => 
  127.41 -       SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.lift_procedure_tac ctxt thm))) *}
  127.42 +       SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.lift_procedure_tac ctxt [] thm))) *}
  127.43    {* sets up the three goals for the quotient lifting procedure *}
  127.44  
  127.45  method_setup descending =
  127.46 -  {* Scan.succeed (fn ctxt => SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.descend_tac ctxt))) *}
  127.47 +  {* Scan.succeed (fn ctxt => SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.descend_tac ctxt []))) *}
  127.48    {* decends theorems to the raw level *}
  127.49  
  127.50  method_setup descending_setup =
  127.51 -  {* Scan.succeed (fn ctxt => SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.descend_procedure_tac ctxt))) *}
  127.52 +  {* Scan.succeed (fn ctxt => SIMPLE_METHOD (HEADGOAL (Quotient_Tacs.descend_procedure_tac ctxt []))) *}
  127.53    {* sets up the three goals for the decending theorems *}
  127.54  
  127.55  method_setup regularize =
   128.1 --- a/src/HOL/Rat.thy	Thu Sep 02 17:12:40 2010 +0200
   128.2 +++ b/src/HOL/Rat.thy	Thu Sep 02 17:28:00 2010 +0200
   128.3 @@ -1083,18 +1083,18 @@
   128.4    by (cases "0::int" a rule: linorder_cases) (simp_all add: quotient_of_Fract)
   128.5  qed
   128.6  
   128.7 -instantiation rat :: eq
   128.8 +instantiation rat :: equal
   128.9  begin
  128.10  
  128.11  definition [code]:
  128.12 -  "eq_class.eq a b \<longleftrightarrow> quotient_of a = quotient_of b"
  128.13 +  "HOL.equal a b \<longleftrightarrow> quotient_of a = quotient_of b"
  128.14  
  128.15  instance proof
  128.16 -qed (simp add: eq_rat_def quotient_of_inject_eq)
  128.17 +qed (simp add: equal_rat_def quotient_of_inject_eq)
  128.18  
  128.19  lemma rat_eq_refl [code nbe]:
  128.20 -  "eq_class.eq (r::rat) r \<longleftrightarrow> True"
  128.21 -  by (rule HOL.eq_refl)
  128.22 +  "HOL.equal (r::rat) r \<longleftrightarrow> True"
  128.23 +  by (rule equal_refl)
  128.24  
  128.25  end
  128.26  
   129.1 --- a/src/HOL/RealDef.thy	Thu Sep 02 17:12:40 2010 +0200
   129.2 +++ b/src/HOL/RealDef.thy	Thu Sep 02 17:28:00 2010 +0200
   129.3 @@ -1697,19 +1697,21 @@
   129.4    "Ratreal (number_of r / number_of s) = number_of r / number_of s"
   129.5  unfolding Ratreal_number_of_quotient [symmetric] Ratreal_def of_rat_divide ..
   129.6  
   129.7 -instantiation real :: eq
   129.8 +instantiation real :: equal
   129.9  begin
  129.10  
  129.11 -definition "eq_class.eq (x\<Colon>real) y \<longleftrightarrow> x - y = 0"
  129.12 +definition "HOL.equal (x\<Colon>real) y \<longleftrightarrow> x - y = 0"
  129.13  
  129.14 -instance by default (simp add: eq_real_def)
  129.15 +instance proof
  129.16 +qed (simp add: equal_real_def)
  129.17  
  129.18 -lemma real_eq_code [code]: "eq_class.eq (Ratreal x) (Ratreal y) \<longleftrightarrow> eq_class.eq x y"
  129.19 -  by (simp add: eq_real_def eq)
  129.20 +lemma real_equal_code [code]:
  129.21 +  "HOL.equal (Ratreal x) (Ratreal y) \<longleftrightarrow> HOL.equal x y"
  129.22 +  by (simp add: equal_real_def equal)
  129.23  
  129.24 -lemma real_eq_refl [code nbe]:
  129.25 -  "eq_class.eq (x::real) x \<longleftrightarrow> True"
  129.26 -  by (rule HOL.eq_refl)
  129.27 +lemma [code nbe]:
  129.28 +  "HOL.equal (x::real) x \<longleftrightarrow> True"
  129.29 +  by (rule equal_refl)
  129.30  
  129.31  end
  129.32  
   130.1 --- a/src/HOL/Set.thy	Thu Sep 02 17:12:40 2010 +0200
   130.2 +++ b/src/HOL/Set.thy	Thu Sep 02 17:28:00 2010 +0200
   130.3 @@ -219,8 +219,8 @@
   130.4    val Type (set_type, _) = @{typ "'a set"};   (* FIXME 'a => bool (!?!) *)
   130.5    val All_binder = Syntax.binder_name @{const_syntax All};
   130.6    val Ex_binder = Syntax.binder_name @{const_syntax Ex};
   130.7 -  val impl = @{const_syntax "op -->"};
   130.8 -  val conj = @{const_syntax "op &"};
   130.9 +  val impl = @{const_syntax HOL.implies};
  130.10 +  val conj = @{const_syntax HOL.conj};
  130.11    val sbset = @{const_syntax subset};
  130.12    val sbset_eq = @{const_syntax subset_eq};
  130.13  
  130.14 @@ -268,8 +268,8 @@
  130.15  
  130.16      fun setcompr_tr [e, idts, b] =
  130.17        let
  130.18 -        val eq = Syntax.const @{const_syntax "op ="} $ Bound (nvars idts) $ e;
  130.19 -        val P = Syntax.const @{const_syntax "op &"} $ eq $ b;
  130.20 +        val eq = Syntax.const @{const_syntax HOL.eq} $ Bound (nvars idts) $ e;
  130.21 +        val P = Syntax.const @{const_syntax HOL.conj} $ eq $ b;
  130.22          val exP = ex_tr [idts, P];
  130.23        in Syntax.const @{const_syntax Collect} $ Term.absdummy (dummyT, exP) end;
  130.24  
  130.25 @@ -288,8 +288,8 @@
  130.26    fun setcompr_tr' [Abs (abs as (_, _, P))] =
  130.27      let
  130.28        fun check (Const (@{const_syntax Ex}, _) $ Abs (_, _, P), n) = check (P, n + 1)
  130.29 -        | check (Const (@{const_syntax "op &"}, _) $
  130.30 -              (Const (@{const_syntax "op ="}, _) $ Bound m $ e) $ P, n) =
  130.31 +        | check (Const (@{const_syntax HOL.conj}, _) $
  130.32 +              (Const (@{const_syntax HOL.eq}, _) $ Bound m $ e) $ P, n) =
  130.33              n > 0 andalso m = n andalso not (loose_bvar1 (P, n)) andalso
  130.34              subset (op =) (0 upto (n - 1), add_loose_bnos (e, 0, []))
  130.35          | check _ = false;
  130.36 @@ -305,7 +305,7 @@
  130.37            val M = Syntax.const @{syntax_const "_Coll"} $ x $ t;
  130.38          in
  130.39            case t of
  130.40 -            Const (@{const_syntax "op &"}, _) $
  130.41 +            Const (@{const_syntax HOL.conj}, _) $
  130.42                (Const (@{const_syntax Set.member}, _) $
  130.43                  (Const (@{syntax_const "_bound"}, _) $ Free (yN, _)) $ A) $ P =>
  130.44              if xN = yN then Syntax.const @{syntax_const "_Collect"} $ x $ A $ P else M
   131.1 --- a/src/HOL/Statespace/DistinctTreeProver.thy	Thu Sep 02 17:12:40 2010 +0200
   131.2 +++ b/src/HOL/Statespace/DistinctTreeProver.thy	Thu Sep 02 17:28:00 2010 +0200
   131.3 @@ -32,17 +32,18 @@
   131.4  subsection {* Distinctness of Nodes *}
   131.5  
   131.6  
   131.7 -consts set_of:: "'a tree \<Rightarrow> 'a set"
   131.8 -primrec 
   131.9 -"set_of Tip = {}"
  131.10 -"set_of (Node l x d r) = (if d then {} else {x}) \<union> set_of l \<union> set_of r"
  131.11 +primrec set_of :: "'a tree \<Rightarrow> 'a set"
  131.12 +where
  131.13 +  "set_of Tip = {}"
  131.14 +| "set_of (Node l x d r) = (if d then {} else {x}) \<union> set_of l \<union> set_of r"
  131.15  
  131.16 -consts all_distinct:: "'a tree \<Rightarrow> bool"
  131.17 -primrec
  131.18 -"all_distinct Tip = True"
  131.19 -"all_distinct (Node l x d r) = ((d \<or> (x \<notin> set_of l \<and> x \<notin> set_of r)) \<and> 
  131.20 -                               set_of l \<inter> set_of r = {} \<and>
  131.21 -                               all_distinct l \<and> all_distinct r)"
  131.22 +primrec all_distinct :: "'a tree \<Rightarrow> bool"
  131.23 +where
  131.24 +  "all_distinct Tip = True"
  131.25 +| "all_distinct (Node l x d r) =
  131.26 +    ((d \<or> (x \<notin> set_of l \<and> x \<notin> set_of r)) \<and> 
  131.27 +      set_of l \<inter> set_of r = {} \<and>
  131.28 +      all_distinct l \<and> all_distinct r)"
  131.29  
  131.30  text {* Given a binary tree @{term "t"} for which 
  131.31  @{const all_distinct} holds, given two different nodes contained in the tree,
  131.32 @@ -99,19 +100,19 @@
  131.33  *}
  131.34  
  131.35  
  131.36 -consts "delete" :: "'a \<Rightarrow> 'a tree \<Rightarrow> 'a tree option"
  131.37 -primrec
  131.38 -"delete x Tip = None"
  131.39 -"delete x (Node l y d r) = (case delete x l of
  131.40 -                              Some l' \<Rightarrow>
  131.41 -                               (case delete x r of 
  131.42 -                                  Some r' \<Rightarrow> Some (Node l' y (d \<or> (x=y)) r')
  131.43 -                                | None \<Rightarrow> Some (Node l' y (d \<or> (x=y)) r))
  131.44 -                             | None \<Rightarrow>
  131.45 -                                (case (delete x r) of 
  131.46 -                                   Some r' \<Rightarrow> Some (Node l y (d \<or> (x=y)) r')
  131.47 -                                 | None \<Rightarrow> if x=y \<and> \<not>d then Some (Node l y True r)
  131.48 -                                           else None))"
  131.49 +primrec delete :: "'a \<Rightarrow> 'a tree \<Rightarrow> 'a tree option"
  131.50 +where
  131.51 +  "delete x Tip = None"
  131.52 +| "delete x (Node l y d r) = (case delete x l of
  131.53 +                                Some l' \<Rightarrow>
  131.54 +                                 (case delete x r of 
  131.55 +                                    Some r' \<Rightarrow> Some (Node l' y (d \<or> (x=y)) r')
  131.56 +                                  | None \<Rightarrow> Some (Node l' y (d \<or> (x=y)) r))
  131.57 +                               | None \<Rightarrow>
  131.58 +                                  (case (delete x r) of 
  131.59 +                                     Some r' \<Rightarrow> Some (Node l y (d \<or> (x=y)) r')
  131.60 +                                   | None \<Rightarrow> if x=y \<and> \<not>d then Some (Node l y True r)
  131.61 +                                             else None))"
  131.62  
  131.63  
  131.64  lemma delete_Some_set_of: "\<And>t'. delete x t = Some t' \<Longrightarrow> set_of t' \<subseteq> set_of t"
  131.65 @@ -293,15 +294,15 @@
  131.66  qed
  131.67  
  131.68  
  131.69 -consts "subtract" :: "'a tree \<Rightarrow> 'a tree \<Rightarrow> 'a tree option"
  131.70 -primrec
  131.71 -"subtract Tip t = Some t"
  131.72 -"subtract (Node l x b r) t = 
  131.73 -   (case delete x t of
  131.74 -      Some t' \<Rightarrow> (case subtract l t' of 
  131.75 -                   Some t'' \<Rightarrow> subtract r t''
  131.76 -                  | None \<Rightarrow> None)
  131.77 -    | None \<Rightarrow> None)"
  131.78 +primrec subtract :: "'a tree \<Rightarrow> 'a tree \<Rightarrow> 'a tree option"
  131.79 +where
  131.80 +  "subtract Tip t = Some t"
  131.81 +| "subtract (Node l x b r) t =
  131.82 +     (case delete x t of
  131.83 +        Some t' \<Rightarrow> (case subtract l t' of 
  131.84 +                     Some t'' \<Rightarrow> subtract r t''
  131.85 +                    | None \<Rightarrow> None)
  131.86 +       | None \<Rightarrow> None)"
  131.87  
  131.88  lemma subtract_Some_set_of_res: 
  131.89    "\<And>t\<^isub>2 t. subtract t\<^isub>1 t\<^isub>2 = Some t \<Longrightarrow> set_of t \<subseteq> set_of t\<^isub>2"
   132.1 --- a/src/HOL/Statespace/StateFun.thy	Thu Sep 02 17:12:40 2010 +0200
   132.2 +++ b/src/HOL/Statespace/StateFun.thy	Thu Sep 02 17:28:00 2010 +0200
   132.3 @@ -33,10 +33,10 @@
   132.4  lemma K_statefun_cong [cong]: "K_statefun c x = K_statefun c x"
   132.5    by (rule refl)
   132.6  
   132.7 -definition lookup:: "('v \<Rightarrow> 'a) \<Rightarrow> 'n \<Rightarrow> ('n \<Rightarrow> 'v) \<Rightarrow> 'a"
   132.8 +definition lookup :: "('v \<Rightarrow> 'a) \<Rightarrow> 'n \<Rightarrow> ('n \<Rightarrow> 'v) \<Rightarrow> 'a"
   132.9    where "lookup destr n s = destr (s n)"
  132.10  
  132.11 -definition update::
  132.12 +definition update ::
  132.13    "('v \<Rightarrow> 'a1) \<Rightarrow> ('a2 \<Rightarrow> 'v) \<Rightarrow> 'n \<Rightarrow> ('a1 \<Rightarrow> 'a2) \<Rightarrow> ('n \<Rightarrow> 'v) \<Rightarrow> ('n \<Rightarrow> 'v)"
  132.14    where "update destr constr n f s = s(n := constr (f (destr (s n))))"
  132.15  
   133.1 --- a/src/HOL/Statespace/StateSpaceEx.thy	Thu Sep 02 17:12:40 2010 +0200
   133.2 +++ b/src/HOL/Statespace/StateSpaceEx.thy	Thu Sep 02 17:28:00 2010 +0200
   133.3 @@ -1,14 +1,12 @@
   133.4  (*  Title:      StateSpaceEx.thy
   133.5 -    ID:         $Id$
   133.6      Author:     Norbert Schirmer, TU Muenchen
   133.7  *)
   133.8  
   133.9  header {* Examples \label{sec:Examples} *}
  133.10  theory StateSpaceEx
  133.11  imports StateSpaceLocale StateSpaceSyntax
  133.12 +begin
  133.13  
  133.14 -begin
  133.15 -(* FIXME: Use proper keywords file *)
  133.16  (*<*)
  133.17  syntax
  133.18   "_statespace_updates" :: "('a \<Rightarrow> 'b) \<Rightarrow> updbinds \<Rightarrow> ('a \<Rightarrow> 'b)" ("_\<langle>_\<rangle>" [900,0] 900)
   134.1 --- a/src/HOL/Statespace/StateSpaceLocale.thy	Thu Sep 02 17:12:40 2010 +0200
   134.2 +++ b/src/HOL/Statespace/StateSpaceLocale.thy	Thu Sep 02 17:28:00 2010 +0200
   134.3 @@ -1,5 +1,4 @@
   134.4  (*  Title:      StateSpaceLocale.thy
   134.5 -    ID:         $Id$
   134.6      Author:     Norbert Schirmer, TU Muenchen
   134.7  *)
   134.8  
   134.9 @@ -18,7 +17,7 @@
  134.10  
  134.11  locale project_inject =
  134.12   fixes project :: "'value \<Rightarrow> 'a"
  134.13 - and   "inject":: "'a \<Rightarrow> 'value"
  134.14 +  and inject :: "'a \<Rightarrow> 'value"
  134.15   assumes project_inject_cancel [statefun_simp]: "project (inject x) = x"
  134.16  
  134.17  lemma (in project_inject)
   135.1 --- a/src/HOL/Statespace/StateSpaceSyntax.thy	Thu Sep 02 17:12:40 2010 +0200
   135.2 +++ b/src/HOL/Statespace/StateSpaceSyntax.thy	Thu Sep 02 17:28:00 2010 +0200
   135.3 @@ -5,7 +5,6 @@
   135.4  header {* Syntax for State Space Lookup and Update \label{sec:StateSpaceSyntax}*}
   135.5  theory StateSpaceSyntax
   135.6  imports StateSpaceLocale
   135.7 -
   135.8  begin
   135.9  
  135.10  text {* The state space syntax is kept in an extra theory so that you
   136.1 --- a/src/HOL/Statespace/distinct_tree_prover.ML	Thu Sep 02 17:12:40 2010 +0200
   136.2 +++ b/src/HOL/Statespace/distinct_tree_prover.ML	Thu Sep 02 17:28:00 2010 +0200
   136.3 @@ -343,7 +343,7 @@
   136.4    end handle Option => NONE)
   136.5  
   136.6  fun distinctTree_tac names ctxt 
   136.7 -      (Const (@{const_name Trueprop},_) $ (Const (@{const_name Not}, _) $ (Const (@{const_name "op ="}, _) $ x $ y)), i) =
   136.8 +      (Const (@{const_name Trueprop},_) $ (Const (@{const_name Not}, _) $ (Const (@{const_name HOL.eq}, _) $ x $ y)), i) =
   136.9    (case get_fst_success (neq_x_y ctxt x y) names of
  136.10       SOME neq => rtac neq i
  136.11     | NONE => no_tac)
  136.12 @@ -356,7 +356,7 @@
  136.13  
  136.14  fun distinct_simproc names =
  136.15    Simplifier.simproc_global @{theory HOL} "DistinctTreeProver.distinct_simproc" ["x = y"]
  136.16 -    (fn thy => fn ss => fn (Const (@{const_name "op ="},_)$x$y) =>
  136.17 +    (fn thy => fn ss => fn (Const (@{const_name HOL.eq},_)$x$y) =>
  136.18          case try Simplifier.the_context ss of
  136.19          SOME ctxt => Option.map (fn neq => neq_to_eq_False OF [neq]) 
  136.20                        (get_fst_success (neq_x_y ctxt x y) names)
   137.1 --- a/src/HOL/Statespace/state_fun.ML	Thu Sep 02 17:12:40 2010 +0200
   137.2 +++ b/src/HOL/Statespace/state_fun.ML	Thu Sep 02 17:28:00 2010 +0200
   137.3 @@ -53,7 +53,7 @@
   137.4  val lazy_conj_simproc =
   137.5    Simplifier.simproc_global @{theory HOL} "lazy_conj_simp" ["P & Q"]
   137.6      (fn thy => fn ss => fn t =>
   137.7 -      (case t of (Const (@{const_name "op &"},_)$P$Q) => 
   137.8 +      (case t of (Const (@{const_name HOL.conj},_)$P$Q) => 
   137.9           let
  137.10              val P_P' = Simplifier.rewrite ss (cterm_of thy P);
  137.11              val P' = P_P' |> prop_of |> Logic.dest_equals |> #2 
  137.12 @@ -285,7 +285,7 @@
  137.13                              then Bound 2
  137.14                              else raise TERM ("",[n]);
  137.15                     val sel' = lo $ d $ n' $ s;
  137.16 -                  in (Const (@{const_name "op ="},Teq)$sel'$x',hd (binder_types Teq),nT,swap) end;
  137.17 +                  in (Const (@{const_name HOL.eq},Teq)$sel'$x',hd (binder_types Teq),nT,swap) end;
  137.18  
  137.19           fun dest_state (s as Bound 0) = s
  137.20             | dest_state (s as (Const (sel,sT)$Bound 0)) =
  137.21 @@ -295,10 +295,10 @@
  137.22             | dest_state s = 
  137.23                      raise TERM ("StateFun.ex_lookup_eq_simproc: not a record slector",[s]);
  137.24    
  137.25 -         fun dest_sel_eq (Const (@{const_name "op ="},Teq)$
  137.26 +         fun dest_sel_eq (Const (@{const_name HOL.eq},Teq)$
  137.27                             ((lo as (Const ("StateFun.lookup",lT)))$d$n$s)$X) =
  137.28                             (false,Teq,lT,lo,d,n,X,dest_state s)
  137.29 -           | dest_sel_eq (Const (@{const_name "op ="},Teq)$X$
  137.30 +           | dest_sel_eq (Const (@{const_name HOL.eq},Teq)$X$
  137.31                              ((lo as (Const ("StateFun.lookup",lT)))$d$n$s)) =
  137.32                             (true,Teq,lT,lo,d,n,X,dest_state s)
  137.33             | dest_sel_eq _ = raise TERM ("",[]);
   138.1 --- a/src/HOL/Statespace/state_space.ML	Thu Sep 02 17:12:40 2010 +0200
   138.2 +++ b/src/HOL/Statespace/state_space.ML	Thu Sep 02 17:28:00 2010 +0200
   138.3 @@ -223,7 +223,7 @@
   138.4  
   138.5  fun distinctTree_tac ctxt
   138.6        (Const (@{const_name Trueprop},_) $
   138.7 -        (Const (@{const_name Not}, _) $ (Const (@{const_name "op ="}, _) $ (x as Free _)$ (y as Free _))), i) =
   138.8 +        (Const (@{const_name Not}, _) $ (Const (@{const_name HOL.eq}, _) $ (x as Free _)$ (y as Free _))), i) =
   138.9    (case (neq_x_y ctxt x y) of
  138.10       SOME neq => rtac neq i
  138.11     | NONE => no_tac)
  138.12 @@ -236,7 +236,7 @@
  138.13  
  138.14  val distinct_simproc =
  138.15    Simplifier.simproc_global @{theory HOL} "StateSpace.distinct_simproc" ["x = y"]
  138.16 -    (fn thy => fn ss => (fn (Const (@{const_name "op ="},_)$(x as Free _)$(y as Free _)) =>
  138.17 +    (fn thy => fn ss => (fn (Const (@{const_name HOL.eq},_)$(x as Free _)$(y as Free _)) =>
  138.18          (case try Simplifier.the_context ss of
  138.19            SOME ctxt => Option.map (fn neq => DistinctTreeProver.neq_to_eq_False OF [neq])
  138.20                         (neq_x_y ctxt x y)
  138.21 @@ -277,28 +277,29 @@
  138.22      fun comps_of_thm thm = prop_of thm
  138.23               |> (fn (_$(_$t)) => DistinctTreeProver.dest_tree t) |> map (fst o dest_Free);
  138.24  
  138.25 -    fun type_attr phi (ctxt,thm) =
  138.26 -      (case ctxt of Context.Theory _ => (ctxt,thm)
  138.27 -       | _ =>
  138.28 +    fun type_attr phi = Thm.declaration_attribute (fn thm => fn context =>
  138.29 +      (case context of
  138.30 +        Context.Theory _ => context
  138.31 +      | Context.Proof ctxt =>
  138.32          let
  138.33 -          val {declinfo,distinctthm=tt,silent} = (NameSpaceData.get ctxt);
  138.34 +          val {declinfo,distinctthm=tt,silent} = NameSpaceData.get context;
  138.35            val all_names = comps_of_thm thm;
  138.36            fun upd name tt =
  138.37 -               (case (Symtab.lookup tt name) of
  138.38 +               (case Symtab.lookup tt name of
  138.39                   SOME dthm => if sorted_subset (op =) (comps_of_thm dthm) all_names
  138.40                                then Symtab.update (name,thm) tt else tt
  138.41 -                | NONE => Symtab.update (name,thm) tt)
  138.42 +               | NONE => Symtab.update (name,thm) tt)
  138.43  
  138.44            val tt' = tt |> fold upd all_names;
  138.45            val activate_simproc =
  138.46 -              Output.no_warnings_CRITICAL   (* FIXME !?! *)
  138.47 -               (Simplifier.map_ss (fn ss => ss addsimprocs [distinct_simproc]));
  138.48 -          val ctxt' =
  138.49 -              ctxt
  138.50 +            Simplifier.map_ss
  138.51 +              (Simplifier.with_context (Context_Position.set_visible false ctxt)
  138.52 +                (fn ss => ss addsimprocs [distinct_simproc]));
  138.53 +          val context' =
  138.54 +              context
  138.55                |> NameSpaceData.put {declinfo=declinfo,distinctthm=tt',silent=silent}
  138.56 -              |> activate_simproc
  138.57 -        in (ctxt',thm)
  138.58 -        end)
  138.59 +              |> activate_simproc;
  138.60 +        in context' end));
  138.61  
  138.62      val attr = Attrib.internal type_attr;
  138.63  
   139.1 --- a/src/HOL/String.thy	Thu Sep 02 17:12:40 2010 +0200
   139.2 +++ b/src/HOL/String.thy	Thu Sep 02 17:28:00 2010 +0200
   139.3 @@ -53,7 +53,7 @@
   139.4     (fn n => fn m => Drule.instantiate' [] [SOME n, SOME m] @{thm nibble_pair_of_char.simps})
   139.5        nibbles nibbles;
   139.6  in
   139.7 -  PureThy.note_thmss Thm.definitionK [((Binding.name "nibble_pair_of_char_simps", []), [(thms, [])])]
   139.8 +  PureThy.note_thmss Thm.definitionK [((@{binding nibble_pair_of_char_simps}, []), [(thms, [])])]
   139.9    #-> (fn [(_, thms)] => fold_rev Code.add_eqn thms)
  139.10  end
  139.11  *}
  139.12 @@ -183,10 +183,10 @@
  139.13    fold String_Code.add_literal_string ["SML", "OCaml", "Haskell", "Scala"]
  139.14  *}
  139.15  
  139.16 -code_instance literal :: eq
  139.17 +code_instance literal :: equal
  139.18    (Haskell -)
  139.19  
  139.20 -code_const "eq_class.eq \<Colon> literal \<Rightarrow> literal \<Rightarrow> bool"
  139.21 +code_const "HOL.equal \<Colon> literal \<Rightarrow> literal \<Rightarrow> bool"
  139.22    (SML "!((_ : string) = _)")
  139.23    (OCaml "!((_ : string) = _)")
  139.24    (Haskell infixl 4 "==")
   140.1 --- a/src/HOL/TLA/Intensional.thy	Thu Sep 02 17:12:40 2010 +0200
   140.2 +++ b/src/HOL/TLA/Intensional.thy	Thu Sep 02 17:28:00 2010 +0200
   140.3 @@ -279,7 +279,7 @@
   140.4  
   140.5      fun hflatten t =
   140.6          case (concl_of t) of
   140.7 -          Const _ $ (Const (@{const_name "op -->"}, _) $ _ $ _) => hflatten (t RS mp)
   140.8 +          Const _ $ (Const (@{const_name HOL.implies}, _) $ _ $ _) => hflatten (t RS mp)
   140.9          | _ => (hflatten (matchsome conjI t)) handle THM _ => zero_var_indexes t
  140.10    in
  140.11      hflatten t
   141.1 --- a/src/HOL/Tools/ATP/atp_systems.ML	Thu Sep 02 17:12:40 2010 +0200
   141.2 +++ b/src/HOL/Tools/ATP/atp_systems.ML	Thu Sep 02 17:28:00 2010 +0200
   141.3 @@ -293,7 +293,7 @@
   141.4    (remotify_name name, remotify_config system_name system_versions config)
   141.5  
   141.6  val remote_e = remotify_prover e "EP" ["1.0", "1.1", "1.2"]
   141.7 -val remote_vampire = remotify_prover vampire "Vampire" ["9.9", "0.6", "1.0"]
   141.8 +val remote_vampire = remotify_prover vampire "Vampire" ["9.0", "1.0", "0.6"]
   141.9  val remote_sine_e =
  141.10    remote_prover "sine_e" "SInE" [] [] [(Unprovable, "says Unknown")]
  141.11                  1000 (* FUDGE *) false true
   142.1 --- a/src/HOL/Tools/Datatype/datatype_abs_proofs.ML	Thu Sep 02 17:12:40 2010 +0200
   142.2 +++ b/src/HOL/Tools/Datatype/datatype_abs_proofs.ML	Thu Sep 02 17:28:00 2010 +0200
   142.3 @@ -416,7 +416,7 @@
   142.4      fun prove_case_cong ((t, nchotomy), case_rewrites) =
   142.5        let
   142.6          val (Const ("==>", _) $ tm $ _) = t;
   142.7 -        val (Const (@{const_name Trueprop}, _) $ (Const (@{const_name "op ="}, _) $ _ $ Ma)) = tm;
   142.8 +        val (Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ Ma)) = tm;
   142.9          val cert = cterm_of thy;
  142.10          val nchotomy' = nchotomy RS spec;
  142.11          val [v] = Term.add_vars (concl_of nchotomy') [];
   143.1 --- a/src/HOL/Tools/Datatype/datatype_aux.ML	Thu Sep 02 17:12:40 2010 +0200
   143.2 +++ b/src/HOL/Tools/Datatype/datatype_aux.ML	Thu Sep 02 17:28:00 2010 +0200
   143.3 @@ -120,8 +120,8 @@
   143.4  fun split_conj_thm th =
   143.5    ((th RS conjunct1)::(split_conj_thm (th RS conjunct2))) handle THM _ => [th];
   143.6  
   143.7 -val mk_conj = foldr1 (HOLogic.mk_binop @{const_name "op &"});
   143.8 -val mk_disj = foldr1 (HOLogic.mk_binop @{const_name "op |"});
   143.9 +val mk_conj = foldr1 (HOLogic.mk_binop @{const_name HOL.conj});
  143.10 +val mk_disj = foldr1 (HOLogic.mk_binop @{const_name HOL.disj});
  143.11  
  143.12  fun app_bnds t i = list_comb (t, map Bound (i - 1 downto 0));
  143.13  
   144.1 --- a/src/HOL/Tools/Datatype/datatype_codegen.ML	Thu Sep 02 17:12:40 2010 +0200
   144.2 +++ b/src/HOL/Tools/Datatype/datatype_codegen.ML	Thu Sep 02 17:28:00 2010 +0200
   144.3 @@ -68,7 +68,7 @@
   144.4      val { descr, index, inject = inject_thms, distinct = distinct_thms, ... } =
   144.5        Datatype_Data.the_info thy tyco;
   144.6      val ty = Type (tyco, map TFree vs);
   144.7 -    fun mk_eq (t1, t2) = Const (@{const_name eq_class.eq}, ty --> ty --> HOLogic.boolT)
   144.8 +    fun mk_eq (t1, t2) = Const (@{const_name HOL.equal}, ty --> ty --> HOLogic.boolT)
   144.9        $ t1 $ t2;
  144.10      fun true_eq t12 = HOLogic.mk_eq (mk_eq t12, HOLogic.true_const);
  144.11      fun false_eq t12 = HOLogic.mk_eq (mk_eq t12, HOLogic.false_const);
  144.12 @@ -83,7 +83,7 @@
  144.13      val distincts = maps prep_distinct (snd (nth (Datatype_Prop.make_distincts [descr] vs) index));
  144.14      val refl = HOLogic.mk_Trueprop (true_eq (Free ("x", ty), Free ("x", ty)));
  144.15      val simpset = Simplifier.global_context thy (HOL_basic_ss addsimps 
  144.16 -      (map Simpdata.mk_eq (@{thm eq} :: @{thm eq_True} :: inject_thms @ distinct_thms)));
  144.17 +      (map Simpdata.mk_eq (@{thm equal} :: @{thm eq_True} :: inject_thms @ distinct_thms)));
  144.18      fun prove prop = Skip_Proof.prove_global thy [] [] prop (K (ALLGOALS (simp_tac simpset)))
  144.19        |> Simpdata.mk_eq;
  144.20    in (map prove (triv_injects @ injects @ distincts), prove refl) end;
  144.21 @@ -96,7 +96,7 @@
  144.22          fun mk_side const_name = Const (const_name, ty --> ty --> HOLogic.boolT)
  144.23            $ Free ("x", ty) $ Free ("y", ty);
  144.24          val def = HOLogic.mk_Trueprop (HOLogic.mk_eq
  144.25 -          (mk_side @{const_name eq_class.eq}, mk_side @{const_name "op ="}));
  144.26 +          (mk_side @{const_name HOL.equal}, mk_side @{const_name HOL.eq}));
  144.27          val def' = Syntax.check_term lthy def;
  144.28          val ((_, (_, thm)), lthy') = Specification.definition
  144.29            (NONE, (Attrib.empty_binding, def')) lthy;
  144.30 @@ -115,7 +115,7 @@
  144.31        #> snd
  144.32    in
  144.33      thy
  144.34 -    |> Class.instantiation (tycos, vs, [HOLogic.class_eq])
  144.35 +    |> Class.instantiation (tycos, vs, [HOLogic.class_equal])
  144.36      |> fold_map add_def tycos
  144.37      |-> (fn def_thms => Class.prove_instantiation_exit_result (map o Morphism.thm)
  144.38           (fn _ => fn def_thms => tac def_thms) def_thms)
  144.39 @@ -135,7 +135,7 @@
  144.40      val case_rewrites = maps (#case_rewrites o Datatype_Data.the_info thy) tycos;
  144.41      val certs = map (mk_case_cert thy) tycos;
  144.42      val tycos_eq = filter_out
  144.43 -      (fn tyco => can (Sorts.mg_domain (Sign.classes_of thy) tyco) [HOLogic.class_eq]) tycos;
  144.44 +      (fn tyco => can (Sorts.mg_domain (Sign.classes_of thy) tyco) [HOLogic.class_equal]) tycos;
  144.45    in
  144.46      if null css then thy
  144.47      else thy
   145.1 --- a/src/HOL/Tools/Datatype/datatype_data.ML	Thu Sep 02 17:12:40 2010 +0200
   145.2 +++ b/src/HOL/Tools/Datatype/datatype_data.ML	Thu Sep 02 17:28:00 2010 +0200
   145.3 @@ -257,7 +257,9 @@
   145.4             Pretty.str " =" :: Pretty.brk 1 ::
   145.5             flat (separate [Pretty.brk 1, Pretty.str "| "]
   145.6               (map (single o pretty_constr) cos)));
   145.7 -    in Thy_Output.output (Thy_Output.maybe_pretty_source (K pretty_datatype) src [()]) end);
   145.8 +    in
   145.9 +      Thy_Output.output ctxt (Thy_Output.maybe_pretty_source (K (K pretty_datatype)) ctxt src [()])
  145.10 +    end);
  145.11  
  145.12  
  145.13  
  145.14 @@ -428,7 +430,7 @@
  145.15            unflat rules (map Drule.zero_var_indexes_list raw_thms);
  145.16              (*FIXME somehow dubious*)
  145.17        in
  145.18 -        ProofContext.theory_result
  145.19 +        ProofContext.background_theory_result
  145.20            (prove_rep_datatype config dt_names alt_names descr vs
  145.21              raw_inject half_distinct raw_induct)
  145.22          #-> after_qed
   146.1 --- a/src/HOL/Tools/Datatype/datatype_prop.ML	Thu Sep 02 17:12:40 2010 +0200
   146.2 +++ b/src/HOL/Tools/Datatype/datatype_prop.ML	Thu Sep 02 17:28:00 2010 +0200
   146.3 @@ -70,7 +70,7 @@
   146.4            val frees' = map Free ((map ((op ^) o (rpair "'")) tnames) ~~ Ts);
   146.5          in cons (HOLogic.mk_Trueprop (HOLogic.mk_eq
   146.6            (HOLogic.mk_eq (list_comb (constr_t, frees), list_comb (constr_t, frees')),
   146.7 -           foldr1 (HOLogic.mk_binop @{const_name "op &"})
   146.8 +           foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
   146.9               (map HOLogic.mk_eq (frees ~~ frees')))))
  146.10          end;
  146.11    in
  146.12 @@ -149,7 +149,7 @@
  146.13      val prems = maps (fn ((i, (_, _, constrs)), T) =>
  146.14        map (make_ind_prem i T) constrs) (descr' ~~ recTs);
  146.15      val tnames = make_tnames recTs;
  146.16 -    val concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name "op &"})
  146.17 +    val concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
  146.18        (map (fn (((i, _), T), tname) => make_pred i T $ Free (tname, T))
  146.19          (descr' ~~ recTs ~~ tnames)))
  146.20  
   147.1 --- a/src/HOL/Tools/Datatype/datatype_realizer.ML	Thu Sep 02 17:12:40 2010 +0200
   147.2 +++ b/src/HOL/Tools/Datatype/datatype_realizer.ML	Thu Sep 02 17:28:00 2010 +0200
   147.3 @@ -99,7 +99,7 @@
   147.4          if member (op =) is i then SOME
   147.5            (list_comb (Const (s, fTs ---> T --> U), rec_fns) $ Free (tname, T))
   147.6          else NONE) (descr ~~ recTs ~~ rec_result_Ts ~~ rec_names ~~ tnames));
   147.7 -    val concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name "op &"})
   147.8 +    val concl = HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
   147.9        (map (fn ((((i, _), T), U), tname) =>
  147.10          make_pred i U T (mk_proj i is r) (Free (tname, T)))
  147.11            (descr ~~ recTs ~~ rec_result_Ts ~~ tnames)));
   148.1 --- a/src/HOL/Tools/Function/function_common.ML	Thu Sep 02 17:12:40 2010 +0200
   148.2 +++ b/src/HOL/Tools/Function/function_common.ML	Thu Sep 02 17:28:00 2010 +0200
   148.3 @@ -164,7 +164,7 @@
   148.4  structure Termination_Simps = Named_Thms
   148.5  (
   148.6    val name = "termination_simp"
   148.7 -  val description = "Simplification rule for termination proofs"
   148.8 +  val description = "simplification rules for termination proofs"
   148.9  )
  148.10  
  148.11  
  148.12 @@ -175,7 +175,7 @@
  148.13    type T = Proof.context -> tactic
  148.14    val empty = (fn _ => error "Termination prover not configured")
  148.15    val extend = I
  148.16 -  fun merge (a, b) = b  (* FIXME ? *)
  148.17 +  fun merge (a, _) = a
  148.18  )
  148.19  
  148.20  val set_termination_prover = TerminationProver.put
   149.1 --- a/src/HOL/Tools/Function/function_core.ML	Thu Sep 02 17:12:40 2010 +0200
   149.2 +++ b/src/HOL/Tools/Function/function_core.ML	Thu Sep 02 17:28:00 2010 +0200
   149.3 @@ -860,9 +860,9 @@
   149.4            rtac (instantiate' [] [SOME (cterm_of thy lhs_acc)] case_split) 1
   149.5            THEN (rtac (Thm.forall_elim_vars 0 psimp) THEN_ALL_NEW assume_tac) 1
   149.6            THEN (simp_default_tac (simpset_of ctxt) 1)
   149.7 -          THEN (etac not_acc_down 1)
   149.8 -          THEN ((etac R_cases)
   149.9 -            THEN_ALL_NEW (simp_default_tac (simpset_of ctxt))) 1)
  149.10 +          THEN TRY ((etac not_acc_down 1)
  149.11 +            THEN ((etac R_cases)
  149.12 +              THEN_ALL_NEW (simp_default_tac (simpset_of ctxt))) 1))
  149.13          |> fold_rev forall_intr_rename (map fst oqs ~~ cqs)
  149.14        end
  149.15    in
   150.1 --- a/src/HOL/Tools/Function/measure_functions.ML	Thu Sep 02 17:12:40 2010 +0200
   150.2 +++ b/src/HOL/Tools/Function/measure_functions.ML	Thu Sep 02 17:28:00 2010 +0200
   150.3 @@ -20,7 +20,7 @@
   150.4  (
   150.5    val name = "measure_function"
   150.6    val description =
   150.7 -    "Rules that guide the heuristic generation of measure functions"
   150.8 +    "rules that guide the heuristic generation of measure functions"
   150.9  );
  150.10  
  150.11  fun mk_is_measure t =
   151.1 --- a/src/HOL/Tools/Function/scnp_reconstruct.ML	Thu Sep 02 17:12:40 2010 +0200
   151.2 +++ b/src/HOL/Tools/Function/scnp_reconstruct.ML	Thu Sep 02 17:28:00 2010 +0200
   151.3 @@ -68,7 +68,7 @@
   151.4    type T = multiset_setup option
   151.5    val empty = NONE
   151.6    val extend = I;
   151.7 -  fun merge (v1, v2) = if is_some v2 then v2 else v1   (* FIXME prefer v1 !?! *)
   151.8 +  fun merge (v1, v2) = if is_some v1 then v1 else v2
   151.9  )
  151.10  
  151.11  val multiset_setup = Multiset_Setup.put o SOME
   152.1 --- a/src/HOL/Tools/Function/termination.ML	Thu Sep 02 17:12:40 2010 +0200
   152.2 +++ b/src/HOL/Tools/Function/termination.ML	Thu Sep 02 17:28:00 2010 +0200
   152.3 @@ -148,7 +148,7 @@
   152.4      val cs = Function_Lib.dest_binop_list @{const_name Lattices.sup} rel
   152.5      fun collect_pats (Const (@{const_name Collect}, _) $ Abs (_, _, c)) =
   152.6        let
   152.7 -        val (Const (@{const_name "op &"}, _) $ (Const (@{const_name "op ="}, _) $ _ $ (Const (@{const_name Pair}, _) $ r $ l)) $ _)
   152.8 +        val (Const (@{const_name HOL.conj}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ (Const (@{const_name Pair}, _) $ r $ l)) $ _)
   152.9            = Term.strip_qnt_body @{const_name Ex} c
  152.10        in cons r o cons l end
  152.11    in
  152.12 @@ -185,7 +185,7 @@
  152.13      val vs = Term.strip_qnt_vars @{const_name Ex} c
  152.14  
  152.15      (* FIXME: throw error "dest_call" for malformed terms *)
  152.16 -    val (Const (@{const_name "op &"}, _) $ (Const (@{const_name "op ="}, _) $ _ $ (Const (@{const_name Pair}, _) $ r $ l)) $ Gam)
  152.17 +    val (Const (@{const_name HOL.conj}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ (Const (@{const_name Pair}, _) $ r $ l)) $ Gam)
  152.18        = Term.strip_qnt_body @{const_name Ex} c
  152.19      val (p, l') = dest_inj sk l
  152.20      val (q, r') = dest_inj sk r
   153.1 --- a/src/HOL/Tools/Nitpick/minipick.ML	Thu Sep 02 17:12:40 2010 +0200
   153.2 +++ b/src/HOL/Tools/Nitpick/minipick.ML	Thu Sep 02 17:28:00 2010 +0200
   153.3 @@ -123,16 +123,16 @@
   153.4           Exist (decls_for SRep card Ts T, to_F (T :: Ts) t')
   153.5         | (t0 as Const (@{const_name Ex}, _)) $ t1 =>
   153.6           to_F Ts (t0 $ eta_expand Ts t1 1)
   153.7 -       | Const (@{const_name "op ="}, _) $ t1 $ t2 =>
   153.8 +       | Const (@{const_name HOL.eq}, _) $ t1 $ t2 =>
   153.9           RelEq (to_R_rep Ts t1, to_R_rep Ts t2)
  153.10         | Const (@{const_name ord_class.less_eq},
  153.11                  Type (@{type_name fun},
  153.12                        [Type (@{type_name fun}, [_, @{typ bool}]), _]))
  153.13           $ t1 $ t2 =>
  153.14           Subset (to_R_rep Ts t1, to_R_rep Ts t2)
  153.15 -       | @{const "op &"} $ t1 $ t2 => And (to_F Ts t1, to_F Ts t2)
  153.16 -       | @{const "op |"} $ t1 $ t2 => Or (to_F Ts t1, to_F Ts t2)
  153.17 -       | @{const "op -->"} $ t1 $ t2 => Implies (to_F Ts t1, to_F Ts t2)
  153.18 +       | @{const HOL.conj} $ t1 $ t2 => And (to_F Ts t1, to_F Ts t2)
  153.19 +       | @{const HOL.disj} $ t1 $ t2 => Or (to_F Ts t1, to_F Ts t2)
  153.20 +       | @{const HOL.implies} $ t1 $ t2 => Implies (to_F Ts t1, to_F Ts t2)
  153.21         | t1 $ t2 => Subset (to_S_rep Ts t2, to_R_rep Ts t1)
  153.22         | Free _ => raise SAME ()
  153.23         | Term.Var _ => raise SAME ()
  153.24 @@ -165,20 +165,20 @@
  153.25           @{const Not} => to_R_rep Ts (eta_expand Ts t 1)
  153.26         | Const (@{const_name All}, _) => to_R_rep Ts (eta_expand Ts t 1)
  153.27         | Const (@{const_name Ex}, _) => to_R_rep Ts (eta_expand Ts t 1)
  153.28 -       | Const (@{const_name "op ="}, _) $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.29 -       | Const (@{const_name "op ="}, _) => to_R_rep Ts (eta_expand Ts t 2)
  153.30 +       | Const (@{const_name HOL.eq}, _) $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.31 +       | Const (@{const_name HOL.eq}, _) => to_R_rep Ts (eta_expand Ts t 2)
  153.32         | Const (@{const_name ord_class.less_eq},
  153.33                  Type (@{type_name fun},
  153.34                        [Type (@{type_name fun}, [_, @{typ bool}]), _])) $ _ =>
  153.35           to_R_rep Ts (eta_expand Ts t 1)
  153.36         | Const (@{const_name ord_class.less_eq}, _) =>
  153.37           to_R_rep Ts (eta_expand Ts t 2)
  153.38 -       | @{const "op &"} $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.39 -       | @{const "op &"} => to_R_rep Ts (eta_expand Ts t 2)
  153.40 -       | @{const "op |"} $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.41 -       | @{const "op |"} => to_R_rep Ts (eta_expand Ts t 2)
  153.42 -       | @{const "op -->"} $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.43 -       | @{const "op -->"} => to_R_rep Ts (eta_expand Ts t 2)
  153.44 +       | @{const HOL.conj} $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.45 +       | @{const HOL.conj} => to_R_rep Ts (eta_expand Ts t 2)
  153.46 +       | @{const HOL.disj} $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.47 +       | @{const HOL.disj} => to_R_rep Ts (eta_expand Ts t 2)
  153.48 +       | @{const HOL.implies} $ _ => to_R_rep Ts (eta_expand Ts t 1)
  153.49 +       | @{const HOL.implies} => to_R_rep Ts (eta_expand Ts t 2)
  153.50         | Const (@{const_name bot_class.bot},
  153.51                  T as Type (@{type_name fun}, [_, @{typ bool}])) =>
  153.52           empty_n_ary_rel (arity_of RRep card T)
   154.1 --- a/src/HOL/Tools/Nitpick/nitpick.ML	Thu Sep 02 17:12:40 2010 +0200
   154.2 +++ b/src/HOL/Tools/Nitpick/nitpick.ML	Thu Sep 02 17:28:00 2010 +0200
   154.3 @@ -182,7 +182,7 @@
   154.4  fun none_true assigns = forall (not_equal (SOME true) o snd) assigns
   154.5  
   154.6  val syntactic_sorts =
   154.7 -  @{sort "{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,eq}"} @
   154.8 +  @{sort "{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,equal}"} @
   154.9    @{sort number}
  154.10  fun has_tfree_syntactic_sort (TFree (_, S as _ :: _)) =
  154.11      subset (op =) (S, syntactic_sorts)
   155.1 --- a/src/HOL/Tools/Nitpick/nitpick_hol.ML	Thu Sep 02 17:12:40 2010 +0200
   155.2 +++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML	Thu Sep 02 17:28:00 2010 +0200
   155.3 @@ -386,13 +386,13 @@
   155.4      if t0 = conn_t then strip_connective t0 t2 @ strip_connective t0 t1 else [t]
   155.5    | strip_connective _ t = [t]
   155.6  fun strip_any_connective (t as (t0 $ _ $ _)) =
   155.7 -    if t0 = @{const "op &"} orelse t0 = @{const "op |"} then
   155.8 +    if t0 = @{const HOL.conj} orelse t0 = @{const HOL.disj} then
   155.9        (strip_connective t0 t, t0)
  155.10      else
  155.11        ([t], @{const Not})
  155.12    | strip_any_connective t = ([t], @{const Not})
  155.13 -val conjuncts_of = strip_connective @{const "op &"}
  155.14 -val disjuncts_of = strip_connective @{const "op |"}
  155.15 +val conjuncts_of = strip_connective @{const HOL.conj}
  155.16 +val disjuncts_of = strip_connective @{const HOL.disj}
  155.17  
  155.18  (* When you add constants to these lists, make sure to handle them in
  155.19     "Nitpick_Nut.nut_from_term", and perhaps in "Nitpick_Mono.consider_term" as
  155.20 @@ -408,10 +408,10 @@
  155.21     (@{const_name True}, 0),
  155.22     (@{const_name All}, 1),
  155.23     (@{const_name Ex}, 1),
  155.24 -   (@{const_name "op ="}, 1),
  155.25 -   (@{const_name "op &"}, 2),
  155.26 -   (@{const_name "op |"}, 2),
  155.27 -   (@{const_name "op -->"}, 2),
  155.28 +   (@{const_name HOL.eq}, 1),
  155.29 +   (@{const_name HOL.conj}, 2),
  155.30 +   (@{const_name HOL.disj}, 2),
  155.31 +   (@{const_name HOL.implies}, 2),
  155.32     (@{const_name If}, 3),
  155.33     (@{const_name Let}, 2),
  155.34     (@{const_name Pair}, 2),
  155.35 @@ -1275,7 +1275,7 @@
  155.36          forall is_Var args andalso not (has_duplicates (op =) args)
  155.37        | _ => false
  155.38      fun do_eq (Const (@{const_name "=="}, _) $ t1 $ _) = do_lhs t1
  155.39 -      | do_eq (@{const Trueprop} $ (Const (@{const_name "op ="}, _) $ t1 $ _)) =
  155.40 +      | do_eq (@{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t1 $ _)) =
  155.41          do_lhs t1
  155.42        | do_eq _ = false
  155.43    in do_eq end
  155.44 @@ -1347,7 +1347,7 @@
  155.45      @{const "==>"} $ _ $ t2 => term_under_def t2
  155.46    | Const (@{const_name "=="}, _) $ t1 $ _ => term_under_def t1
  155.47    | @{const Trueprop} $ t1 => term_under_def t1
  155.48 -  | Const (@{const_name "op ="}, _) $ t1 $ _ => term_under_def t1
  155.49 +  | Const (@{const_name HOL.eq}, _) $ t1 $ _ => term_under_def t1
  155.50    | Abs (_, _, t') => term_under_def t'
  155.51    | t1 $ _ => term_under_def t1
  155.52    | _ => t
  155.53 @@ -1371,7 +1371,7 @@
  155.54      val (lhs, rhs) =
  155.55        case t of
  155.56          Const (@{const_name "=="}, _) $ t1 $ t2 => (t1, t2)
  155.57 -      | @{const Trueprop} $ (Const (@{const_name "op ="}, _) $ t1 $ t2) =>
  155.58 +      | @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t1 $ t2) =>
  155.59          (t1, t2)
  155.60        | _ => raise TERM ("Nitpick_HOL.normalized_rhs_of", [t])
  155.61      val args = strip_comb lhs |> snd
  155.62 @@ -1453,8 +1453,8 @@
  155.63    | @{const "==>"} $ _ $ t2 => lhs_of_equation t2
  155.64    | @{const Trueprop} $ t1 => lhs_of_equation t1
  155.65    | Const (@{const_name All}, _) $ Abs (_, _, t1) => lhs_of_equation t1
  155.66 -  | Const (@{const_name "op ="}, _) $ t1 $ _ => SOME t1
  155.67 -  | @{const "op -->"} $ _ $ t2 => lhs_of_equation t2
  155.68 +  | Const (@{const_name HOL.eq}, _) $ t1 $ _ => SOME t1
  155.69 +  | @{const HOL.implies} $ _ $ t2 => lhs_of_equation t2
  155.70    | _ => NONE
  155.71  fun is_constr_pattern _ (Bound _) = true
  155.72    | is_constr_pattern _ (Var _) = true
  155.73 @@ -1807,7 +1807,7 @@
  155.74                          (betapply (t2, var_t))
  155.75      end
  155.76    | extensional_equal _ T t1 t2 =
  155.77 -    Const (@{const_name "op ="}, T --> T --> bool_T) $ t1 $ t2
  155.78 +    Const (@{const_name HOL.eq}, T --> T --> bool_T) $ t1 $ t2
  155.79  
  155.80  fun equationalize_term ctxt tag t =
  155.81    let
  155.82 @@ -1816,7 +1816,7 @@
  155.83    in
  155.84      Logic.list_implies (prems,
  155.85          case concl of
  155.86 -          @{const Trueprop} $ (Const (@{const_name "op ="}, Type (_, [T, _]))
  155.87 +          @{const Trueprop} $ (Const (@{const_name HOL.eq}, Type (_, [T, _]))
  155.88                                 $ t1 $ t2) =>
  155.89            @{const Trueprop} $ extensional_equal j T t1 t2
  155.90          | @{const Trueprop} $ t' =>
  155.91 @@ -2148,8 +2148,8 @@
  155.92            fun repair_rec j (Const (@{const_name Ex}, T1) $ Abs (s2, T2, t2')) =
  155.93                Const (@{const_name Ex}, T1)
  155.94                $ Abs (s2, T2, repair_rec (j + 1) t2')
  155.95 -            | repair_rec j (@{const "op &"} $ t1 $ t2) =
  155.96 -              @{const "op &"} $ repair_rec j t1 $ repair_rec j t2
  155.97 +            | repair_rec j (@{const HOL.conj} $ t1 $ t2) =
  155.98 +              @{const HOL.conj} $ repair_rec j t1 $ repair_rec j t2
  155.99              | repair_rec j t =
 155.100                let val (head, args) = strip_comb t in
 155.101                  if head = Bound j then
 155.102 @@ -2290,7 +2290,7 @@
 155.103    | simps => simps
 155.104  fun is_equational_fun_surely_complete hol_ctxt x =
 155.105    case equational_fun_axioms hol_ctxt x of
 155.106 -    [@{const Trueprop} $ (Const (@{const_name "op ="}, _) $ t1 $ _)] =>
 155.107 +    [@{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t1 $ _)] =>
 155.108      strip_comb t1 |> snd |> forall is_Var
 155.109    | _ => false
 155.110  
   156.1 --- a/src/HOL/Tools/Nitpick/nitpick_model.ML	Thu Sep 02 17:12:40 2010 +0200
   156.2 +++ b/src/HOL/Tools/Nitpick/nitpick_model.ML	Thu Sep 02 17:28:00 2010 +0200
   156.3 @@ -590,7 +590,7 @@
   156.4                        if co then
   156.5                          Const (@{const_name The}, (T --> bool_T) --> T)
   156.6                          $ Abs (cyclic_co_val_name (), T,
   156.7 -                               Const (@{const_name "op ="}, T --> T --> bool_T)
   156.8 +                               Const (@{const_name HOL.eq}, T --> T --> bool_T)
   156.9                                 $ Bound 0 $ abstract_over (var, t))
  156.10                        else
  156.11                          cyclic_atom ()
  156.12 @@ -849,7 +849,7 @@
  156.13  (** Model reconstruction **)
  156.14  
  156.15  fun unfold_outer_the_binders (t as Const (@{const_name The}, _)
  156.16 -                                   $ Abs (s, T, Const (@{const_name "op ="}, _)
  156.17 +                                   $ Abs (s, T, Const (@{const_name HOL.eq}, _)
  156.18                                                  $ Bound 0 $ t')) =
  156.19      betapply (Abs (s, T, t'), t) |> unfold_outer_the_binders
  156.20    | unfold_outer_the_binders t = t
   157.1 --- a/src/HOL/Tools/Nitpick/nitpick_mono.ML	Thu Sep 02 17:12:40 2010 +0200
   157.2 +++ b/src/HOL/Tools/Nitpick/nitpick_mono.ML	Thu Sep 02 17:28:00 2010 +0200
   157.3 @@ -222,7 +222,7 @@
   157.4    | fin_fun_body _ _ (t as Const (@{const_name None}, _)) = SOME t
   157.5    | fin_fun_body dom_T ran_T
   157.6                   ((t0 as Const (@{const_name If}, _))
   157.7 -                  $ (t1 as Const (@{const_name "op ="}, _) $ Bound 0 $ t1')
   157.8 +                  $ (t1 as Const (@{const_name HOL.eq}, _) $ Bound 0 $ t1')
   157.9                    $ t2 $ t3) =
  157.10      (if loose_bvar1 (t1', 0) then
  157.11         NONE
  157.12 @@ -650,7 +650,7 @@
  157.13                                       Bound 0)))) accum
  157.14                    |>> mtype_of_mterm
  157.15                  end
  157.16 -              | @{const_name "op ="} => do_equals T accum
  157.17 +              | @{const_name HOL.eq} => do_equals T accum
  157.18                | @{const_name The} =>
  157.19                  (trace_msg (K "*** The"); raise UNSOLVABLE ())
  157.20                | @{const_name Eps} =>
  157.21 @@ -760,7 +760,7 @@
  157.22                      do_term (incr_boundvars ~1 t1') accum
  157.23                    else
  157.24                      raise SAME ()
  157.25 -                | (t11 as Const (@{const_name "op ="}, _)) $ Bound 0 $ t13 =>
  157.26 +                | (t11 as Const (@{const_name HOL.eq}, _)) $ Bound 0 $ t13 =>
  157.27                    if not (loose_bvar1 (t13, 0)) then
  157.28                      do_term (incr_boundvars ~1 (t11 $ t13)) accum
  157.29                    else
  157.30 @@ -774,10 +774,10 @@
  157.31                          (MAbs (s, T, M, S Minus, m'), accum |>> pop_bound)
  157.32                        end))
  157.33           | (t0 as Const (@{const_name All}, _))
  157.34 -           $ Abs (s', T', (t10 as @{const "op -->"}) $ (t11 $ Bound 0) $ t12) =>
  157.35 +           $ Abs (s', T', (t10 as @{const HOL.implies}) $ (t11 $ Bound 0) $ t12) =>
  157.36             do_bounded_quantifier t0 s' T' t10 t11 t12 accum
  157.37           | (t0 as Const (@{const_name Ex}, _))
  157.38 -           $ Abs (s', T', (t10 as @{const "op &"}) $ (t11 $ Bound 0) $ t12) =>
  157.39 +           $ Abs (s', T', (t10 as @{const HOL.conj}) $ (t11 $ Bound 0) $ t12) =>
  157.40             do_bounded_quantifier t0 s' T' t10 t11 t12 accum
  157.41           | Const (@{const_name Let}, _) $ t1 $ t2 =>
  157.42             do_term (betapply (t2, t1)) accum
  157.43 @@ -876,19 +876,19 @@
  157.44                  do_term (@{const Not}
  157.45                           $ (HOLogic.eq_const (domain_type T0) $ t1
  157.46                              $ Abs (Name.uu, T1, @{const False}))) accum)
  157.47 -           | Const (x as (@{const_name "op ="}, _)) $ t1 $ t2 =>
  157.48 +           | Const (x as (@{const_name HOL.eq}, _)) $ t1 $ t2 =>
  157.49               do_equals x t1 t2
  157.50             | Const (@{const_name Let}, _) $ t1 $ t2 =>
  157.51               do_formula sn (betapply (t2, t1)) accum
  157.52             | (t0 as Const (s0, _)) $ t1 $ t2 =>
  157.53               if s0 = @{const_name "==>"} orelse
  157.54                  s0 = @{const_name Pure.conjunction} orelse
  157.55 -                s0 = @{const_name "op &"} orelse
  157.56 -                s0 = @{const_name "op |"} orelse
  157.57 -                s0 = @{const_name "op -->"} then
  157.58 +                s0 = @{const_name HOL.conj} orelse
  157.59 +                s0 = @{const_name HOL.disj} orelse
  157.60 +                s0 = @{const_name HOL.implies} then
  157.61                 let
  157.62                   val impl = (s0 = @{const_name "==>"} orelse
  157.63 -                             s0 = @{const_name "op -->"})
  157.64 +                             s0 = @{const_name HOL.implies})
  157.65                   val (m1, accum) = do_formula (sn |> impl ? negate) t1 accum
  157.66                   val (m2, accum) = do_formula sn t2 accum
  157.67                 in
  157.68 @@ -973,10 +973,10 @@
  157.69              do_conjunction t0 t1 t2 accum
  157.70            | (t0 as Const (@{const_name All}, _)) $ Abs (s0, T1, t1) =>
  157.71              do_all t0 s0 T1 t1 accum
  157.72 -          | Const (x as (@{const_name "op ="}, _)) $ t1 $ t2 =>
  157.73 +          | Const (x as (@{const_name HOL.eq}, _)) $ t1 $ t2 =>
  157.74              consider_general_equals mdata true x t1 t2 accum
  157.75 -          | (t0 as @{const "op &"}) $ t1 $ t2 => do_conjunction t0 t1 t2 accum
  157.76 -          | (t0 as @{const "op -->"}) $ t1 $ t2 => do_implies t0 t1 t2 accum
  157.77 +          | (t0 as @{const HOL.conj}) $ t1 $ t2 => do_conjunction t0 t1 t2 accum
  157.78 +          | (t0 as @{const HOL.implies}) $ t1 $ t2 => do_implies t0 t1 t2 accum
  157.79            | _ => raise TERM ("Nitpick_Mono.consider_definitional_axiom.\
  157.80                               \do_formula", [t])
  157.81      in do_formula t end
  157.82 @@ -1069,7 +1069,7 @@
  157.83                      Abs (Name.uu, set_T', @{const True})
  157.84                    | _ => Const (s, T')
  157.85                  else if s = @{const_name "=="} orelse
  157.86 -                        s = @{const_name "op ="} then
  157.87 +                        s = @{const_name HOL.eq} then
  157.88                    let
  157.89                      val T =
  157.90                        case T' of
   158.1 --- a/src/HOL/Tools/Nitpick/nitpick_nut.ML	Thu Sep 02 17:12:40 2010 +0200
   158.2 +++ b/src/HOL/Tools/Nitpick/nitpick_nut.ML	Thu Sep 02 17:28:00 2010 +0200
   158.3 @@ -447,7 +447,7 @@
   158.4                  val t1 = incr_boundvars n t1
   158.5                  val t2 = incr_boundvars n t2
   158.6                  val xs = map Bound (n - 1 downto 0)
   158.7 -                val equation = Const (@{const_name "op ="},
   158.8 +                val equation = Const (@{const_name HOL.eq},
   158.9                                        body_T --> body_T --> bool_T)
  158.10                                     $ betapplys (t1, xs) $ betapplys (t2, xs)
  158.11                  val t =
  158.12 @@ -515,14 +515,14 @@
  158.13            do_description_operator The @{const_name undefined_fast_The} x t1
  158.14          | (Const (x as (@{const_name Eps}, _)), [t1]) =>
  158.15            do_description_operator Eps @{const_name undefined_fast_Eps} x t1
  158.16 -        | (Const (@{const_name "op ="}, T), [t1]) =>
  158.17 +        | (Const (@{const_name HOL.eq}, T), [t1]) =>
  158.18            Op1 (SingletonSet, range_type T, Any, sub t1)
  158.19 -        | (Const (@{const_name "op ="}, T), [t1, t2]) => sub_equals T t1 t2
  158.20 -        | (Const (@{const_name "op &"}, _), [t1, t2]) =>
  158.21 +        | (Const (@{const_name HOL.eq}, T), [t1, t2]) => sub_equals T t1 t2
  158.22 +        | (Const (@{const_name HOL.conj}, _), [t1, t2]) =>
  158.23            Op2 (And, bool_T, Any, sub' t1, sub' t2)
  158.24 -        | (Const (@{const_name "op |"}, _), [t1, t2]) =>
  158.25 +        | (Const (@{const_name HOL.disj}, _), [t1, t2]) =>
  158.26            Op2 (Or, bool_T, Any, sub t1, sub t2)
  158.27 -        | (Const (@{const_name "op -->"}, _), [t1, t2]) =>
  158.28 +        | (Const (@{const_name HOL.implies}, _), [t1, t2]) =>
  158.29            Op2 (Or, bool_T, Any, Op1 (Not, bool_T, Any, sub t1), sub' t2)
  158.30          | (Const (@{const_name If}, T), [t1, t2, t3]) =>
  158.31            Op3 (If, nth_range_type 3 T, Any, sub t1, sub t2, sub t3)
   159.1 --- a/src/HOL/Tools/Nitpick/nitpick_preproc.ML	Thu Sep 02 17:12:40 2010 +0200
   159.2 +++ b/src/HOL/Tools/Nitpick/nitpick_preproc.ML	Thu Sep 02 17:28:00 2010 +0200
   159.3 @@ -41,9 +41,9 @@
   159.4      fun aux def (Const (@{const_name "=="}, _) $ t1 $ t2) =
   159.5          aux def t1 andalso aux false t2
   159.6        | aux def (@{const "==>"} $ t1 $ t2) = aux false t1 andalso aux def t2
   159.7 -      | aux def (Const (@{const_name "op ="}, _) $ t1 $ t2) =
   159.8 +      | aux def (Const (@{const_name HOL.eq}, _) $ t1 $ t2) =
   159.9          aux def t1 andalso aux false t2
  159.10 -      | aux def (@{const "op -->"} $ t1 $ t2) = aux false t1 andalso aux def t2
  159.11 +      | aux def (@{const HOL.implies} $ t1 $ t2) = aux false t1 andalso aux def t2
  159.12        | aux def (t1 $ t2) = aux def t1 andalso aux def t2
  159.13        | aux def (t as Const (s, _)) =
  159.14          (not def orelse t <> @{const Suc}) andalso
  159.15 @@ -149,7 +149,7 @@
  159.16        case t of
  159.17          @{const Trueprop} $ t1 => box_var_in_def new_Ts old_Ts t1 z
  159.18        | Const (s0, _) $ t1 $ _ =>
  159.19 -        if s0 = @{const_name "=="} orelse s0 = @{const_name "op ="} then
  159.20 +        if s0 = @{const_name "=="} orelse s0 = @{const_name HOL.eq} then
  159.21            let
  159.22              val (t', args) = strip_comb t1
  159.23              val T' = fastype_of1 (new_Ts, do_term new_Ts old_Ts Neut t')
  159.24 @@ -209,16 +209,16 @@
  159.25          do_quantifier new_Ts old_Ts polar s0 T0 s1 T1 t1
  159.26        | Const (s0 as @{const_name Ex}, T0) $ Abs (s1, T1, t1) =>
  159.27          do_quantifier new_Ts old_Ts polar s0 T0 s1 T1 t1
  159.28 -      | Const (s0 as @{const_name "op ="}, T0) $ t1 $ t2 =>
  159.29 +      | Const (s0 as @{const_name HOL.eq}, T0) $ t1 $ t2 =>
  159.30          do_equals new_Ts old_Ts s0 T0 t1 t2
  159.31 -      | @{const "op &"} $ t1 $ t2 =>
  159.32 -        @{const "op &"} $ do_term new_Ts old_Ts polar t1
  159.33 +      | @{const HOL.conj} $ t1 $ t2 =>
  159.34 +        @{const HOL.conj} $ do_term new_Ts old_Ts polar t1
  159.35          $ do_term new_Ts old_Ts polar t2
  159.36 -      | @{const "op |"} $ t1 $ t2 =>
  159.37 -        @{const "op |"} $ do_term new_Ts old_Ts polar t1
  159.38 +      | @{const HOL.disj} $ t1 $ t2 =>
  159.39 +        @{const HOL.disj} $ do_term new_Ts old_Ts polar t1
  159.40          $ do_term new_Ts old_Ts polar t2
  159.41 -      | @{const "op -->"} $ t1 $ t2 =>
  159.42 -        @{const "op -->"} $ do_term new_Ts old_Ts (flip_polarity polar) t1
  159.43 +      | @{const HOL.implies} $ t1 $ t2 =>
  159.44 +        @{const HOL.implies} $ do_term new_Ts old_Ts (flip_polarity polar) t1
  159.45          $ do_term new_Ts old_Ts polar t2
  159.46        | Const (x as (s, T)) =>
  159.47          if is_descr s then
  159.48 @@ -332,9 +332,9 @@
  159.49          do_eq_or_imp Ts true def t0 t1 t2 seen
  159.50        | (t0 as @{const "==>"}) $ t1 $ t2 =>
  159.51          if def then (t, []) else do_eq_or_imp Ts false def t0 t1 t2 seen
  159.52 -      | (t0 as Const (@{const_name "op ="}, _)) $ t1 $ t2 =>
  159.53 +      | (t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2 =>
  159.54          do_eq_or_imp Ts true def t0 t1 t2 seen
  159.55 -      | (t0 as @{const "op -->"}) $ t1 $ t2 =>
  159.56 +      | (t0 as @{const HOL.implies}) $ t1 $ t2 =>
  159.57          do_eq_or_imp Ts false def t0 t1 t2 seen
  159.58        | Abs (s, T, t') =>
  159.59          let val (t', seen) = do_term (T :: Ts) def t' [] seen in
  159.60 @@ -399,9 +399,9 @@
  159.61          aux_eq careful true t0 t1 t2
  159.62        | aux careful ((t0 as @{const "==>"}) $ t1 $ t2) =
  159.63          t0 $ aux false t1 $ aux careful t2
  159.64 -      | aux careful ((t0 as Const (@{const_name "op ="}, _)) $ t1 $ t2) =
  159.65 +      | aux careful ((t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2) =
  159.66          aux_eq careful true t0 t1 t2
  159.67 -      | aux careful ((t0 as @{const "op -->"}) $ t1 $ t2) =
  159.68 +      | aux careful ((t0 as @{const HOL.implies}) $ t1 $ t2) =
  159.69          t0 $ aux false t1 $ aux careful t2
  159.70        | aux careful (Abs (s, T, t')) = Abs (s, T, aux careful t')
  159.71        | aux careful (t1 $ t2) = aux careful t1 $ aux careful t2
  159.72 @@ -449,7 +449,7 @@
  159.73  (** Destruction of universal and existential equalities **)
  159.74  
  159.75  fun curry_assms (@{const "==>"} $ (@{const Trueprop}
  159.76 -                                   $ (@{const "op &"} $ t1 $ t2)) $ t3) =
  159.77 +                                   $ (@{const HOL.conj} $ t1 $ t2)) $ t3) =
  159.78      curry_assms (Logic.list_implies ([t1, t2] |> map HOLogic.mk_Trueprop, t3))
  159.79    | curry_assms (@{const "==>"} $ t1 $ t2) =
  159.80      @{const "==>"} $ curry_assms t1 $ curry_assms t2
  159.81 @@ -464,9 +464,9 @@
  159.82      and aux_implies prems zs t1 t2 =
  159.83        case t1 of
  159.84          Const (@{const_name "=="}, _) $ Var z $ t' => aux_eq prems zs z t' t1 t2
  159.85 -      | @{const Trueprop} $ (Const (@{const_name "op ="}, _) $ Var z $ t') =>
  159.86 +      | @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ Var z $ t') =>
  159.87          aux_eq prems zs z t' t1 t2
  159.88 -      | @{const Trueprop} $ (Const (@{const_name "op ="}, _) $ t' $ Var z) =>
  159.89 +      | @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t' $ Var z) =>
  159.90          aux_eq prems zs z t' t1 t2
  159.91        | _ => aux (t1 :: prems) (Term.add_vars t1 zs) t2
  159.92      and aux_eq prems zs z t' t1 t2 =
  159.93 @@ -499,7 +499,7 @@
  159.94              handle SAME () => do_term (t :: seen) ts
  159.95          in
  159.96            case t of
  159.97 -            Const (@{const_name "op ="}, _) $ t1 $ t2 => do_eq true t1 t2
  159.98 +            Const (@{const_name HOL.eq}, _) $ t1 $ t2 => do_eq true t1 t2
  159.99            | _ => do_term (t :: seen) ts
 159.100          end
 159.101    in do_term end
 159.102 @@ -604,12 +604,12 @@
 159.103            do_quantifier s0 T0 s1 T1 t1
 159.104          | Const (s0 as @{const_name Ex}, T0) $ Abs (s1, T1, t1) =>
 159.105            do_quantifier s0 T0 s1 T1 t1
 159.106 -        | @{const "op &"} $ t1 $ t2 =>
 159.107 +        | @{const HOL.conj} $ t1 $ t2 =>
 159.108            s_conj (pairself (aux ss Ts js skolemizable polar) (t1, t2))
 159.109 -        | @{const "op |"} $ t1 $ t2 =>
 159.110 +        | @{const HOL.disj} $ t1 $ t2 =>
 159.111            s_disj (pairself (aux ss Ts js skolemizable polar) (t1, t2))
 159.112 -        | @{const "op -->"} $ t1 $ t2 =>
 159.113 -          @{const "op -->"} $ aux ss Ts js skolemizable (flip_polarity polar) t1
 159.114 +        | @{const HOL.implies} $ t1 $ t2 =>
 159.115 +          @{const HOL.implies} $ aux ss Ts js skolemizable (flip_polarity polar) t1
 159.116            $ aux ss Ts js skolemizable polar t2
 159.117          | (t0 as Const (@{const_name Let}, _)) $ t1 $ t2 =>
 159.118            t0 $ t1 $ aux ss Ts js skolemizable polar t2
 159.119 @@ -620,8 +620,8 @@
 159.120              let
 159.121                val gfp = (fixpoint_kind_of_const thy def_table x = Gfp)
 159.122                val (pref, connective) =
 159.123 -                if gfp then (lbfp_prefix, @{const "op |"})
 159.124 -                else (ubfp_prefix, @{const "op &"})
 159.125 +                if gfp then (lbfp_prefix, @{const HOL.disj})
 159.126 +                else (ubfp_prefix, @{const HOL.conj})
 159.127                fun pos () = unrolled_inductive_pred_const hol_ctxt gfp x
 159.128                             |> aux ss Ts js skolemizable polar
 159.129                fun neg () = Const (pref ^ s, T)
 159.130 @@ -653,7 +653,7 @@
 159.131  
 159.132  fun params_in_equation (@{const "==>"} $ _ $ t2) = params_in_equation t2
 159.133    | params_in_equation (@{const Trueprop} $ t1) = params_in_equation t1
 159.134 -  | params_in_equation (Const (@{const_name "op ="}, _) $ t1 $ _) =
 159.135 +  | params_in_equation (Const (@{const_name HOL.eq}, _) $ t1 $ _) =
 159.136      snd (strip_comb t1)
 159.137    | params_in_equation _ = []
 159.138  
 159.139 @@ -1105,7 +1105,7 @@
 159.140    case t of
 159.141      (t0 as Const (@{const_name All}, T0)) $ Abs (s, T1, t1) =>
 159.142      (case t1 of
 159.143 -       (t10 as @{const "op &"}) $ t11 $ t12 =>
 159.144 +       (t10 as @{const HOL.conj}) $ t11 $ t12 =>
 159.145         t10 $ distribute_quantifiers (t0 $ Abs (s, T1, t11))
 159.146             $ distribute_quantifiers (t0 $ Abs (s, T1, t12))
 159.147       | (t10 as @{const Not}) $ t11 =>
 159.148 @@ -1118,10 +1118,10 @@
 159.149           t0 $ Abs (s, T1, distribute_quantifiers t1))
 159.150    | (t0 as Const (@{const_name Ex}, T0)) $ Abs (s, T1, t1) =>
 159.151      (case distribute_quantifiers t1 of
 159.152 -       (t10 as @{const "op |"}) $ t11 $ t12 =>
 159.153 +       (t10 as @{const HOL.disj}) $ t11 $ t12 =>
 159.154         t10 $ distribute_quantifiers (t0 $ Abs (s, T1, t11))
 159.155             $ distribute_quantifiers (t0 $ Abs (s, T1, t12))
 159.156 -     | (t10 as @{const "op -->"}) $ t11 $ t12 =>
 159.157 +     | (t10 as @{const HOL.implies}) $ t11 $ t12 =>
 159.158         t10 $ distribute_quantifiers (Const (@{const_name All}, T0)
 159.159                                       $ Abs (s, T1, t11))
 159.160             $ distribute_quantifiers (t0 $ Abs (s, T1, t12))
   160.1 --- a/src/HOL/Tools/Predicate_Compile/code_prolog.ML	Thu Sep 02 17:12:40 2010 +0200
   160.2 +++ b/src/HOL/Tools/Predicate_Compile/code_prolog.ML	Thu Sep 02 17:28:00 2010 +0200
   160.3 @@ -6,8 +6,16 @@
   160.4  
   160.5  signature CODE_PROLOG =
   160.6  sig
   160.7 -  type code_options = {ensure_groundness : bool}
   160.8 -  val options : code_options ref
   160.9 +  datatype prolog_system = SWI_PROLOG | YAP
  160.10 +  type code_options =
  160.11 +    {ensure_groundness : bool,
  160.12 +     limited_types : (typ * int) list,
  160.13 +     limited_predicates : (string list * int) list,
  160.14 +     replacing : ((string * string) * string) list,
  160.15 +     manual_reorder : ((string * int) * int list) list,
  160.16 +     prolog_system : prolog_system}
  160.17 +  val code_options_of : theory -> code_options 
  160.18 +  val map_code_options : (code_options -> code_options) -> theory -> theory
  160.19  
  160.20    datatype arith_op = Plus | Minus
  160.21    datatype prol_term = Var of string | Cons of string | AppF of string * prol_term list
  160.22 @@ -21,14 +29,16 @@
  160.23    type clause = ((string * prol_term list) * prem);
  160.24    type logic_program = clause list;
  160.25    type constant_table = (string * string) list
  160.26 -    
  160.27 -  val generate : code_options -> Proof.context -> string -> (logic_program * constant_table)
  160.28 +
  160.29 +  val generate : bool -> Proof.context -> string -> (logic_program * constant_table)
  160.30    val write_program : logic_program -> string
  160.31 -  val run : logic_program -> string -> string list -> int option -> prol_term list list
  160.32 +  val run : prolog_system -> logic_program -> string -> string list -> int option -> prol_term list list
  160.33  
  160.34    val quickcheck : Proof.context -> bool -> term -> int -> term list option * (bool list * bool)
  160.35  
  160.36    val trace : bool Unsynchronized.ref
  160.37 +  
  160.38 +  val replace : ((string * string) * string) -> logic_program -> logic_program
  160.39  end;
  160.40  
  160.41  structure Code_Prolog : CODE_PROLOG =
  160.42 @@ -42,9 +52,41 @@
  160.43  
  160.44  (* code generation options *)
  160.45  
  160.46 -type code_options = {ensure_groundness : bool}
  160.47 +datatype prolog_system = SWI_PROLOG | YAP
  160.48 +
  160.49 +type code_options =
  160.50 +  {ensure_groundness : bool,
  160.51 +   limited_types : (typ * int) list,
  160.52 +   limited_predicates : (string list * int) list,
  160.53 +   replacing : ((string * string) * string) list,
  160.54 +   manual_reorder : ((string * int) * int list) list,
  160.55 +   prolog_system : prolog_system}
  160.56  
  160.57 -val options = Unsynchronized.ref {ensure_groundness = false};
  160.58 +structure Options = Theory_Data
  160.59 +(
  160.60 +  type T = code_options
  160.61 +  val empty = {ensure_groundness = false,
  160.62 +    limited_types = [], limited_predicates = [], replacing = [], manual_reorder = [],
  160.63 +    prolog_system = SWI_PROLOG}
  160.64 +  val extend = I;
  160.65 +  fun merge
  160.66 +    ({ensure_groundness = ensure_groundness1, limited_types = limited_types1,
  160.67 +      limited_predicates = limited_predicates1, replacing = replacing1,
  160.68 +      manual_reorder = manual_reorder1, prolog_system = prolog_system1},
  160.69 +     {ensure_groundness = ensure_groundness2, limited_types = limited_types2,
  160.70 +      limited_predicates = limited_predicates2, replacing = replacing2,
  160.71 +      manual_reorder = manual_reorder2, prolog_system = prolog_system2}) =
  160.72 +    {ensure_groundness = ensure_groundness1 orelse ensure_groundness2,
  160.73 +     limited_types = AList.merge (op =) (K true) (limited_types1, limited_types2),
  160.74 +     limited_predicates = AList.merge (op =) (K true) (limited_predicates1, limited_predicates2),
  160.75 +     manual_reorder = AList.merge (op =) (K true) (manual_reorder1, manual_reorder2),
  160.76 +     replacing = Library.merge (op =) (replacing1, replacing2),
  160.77 +     prolog_system = prolog_system1};
  160.78 +);
  160.79 +
  160.80 +val code_options_of = Options.get
  160.81 +
  160.82 +val map_code_options = Options.map
  160.83  
  160.84  (* general string functions *)
  160.85  
  160.86 @@ -118,16 +160,32 @@
  160.87  
  160.88  (* translation from introduction rules to internal representation *)
  160.89  
  160.90 +fun mk_conform f empty avoid name =
  160.91 +  let
  160.92 +    fun dest_Char (Symbol.Char c) = c
  160.93 +    val name' = space_implode "" (map (dest_Char o Symbol.decode)
  160.94 +      (filter (fn s => Symbol.is_ascii_letter s orelse Symbol.is_ascii_digit s)
  160.95 +        (Symbol.explode name)))
  160.96 +    val name'' = f (if name' = "" then empty else name')
  160.97 +  in (if member (op =) avoid name'' then Name.variant avoid name'' else name'') end
  160.98 +
  160.99  (** constant table **)
 160.100  
 160.101  type constant_table = (string * string) list
 160.102  
 160.103  (* assuming no clashing *)
 160.104 -fun mk_constant_table consts =
 160.105 -  AList.make (first_lower o Long_Name.base_name) consts
 160.106 -
 160.107  fun declare_consts consts constant_table =
 160.108 -  fold (fn c => AList.update (op =) (c, first_lower (Long_Name.base_name c))) consts constant_table
 160.109 +  let
 160.110 +    fun update' c table =
 160.111 +      if AList.defined (op =) table c then table else
 160.112 +        let
 160.113 +          val c' = mk_conform first_lower "pred" (map snd table) (Long_Name.base_name c)
 160.114 +        in
 160.115 +          AList.update (op =) (c, c') table
 160.116 +        end
 160.117 +  in
 160.118 +    fold update' consts constant_table
 160.119 +  end
 160.120    
 160.121  fun translate_const constant_table c =
 160.122    case AList.lookup (op =) constant_table c of
 160.123 @@ -173,7 +231,7 @@
 160.124  
 160.125  fun translate_literal ctxt constant_table t =
 160.126    case strip_comb t of
 160.127 -    (Const (@{const_name "op ="}, _), [l, r]) =>
 160.128 +    (Const (@{const_name HOL.eq}, _), [l, r]) =>
 160.129        let
 160.130          val l' = translate_term ctxt constant_table l
 160.131          val r' = translate_term ctxt constant_table r
 160.132 @@ -190,10 +248,10 @@
 160.133  
 160.134  fun mk_groundness_prems t = map Ground (Term.add_frees t [])
 160.135    
 160.136 -fun translate_prem options ctxt constant_table t =  
 160.137 +fun translate_prem ensure_groundness ctxt constant_table t =  
 160.138      case try HOLogic.dest_not t of
 160.139        SOME t =>
 160.140 -        if #ensure_groundness options then
 160.141 +        if ensure_groundness then
 160.142            Conj (mk_groundness_prems t @ [NegRel_of (translate_literal ctxt constant_table t)])
 160.143          else
 160.144            NegRel_of (translate_literal ctxt constant_table t)
 160.145 @@ -215,7 +273,7 @@
 160.146        (Trueprop_conv (Conv.try_conv (Conv.rewr_conv @{thm Predicate.eq_is_eq}))))
 160.147      (Thm.transfer thy rule)
 160.148  
 160.149 -fun translate_intros options ctxt gr const constant_table =
 160.150 +fun translate_intros ensure_groundness ctxt gr const constant_table =
 160.151    let
 160.152      val intros = map (preprocess_intro (ProofContext.theory_of ctxt)) (Graph.get_node gr const)
 160.153      val (intros', ctxt') = Variable.import_terms true (map prop_of intros) ctxt
 160.154 @@ -225,32 +283,11 @@
 160.155        let
 160.156          val head = HOLogic.dest_Trueprop (Logic.strip_imp_concl intro)
 160.157          val prems = map HOLogic.dest_Trueprop (Logic.strip_imp_prems intro)
 160.158 -        val prems' = Conj (map (translate_prem options ctxt' constant_table') prems)
 160.159 +        val prems' = Conj (map (translate_prem ensure_groundness ctxt' constant_table') prems)
 160.160          val clause = (dest_Rel (translate_literal ctxt' constant_table' head), prems')
 160.161        in clause end
 160.162 -  in (map translate_intro intros', constant_table') end
 160.163 -
 160.164 -val preprocess_options = Predicate_Compile_Aux.Options {
 160.165 -  expected_modes = NONE,
 160.166 -  proposed_modes = NONE,
 160.167 -  proposed_names = [],
 160.168 -  show_steps = false,
 160.169 -  show_intermediate_results = false,
 160.170 -  show_proof_trace = false,
 160.171 -  show_modes = false,
 160.172 -  show_mode_inference = false,
 160.173 -  show_compilation = false,
 160.174 -  show_caught_failures = false,
 160.175 -  skip_proof = true,
 160.176 -  no_topmost_reordering = false,
 160.177 -  function_flattening = true,
 160.178 -  specialise = false,
 160.179 -  fail_safe_function_flattening = false,
 160.180 -  no_higher_order_predicate = [],
 160.181 -  inductify = false,
 160.182 -  detect_switches = true,
 160.183 -  compilation = Predicate_Compile_Aux.Pred
 160.184 -}
 160.185 +    val res = (map translate_intro intros', constant_table')
 160.186 +  in res end
 160.187  
 160.188  fun depending_preds_of (key, intros) =
 160.189    fold Term.add_const_names (map Thm.prop_of intros) []
 160.190 @@ -272,19 +309,20 @@
 160.191      fst (extend' key (G, []))
 160.192    end
 160.193  
 160.194 -fun generate options ctxt const =
 160.195 +fun generate ensure_groundness ctxt const =
 160.196    let 
 160.197      fun strong_conn_of gr keys =
 160.198        Graph.strong_conn (Graph.subgraph (member (op =) (Graph.all_succs gr keys)) gr)
 160.199      val gr = Predicate_Compile_Core.intros_graph_of ctxt
 160.200      val gr' = add_edges depending_preds_of const gr
 160.201      val scc = strong_conn_of gr' [const]
 160.202 -    val constant_table = mk_constant_table (flat scc)
 160.203 +    val constant_table = declare_consts (flat scc) []
 160.204    in
 160.205 -    apfst flat (fold_map (translate_intros options ctxt gr) (flat scc) constant_table)
 160.206 +    apfst flat (fold_map (translate_intros ensure_groundness ctxt gr) (flat scc) constant_table)
 160.207    end
 160.208    
 160.209 -(* add implementation for ground predicates *)
 160.210 +(* implementation for fully enumerating predicates and
 160.211 +  for size-limited predicates for enumerating the values of a datatype upto a specific size *)
 160.212  
 160.213  fun add_ground_typ (Conj prems) = fold add_ground_typ prems
 160.214    | add_ground_typ (Ground (_, T)) = insert (op =) T
 160.215 @@ -294,34 +332,58 @@
 160.216    first_lower (Long_Name.base_name Tcon) ^ space_implode "_" (map mk_relname Targs)
 160.217    | mk_relname _ = raise Fail "unexpected type"
 160.218  
 160.219 +fun mk_lim_relname T = "lim_" ^  mk_relname T
 160.220 +
 160.221  (* This is copied from "pat_completeness.ML" *)
 160.222  fun inst_constrs_of thy (T as Type (name, _)) =
 160.223    map (fn (Cn,CT) =>
 160.224      Envir.subst_term_types (Sign.typ_match thy (body_type CT, T) Vartab.empty) (Const (Cn, CT)))
 160.225      (the (Datatype.get_constrs thy name))
 160.226    | inst_constrs_of thy T = raise TYPE ("inst_constrs_of", [T], [])
 160.227 +
 160.228 +fun is_recursive_constr T (Const (constr_name, T')) = member (op =) (binder_types T') T
 160.229    
 160.230 -fun mk_ground_impl ctxt (T as Type (Tcon, Targs)) (seen, constant_table) =
 160.231 +fun mk_ground_impl ctxt limited_types (T as Type (Tcon, Targs)) (seen, constant_table) =
 160.232    if member (op =) seen T then ([], (seen, constant_table))
 160.233    else
 160.234      let
 160.235 -      val rel_name = mk_relname T
 160.236 -      fun mk_impl (Const (constr_name, T)) (seen, constant_table) =
 160.237 +      val (limited, size) = case AList.lookup (op =) limited_types T of
 160.238 +        SOME s => (true, s)
 160.239 +      | NONE => (false, 0)      
 160.240 +      val rel_name = (if limited then mk_lim_relname else mk_relname) T
 160.241 +      fun mk_impl (Const (constr_name, cT), recursive) (seen, constant_table) =
 160.242          let
 160.243            val constant_table' = declare_consts [constr_name] constant_table
 160.244 +          val Ts = binder_types cT
 160.245            val (rec_clauses, (seen', constant_table'')) =
 160.246 -            fold_map (mk_ground_impl ctxt) (binder_types T) (seen, constant_table')
 160.247 -          val vars = map (fn i => Var ("x" ^ string_of_int i)) (1 upto (length (binder_types T)))    
 160.248 -          fun mk_prem v T = Rel (mk_relname T, [v])
 160.249 +            fold_map (mk_ground_impl ctxt limited_types) Ts (seen, constant_table')
 160.250 +          val vars = map (fn i => Var ("x" ^ string_of_int i)) (1 upto (length Ts))
 160.251 +          val lim_var =
 160.252 +            if limited then
 160.253 +              if recursive then [AppF ("suc", [Var "Lim"])]              
 160.254 +              else [Var "Lim"]
 160.255 +            else [] 
 160.256 +          fun mk_prem v T' =
 160.257 +            if limited andalso T' = T then Rel (mk_lim_relname T', [Var "Lim", v])
 160.258 +            else Rel (mk_relname T', [v])
 160.259            val clause =
 160.260 -            ((rel_name, [maybe_AppF (translate_const constant_table'' constr_name, vars)]),
 160.261 -             Conj (map2 mk_prem vars (binder_types T)))
 160.262 +            ((rel_name, lim_var @ [maybe_AppF (translate_const constant_table'' constr_name, vars)]),
 160.263 +             Conj (map2 mk_prem vars Ts))
 160.264          in
 160.265            (clause :: flat rec_clauses, (seen', constant_table''))
 160.266          end
 160.267        val constrs = inst_constrs_of (ProofContext.theory_of ctxt) T
 160.268 -    in apfst flat (fold_map mk_impl constrs (T :: seen, constant_table)) end
 160.269 - | mk_ground_impl ctxt T (seen, constant_table) =
 160.270 +      val constrs' = (constrs ~~ map (is_recursive_constr T) constrs)
 160.271 +        |> (fn cs => filter_out snd cs @ filter snd cs)
 160.272 +      val (clauses, constant_table') =
 160.273 +        apfst flat (fold_map mk_impl constrs' (T :: seen, constant_table))
 160.274 +      val size_term = funpow size (fn t => AppF ("suc", [t])) (Cons "zero")
 160.275 +    in
 160.276 +      ((if limited then
 160.277 +        cons ((mk_relname T, [Var "x"]), Rel (mk_lim_relname T, [size_term, Var "x"]))
 160.278 +      else I) clauses, constant_table')
 160.279 +    end
 160.280 + | mk_ground_impl ctxt _ T (seen, constant_table) =
 160.281     raise Fail ("unexpected type :" ^ Syntax.string_of_typ ctxt T)
 160.282  
 160.283  fun replace_ground (Conj prems) = Conj (map replace_ground prems)
 160.284 @@ -329,36 +391,97 @@
 160.285      Rel (mk_relname T, [Var x])  
 160.286    | replace_ground p = p
 160.287    
 160.288 -fun add_ground_predicates ctxt (p, constant_table) =
 160.289 +fun add_ground_predicates ctxt limited_types (p, constant_table) =
 160.290    let
 160.291      val ground_typs = fold (add_ground_typ o snd) p []
 160.292 -    val (grs, (_, constant_table')) = fold_map (mk_ground_impl ctxt) ground_typs ([], constant_table)
 160.293 +    val (grs, (_, constant_table')) = fold_map (mk_ground_impl ctxt limited_types) ground_typs ([], constant_table)
 160.294      val p' = map (apsnd replace_ground) p
 160.295    in
 160.296      ((flat grs) @ p', constant_table')
 160.297    end
 160.298 -    
 160.299 +
 160.300 +(* make depth-limited version of predicate *)
 160.301 +
 160.302 +fun mk_lim_rel_name rel_name = "lim_" ^ rel_name
 160.303 +
 160.304 +fun mk_depth_limited rel_names ((rel_name, ts), prem) =
 160.305 +  let
 160.306 +    fun has_positive_recursive_prems (Conj prems) = exists has_positive_recursive_prems prems
 160.307 +      | has_positive_recursive_prems (Rel (rel, ts)) = member (op =) rel_names rel
 160.308 +      | has_positive_recursive_prems _ = false
 160.309 +    fun mk_lim_prem (Conj prems) = Conj (map mk_lim_prem prems)
 160.310 +      | mk_lim_prem (p as Rel (rel, ts)) =
 160.311 +        if member (op =) rel_names rel then Rel (mk_lim_rel_name rel, Var "Lim" :: ts) else p
 160.312 +      | mk_lim_prem p = p
 160.313 +  in
 160.314 +    if has_positive_recursive_prems prem then
 160.315 +      ((mk_lim_rel_name rel_name, (AppF ("suc", [Var "Lim"]))  :: ts), mk_lim_prem prem)
 160.316 +    else
 160.317 +      ((mk_lim_rel_name rel_name, (Var "Lim") :: ts), prem)
 160.318 +  end
 160.319 +
 160.320 +fun add_limited_predicates limited_predicates =
 160.321 +  let                                     
 160.322 +    fun add (rel_names, limit) (p, constant_table) = 
 160.323 +      let
 160.324 +        val clauses = filter (fn ((rel, _), _) => member (op =) rel_names rel) p
 160.325 +        val clauses' = map (mk_depth_limited rel_names) clauses
 160.326 +        fun nat_term_of n = funpow n (fn t => AppF ("suc", [t])) (Cons "zero")
 160.327 +        fun mk_entry_clause rel_name =
 160.328 +          let
 160.329 +            val nargs = length (snd (fst
 160.330 +              (the (find_first (fn ((rel, _), _) => rel = rel_name) clauses))))
 160.331 +            val vars = map (fn i => Var ("x" ^ string_of_int i)) (1 upto nargs)        
 160.332 +          in
 160.333 +            (("limited_" ^ rel_name, vars), Rel ("lim_" ^ rel_name, nat_term_of limit :: vars))
 160.334 +          end
 160.335 +      in (p @ (map mk_entry_clause rel_names) @ clauses', constant_table) end
 160.336 +  in
 160.337 +    fold add limited_predicates
 160.338 +  end
 160.339 +
 160.340 +
 160.341 +(* replace predicates in clauses *)
 160.342 +
 160.343 +(* replace (A, B, C) p = replace A by B in clauses of C *)
 160.344 +fun replace ((from, to), location) p =
 160.345 +  let
 160.346 +    fun replace_prem (Conj prems) = Conj (map replace_prem prems)
 160.347 +      | replace_prem (r as Rel (rel, ts)) =
 160.348 +          if rel = from then Rel (to, ts) else r
 160.349 +      | replace_prem r = r
 160.350 +  in
 160.351 +    map (fn ((rel, args), prem) => ((rel, args), (if rel = location then replace_prem else I) prem)) p
 160.352 +  end
 160.353 +
 160.354 +  
 160.355 +(* reorder manually : reorder premises of ith clause of predicate p by a permutation perm *)
 160.356 +
 160.357 +fun reorder_manually reorder p =
 160.358 +  let
 160.359 +    fun reorder' (clause as ((rel, args), prem)) seen =
 160.360 +      let
 160.361 +        val seen' = AList.map_default (op =) (rel, 0) (fn x => x + 1) seen
 160.362 +        val i = the (AList.lookup (op =) seen' rel)
 160.363 +        val perm = AList.lookup (op =) reorder (rel, i)
 160.364 +        val prem' = (case perm of 
 160.365 +          SOME p => (case prem of Conj prems => Conj (map (nth prems) p) | _ => prem)
 160.366 +        | NONE => prem)
 160.367 +      in (((rel, args), prem'), seen') end
 160.368 +  in
 160.369 +    fst (fold_map reorder' p [])
 160.370 +  end
 160.371  (* rename variables to prolog-friendly names *)
 160.372  
 160.373  fun rename_vars_term renaming = map_vars (fn v => the (AList.lookup (op =) renaming v))
 160.374  
 160.375  fun rename_vars_prem renaming = map_term_prem (rename_vars_term renaming)
 160.376  
 160.377 -fun dest_Char (Symbol.Char c) = c
 160.378 -
 160.379  fun is_prolog_conform v =
 160.380    forall (fn s => Symbol.is_ascii_letter s orelse Symbol.is_ascii_digit s) (Symbol.explode v)
 160.381 -
 160.382 -fun mk_conform avoid v =
 160.383 -  let 
 160.384 -    val v' = space_implode "" (map (dest_Char o Symbol.decode)
 160.385 -      (filter (fn s => Symbol.is_ascii_letter s orelse Symbol.is_ascii_digit s)
 160.386 -        (Symbol.explode v)))
 160.387 -    val v' = if v' = "" then "var" else v'
 160.388 -  in Name.variant avoid (first_upper v') end
 160.389    
 160.390  fun mk_renaming v renaming =
 160.391 -  (v, mk_conform (map snd renaming) v) :: renaming
 160.392 +  (v, mk_conform first_upper "Var" (map snd renaming) v) :: renaming
 160.393  
 160.394  fun rename_vars_clause ((rel, args), prem) =
 160.395    let
 160.396 @@ -367,7 +490,7 @@
 160.397    in ((rel, map (rename_vars_term renaming) args), rename_vars_prem renaming prem) end
 160.398    
 160.399  val rename_vars_program = map rename_vars_clause
 160.400 -  
 160.401 +
 160.402  (* code printer *)
 160.403  
 160.404  fun write_arith_op Plus = "+"
 160.405 @@ -396,14 +519,16 @@
 160.406  fun write_program p =
 160.407    cat_lines (map write_clause p) 
 160.408  
 160.409 -(** query templates **)
 160.410 +(* query templates *)
 160.411  
 160.412 -fun query_first rel vnames =
 160.413 +(** query and prelude for swi-prolog **)
 160.414 +
 160.415 +fun swi_prolog_query_first rel vnames =
 160.416    "eval :- once("  ^ rel ^ "(" ^ space_implode ", " vnames ^ ")),\n" ^
 160.417    "writef('" ^ space_implode ";" (map (fn v => v ^ " = %w") vnames) ^
 160.418    "\\n', [" ^ space_implode ", " vnames ^ "]).\n"
 160.419    
 160.420 -fun query_firstn n rel vnames =
 160.421 +fun swi_prolog_query_firstn n rel vnames =
 160.422    "eval :- findnsols(" ^ string_of_int n ^ ", (" ^ space_implode ", " vnames ^ "), " ^
 160.423      rel ^ "(" ^ space_implode ", " vnames ^ "), Sols), writelist(Sols).\n" ^
 160.424      "writelist([]).\n" ^
 160.425 @@ -411,7 +536,7 @@
 160.426      "writef('" ^ space_implode ";" (map (fn v => v ^ " = %w") vnames) ^
 160.427      "\\n', [" ^ space_implode ", " vnames ^ "]), writelist(T).\n"
 160.428    
 160.429 -val prelude =
 160.430 +val swi_prolog_prelude =
 160.431    "#!/usr/bin/swipl -q -t main -f\n\n" ^
 160.432    ":- use_module(library('dialect/ciao/aggregates')).\n" ^
 160.433    ":- style_check(-singleton).\n" ^
 160.434 @@ -420,7 +545,38 @@
 160.435    "main :- catch(eval, E, (print_message(error, E), fail)), halt.\n" ^
 160.436    "main :- halt(1).\n"
 160.437  
 160.438 +(** query and prelude for yap **)
 160.439 +
 160.440 +fun yap_query_first rel vnames =
 160.441 +  "eval :- once(" ^ rel ^ "(" ^ space_implode ", " vnames ^ ")),\n" ^
 160.442 +  "format('" ^ space_implode ";" (map (fn v => v ^ " = ~w") vnames) ^
 160.443 +  "\\n', [" ^ space_implode ", " vnames ^ "]).\n"
 160.444 +
 160.445 +val yap_prelude =
 160.446 +  "#!/usr/bin/yap -L\n\n" ^
 160.447 +  ":- initialization(eval).\n"
 160.448 +
 160.449 +(* system-dependent query, prelude and invocation *)
 160.450 +
 160.451 +fun query system nsols = 
 160.452 +  case system of
 160.453 +    SWI_PROLOG =>
 160.454 +      (case nsols of NONE => swi_prolog_query_first | SOME n => swi_prolog_query_firstn n)
 160.455 +  | YAP =>
 160.456 +      case nsols of NONE => yap_query_first | SOME n =>
 160.457 +        error "No support for querying multiple solutions in the prolog system yap"
 160.458 +
 160.459 +fun prelude system =
 160.460 +  case system of SWI_PROLOG => swi_prolog_prelude | YAP => yap_prelude
 160.461 +
 160.462 +fun invoke system file_name =
 160.463 +  let
 160.464 +    val cmd =
 160.465 +      case system of SWI_PROLOG => "/usr/local/bin/swipl -f " | YAP => "/usr/local/bin/yap -L "
 160.466 +  in fst (bash_output (cmd ^ file_name)) end
 160.467 +
 160.468  (* parsing prolog solution *)
 160.469 +
 160.470  val scan_number =
 160.471    Scan.many1 Symbol.is_ascii_digit
 160.472  
 160.473 @@ -465,32 +621,30 @@
 160.474          (l :: r :: []) => parse_term (unprefix " " r)
 160.475        | _ => raise Fail "unexpected equation in prolog output"
 160.476      fun parse_solution s = map dest_eq (space_explode ";" s)
 160.477 +    val sols = case space_explode "\n" sol of [] => [] | s => fst (split_last s)  
 160.478    in
 160.479 -    map parse_solution (fst (split_last (space_explode "\n" sol)))
 160.480 +    map parse_solution sols
 160.481    end 
 160.482    
 160.483  (* calling external interpreter and getting results *)
 160.484  
 160.485 -fun run p query_rel vnames nsols =
 160.486 +fun run system p query_rel vnames nsols =
 160.487    let
 160.488 -    val cmd = Path.named_root
 160.489 -    val query = case nsols of NONE => query_first | SOME n => query_firstn n
 160.490      val p' = rename_vars_program p
 160.491      val _ = tracing "Renaming variable names..."
 160.492      val renaming = fold mk_renaming vnames [] 
 160.493      val vnames' = map (fn v => the (AList.lookup (op =) renaming v)) vnames
 160.494 -    val prog = prelude ^ query query_rel vnames' ^ write_program p'
 160.495 +    val prog = prelude system ^ query system nsols query_rel vnames' ^ write_program p'
 160.496      val _ = tracing ("Generated prolog program:\n" ^ prog)
 160.497 -    val prolog_file = File.tmp_path (Path.basic "prolog_file")
 160.498 -    val _ = File.write prolog_file prog
 160.499 -    val (solution, _) = bash_output ("/usr/local/bin/swipl -f " ^ File.shell_path prolog_file)
 160.500 +    val solution = Cache_IO.with_tmp_file "prolog_file" (fn prolog_file =>
 160.501 +      (File.write prolog_file prog; invoke system (Path.implode prolog_file)))
 160.502      val _ = tracing ("Prolog returned solution(s):\n" ^ solution)
 160.503      val tss = parse_solutions solution
 160.504    in
 160.505      tss
 160.506    end
 160.507  
 160.508 -(* values command *)
 160.509 +(* restoring types in terms *)
 160.510  
 160.511  fun restore_term ctxt constant_table (Var s, T) = Free (s, T)
 160.512    | restore_term ctxt constant_table (Number n, @{typ "int"}) = HOLogic.mk_number @{typ "int"} n
 160.513 @@ -509,9 +663,33 @@
 160.514          map (restore_term ctxt constant_table) (args ~~ argsT'))
 160.515      end
 160.516  
 160.517 +(* values command *)
 160.518 +
 160.519 +val preprocess_options = Predicate_Compile_Aux.Options {
 160.520 +  expected_modes = NONE,
 160.521 +  proposed_modes = NONE,
 160.522 +  proposed_names = [],
 160.523 +  show_steps = false,
 160.524 +  show_intermediate_results = false,
 160.525 +  show_proof_trace = false,
 160.526 +  show_modes = false,
 160.527 +  show_mode_inference = false,
 160.528 +  show_compilation = false,
 160.529 +  show_caught_failures = false,
 160.530 +  skip_proof = true,
 160.531 +  no_topmost_reordering = false,
 160.532 +  function_flattening = true,
 160.533 +  specialise = false,
 160.534 +  fail_safe_function_flattening = false,
 160.535 +  no_higher_order_predicate = [],
 160.536 +  inductify = false,
 160.537 +  detect_switches = true,
 160.538 +  compilation = Predicate_Compile_Aux.Pred
 160.539 +}
 160.540 +
 160.541  fun values ctxt soln t_compr =
 160.542    let
 160.543 -    val options = !options
 160.544 +    val options = code_options_of (ProofContext.theory_of ctxt)
 160.545      val split = case t_compr of (Const (@{const_name Collect}, _) $ t) => t
 160.546        | _ => error ("Not a set comprehension: " ^ Syntax.string_of_term ctxt t_compr);
 160.547      val (body, Ts, fp) = HOLogic.strip_psplits split;
 160.548 @@ -530,14 +708,21 @@
 160.549      val _ = tracing "Preprocessing specification..."
 160.550      val T = Sign.the_const_type (ProofContext.theory_of ctxt) name
 160.551      val t = Const (name, T)
 160.552 -    val ctxt' = ProofContext.theory (Context.copy_thy) ctxt
 160.553 -    val thy' = Predicate_Compile.preprocess preprocess_options t (ProofContext.theory_of ctxt')
 160.554 -    val ctxt'' = ProofContext.init_global thy'
 160.555 +    val thy' =
 160.556 +      Theory.copy (ProofContext.theory_of ctxt)
 160.557 +      |> Predicate_Compile.preprocess preprocess_options t
 160.558 +    val ctxt' = ProofContext.init_global thy'
 160.559      val _ = tracing "Generating prolog program..."
 160.560 -    val (p, constant_table) = generate options ctxt'' name
 160.561 -      |> (if #ensure_groundness options then add_ground_predicates ctxt'' else I)
 160.562 +    val (p, constant_table) = generate (#ensure_groundness options) ctxt' name
 160.563 +      |> (if #ensure_groundness options then
 160.564 +          add_ground_predicates ctxt' (#limited_types options)
 160.565 +        else I)
 160.566 +      |> add_limited_predicates (#limited_predicates options)
 160.567 +      |> apfst (fold replace (#replacing options))
 160.568 +      |> apfst (reorder_manually (#manual_reorder options))
 160.569      val _ = tracing "Running prolog program..."
 160.570 -    val tss = run p (translate_const constant_table name) (map first_upper vnames) soln
 160.571 +    val tss = run (#prolog_system options)
 160.572 +      p (translate_const constant_table name) (map first_upper vnames) soln
 160.573      val _ = tracing "Restoring terms..."
 160.574      val empty = Const("Orderings.bot_class.bot", fastype_of t_compr)
 160.575      fun mk_insert x S =
 160.576 @@ -553,7 +738,7 @@
 160.577              mk_set_compr (t :: in_insert) ts xs
 160.578            else
 160.579              let
 160.580 -              val uu as (uuN, uuT) = singleton (Variable.variant_frees ctxt'' [t]) ("uu", fastype_of t)
 160.581 +              val uu as (uuN, uuT) = singleton (Variable.variant_frees ctxt' [t]) ("uu", fastype_of t)
 160.582                val set_compr =
 160.583                  HOLogic.mk_Collect (uuN, uuT, fold (fn (s, T) => fn t => HOLogic.mk_exists (s, T, t))
 160.584                    frees (HOLogic.mk_conj (HOLogic.mk_eq (Free uu, t), @{term "True"})))
 160.585 @@ -564,7 +749,7 @@
 160.586          end
 160.587    in
 160.588        foldl1 (HOLogic.mk_binop @{const_name sup}) (mk_set_compr []
 160.589 -        (map (fn ts => HOLogic.mk_tuple (map (restore_term ctxt'' constant_table) (ts ~~ Ts))) tss) [])
 160.590 +        (map (fn ts => HOLogic.mk_tuple (map (restore_term ctxt' constant_table) (ts ~~ Ts))) tss) [])
 160.591    end
 160.592  
 160.593  fun values_cmd print_modes soln raw_t state =
 160.594 @@ -595,20 +780,20 @@
 160.595  
 160.596  (* FIXME: large copy of Predicate_Compile_Quickcheck - refactor out commons *)
 160.597  
 160.598 -fun strip_imp_prems (Const(@{const_name "op -->"}, _) $ A $ B) = A :: strip_imp_prems B
 160.599 +fun strip_imp_prems (Const(@{const_name HOL.implies}, _) $ A $ B) = A :: strip_imp_prems B
 160.600    | strip_imp_prems _ = [];
 160.601  
 160.602 -fun strip_imp_concl (Const(@{const_name "op -->"}, _) $ A $ B) = strip_imp_concl B
 160.603 +fun strip_imp_concl (Const(@{const_name HOL.implies}, _) $ A $ B) = strip_imp_concl B
 160.604    | strip_imp_concl A = A : term;
 160.605  
 160.606  fun strip_horn A = (strip_imp_prems A, strip_imp_concl A);
 160.607  
 160.608  fun quickcheck ctxt report t size =
 160.609    let
 160.610 -    val ctxt' = ProofContext.theory (Context.copy_thy) ctxt
 160.611 -    val thy = (ProofContext.theory_of ctxt')
 160.612 +    val options = code_options_of (ProofContext.theory_of ctxt)
 160.613 +    val thy = Theory.copy (ProofContext.theory_of ctxt)
 160.614      val (vs, t') = strip_abs t
 160.615 -    val vs' = Variable.variant_frees ctxt' [] vs
 160.616 +    val vs' = Variable.variant_frees ctxt [] vs
 160.617      val Ts = map snd vs'
 160.618      val t'' = subst_bounds (map Free (rev vs'), t')
 160.619      val (prems, concl) = strip_horn t''
 160.620 @@ -624,15 +809,21 @@
 160.621      val intro = Goal.prove (ProofContext.init_global thy1) (map fst vs') [] t tac
 160.622      val thy2 = Context.theory_map (Predicate_Compile_Alternative_Defs.add_thm intro) thy1
 160.623      val thy3 = Predicate_Compile.preprocess preprocess_options const thy2
 160.624 -    val ctxt'' = ProofContext.init_global thy3
 160.625 +    val ctxt' = ProofContext.init_global thy3
 160.626      val _ = tracing "Generating prolog program..."
 160.627 -    val (p, constant_table) = generate {ensure_groundness = true} ctxt'' full_constname
 160.628 -      |> add_ground_predicates ctxt''
 160.629 +    val (p, constant_table) = generate true ctxt' full_constname
 160.630 +      |> add_ground_predicates ctxt' (#limited_types options)
 160.631 +      |> add_limited_predicates (#limited_predicates options)
 160.632 +      |> apfst (fold replace (#replacing options))
 160.633 +      |> apfst (reorder_manually (#manual_reorder options))
 160.634      val _ = tracing "Running prolog program..."
 160.635 -    val [ts] = run p (translate_const constant_table full_constname) (map fst vs')
 160.636 -      (SOME 1)
 160.637 +    val tss = run (#prolog_system options)
 160.638 +      p (translate_const constant_table full_constname) (map fst vs') (SOME 1)
 160.639      val _ = tracing "Restoring terms..."
 160.640 -    val res = SOME (map (restore_term ctxt'' constant_table) (ts ~~ Ts))
 160.641 +    val res =
 160.642 +      case tss of
 160.643 +        [ts] => SOME (map (restore_term ctxt' constant_table) (ts ~~ Ts))
 160.644 +      | _ => NONE
 160.645      val empty_report = ([], false)
 160.646    in
 160.647      (res, empty_report)
   161.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile.ML	Thu Sep 02 17:12:40 2010 +0200
   161.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile.ML	Thu Sep 02 17:28:00 2010 +0200
   161.3 @@ -176,9 +176,9 @@
   161.4       val t = Const (const, T)
   161.5       val options = extract_options (((expected_modes, proposed_modes), raw_options), const)
   161.6    in
   161.7 -    if (is_inductify options) then
   161.8 +    if is_inductify options then
   161.9        let
  161.10 -        val lthy' = Local_Theory.theory (preprocess options t) lthy
  161.11 +        val lthy' = Local_Theory.background_theory (preprocess options t) lthy
  161.12          val const =
  161.13            case Predicate_Compile_Fun.pred_of_function (ProofContext.theory_of lthy') const of
  161.14              SOME c => c
   162.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML	Thu Sep 02 17:12:40 2010 +0200
   162.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML	Thu Sep 02 17:28:00 2010 +0200
   162.3 @@ -405,13 +405,13 @@
   162.4  (* general syntactic functions *)
   162.5  
   162.6  (*Like dest_conj, but flattens conjunctions however nested*)
   162.7 -fun conjuncts_aux (Const (@{const_name "op &"}, _) $ t $ t') conjs = conjuncts_aux t (conjuncts_aux t' conjs)
   162.8 +fun conjuncts_aux (Const (@{const_name HOL.conj}, _) $ t $ t') conjs = conjuncts_aux t (conjuncts_aux t' conjs)
   162.9    | conjuncts_aux t conjs = t::conjs;
  162.10  
  162.11  fun conjuncts t = conjuncts_aux t [];
  162.12  
  162.13  fun is_equationlike_term (Const ("==", _) $ _ $ _) = true
  162.14 -  | is_equationlike_term (Const (@{const_name Trueprop}, _) $ (Const (@{const_name "op ="}, _) $ _ $ _)) = true
  162.15 +  | is_equationlike_term (Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ _)) = true
  162.16    | is_equationlike_term _ = false
  162.17    
  162.18  val is_equationlike = is_equationlike_term o prop_of 
   163.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Thu Sep 02 17:12:40 2010 +0200
   163.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Thu Sep 02 17:28:00 2010 +0200
   163.3 @@ -63,6 +63,19 @@
   163.4    val add_random_dseq_equations : options -> string list -> theory -> theory
   163.5    val add_new_random_dseq_equations : options -> string list -> theory -> theory
   163.6    val mk_tracing : string -> term -> term
   163.7 +  val prepare_intrs : options -> compilation -> theory -> string list -> thm list ->
   163.8 +    ((string * typ) list * string list * string list * (string * mode list) list *
   163.9 +      (string *  (Term.term list * Predicate_Compile_Aux.indprem list) list) list)
  163.10 +  type mode_analysis_options = {use_random : bool, reorder_premises : bool, infer_pos_and_neg_modes : bool}  
  163.11 +  datatype mode_derivation = Mode_App of mode_derivation * mode_derivation | Context of mode
  163.12 +  | Mode_Pair of mode_derivation * mode_derivation | Term of mode
  163.13 +  type moded_clause = term list * (Predicate_Compile_Aux.indprem * mode_derivation) list
  163.14 +  type 'a pred_mode_table = (string * ((bool * mode) * 'a) list) list
  163.15 +
  163.16 +  val infer_modes : 
  163.17 +    mode_analysis_options -> options -> compilation -> (string * typ) list -> (string * mode list) list ->
  163.18 +      string list -> (string *  (Term.term list * Predicate_Compile_Aux.indprem list) list) list ->
  163.19 +      theory -> ((moded_clause list pred_mode_table * string list) * theory)
  163.20  end;
  163.21  
  163.22  structure Predicate_Compile_Core : PREDICATE_COMPILE_CORE =
  163.23 @@ -524,7 +537,7 @@
  163.24  
  163.25  fun dest_conjunct_prem th =
  163.26    case HOLogic.dest_Trueprop (prop_of th) of
  163.27 -    (Const (@{const_name "op &"}, _) $ t $ t') =>
  163.28 +    (Const (@{const_name HOL.conj}, _) $ t $ t') =>
  163.29        dest_conjunct_prem (th RS @{thm conjunct1})
  163.30          @ dest_conjunct_prem (th RS @{thm conjunct2})
  163.31      | _ => [th]
  163.32 @@ -587,7 +600,7 @@
  163.33  
  163.34  fun preprocess_elim ctxt elimrule =
  163.35    let
  163.36 -    fun replace_eqs (Const (@{const_name Trueprop}, _) $ (Const (@{const_name "op ="}, T) $ lhs $ rhs)) =
  163.37 +    fun replace_eqs (Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, T) $ lhs $ rhs)) =
  163.38         HOLogic.mk_Trueprop (Const (@{const_name Predicate.eq}, T) $ lhs $ rhs)
  163.39       | replace_eqs t = t
  163.40      val thy = ProofContext.theory_of ctxt
  163.41 @@ -730,9 +743,7 @@
  163.42    type T = (mode * (compilation_funs -> typ -> term)) list Symtab.table;
  163.43    val empty = Symtab.empty;
  163.44    val extend = I;
  163.45 -  val merge = Symtab.merge ((K true)
  163.46 -    : ((mode * (compilation_funs -> typ -> term)) list *
  163.47 -      (mode * (compilation_funs -> typ -> term)) list -> bool));
  163.48 +  fun merge data : T = Symtab.merge (K true) data;
  163.49  );
  163.50  
  163.51  fun alternative_compilation_of_global thy pred_name mode =
  163.52 @@ -3033,12 +3044,13 @@
  163.53      "adding alternative introduction rules for code generation of inductive predicates"
  163.54  
  163.55  (* TODO: make Theory_Data to Generic_Data & remove duplication of local theory and theory *)
  163.56 +(* FIXME ... this is important to avoid changing the background theory below *)
  163.57  fun generic_code_pred prep_const options raw_const lthy =
  163.58    let
  163.59      val thy = ProofContext.theory_of lthy
  163.60      val const = prep_const thy raw_const
  163.61      val ctxt = ProofContext.init_global thy
  163.62 -    val lthy' = Local_Theory.theory (PredData.map
  163.63 +    val lthy' = Local_Theory.background_theory (PredData.map
  163.64          (extend (fetch_pred_data ctxt) (depending_preds_of ctxt) const)) lthy
  163.65      val thy' = ProofContext.theory_of lthy'
  163.66      val ctxt' = ProofContext.init_global thy'
  163.67 @@ -3063,7 +3075,7 @@
  163.68          val global_thms = ProofContext.export goal_ctxt
  163.69            (ProofContext.init_global (ProofContext.theory_of goal_ctxt)) (map the_single thms)
  163.70        in
  163.71 -        goal_ctxt |> Local_Theory.theory (fold set_elim global_thms #>
  163.72 +        goal_ctxt |> Local_Theory.background_theory (fold set_elim global_thms #>
  163.73            ((case compilation options of
  163.74               Pred => add_equations
  163.75             | DSeq => add_dseq_equations
   164.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML	Thu Sep 02 17:12:40 2010 +0200
   164.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML	Thu Sep 02 17:28:00 2010 +0200
   164.3 @@ -111,7 +111,7 @@
   164.4  
   164.5  fun mk_meta_equation th =
   164.6    case prop_of th of
   164.7 -    Const (@{const_name Trueprop}, _) $ (Const (@{const_name "op ="}, _) $ _ $ _) => th RS @{thm eq_reflection}
   164.8 +    Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ _) => th RS @{thm eq_reflection}
   164.9    | _ => th
  164.10  
  164.11  val meta_fun_cong = @{lemma "f == g ==> f x == g x" by simp}
  164.12 @@ -217,12 +217,12 @@
  164.13     @{const_name "==>"},
  164.14     @{const_name Trueprop},
  164.15     @{const_name Not},
  164.16 -   @{const_name "op ="},
  164.17 -   @{const_name "op -->"},
  164.18 +   @{const_name HOL.eq},
  164.19 +   @{const_name HOL.implies},
  164.20     @{const_name All},
  164.21     @{const_name Ex}, 
  164.22 -   @{const_name "op &"},
  164.23 -   @{const_name "op |"}]
  164.24 +   @{const_name HOL.conj},
  164.25 +   @{const_name HOL.disj}]
  164.26  
  164.27  fun special_cases (c, T) = member (op =) [
  164.28    @{const_name Product_Type.Unity},
   165.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML	Thu Sep 02 17:12:40 2010 +0200
   165.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML	Thu Sep 02 17:28:00 2010 +0200
   165.3 @@ -21,8 +21,7 @@
   165.4  structure Fun_Pred = Theory_Data
   165.5  (
   165.6    type T = (term * term) Item_Net.T;
   165.7 -  val empty = Item_Net.init ((op aconv o pairself fst) : (term * term) * (term * term) -> bool)
   165.8 -    (single o fst);
   165.9 +  val empty : T = Item_Net.init (op aconv o pairself fst) (single o fst);
  165.10    val extend = I;
  165.11    val merge = Item_Net.merge;
  165.12  )
  165.13 @@ -352,13 +351,17 @@
  165.14          |> map (fn (resargs, (names', prems')) =>
  165.15            let
  165.16              val prem' = HOLogic.mk_Trueprop (mk_lit (list_comb (P, resargs)))
  165.17 -          in (prem'::prems', names') end)
  165.18 +          in (prems' @ [prem'], names') end)
  165.19        end
  165.20      val intro_ts' = folds_map rewrite prems frees
  165.21        |> maps (fn (prems', frees') =>
  165.22          rewrite concl frees'
  165.23 -        |> map (fn (concl'::conclprems, _) =>
  165.24 -          Logic.list_implies ((flat prems') @ conclprems, concl')))
  165.25 +        |> map (fn (conclprems, _) =>
  165.26 +          let
  165.27 +            val (conclprems', concl') = split_last conclprems
  165.28 +          in
  165.29 +            Logic.list_implies ((flat prems') @ conclprems', concl')
  165.30 +          end))
  165.31      (*val _ = tracing ("Rewritten intro to " ^
  165.32        commas (map (Syntax.string_of_term_global thy) intro_ts'))*)
  165.33    in
   166.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_pred.ML	Thu Sep 02 17:12:40 2010 +0200
   166.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_pred.ML	Thu Sep 02 17:28:00 2010 +0200
   166.3 @@ -89,8 +89,8 @@
   166.4  fun is_compound ((Const (@{const_name Not}, _)) $ t) =
   166.5      error "is_compound: Negation should not occur; preprocessing is defect"
   166.6    | is_compound ((Const (@{const_name Ex}, _)) $ _) = true
   166.7 -  | is_compound ((Const (@{const_name "op |"}, _)) $ _ $ _) = true
   166.8 -  | is_compound ((Const (@{const_name "op &"}, _)) $ _ $ _) =
   166.9 +  | is_compound ((Const (@{const_name HOL.disj}, _)) $ _ $ _) = true
  166.10 +  | is_compound ((Const (@{const_name HOL.conj}, _)) $ _ $ _) =
  166.11      error "is_compound: Conjunction should not occur; preprocessing is defect"
  166.12    | is_compound _ = false
  166.13  
  166.14 @@ -250,7 +250,7 @@
  166.15  
  166.16  fun split_conjs thy t =
  166.17    let 
  166.18 -    fun split_conjunctions (Const (@{const_name "op &"}, _) $ t1 $ t2) =
  166.19 +    fun split_conjunctions (Const (@{const_name HOL.conj}, _) $ t1 $ t2) =
  166.20      (split_conjunctions t1) @ (split_conjunctions t2)
  166.21      | split_conjunctions t = [t]
  166.22    in
  166.23 @@ -259,7 +259,8 @@
  166.24  
  166.25  fun rewrite_intros thy =
  166.26    Simplifier.full_simplify (HOL_basic_ss addsimps [@{thm all_not_ex}])
  166.27 -  #> Simplifier.full_simplify (HOL_basic_ss addsimps @{thms bool_simps} addsimps @{thms nnf_simps})
  166.28 +  #> Simplifier.full_simplify
  166.29 +    (HOL_basic_ss addsimps (tl @{thms bool_simps}) addsimps @{thms nnf_simps})
  166.30    #> map_term thy (maps_premises (split_conjs thy))
  166.31  
  166.32  fun print_specs options thy msg ths =
   167.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML	Thu Sep 02 17:12:40 2010 +0200
   167.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML	Thu Sep 02 17:28:00 2010 +0200
   167.3 @@ -168,10 +168,10 @@
   167.4      mk_split_lambda' xs t
   167.5    end;
   167.6  
   167.7 -fun strip_imp_prems (Const(@{const_name "op -->"}, _) $ A $ B) = A :: strip_imp_prems B
   167.8 +fun strip_imp_prems (Const(@{const_name HOL.implies}, _) $ A $ B) = A :: strip_imp_prems B
   167.9    | strip_imp_prems _ = [];
  167.10  
  167.11 -fun strip_imp_concl (Const(@{const_name "op -->"}, _) $ A $ B) = strip_imp_concl B
  167.12 +fun strip_imp_concl (Const(@{const_name HOL.implies}, _) $ A $ B) = strip_imp_concl B
  167.13    | strip_imp_concl A = A : term;
  167.14  
  167.15  fun strip_horn A = (strip_imp_prems A, strip_imp_concl A);
  167.16 @@ -185,10 +185,9 @@
  167.17  
  167.18  fun compile_term compilation options ctxt t =
  167.19    let
  167.20 -    val ctxt' = ProofContext.theory (Context.copy_thy) ctxt
  167.21 -    val thy = (ProofContext.theory_of ctxt') 
  167.22 +    val thy = Theory.copy (ProofContext.theory_of ctxt)
  167.23      val (vs, t') = strip_abs t
  167.24 -    val vs' = Variable.variant_frees ctxt' [] vs
  167.25 +    val vs' = Variable.variant_frees ctxt [] vs
  167.26      val t'' = subst_bounds (map Free (rev vs'), t')
  167.27      val (prems, concl) = strip_horn t''
  167.28      val constname = "pred_compile_quickcheck"
   168.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_specialisation.ML	Thu Sep 02 17:12:40 2010 +0200
   168.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_specialisation.ML	Thu Sep 02 17:28:00 2010 +0200
   168.3 @@ -18,8 +18,7 @@
   168.4  structure Specialisations = Theory_Data
   168.5  (
   168.6    type T = (term * term) Item_Net.T;
   168.7 -  val empty = Item_Net.init ((op aconv o pairself fst) : (term * term) * (term * term) -> bool)
   168.8 -    (single o fst);
   168.9 +  val empty : T = Item_Net.init (op aconv o pairself fst) (single o fst);
  168.10    val extend = I;
  168.11    val merge = Item_Net.merge;
  168.12  )
   169.1 --- a/src/HOL/Tools/Qelim/cooper.ML	Thu Sep 02 17:12:40 2010 +0200
   169.2 +++ b/src/HOL/Tools/Qelim/cooper.ML	Thu Sep 02 17:28:00 2010 +0200
   169.3 @@ -28,7 +28,7 @@
   169.4     @{term "op * :: int => _"}, @{term "op * :: nat => _"},
   169.5     @{term "op div :: int => _"}, @{term "op div :: nat => _"},
   169.6     @{term "op mod :: int => _"}, @{term "op mod :: nat => _"},
   169.7 -   @{term "op &"}, @{term "op |"}, @{term "op -->"}, 
   169.8 +   @{term HOL.conj}, @{term HOL.disj}, @{term HOL.implies}, 
   169.9     @{term "op = :: int => _"}, @{term "op = :: nat => _"}, @{term "op = :: bool => _"},
  169.10     @{term "op < :: int => _"}, @{term "op < :: nat => _"},
  169.11     @{term "op <= :: int => _"}, @{term "op <= :: nat => _"},
  169.12 @@ -120,10 +120,10 @@
  169.13  
  169.14  fun whatis x ct =
  169.15  ( case (term_of ct) of
  169.16 -  Const(@{const_name "op &"},_)$_$_ => And (Thm.dest_binop ct)
  169.17 -| Const (@{const_name "op |"},_)$_$_ => Or (Thm.dest_binop ct)
  169.18 -| Const (@{const_name "op ="},_)$y$_ => if term_of x aconv y then Eq (Thm.dest_arg ct) else Nox
  169.19 -| Const (@{const_name Not},_) $ (Const (@{const_name "op ="},_)$y$_) =>
  169.20 +  Const(@{const_name HOL.conj},_)$_$_ => And (Thm.dest_binop ct)
  169.21 +| Const (@{const_name HOL.disj},_)$_$_ => Or (Thm.dest_binop ct)
  169.22 +| Const (@{const_name HOL.eq},_)$y$_ => if term_of x aconv y then Eq (Thm.dest_arg ct) else Nox
  169.23 +| Const (@{const_name Not},_) $ (Const (@{const_name HOL.eq},_)$y$_) =>
  169.24    if term_of x aconv y then NEq (funpow 2 Thm.dest_arg ct) else Nox
  169.25  | Const (@{const_name Orderings.less}, _) $ y$ z =>
  169.26     if term_of x aconv y then Lt (Thm.dest_arg ct)
  169.27 @@ -274,7 +274,7 @@
  169.28    | lin vs (Const (@{const_name Not},T)$t) = Const (@{const_name Not},T)$ (lin vs t)
  169.29    | lin (vs as x::_) (Const(@{const_name Rings.dvd},_)$d$t) =
  169.30      HOLogic.mk_binrel @{const_name Rings.dvd} (numeral1 abs d, lint vs t)
  169.31 -  | lin (vs as x::_) ((b as Const(@{const_name "op ="},_))$s$t) =
  169.32 +  | lin (vs as x::_) ((b as Const(@{const_name HOL.eq},_))$s$t) =
  169.33       (case lint vs (subC$t$s) of
  169.34        (t as a$(m$c$y)$r) =>
  169.35          if x <> y then b$zero$t
  169.36 @@ -345,7 +345,7 @@
  169.37     case (term_of t) of
  169.38      Const(s,_)$(Const(@{const_name Groups.times},_)$c$y)$ _ =>
  169.39      if x aconv y andalso member (op =)
  169.40 -      ["op =", @{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
  169.41 +      [@{const_name HOL.eq}, @{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
  169.42      then (ins (dest_number c) acc,dacc) else (acc,dacc)
  169.43    | Const(s,_)$_$(Const(@{const_name Groups.times},_)$c$y) =>
  169.44      if x aconv y andalso member (op =)
  169.45 @@ -353,8 +353,8 @@
  169.46      then (ins (dest_number c) acc, dacc) else (acc,dacc)
  169.47    | Const(@{const_name Rings.dvd},_)$_$(Const(@{const_name Groups.plus},_)$(Const(@{const_name Groups.times},_)$c$y)$_) =>
  169.48      if x aconv y then (acc,ins (dest_number c) dacc) else (acc,dacc)
  169.49 -  | Const(@{const_name "op &"},_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
  169.50 -  | Const(@{const_name "op |"},_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
  169.51 +  | Const(@{const_name HOL.conj},_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
  169.52 +  | Const(@{const_name HOL.disj},_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
  169.53    | Const (@{const_name Not},_)$_ => h (acc,dacc) (Thm.dest_arg t)
  169.54    | _ => (acc, dacc)
  169.55    val (cs,ds) = h ([],[]) p
  169.56 @@ -382,12 +382,12 @@
  169.57      end
  169.58    fun unit_conv t =
  169.59     case (term_of t) of
  169.60 -   Const(@{const_name "op &"},_)$_$_ => Conv.binop_conv unit_conv t
  169.61 -  | Const(@{const_name "op |"},_)$_$_ => Conv.binop_conv unit_conv t
  169.62 +   Const(@{const_name HOL.conj},_)$_$_ => Conv.binop_conv unit_conv t
  169.63 +  | Const(@{const_name HOL.disj},_)$_$_ => Conv.binop_conv unit_conv t
  169.64    | Const (@{const_name Not},_)$_ => Conv.arg_conv unit_conv t
  169.65    | Const(s,_)$(Const(@{const_name Groups.times},_)$c$y)$ _ =>
  169.66      if x=y andalso member (op =)
  169.67 -      ["op =", @{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
  169.68 +      [@{const_name HOL.eq}, @{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
  169.69      then cv (l div dest_number c) t else Thm.reflexive t
  169.70    | Const(s,_)$_$(Const(@{const_name Groups.times},_)$c$y) =>
  169.71      if x=y andalso member (op =)
  169.72 @@ -569,7 +569,7 @@
  169.73  fun add_bools t =
  169.74    let
  169.75      val ops = [@{term "op = :: int => _"}, @{term "op < :: int => _"}, @{term "op <= :: int => _"},
  169.76 -      @{term "op &"}, @{term "op |"}, @{term "op -->"}, @{term "op = :: bool => _"},
  169.77 +      @{term HOL.conj}, @{term HOL.disj}, @{term HOL.implies}, @{term "op = :: bool => _"},
  169.78        @{term "Not"}, @{term "All :: (int => _) => _"},
  169.79        @{term "Ex :: (int => _) => _"}, @{term "True"}, @{term "False"}];
  169.80      val is_op = member (op =) ops;
  169.81 @@ -612,11 +612,11 @@
  169.82  
  169.83  fun fm_of_term ps vs (Const (@{const_name True}, _)) = Proc.T
  169.84    | fm_of_term ps vs (Const (@{const_name False}, _)) = Proc.F
  169.85 -  | fm_of_term ps vs (Const (@{const_name "op &"}, _) $ t1 $ t2) =
  169.86 +  | fm_of_term ps vs (Const (@{const_name HOL.conj}, _) $ t1 $ t2) =
  169.87        Proc.And (fm_of_term ps vs t1, fm_of_term ps vs t2)
  169.88 -  | fm_of_term ps vs (Const (@{const_name "op |"}, _) $ t1 $ t2) =
  169.89 +  | fm_of_term ps vs (Const (@{const_name HOL.disj}, _) $ t1 $ t2) =
  169.90        Proc.Or (fm_of_term ps vs t1, fm_of_term ps vs t2)
  169.91 -  | fm_of_term ps vs (Const (@{const_name "op -->"}, _) $ t1 $ t2) =
  169.92 +  | fm_of_term ps vs (Const (@{const_name HOL.implies}, _) $ t1 $ t2) =
  169.93        Proc.Imp (fm_of_term ps vs t1, fm_of_term ps vs t2)
  169.94    | fm_of_term ps vs (@{term "op = :: bool => _ "} $ t1 $ t2) =
  169.95        Proc.Iff (fm_of_term ps vs t1, fm_of_term ps vs t2)
  169.96 @@ -679,15 +679,17 @@
  169.97  
  169.98  end;
  169.99  
 169.100 -val (_, oracle) = Context.>>> (Context.map_theory_result (Thm.add_oracle (Binding.name "cooper",
 169.101 -  (fn (ctxt, t) => (Thm.cterm_of (ProofContext.theory_of ctxt) o Logic.mk_equals o pairself HOLogic.mk_Trueprop)
 169.102 -    (t, procedure t)))));
 169.103 +val (_, oracle) = Context.>>> (Context.map_theory_result
 169.104 +  (Thm.add_oracle (@{binding cooper},
 169.105 +    (fn (ctxt, t) =>
 169.106 +      (Thm.cterm_of (ProofContext.theory_of ctxt) o Logic.mk_equals o pairself HOLogic.mk_Trueprop)
 169.107 +        (t, procedure t)))));
 169.108  
 169.109  val comp_ss = HOL_ss addsimps @{thms semiring_norm};
 169.110  
 169.111  fun strip_objimp ct =
 169.112    (case Thm.term_of ct of
 169.113 -    Const (@{const_name "op -->"}, _) $ _ $ _ =>
 169.114 +    Const (@{const_name HOL.implies}, _) $ _ $ _ =>
 169.115        let val (A, B) = Thm.dest_binop ct
 169.116        in A :: strip_objimp B end
 169.117    | _ => [ct]);
 169.118 @@ -712,7 +714,7 @@
 169.119       val qs = filter P ps
 169.120       val q = if P c then c else @{cterm "False"}
 169.121       val ng = fold_rev (fn (a,v) => fn t => Thm.capply a (Thm.cabs v t)) qvs 
 169.122 -         (fold_rev (fn p => fn q => Thm.capply (Thm.capply @{cterm "op -->"} p) q) qs q)
 169.123 +         (fold_rev (fn p => fn q => Thm.capply (Thm.capply @{cterm HOL.implies} p) q) qs q)
 169.124       val g = Thm.capply (Thm.capply @{cterm "op ==>"} (Thm.capply @{cterm "Trueprop"} ng)) p'
 169.125       val ntac = (case qs of [] => q aconvc @{cterm "False"}
 169.126                           | _ => false)
   170.1 --- a/src/HOL/Tools/Qelim/qelim.ML	Thu Sep 02 17:12:40 2010 +0200
   170.2 +++ b/src/HOL/Tools/Qelim/qelim.ML	Thu Sep 02 17:28:00 2010 +0200
   170.3 @@ -25,8 +25,8 @@
   170.4     case (term_of p) of
   170.5      Const(s,T)$_$_ => 
   170.6         if domain_type T = HOLogic.boolT
   170.7 -          andalso member (op =) [@{const_name "op &"}, @{const_name "op |"},
   170.8 -            @{const_name "op -->"}, @{const_name "op ="}] s
   170.9 +          andalso member (op =) [@{const_name HOL.conj}, @{const_name HOL.disj},
  170.10 +            @{const_name HOL.implies}, @{const_name HOL.eq}] s
  170.11         then binop_conv (conv env) p 
  170.12         else atcv env p
  170.13    | Const(@{const_name Not},_)$_ => arg_conv (conv env) p
   171.1 --- a/src/HOL/Tools/Quotient/quotient_info.ML	Thu Sep 02 17:12:40 2010 +0200
   171.2 +++ b/src/HOL/Tools/Quotient/quotient_info.ML	Thu Sep 02 17:28:00 2010 +0200
   171.3 @@ -56,10 +56,12 @@
   171.4  type maps_info = {mapfun: string, relmap: string}
   171.5  
   171.6  structure MapsData = Theory_Data
   171.7 -  (type T = maps_info Symtab.table
   171.8 -   val empty = Symtab.empty
   171.9 -   val extend = I
  171.10 -   fun merge data = Symtab.merge (K true) data)
  171.11 +(
  171.12 +  type T = maps_info Symtab.table
  171.13 +  val empty = Symtab.empty
  171.14 +  val extend = I
  171.15 +  fun merge data = Symtab.merge (K true) data
  171.16 +)
  171.17  
  171.18  fun maps_defined thy s =
  171.19    Symtab.defined (MapsData.get thy) s
  171.20 @@ -70,7 +72,7 @@
  171.21    | NONE => raise NotFound
  171.22  
  171.23  fun maps_update_thy k minfo = MapsData.map (Symtab.update (k, minfo))
  171.24 -fun maps_update k minfo = ProofContext.theory (maps_update_thy k minfo)
  171.25 +fun maps_update k minfo = ProofContext.background_theory (maps_update_thy k minfo)  (* FIXME *)
  171.26  
  171.27  fun maps_attribute_aux s minfo = Thm.declaration_attribute
  171.28    (fn _ => Context.mapping (maps_update_thy s minfo) (maps_update s minfo))
  171.29 @@ -120,10 +122,12 @@
  171.30  type quotdata_info = {qtyp: typ, rtyp: typ, equiv_rel: term, equiv_thm: thm}
  171.31  
  171.32  structure QuotData = Theory_Data
  171.33 -  (type T = quotdata_info Symtab.table
  171.34 -   val empty = Symtab.empty
  171.35 -   val extend = I
  171.36 -   fun merge data = Symtab.merge (K true) data)
  171.37 +(
  171.38 +  type T = quotdata_info Symtab.table
  171.39 +  val empty = Symtab.empty
  171.40 +  val extend = I
  171.41 +  fun merge data = Symtab.merge (K true) data
  171.42 +)
  171.43  
  171.44  fun transform_quotdata phi {qtyp, rtyp, equiv_rel, equiv_thm} =
  171.45    {qtyp = Morphism.typ phi qtyp,
  171.46 @@ -174,10 +178,12 @@
  171.47     for example given "nat fset" we need to find "'a fset";
  171.48     but overloaded constants share the same name *)
  171.49  structure QConstsData = Theory_Data
  171.50 -  (type T = (qconsts_info list) Symtab.table
  171.51 -   val empty = Symtab.empty
  171.52 -   val extend = I
  171.53 -   val merge = Symtab.merge_list qconsts_info_eq)
  171.54 +(
  171.55 +  type T = qconsts_info list Symtab.table
  171.56 +  val empty = Symtab.empty
  171.57 +  val extend = I
  171.58 +  val merge = Symtab.merge_list qconsts_info_eq
  171.59 +)
  171.60  
  171.61  fun transform_qconsts phi {qconst, rconst, def} =
  171.62    {qconst = Morphism.term phi qconst,
  171.63 @@ -229,39 +235,49 @@
  171.64  
  171.65  (* equivalence relation theorems *)
  171.66  structure EquivRules = Named_Thms
  171.67 -  (val name = "quot_equiv"
  171.68 -   val description = "Equivalence relation theorems.")
  171.69 +(
  171.70 +  val name = "quot_equiv"
  171.71 +  val description = "equivalence relation theorems"
  171.72 +)
  171.73  
  171.74  val equiv_rules_get = EquivRules.get
  171.75  val equiv_rules_add = EquivRules.add
  171.76  
  171.77  (* respectfulness theorems *)
  171.78  structure RspRules = Named_Thms
  171.79 -  (val name = "quot_respect"
  171.80 -   val description = "Respectfulness theorems.")
  171.81 +(
  171.82 +  val name = "quot_respect"
  171.83 +  val description = "respectfulness theorems"
  171.84 +)
  171.85  
  171.86  val rsp_rules_get = RspRules.get
  171.87  val rsp_rules_add = RspRules.add
  171.88  
  171.89  (* preservation theorems *)
  171.90  structure PrsRules = Named_Thms
  171.91 -  (val name = "quot_preserve"
  171.92 -   val description = "Preservation theorems.")
  171.93 +(
  171.94 +  val name = "quot_preserve"
  171.95 +  val description = "preservation theorems"
  171.96 +)
  171.97  
  171.98  val prs_rules_get = PrsRules.get
  171.99  val prs_rules_add = PrsRules.add
 171.100  
 171.101  (* id simplification theorems *)
 171.102  structure IdSimps = Named_Thms
 171.103 -  (val name = "id_simps"
 171.104 -   val description = "Identity simp rules for maps.")
 171.105 +(
 171.106 +  val name = "id_simps"
 171.107 +  val description = "identity simp rules for maps"
 171.108 +)
 171.109  
 171.110  val id_simps_get = IdSimps.get
 171.111  
 171.112  (* quotient theorems *)
 171.113  structure QuotientRules = Named_Thms
 171.114 -  (val name = "quot_thm"
 171.115 -   val description = "Quotient theorems.")
 171.116 +(
 171.117 +  val name = "quot_thm"
 171.118 +  val description = "quotient theorems"
 171.119 +)
 171.120  
 171.121  val quotient_rules_get = QuotientRules.get
 171.122  val quotient_rules_add = QuotientRules.add
   172.1 --- a/src/HOL/Tools/Quotient/quotient_tacs.ML	Thu Sep 02 17:12:40 2010 +0200
   172.2 +++ b/src/HOL/Tools/Quotient/quotient_tacs.ML	Thu Sep 02 17:28:00 2010 +0200
   172.3 @@ -12,11 +12,11 @@
   172.4    val all_injection_tac: Proof.context -> int -> tactic
   172.5    val clean_tac: Proof.context -> int -> tactic
   172.6    
   172.7 -  val descend_procedure_tac: Proof.context -> int -> tactic
   172.8 -  val descend_tac: Proof.context -> int -> tactic
   172.9 +  val descend_procedure_tac: Proof.context -> thm list -> int -> tactic
  172.10 +  val descend_tac: Proof.context -> thm list -> int -> tactic
  172.11   
  172.12 -  val lift_procedure_tac: Proof.context -> thm -> int -> tactic
  172.13 -  val lift_tac: Proof.context -> thm list -> int -> tactic
  172.14 +  val lift_procedure_tac: Proof.context -> thm list -> thm -> int -> tactic
  172.15 +  val lift_tac: Proof.context -> thm list -> thm list -> int -> tactic
  172.16  
  172.17    val lifted: Proof.context -> typ list -> thm list -> thm -> thm
  172.18    val lifted_attrib: attribute
  172.19 @@ -338,7 +338,7 @@
  172.20        => rtac @{thm fun_relI} THEN' quot_true_tac ctxt unlam
  172.21  
  172.22      (* (op =) (Ball...) (Ball...) ----> (op =) (...) (...) *)
  172.23 -| (Const (@{const_name "op ="},_) $
  172.24 +| (Const (@{const_name HOL.eq},_) $
  172.25      (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
  172.26      (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _))
  172.27        => rtac @{thm ball_rsp} THEN' dtac @{thm QT_all}
  172.28 @@ -350,7 +350,7 @@
  172.29        => rtac @{thm fun_relI} THEN' quot_true_tac ctxt unlam
  172.30  
  172.31      (* (op =) (Bex...) (Bex...) ----> (op =) (...) (...) *)
  172.32 -| Const (@{const_name "op ="},_) $
  172.33 +| Const (@{const_name HOL.eq},_) $
  172.34      (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
  172.35      (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
  172.36        => rtac @{thm bex_rsp} THEN' dtac @{thm QT_ex}
  172.37 @@ -370,13 +370,13 @@
  172.38      (Const(@{const_name Babs},_) $ (Const (@{const_name Respects}, _) $ _) $ _))
  172.39        => rtac @{thm babs_rsp} THEN' RANGE [quotient_tac ctxt]
  172.40  
  172.41 -| Const (@{const_name "op ="},_) $ (R $ _ $ _) $ (_ $ _ $ _) =>
  172.42 +| Const (@{const_name HOL.eq},_) $ (R $ _ $ _) $ (_ $ _ $ _) =>
  172.43     (rtac @{thm refl} ORELSE'
  172.44      (equals_rsp_tac R ctxt THEN' RANGE [
  172.45         quot_true_tac ctxt (fst o dest_bcomb), quot_true_tac ctxt (snd o dest_bcomb)]))
  172.46  
  172.47      (* reflexivity of operators arising from Cong_tac *)
  172.48 -| Const (@{const_name "op ="},_) $ _ $ _ => rtac @{thm refl}
  172.49 +| Const (@{const_name HOL.eq},_) $ _ $ _ => rtac @{thm refl}
  172.50  
  172.51     (* respectfulness of constants; in particular of a simple relation *)
  172.52  | _ $ (Const _) $ (Const _)  (* fun_rel, list_rel, etc but not equality *)
  172.53 @@ -606,9 +606,9 @@
  172.54    val rtrm' = HOLogic.dest_Trueprop rtrm
  172.55    val qtrm' = HOLogic.dest_Trueprop qtrm
  172.56    val reg_goal = regularize_trm_chk ctxt (rtrm', qtrm')
  172.57 -    handle (LIFT_MATCH msg) => lift_match_error ctxt msg rtrm qtrm
  172.58 +    handle LIFT_MATCH msg => lift_match_error ctxt msg rtrm qtrm
  172.59    val inj_goal = inj_repabs_trm_chk ctxt (reg_goal, qtrm')
  172.60 -    handle (LIFT_MATCH msg) => lift_match_error ctxt msg rtrm qtrm
  172.61 +    handle LIFT_MATCH msg => lift_match_error ctxt msg rtrm qtrm
  172.62  in
  172.63    Drule.instantiate' []
  172.64      [SOME (cterm_of thy rtrm'),
  172.65 @@ -618,10 +618,21 @@
  172.66  end
  172.67  
  172.68  
  172.69 +(* Since we use Ball and Bex during the lifting and descending,
  172.70 +   we cannot deal with lemmas containing them, unless we unfold
  172.71 +   them by default. *)
  172.72 +
  172.73 +val default_unfolds = @{thms Ball_def Bex_def}
  172.74 +
  172.75 +
  172.76  (** descending as tactic **)
  172.77  
  172.78 -fun descend_procedure_tac ctxt =
  172.79 -  Object_Logic.full_atomize_tac
  172.80 +fun descend_procedure_tac ctxt simps =
  172.81 +let
  172.82 +  val ss = (mk_minimal_ss ctxt) addsimps (simps @ default_unfolds)
  172.83 +in
  172.84 +  full_simp_tac ss
  172.85 +  THEN' Object_Logic.full_atomize_tac
  172.86    THEN' gen_frees_tac ctxt
  172.87    THEN' SUBGOAL (fn (goal, i) =>
  172.88          let
  172.89 @@ -631,11 +642,12 @@
  172.90          in
  172.91            rtac rule i
  172.92          end)
  172.93 +end
  172.94  
  172.95 -fun descend_tac ctxt =
  172.96 +fun descend_tac ctxt simps =
  172.97  let
  172.98    val mk_tac_raw =
  172.99 -    descend_procedure_tac ctxt
 172.100 +    descend_procedure_tac ctxt simps
 172.101      THEN' RANGE
 172.102        [Object_Logic.rulify_tac THEN' (K all_tac),
 172.103         regularize_tac ctxt,
 172.104 @@ -650,15 +662,20 @@
 172.105  
 172.106  
 172.107  (* the tactic leaves three subgoals to be proved *)
 172.108 -fun lift_procedure_tac ctxt rthm =
 172.109 -  Object_Logic.full_atomize_tac
 172.110 +fun lift_procedure_tac ctxt simps rthm =
 172.111 +let
 172.112 +  val ss = (mk_minimal_ss ctxt) addsimps (simps @ default_unfolds)
 172.113 +in
 172.114 +  full_simp_tac ss
 172.115 +  THEN' Object_Logic.full_atomize_tac
 172.116    THEN' gen_frees_tac ctxt
 172.117    THEN' SUBGOAL (fn (goal, i) =>
 172.118      let
 172.119        (* full_atomize_tac contracts eta redexes,
 172.120           so we do it also in the original theorem *)
 172.121        val rthm' = 
 172.122 -        rthm |> Drule.eta_contraction_rule 
 172.123 +        rthm |> full_simplify ss
 172.124 +             |> Drule.eta_contraction_rule 
 172.125               |> Thm.forall_intr_frees
 172.126               |> atomize_thm 
 172.127  
 172.128 @@ -666,32 +683,29 @@
 172.129      in
 172.130        (rtac rule THEN' rtac rthm') i
 172.131      end)
 172.132 -
 172.133 +end
 172.134  
 172.135 -fun lift_single_tac ctxt rthm = 
 172.136 -  lift_procedure_tac ctxt rthm
 172.137 +fun lift_single_tac ctxt simps rthm = 
 172.138 +  lift_procedure_tac ctxt simps rthm
 172.139    THEN' RANGE
 172.140      [ regularize_tac ctxt,
 172.141        all_injection_tac ctxt,
 172.142        clean_tac ctxt ]
 172.143  
 172.144 -fun lift_tac ctxt rthms =
 172.145 +fun lift_tac ctxt simps rthms =
 172.146    Goal.conjunction_tac 
 172.147 -  THEN' RANGE (map (lift_single_tac ctxt) rthms)
 172.148 +  THEN' RANGE (map (lift_single_tac ctxt simps) rthms)
 172.149  
 172.150  
 172.151  (* automated lifting with pre-simplification of the theorems;
 172.152     for internal usage *)
 172.153  fun lifted ctxt qtys simps rthm =
 172.154  let
 172.155 -  val ss = (mk_minimal_ss ctxt) addsimps simps
 172.156 -  val rthm' = asm_full_simplify ss rthm
 172.157 -
 172.158 -  val ((_, [rthm'']), ctxt') = Variable.import true [rthm'] ctxt
 172.159 -  val goal = derive_qtrm ctxt' qtys (prop_of rthm'')
 172.160 +  val ((_, [rthm']), ctxt') = Variable.import true [rthm] ctxt
 172.161 +  val goal = derive_qtrm ctxt' qtys (prop_of rthm')
 172.162  in
 172.163    Goal.prove ctxt' [] [] goal 
 172.164 -    (K (EVERY1 [asm_full_simp_tac ss, lift_single_tac ctxt' rthm'']))
 172.165 +    (K (HEADGOAL (lift_single_tac ctxt' simps rthm')))
 172.166    |> singleton (ProofContext.export ctxt' ctxt)
 172.167  end
 172.168  
   173.1 --- a/src/HOL/Tools/Quotient/quotient_term.ML	Thu Sep 02 17:12:40 2010 +0200
   173.2 +++ b/src/HOL/Tools/Quotient/quotient_term.ML	Thu Sep 02 17:28:00 2010 +0200
   173.3 @@ -267,7 +267,7 @@
   173.4    map_types (Envir.subst_type ty_inst) trm
   173.5  end
   173.6  
   173.7 -fun is_eq (Const (@{const_name "op ="}, _)) = true
   173.8 +fun is_eq (Const (@{const_name HOL.eq}, _)) = true
   173.9    | is_eq _ = false
  173.10  
  173.11  fun mk_rel_compose (trm1, trm2) =
  173.12 @@ -485,7 +485,7 @@
  173.13         end
  173.14  
  173.15    | (Const (@{const_name Ex1}, ty) $ (Abs (_, _,
  173.16 -      (Const (@{const_name "op &"}, _) $ (Const (@{const_name Set.member}, _) $ _ $
  173.17 +      (Const (@{const_name HOL.conj}, _) $ (Const (@{const_name Set.member}, _) $ _ $
  173.18          (Const (@{const_name Respects}, _) $ resrel)) $ (t $ _)))),
  173.19       Const (@{const_name Ex1}, ty') $ t') =>
  173.20         let
  173.21 @@ -539,12 +539,12 @@
  173.22         end
  173.23  
  173.24    | (* equalities need to be replaced by appropriate equivalence relations *)
  173.25 -    (Const (@{const_name "op ="}, ty), Const (@{const_name "op ="}, ty')) =>
  173.26 +    (Const (@{const_name HOL.eq}, ty), Const (@{const_name HOL.eq}, ty')) =>
  173.27           if ty = ty' then rtrm
  173.28           else equiv_relation ctxt (domain_type ty, domain_type ty')
<