merged
authorhaftmann
Mon May 11 17:20:52 2009 +0200 (2009-05-11)
changeset 311080ce5f53fc65d
parent 31107 657386d94f14
parent 31093 ee45b1c733c1
child 31109 54092b86ef81
merged
contrib/SystemOnTPTP/remote
doc-src/Codegen/Thy/Adaption.thy
doc-src/Codegen/Thy/document/Adaption.tex
doc-src/Codegen/Thy/pictures/adaption.tex
etc/isar-keywords.el
lib/jedit/isabelle.xml
src/HOL/Code_Message.thy
src/HOL/Code_Setup.thy
src/HOL/NatBin.thy
src/HOL/Predicate.thy
src/HOL/Tools/int_factor_simprocs.ML
src/HOL/Tools/nat_simprocs.ML
src/HOL/ex/Predicate_Compile.thy
src/HOL/ex/predicate_compile.ML
src/Tools/code/code_funcgr.ML
src/Tools/code/code_name.ML
     1.1 --- a/Admin/mirror-website	Mon May 11 09:39:53 2009 +0200
     1.2 +++ b/Admin/mirror-website	Mon May 11 17:20:52 2009 +0200
     1.3 @@ -12,7 +12,7 @@
     1.4      ;;
     1.5    *.cl.cam.ac.uk)
     1.6      USER=paulson
     1.7 -    DEST=/anfs/www/html/Research/HVG/Isabelle
     1.8 +    DEST=/anfs/www/html/research/hvg/Isabelle
     1.9      ;;
    1.10    *)
    1.11      echo "Unknown destination directory for ${HOST}"
     2.1 --- a/CONTRIBUTORS	Mon May 11 09:39:53 2009 +0200
     2.2 +++ b/CONTRIBUTORS	Mon May 11 17:20:52 2009 +0200
     2.3 @@ -7,6 +7,10 @@
     2.4  Contributions to this Isabelle version
     2.5  --------------------------------------
     2.6  
     2.7 +
     2.8 +Contributions to Isabelle2009
     2.9 +-----------------------------
    2.10 +
    2.11  * March 2009: Robert Himmelmann, TUM and Amine Chaieb, University of
    2.12    Cambridge
    2.13    Elementary topology in Euclidean space.
     3.1 --- a/NEWS	Mon May 11 09:39:53 2009 +0200
     3.2 +++ b/NEWS	Mon May 11 17:20:52 2009 +0200
     3.3 @@ -4,6 +4,26 @@
     3.4  New in this Isabelle version
     3.5  ----------------------------
     3.6  
     3.7 +*** Pure ***
     3.8 +
     3.9 +* On instantiation of classes, remaining undefined class parameters are
    3.10 +formally declared.  INCOMPATIBILITY.
    3.11 +
    3.12 +
    3.13 +*** HOL ***
    3.14 +
    3.15 +* Class semiring_div requires superclass no_zero_divisors and proof of div_mult_mult1;
    3.16 +theorems div_mult_mult1, div_mult_mult2, div_mult_mult1_if, div_mult_mult1 and
    3.17 +div_mult_mult2 have been generalized to class semiring_div, subsuming former
    3.18 +theorems zdiv_zmult_zmult1, zdiv_zmult_zmult1_if, zdiv_zmult_zmult1 and zdiv_zmult_zmult2.
    3.19 +div_mult_mult1 is now [simp] by default.  INCOMPATIBILITY.
    3.20 +
    3.21 +* Power operations on relations and functions are now one dedicate constant compow with
    3.22 +infix syntax "^^".  Power operations on multiplicative monoids retains syntax "^"
    3.23 +and is now defined generic in class power.  INCOMPATIBILITY.
    3.24 +
    3.25 +* ML antiquotation @{code_datatype} inserts definition of a datatype generated
    3.26 +by the code generator; see Predicate.thy for an example.
    3.27  
    3.28  
    3.29  New in Isabelle2009 (April 2009)
    3.30 @@ -187,7 +207,7 @@
    3.31  
    3.32  * Keyword 'code_exception' now named 'code_abort'.  INCOMPATIBILITY.
    3.33  
    3.34 -* Unified theorem tables for both code code generators.  Thus [code
    3.35 +* Unified theorem tables for both code generators.  Thus [code
    3.36  func] has disappeared and only [code] remains.  INCOMPATIBILITY.
    3.37  
    3.38  * Command 'find_consts' searches for constants based on type and name
     4.1 --- a/contrib/SystemOnTPTP/remote	Mon May 11 09:39:53 2009 +0200
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,120 +0,0 @@
     4.4 -#!/usr/bin/env perl
     4.5 -#
     4.6 -# Wrapper for custom remote provers on SystemOnTPTP
     4.7 -# Author: Fabian Immler, TU Muenchen
     4.8 -#
     4.9 -
    4.10 -use warnings;
    4.11 -use strict;
    4.12 -use Getopt::Std;
    4.13 -use HTTP::Request::Common;
    4.14 -use LWP;
    4.15 -
    4.16 -my $SystemOnTPTPFormReplyURL = "http://www.cs.miami.edu/~tptp/cgi-bin/SystemOnTPTPFormReply";
    4.17 -
    4.18 -# default parameters
    4.19 -my %URLParameters = (
    4.20 -    "NoHTML" => 1,
    4.21 -    "QuietFlag" => "-q01",
    4.22 -    "X2TPTP" => "-S",
    4.23 -    "SubmitButton" => "RunSelectedSystems",
    4.24 -    "ProblemSource" => "UPLOAD",
    4.25 -    );
    4.26 -
    4.27 -#----Get format and transform options if specified
    4.28 -my %Options;
    4.29 -getopts("hws:t:c:",\%Options);
    4.30 -
    4.31 -#----Usage
    4.32 -sub usage() {
    4.33 -  print("Usage: remote [<options>] <File name>\n");
    4.34 -  print("    <options> are ...\n");
    4.35 -  print("    -h            - print this help\n");
    4.36 -  print("    -w            - list available ATP systems\n");
    4.37 -  print("    -s<system>    - specified system to use\n");
    4.38 -  print("    -t<timelimit> - CPU time limit for system\n");
    4.39 -  print("    -c<command>   - custom command for system\n");
    4.40 -  print("    <File name>   - TPTP problem file\n");
    4.41 -  exit(0);
    4.42 -}
    4.43 -if (exists($Options{'h'})) {
    4.44 -  usage();
    4.45 -}
    4.46 -#----What systems flag
    4.47 -if (exists($Options{'w'})) {
    4.48 -    $URLParameters{"SubmitButton"} = "ListSystems";
    4.49 -    delete($URLParameters{"ProblemSource"});
    4.50 -}
    4.51 -#----Selected system
    4.52 -my $System;
    4.53 -if (exists($Options{'s'})) {
    4.54 -    $System = $Options{'s'};
    4.55 -} else {
    4.56 -    # use Vampire as default
    4.57 -    $System = "Vampire---9.0";
    4.58 -}
    4.59 -$URLParameters{"System___$System"} = $System;
    4.60 -
    4.61 -#----Time limit
    4.62 -if (exists($Options{'t'})) {
    4.63 -    $URLParameters{"TimeLimit___$System"} = $Options{'t'};
    4.64 -}
    4.65 -#----Custom command
    4.66 -if (exists($Options{'c'})) {
    4.67 -    $URLParameters{"Command___$System"} = $Options{'c'};
    4.68 -}
    4.69 -
    4.70 -#----Get single file name
    4.71 -if (exists($URLParameters{"ProblemSource"})) {
    4.72 -    if (scalar(@ARGV) >= 1) {
    4.73 -        $URLParameters{"UPLOADProblem"} = [shift(@ARGV)];
    4.74 -    } else {
    4.75 -      print("Missing problem file\n");
    4.76 -      usage();
    4.77 -      die;
    4.78 -    }
    4.79 -}
    4.80 -
    4.81 -# Query Server
    4.82 -my $Agent = LWP::UserAgent->new;
    4.83 -if (exists($Options{'t'})) {
    4.84 -  # give server more time to respond
    4.85 -  $Agent->timeout($Options{'t'} + 10);
    4.86 -}
    4.87 -my $Request = POST($SystemOnTPTPFormReplyURL,
    4.88 -	Content_Type => 'form-data',Content => \%URLParameters);
    4.89 -my $Response = $Agent->request($Request);
    4.90 -
    4.91 -#catch errors / failure
    4.92 -if(! $Response->is_success){
    4.93 -  print "HTTP-Error: " . $Response->message . "\n";
    4.94 -  exit(-1);
    4.95 -} elsif (exists($Options{'w'})) {
    4.96 -  print $Response->content;
    4.97 -  exit (0);
    4.98 -} elsif ($Response->content =~ /WARNING: (\S*) does not exist/) {
    4.99 -  print "Specified System $1 does not exist\n";
   4.100 -  exit(-1);
   4.101 -} elsif ($Response->content =~ /%\s*Result\s*:\s*Unsatisfiable.*\n%\s*Output\s*:\s*(CNF)?Refutation.*\n%/) {
   4.102 -  my @lines = split( /\n/, $Response->content);
   4.103 -  my $extract = "";
   4.104 -  foreach my $line (@lines){
   4.105 -      #ignore comments
   4.106 -      if ($line !~ /^%/ && !($line eq "")) {
   4.107 -          $extract .= "$line";
   4.108 -      }
   4.109 -  }
   4.110 -  # insert newlines after ').'
   4.111 -  $extract =~ s/\s//g;
   4.112 -  $extract =~ s/\)\.cnf/\)\.\ncnf/g;
   4.113 -
   4.114 -  # orientation for res_reconstruct.ML
   4.115 -  print "# SZS output start CNFRefutation.\n";
   4.116 -  print "$extract\n";
   4.117 -  print "# SZS output end CNFRefutation.\n";
   4.118 -  exit(0);
   4.119 -} else {
   4.120 -  print "Remote-script could not extract proof:\n".$Response->content;
   4.121 -  exit(-1);
   4.122 -}
   4.123 -
     5.1 --- a/doc-src/Codegen/Makefile	Mon May 11 09:39:53 2009 +0200
     5.2 +++ b/doc-src/Codegen/Makefile	Mon May 11 17:20:52 2009 +0200
     5.3 @@ -17,7 +17,7 @@
     5.4  
     5.5  dvi: $(NAME).dvi
     5.6  
     5.7 -$(NAME).dvi: $(FILES) isabelle_isar.eps architecture.eps adaption.eps
     5.8 +$(NAME).dvi: $(FILES) isabelle_isar.eps architecture.eps adaptation.eps
     5.9  	$(LATEX) $(NAME)
    5.10  	$(BIBTEX) $(NAME)
    5.11  	$(LATEX) $(NAME)
    5.12 @@ -25,7 +25,7 @@
    5.13  
    5.14  pdf: $(NAME).pdf
    5.15  
    5.16 -$(NAME).pdf: $(FILES) isabelle_isar.pdf architecture.pdf adaption.pdf
    5.17 +$(NAME).pdf: $(FILES) isabelle_isar.pdf architecture.pdf adaptation.pdf
    5.18  	$(PDFLATEX) $(NAME)
    5.19  	$(BIBTEX) $(NAME)
    5.20  	$(PDFLATEX) $(NAME)
    5.21 @@ -37,17 +37,17 @@
    5.22  architecture.dvi: Thy/pictures/architecture.tex
    5.23  	latex -output-directory=$(dir $@) $<
    5.24  
    5.25 -adaption.dvi: Thy/pictures/adaption.tex
    5.26 +adaptation.dvi: Thy/pictures/adaptation.tex
    5.27  	latex -output-directory=$(dir $@) $<
    5.28  
    5.29  architecture.eps: architecture.dvi
    5.30  	dvips -E -o $@ $<
    5.31  
    5.32 -adaption.eps: adaption.dvi
    5.33 +adaptation.eps: adaptation.dvi
    5.34  	dvips -E -o $@ $<
    5.35  
    5.36  architecture.pdf: architecture.eps
    5.37  	epstopdf --outfile=$@ $<
    5.38  
    5.39 -adaption.pdf: adaption.eps
    5.40 +adaptation.pdf: adaptation.eps
    5.41  	epstopdf --outfile=$@ $<
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/doc-src/Codegen/Thy/Adaptation.thy	Mon May 11 17:20:52 2009 +0200
     6.3 @@ -0,0 +1,326 @@
     6.4 +theory Adaptation
     6.5 +imports Setup
     6.6 +begin
     6.7 +
     6.8 +setup %invisible {* Code_Target.extend_target ("\<SML>", ("SML", K I)) *}
     6.9 +
    6.10 +section {* Adaptation to target languages \label{sec:adaptation} *}
    6.11 +
    6.12 +subsection {* Adapting code generation *}
    6.13 +
    6.14 +text {*
    6.15 +  The aspects of code generation introduced so far have two aspects
    6.16 +  in common:
    6.17 +
    6.18 +  \begin{itemize}
    6.19 +    \item They act uniformly, without reference to a specific
    6.20 +       target language.
    6.21 +    \item They are \emph{safe} in the sense that as long as you trust
    6.22 +       the code generator meta theory and implementation, you cannot
    6.23 +       produce programs that yield results which are not derivable
    6.24 +       in the logic.
    6.25 +  \end{itemize}
    6.26 +
    6.27 +  \noindent In this section we will introduce means to \emph{adapt} the serialiser
    6.28 +  to a specific target language, i.e.~to print program fragments
    6.29 +  in a way which accommodates \qt{already existing} ingredients of
    6.30 +  a target language environment, for three reasons:
    6.31 +
    6.32 +  \begin{itemize}
    6.33 +    \item improving readability and aesthetics of generated code
    6.34 +    \item gaining efficiency
    6.35 +    \item interface with language parts which have no direct counterpart
    6.36 +      in @{text "HOL"} (say, imperative data structures)
    6.37 +  \end{itemize}
    6.38 +
    6.39 +  \noindent Generally, you should avoid using those features yourself
    6.40 +  \emph{at any cost}:
    6.41 +
    6.42 +  \begin{itemize}
    6.43 +    \item The safe configuration methods act uniformly on every target language,
    6.44 +      whereas for adaptation you have to treat each target language separate.
    6.45 +    \item Application is extremely tedious since there is no abstraction
    6.46 +      which would allow for a static check, making it easy to produce garbage.
    6.47 +    \item More or less subtle errors can be introduced unconsciously.
    6.48 +  \end{itemize}
    6.49 +
    6.50 +  \noindent However, even if you ought refrain from setting up adaptation
    6.51 +  yourself, already the @{text "HOL"} comes with some reasonable default
    6.52 +  adaptations (say, using target language list syntax).  There also some
    6.53 +  common adaptation cases which you can setup by importing particular
    6.54 +  library theories.  In order to understand these, we provide some clues here;
    6.55 +  these however are not supposed to replace a careful study of the sources.
    6.56 +*}
    6.57 +
    6.58 +subsection {* The adaptation principle *}
    6.59 +
    6.60 +text {*
    6.61 +  Figure \ref{fig:adaptation} illustrates what \qt{adaptation} is conceptually
    6.62 +  supposed to be:
    6.63 +
    6.64 +  \begin{figure}[here]
    6.65 +    \includegraphics{adaptation}
    6.66 +    \caption{The adaptation principle}
    6.67 +    \label{fig:adaptation}
    6.68 +  \end{figure}
    6.69 +
    6.70 +  \noindent In the tame view, code generation acts as broker between
    6.71 +  @{text logic}, @{text "intermediate language"} and
    6.72 +  @{text "target language"} by means of @{text translation} and
    6.73 +  @{text serialisation};  for the latter, the serialiser has to observe
    6.74 +  the structure of the @{text language} itself plus some @{text reserved}
    6.75 +  keywords which have to be avoided for generated code.
    6.76 +  However, if you consider @{text adaptation} mechanisms, the code generated
    6.77 +  by the serializer is just the tip of the iceberg:
    6.78 +
    6.79 +  \begin{itemize}
    6.80 +    \item @{text serialisation} can be \emph{parametrised} such that
    6.81 +      logical entities are mapped to target-specific ones
    6.82 +      (e.g. target-specific list syntax,
    6.83 +        see also \secref{sec:adaptation_mechanisms})
    6.84 +    \item Such parametrisations can involve references to a
    6.85 +      target-specific standard @{text library} (e.g. using
    6.86 +      the @{text Haskell} @{verbatim Maybe} type instead
    6.87 +      of the @{text HOL} @{type "option"} type);
    6.88 +      if such are used, the corresponding identifiers
    6.89 +      (in our example, @{verbatim Maybe}, @{verbatim Nothing}
    6.90 +      and @{verbatim Just}) also have to be considered @{text reserved}.
    6.91 +    \item Even more, the user can enrich the library of the
    6.92 +      target-language by providing code snippets
    6.93 +      (\qt{@{text "includes"}}) which are prepended to
    6.94 +      any generated code (see \secref{sec:include});  this typically
    6.95 +      also involves further @{text reserved} identifiers.
    6.96 +  \end{itemize}
    6.97 +
    6.98 +  \noindent As figure \ref{fig:adaptation} illustrates, all these adaptation mechanisms
    6.99 +  have to act consistently;  it is at the discretion of the user
   6.100 +  to take care for this.
   6.101 +*}
   6.102 +
   6.103 +subsection {* Common adaptation patterns *}
   6.104 +
   6.105 +text {*
   6.106 +  The @{theory HOL} @{theory Main} theory already provides a code
   6.107 +  generator setup
   6.108 +  which should be suitable for most applications.  Common extensions
   6.109 +  and modifications are available by certain theories of the @{text HOL}
   6.110 +  library; beside being useful in applications, they may serve
   6.111 +  as a tutorial for customising the code generator setup (see below
   6.112 +  \secref{sec:adaptation_mechanisms}).
   6.113 +
   6.114 +  \begin{description}
   6.115 +
   6.116 +    \item[@{theory "Code_Integer"}] represents @{text HOL} integers by big
   6.117 +       integer literals in target languages.
   6.118 +    \item[@{theory "Code_Char"}] represents @{text HOL} characters by 
   6.119 +       character literals in target languages.
   6.120 +    \item[@{theory "Code_Char_chr"}] like @{text "Code_Char"},
   6.121 +       but also offers treatment of character codes; includes
   6.122 +       @{theory "Code_Char"}.
   6.123 +    \item[@{theory "Efficient_Nat"}] \label{eff_nat} implements natural numbers by integers,
   6.124 +       which in general will result in higher efficiency; pattern
   6.125 +       matching with @{term "0\<Colon>nat"} / @{const "Suc"}
   6.126 +       is eliminated;  includes @{theory "Code_Integer"}
   6.127 +       and @{theory "Code_Index"}.
   6.128 +    \item[@{theory "Code_Index"}] provides an additional datatype
   6.129 +       @{typ index} which is mapped to target-language built-in integers.
   6.130 +       Useful for code setups which involve e.g. indexing of
   6.131 +       target-language arrays.
   6.132 +    \item[@{theory "String"}] provides an additional datatype
   6.133 +       @{typ message_string} which is isomorphic to strings;
   6.134 +       @{typ message_string}s are mapped to target-language strings.
   6.135 +       Useful for code setups which involve e.g. printing (error) messages.
   6.136 +
   6.137 +  \end{description}
   6.138 +
   6.139 +  \begin{warn}
   6.140 +    When importing any of these theories, they should form the last
   6.141 +    items in an import list.  Since these theories adapt the
   6.142 +    code generator setup in a non-conservative fashion,
   6.143 +    strange effects may occur otherwise.
   6.144 +  \end{warn}
   6.145 +*}
   6.146 +
   6.147 +
   6.148 +subsection {* Parametrising serialisation \label{sec:adaptation_mechanisms} *}
   6.149 +
   6.150 +text {*
   6.151 +  Consider the following function and its corresponding
   6.152 +  SML code:
   6.153 +*}
   6.154 +
   6.155 +primrec %quote in_interval :: "nat \<times> nat \<Rightarrow> nat \<Rightarrow> bool" where
   6.156 +  "in_interval (k, l) n \<longleftrightarrow> k \<le> n \<and> n \<le> l"
   6.157 +(*<*)
   6.158 +code_type %invisible bool
   6.159 +  (SML)
   6.160 +code_const %invisible True and False and "op \<and>" and Not
   6.161 +  (SML and and and)
   6.162 +(*>*)
   6.163 +text %quote {*@{code_stmts in_interval (SML)}*}
   6.164 +
   6.165 +text {*
   6.166 +  \noindent Though this is correct code, it is a little bit unsatisfactory:
   6.167 +  boolean values and operators are materialised as distinguished
   6.168 +  entities with have nothing to do with the SML-built-in notion
   6.169 +  of \qt{bool}.  This results in less readable code;
   6.170 +  additionally, eager evaluation may cause programs to
   6.171 +  loop or break which would perfectly terminate when
   6.172 +  the existing SML @{verbatim "bool"} would be used.  To map
   6.173 +  the HOL @{typ bool} on SML @{verbatim "bool"}, we may use
   6.174 +  \qn{custom serialisations}:
   6.175 +*}
   6.176 +
   6.177 +code_type %quotett bool
   6.178 +  (SML "bool")
   6.179 +code_const %quotett True and False and "op \<and>"
   6.180 +  (SML "true" and "false" and "_ andalso _")
   6.181 +
   6.182 +text {*
   6.183 +  \noindent The @{command code_type} command takes a type constructor
   6.184 +  as arguments together with a list of custom serialisations.
   6.185 +  Each custom serialisation starts with a target language
   6.186 +  identifier followed by an expression, which during
   6.187 +  code serialisation is inserted whenever the type constructor
   6.188 +  would occur.  For constants, @{command code_const} implements
   6.189 +  the corresponding mechanism.  Each ``@{verbatim "_"}'' in
   6.190 +  a serialisation expression is treated as a placeholder
   6.191 +  for the type constructor's (the constant's) arguments.
   6.192 +*}
   6.193 +
   6.194 +text %quote {*@{code_stmts in_interval (SML)}*}
   6.195 +
   6.196 +text {*
   6.197 +  \noindent This still is not perfect: the parentheses
   6.198 +  around the \qt{andalso} expression are superfluous.
   6.199 +  Though the serialiser
   6.200 +  by no means attempts to imitate the rich Isabelle syntax
   6.201 +  framework, it provides some common idioms, notably
   6.202 +  associative infixes with precedences which may be used here:
   6.203 +*}
   6.204 +
   6.205 +code_const %quotett "op \<and>"
   6.206 +  (SML infixl 1 "andalso")
   6.207 +
   6.208 +text %quote {*@{code_stmts in_interval (SML)}*}
   6.209 +
   6.210 +text {*
   6.211 +  \noindent The attentive reader may ask how we assert that no generated
   6.212 +  code will accidentally overwrite.  For this reason the serialiser has
   6.213 +  an internal table of identifiers which have to be avoided to be used
   6.214 +  for new declarations.  Initially, this table typically contains the
   6.215 +  keywords of the target language.  It can be extended manually, thus avoiding
   6.216 +  accidental overwrites, using the @{command "code_reserved"} command:
   6.217 +*}
   6.218 +
   6.219 +code_reserved %quote "\<SML>" bool true false andalso
   6.220 +
   6.221 +text {*
   6.222 +  \noindent Next, we try to map HOL pairs to SML pairs, using the
   6.223 +  infix ``@{verbatim "*"}'' type constructor and parentheses:
   6.224 +*}
   6.225 +(*<*)
   6.226 +code_type %invisible *
   6.227 +  (SML)
   6.228 +code_const %invisible Pair
   6.229 +  (SML)
   6.230 +(*>*)
   6.231 +code_type %quotett *
   6.232 +  (SML infix 2 "*")
   6.233 +code_const %quotett Pair
   6.234 +  (SML "!((_),/ (_))")
   6.235 +
   6.236 +text {*
   6.237 +  \noindent The initial bang ``@{verbatim "!"}'' tells the serialiser
   6.238 +  never to put
   6.239 +  parentheses around the whole expression (they are already present),
   6.240 +  while the parentheses around argument place holders
   6.241 +  tell not to put parentheses around the arguments.
   6.242 +  The slash ``@{verbatim "/"}'' (followed by arbitrary white space)
   6.243 +  inserts a space which may be used as a break if necessary
   6.244 +  during pretty printing.
   6.245 +
   6.246 +  These examples give a glimpse what mechanisms
   6.247 +  custom serialisations provide; however their usage
   6.248 +  requires careful thinking in order not to introduce
   6.249 +  inconsistencies -- or, in other words:
   6.250 +  custom serialisations are completely axiomatic.
   6.251 +
   6.252 +  A further noteworthy details is that any special
   6.253 +  character in a custom serialisation may be quoted
   6.254 +  using ``@{verbatim "'"}''; thus, in
   6.255 +  ``@{verbatim "fn '_ => _"}'' the first
   6.256 +  ``@{verbatim "_"}'' is a proper underscore while the
   6.257 +  second ``@{verbatim "_"}'' is a placeholder.
   6.258 +*}
   6.259 +
   6.260 +
   6.261 +subsection {* @{text Haskell} serialisation *}
   6.262 +
   6.263 +text {*
   6.264 +  For convenience, the default
   6.265 +  @{text HOL} setup for @{text Haskell} maps the @{class eq} class to
   6.266 +  its counterpart in @{text Haskell}, giving custom serialisations
   6.267 +  for the class @{class eq} (by command @{command code_class}) and its operation
   6.268 +  @{const HOL.eq}
   6.269 +*}
   6.270 +
   6.271 +code_class %quotett eq
   6.272 +  (Haskell "Eq")
   6.273 +
   6.274 +code_const %quotett "op ="
   6.275 +  (Haskell infixl 4 "==")
   6.276 +
   6.277 +text {*
   6.278 +  \noindent A problem now occurs whenever a type which
   6.279 +  is an instance of @{class eq} in @{text HOL} is mapped
   6.280 +  on a @{text Haskell}-built-in type which is also an instance
   6.281 +  of @{text Haskell} @{text Eq}:
   6.282 +*}
   6.283 +
   6.284 +typedecl %quote bar
   6.285 +
   6.286 +instantiation %quote bar :: eq
   6.287 +begin
   6.288 +
   6.289 +definition %quote "eq_class.eq (x\<Colon>bar) y \<longleftrightarrow> x = y"
   6.290 +
   6.291 +instance %quote by default (simp add: eq_bar_def)
   6.292 +
   6.293 +end %quote (*<*)
   6.294 +
   6.295 +(*>*) code_type %quotett bar
   6.296 +  (Haskell "Integer")
   6.297 +
   6.298 +text {*
   6.299 +  \noindent The code generator would produce
   6.300 +  an additional instance, which of course is rejected by the @{text Haskell}
   6.301 +  compiler.
   6.302 +  To suppress this additional instance, use
   6.303 +  @{text "code_instance"}:
   6.304 +*}
   6.305 +
   6.306 +code_instance %quotett bar :: eq
   6.307 +  (Haskell -)
   6.308 +
   6.309 +
   6.310 +subsection {* Enhancing the target language context \label{sec:include} *}
   6.311 +
   6.312 +text {*
   6.313 +  In rare cases it is necessary to \emph{enrich} the context of a
   6.314 +  target language;  this is accomplished using the @{command "code_include"}
   6.315 +  command:
   6.316 +*}
   6.317 +
   6.318 +code_include %quotett Haskell "Errno"
   6.319 +{*errno i = error ("Error number: " ++ show i)*}
   6.320 +
   6.321 +code_reserved %quotett Haskell Errno
   6.322 +
   6.323 +text {*
   6.324 +  \noindent Such named @{text include}s are then prepended to every generated code.
   6.325 +  Inspect such code in order to find out how @{command "code_include"} behaves
   6.326 +  with respect to a particular target language.
   6.327 +*}
   6.328 +
   6.329 +end
     7.1 --- a/doc-src/Codegen/Thy/Adaption.thy	Mon May 11 09:39:53 2009 +0200
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,326 +0,0 @@
     7.4 -theory Adaption
     7.5 -imports Setup
     7.6 -begin
     7.7 -
     7.8 -setup %invisible {* Code_Target.extend_target ("\<SML>", ("SML", K I)) *}
     7.9 -
    7.10 -section {* Adaption to target languages \label{sec:adaption} *}
    7.11 -
    7.12 -subsection {* Adapting code generation *}
    7.13 -
    7.14 -text {*
    7.15 -  The aspects of code generation introduced so far have two aspects
    7.16 -  in common:
    7.17 -
    7.18 -  \begin{itemize}
    7.19 -    \item They act uniformly, without reference to a specific
    7.20 -       target language.
    7.21 -    \item They are \emph{safe} in the sense that as long as you trust
    7.22 -       the code generator meta theory and implementation, you cannot
    7.23 -       produce programs that yield results which are not derivable
    7.24 -       in the logic.
    7.25 -  \end{itemize}
    7.26 -
    7.27 -  \noindent In this section we will introduce means to \emph{adapt} the serialiser
    7.28 -  to a specific target language, i.e.~to print program fragments
    7.29 -  in a way which accommodates \qt{already existing} ingredients of
    7.30 -  a target language environment, for three reasons:
    7.31 -
    7.32 -  \begin{itemize}
    7.33 -    \item improving readability and aesthetics of generated code
    7.34 -    \item gaining efficiency
    7.35 -    \item interface with language parts which have no direct counterpart
    7.36 -      in @{text "HOL"} (say, imperative data structures)
    7.37 -  \end{itemize}
    7.38 -
    7.39 -  \noindent Generally, you should avoid using those features yourself
    7.40 -  \emph{at any cost}:
    7.41 -
    7.42 -  \begin{itemize}
    7.43 -    \item The safe configuration methods act uniformly on every target language,
    7.44 -      whereas for adaption you have to treat each target language separate.
    7.45 -    \item Application is extremely tedious since there is no abstraction
    7.46 -      which would allow for a static check, making it easy to produce garbage.
    7.47 -    \item More or less subtle errors can be introduced unconsciously.
    7.48 -  \end{itemize}
    7.49 -
    7.50 -  \noindent However, even if you ought refrain from setting up adaption
    7.51 -  yourself, already the @{text "HOL"} comes with some reasonable default
    7.52 -  adaptions (say, using target language list syntax).  There also some
    7.53 -  common adaption cases which you can setup by importing particular
    7.54 -  library theories.  In order to understand these, we provide some clues here;
    7.55 -  these however are not supposed to replace a careful study of the sources.
    7.56 -*}
    7.57 -
    7.58 -subsection {* The adaption principle *}
    7.59 -
    7.60 -text {*
    7.61 -  Figure \ref{fig:adaption} illustrates what \qt{adaption} is conceptually
    7.62 -  supposed to be:
    7.63 -
    7.64 -  \begin{figure}[here]
    7.65 -    \includegraphics{adaption}
    7.66 -    \caption{The adaption principle}
    7.67 -    \label{fig:adaption}
    7.68 -  \end{figure}
    7.69 -
    7.70 -  \noindent In the tame view, code generation acts as broker between
    7.71 -  @{text logic}, @{text "intermediate language"} and
    7.72 -  @{text "target language"} by means of @{text translation} and
    7.73 -  @{text serialisation};  for the latter, the serialiser has to observe
    7.74 -  the structure of the @{text language} itself plus some @{text reserved}
    7.75 -  keywords which have to be avoided for generated code.
    7.76 -  However, if you consider @{text adaption} mechanisms, the code generated
    7.77 -  by the serializer is just the tip of the iceberg:
    7.78 -
    7.79 -  \begin{itemize}
    7.80 -    \item @{text serialisation} can be \emph{parametrised} such that
    7.81 -      logical entities are mapped to target-specific ones
    7.82 -      (e.g. target-specific list syntax,
    7.83 -        see also \secref{sec:adaption_mechanisms})
    7.84 -    \item Such parametrisations can involve references to a
    7.85 -      target-specific standard @{text library} (e.g. using
    7.86 -      the @{text Haskell} @{verbatim Maybe} type instead
    7.87 -      of the @{text HOL} @{type "option"} type);
    7.88 -      if such are used, the corresponding identifiers
    7.89 -      (in our example, @{verbatim Maybe}, @{verbatim Nothing}
    7.90 -      and @{verbatim Just}) also have to be considered @{text reserved}.
    7.91 -    \item Even more, the user can enrich the library of the
    7.92 -      target-language by providing code snippets
    7.93 -      (\qt{@{text "includes"}}) which are prepended to
    7.94 -      any generated code (see \secref{sec:include});  this typically
    7.95 -      also involves further @{text reserved} identifiers.
    7.96 -  \end{itemize}
    7.97 -
    7.98 -  \noindent As figure \ref{fig:adaption} illustrates, all these adaption mechanisms
    7.99 -  have to act consistently;  it is at the discretion of the user
   7.100 -  to take care for this.
   7.101 -*}
   7.102 -
   7.103 -subsection {* Common adaption patterns *}
   7.104 -
   7.105 -text {*
   7.106 -  The @{theory HOL} @{theory Main} theory already provides a code
   7.107 -  generator setup
   7.108 -  which should be suitable for most applications.  Common extensions
   7.109 -  and modifications are available by certain theories of the @{text HOL}
   7.110 -  library; beside being useful in applications, they may serve
   7.111 -  as a tutorial for customising the code generator setup (see below
   7.112 -  \secref{sec:adaption_mechanisms}).
   7.113 -
   7.114 -  \begin{description}
   7.115 -
   7.116 -    \item[@{theory "Code_Integer"}] represents @{text HOL} integers by big
   7.117 -       integer literals in target languages.
   7.118 -    \item[@{theory "Code_Char"}] represents @{text HOL} characters by 
   7.119 -       character literals in target languages.
   7.120 -    \item[@{theory "Code_Char_chr"}] like @{text "Code_Char"},
   7.121 -       but also offers treatment of character codes; includes
   7.122 -       @{theory "Code_Char"}.
   7.123 -    \item[@{theory "Efficient_Nat"}] \label{eff_nat} implements natural numbers by integers,
   7.124 -       which in general will result in higher efficiency; pattern
   7.125 -       matching with @{term "0\<Colon>nat"} / @{const "Suc"}
   7.126 -       is eliminated;  includes @{theory "Code_Integer"}
   7.127 -       and @{theory "Code_Index"}.
   7.128 -    \item[@{theory "Code_Index"}] provides an additional datatype
   7.129 -       @{typ index} which is mapped to target-language built-in integers.
   7.130 -       Useful for code setups which involve e.g. indexing of
   7.131 -       target-language arrays.
   7.132 -    \item[@{theory "Code_Message"}] provides an additional datatype
   7.133 -       @{typ message_string} which is isomorphic to strings;
   7.134 -       @{typ message_string}s are mapped to target-language strings.
   7.135 -       Useful for code setups which involve e.g. printing (error) messages.
   7.136 -
   7.137 -  \end{description}
   7.138 -
   7.139 -  \begin{warn}
   7.140 -    When importing any of these theories, they should form the last
   7.141 -    items in an import list.  Since these theories adapt the
   7.142 -    code generator setup in a non-conservative fashion,
   7.143 -    strange effects may occur otherwise.
   7.144 -  \end{warn}
   7.145 -*}
   7.146 -
   7.147 -
   7.148 -subsection {* Parametrising serialisation \label{sec:adaption_mechanisms} *}
   7.149 -
   7.150 -text {*
   7.151 -  Consider the following function and its corresponding
   7.152 -  SML code:
   7.153 -*}
   7.154 -
   7.155 -primrec %quote in_interval :: "nat \<times> nat \<Rightarrow> nat \<Rightarrow> bool" where
   7.156 -  "in_interval (k, l) n \<longleftrightarrow> k \<le> n \<and> n \<le> l"
   7.157 -(*<*)
   7.158 -code_type %invisible bool
   7.159 -  (SML)
   7.160 -code_const %invisible True and False and "op \<and>" and Not
   7.161 -  (SML and and and)
   7.162 -(*>*)
   7.163 -text %quote {*@{code_stmts in_interval (SML)}*}
   7.164 -
   7.165 -text {*
   7.166 -  \noindent Though this is correct code, it is a little bit unsatisfactory:
   7.167 -  boolean values and operators are materialised as distinguished
   7.168 -  entities with have nothing to do with the SML-built-in notion
   7.169 -  of \qt{bool}.  This results in less readable code;
   7.170 -  additionally, eager evaluation may cause programs to
   7.171 -  loop or break which would perfectly terminate when
   7.172 -  the existing SML @{verbatim "bool"} would be used.  To map
   7.173 -  the HOL @{typ bool} on SML @{verbatim "bool"}, we may use
   7.174 -  \qn{custom serialisations}:
   7.175 -*}
   7.176 -
   7.177 -code_type %quotett bool
   7.178 -  (SML "bool")
   7.179 -code_const %quotett True and False and "op \<and>"
   7.180 -  (SML "true" and "false" and "_ andalso _")
   7.181 -
   7.182 -text {*
   7.183 -  \noindent The @{command code_type} command takes a type constructor
   7.184 -  as arguments together with a list of custom serialisations.
   7.185 -  Each custom serialisation starts with a target language
   7.186 -  identifier followed by an expression, which during
   7.187 -  code serialisation is inserted whenever the type constructor
   7.188 -  would occur.  For constants, @{command code_const} implements
   7.189 -  the corresponding mechanism.  Each ``@{verbatim "_"}'' in
   7.190 -  a serialisation expression is treated as a placeholder
   7.191 -  for the type constructor's (the constant's) arguments.
   7.192 -*}
   7.193 -
   7.194 -text %quote {*@{code_stmts in_interval (SML)}*}
   7.195 -
   7.196 -text {*
   7.197 -  \noindent This still is not perfect: the parentheses
   7.198 -  around the \qt{andalso} expression are superfluous.
   7.199 -  Though the serialiser
   7.200 -  by no means attempts to imitate the rich Isabelle syntax
   7.201 -  framework, it provides some common idioms, notably
   7.202 -  associative infixes with precedences which may be used here:
   7.203 -*}
   7.204 -
   7.205 -code_const %quotett "op \<and>"
   7.206 -  (SML infixl 1 "andalso")
   7.207 -
   7.208 -text %quote {*@{code_stmts in_interval (SML)}*}
   7.209 -
   7.210 -text {*
   7.211 -  \noindent The attentive reader may ask how we assert that no generated
   7.212 -  code will accidentally overwrite.  For this reason the serialiser has
   7.213 -  an internal table of identifiers which have to be avoided to be used
   7.214 -  for new declarations.  Initially, this table typically contains the
   7.215 -  keywords of the target language.  It can be extended manually, thus avoiding
   7.216 -  accidental overwrites, using the @{command "code_reserved"} command:
   7.217 -*}
   7.218 -
   7.219 -code_reserved %quote "\<SML>" bool true false andalso
   7.220 -
   7.221 -text {*
   7.222 -  \noindent Next, we try to map HOL pairs to SML pairs, using the
   7.223 -  infix ``@{verbatim "*"}'' type constructor and parentheses:
   7.224 -*}
   7.225 -(*<*)
   7.226 -code_type %invisible *
   7.227 -  (SML)
   7.228 -code_const %invisible Pair
   7.229 -  (SML)
   7.230 -(*>*)
   7.231 -code_type %quotett *
   7.232 -  (SML infix 2 "*")
   7.233 -code_const %quotett Pair
   7.234 -  (SML "!((_),/ (_))")
   7.235 -
   7.236 -text {*
   7.237 -  \noindent The initial bang ``@{verbatim "!"}'' tells the serialiser
   7.238 -  never to put
   7.239 -  parentheses around the whole expression (they are already present),
   7.240 -  while the parentheses around argument place holders
   7.241 -  tell not to put parentheses around the arguments.
   7.242 -  The slash ``@{verbatim "/"}'' (followed by arbitrary white space)
   7.243 -  inserts a space which may be used as a break if necessary
   7.244 -  during pretty printing.
   7.245 -
   7.246 -  These examples give a glimpse what mechanisms
   7.247 -  custom serialisations provide; however their usage
   7.248 -  requires careful thinking in order not to introduce
   7.249 -  inconsistencies -- or, in other words:
   7.250 -  custom serialisations are completely axiomatic.
   7.251 -
   7.252 -  A further noteworthy details is that any special
   7.253 -  character in a custom serialisation may be quoted
   7.254 -  using ``@{verbatim "'"}''; thus, in
   7.255 -  ``@{verbatim "fn '_ => _"}'' the first
   7.256 -  ``@{verbatim "_"}'' is a proper underscore while the
   7.257 -  second ``@{verbatim "_"}'' is a placeholder.
   7.258 -*}
   7.259 -
   7.260 -
   7.261 -subsection {* @{text Haskell} serialisation *}
   7.262 -
   7.263 -text {*
   7.264 -  For convenience, the default
   7.265 -  @{text HOL} setup for @{text Haskell} maps the @{class eq} class to
   7.266 -  its counterpart in @{text Haskell}, giving custom serialisations
   7.267 -  for the class @{class eq} (by command @{command code_class}) and its operation
   7.268 -  @{const HOL.eq}
   7.269 -*}
   7.270 -
   7.271 -code_class %quotett eq
   7.272 -  (Haskell "Eq")
   7.273 -
   7.274 -code_const %quotett "op ="
   7.275 -  (Haskell infixl 4 "==")
   7.276 -
   7.277 -text {*
   7.278 -  \noindent A problem now occurs whenever a type which
   7.279 -  is an instance of @{class eq} in @{text HOL} is mapped
   7.280 -  on a @{text Haskell}-built-in type which is also an instance
   7.281 -  of @{text Haskell} @{text Eq}:
   7.282 -*}
   7.283 -
   7.284 -typedecl %quote bar
   7.285 -
   7.286 -instantiation %quote bar :: eq
   7.287 -begin
   7.288 -
   7.289 -definition %quote "eq_class.eq (x\<Colon>bar) y \<longleftrightarrow> x = y"
   7.290 -
   7.291 -instance %quote by default (simp add: eq_bar_def)
   7.292 -
   7.293 -end %quote (*<*)
   7.294 -
   7.295 -(*>*) code_type %quotett bar
   7.296 -  (Haskell "Integer")
   7.297 -
   7.298 -text {*
   7.299 -  \noindent The code generator would produce
   7.300 -  an additional instance, which of course is rejected by the @{text Haskell}
   7.301 -  compiler.
   7.302 -  To suppress this additional instance, use
   7.303 -  @{text "code_instance"}:
   7.304 -*}
   7.305 -
   7.306 -code_instance %quotett bar :: eq
   7.307 -  (Haskell -)
   7.308 -
   7.309 -
   7.310 -subsection {* Enhancing the target language context \label{sec:include} *}
   7.311 -
   7.312 -text {*
   7.313 -  In rare cases it is necessary to \emph{enrich} the context of a
   7.314 -  target language;  this is accomplished using the @{command "code_include"}
   7.315 -  command:
   7.316 -*}
   7.317 -
   7.318 -code_include %quotett Haskell "Errno"
   7.319 -{*errno i = error ("Error number: " ++ show i)*}
   7.320 -
   7.321 -code_reserved %quotett Haskell Errno
   7.322 -
   7.323 -text {*
   7.324 -  \noindent Such named @{text include}s are then prepended to every generated code.
   7.325 -  Inspect such code in order to find out how @{command "code_include"} behaves
   7.326 -  with respect to a particular target language.
   7.327 -*}
   7.328 -
   7.329 -end
     8.1 --- a/doc-src/Codegen/Thy/Further.thy	Mon May 11 09:39:53 2009 +0200
     8.2 +++ b/doc-src/Codegen/Thy/Further.thy	Mon May 11 17:20:52 2009 +0200
     8.3 @@ -66,7 +66,7 @@
     8.4  text {*
     8.5    \noindent The soundness of the @{method eval} method depends crucially 
     8.6    on the correctness of the code generator;  this is one of the reasons
     8.7 -  why you should not use adaption (see \secref{sec:adaption}) frivolously.
     8.8 +  why you should not use adaptation (see \secref{sec:adaptation}) frivolously.
     8.9  *}
    8.10  
    8.11  subsection {* Code antiquotation *}
     9.1 --- a/doc-src/Codegen/Thy/Introduction.thy	Mon May 11 09:39:53 2009 +0200
     9.2 +++ b/doc-src/Codegen/Thy/Introduction.thy	Mon May 11 17:20:52 2009 +0200
     9.3 @@ -28,8 +28,8 @@
     9.4    This manifests in the structure of this tutorial: after a short
     9.5    conceptual introduction with an example (\secref{sec:intro}),
     9.6    we discuss the generic customisation facilities (\secref{sec:program}).
     9.7 -  A further section (\secref{sec:adaption}) is dedicated to the matter of
     9.8 -  \qn{adaption} to specific target language environments.  After some
     9.9 +  A further section (\secref{sec:adaptation}) is dedicated to the matter of
    9.10 +  \qn{adaptation} to specific target language environments.  After some
    9.11    further issues (\secref{sec:further}) we conclude with an overview
    9.12    of some ML programming interfaces (\secref{sec:ml}).
    9.13  
    10.1 --- a/doc-src/Codegen/Thy/Program.thy	Mon May 11 09:39:53 2009 +0200
    10.2 +++ b/doc-src/Codegen/Thy/Program.thy	Mon May 11 17:20:52 2009 +0200
    10.3 @@ -323,7 +323,7 @@
    10.4  *}
    10.5  
    10.6  
    10.7 -subsection {* Equality and wellsortedness *}
    10.8 +subsection {* Equality *}
    10.9  
   10.10  text {*
   10.11    Surely you have already noticed how equality is treated
   10.12 @@ -358,60 +358,7 @@
   10.13    manually like any other type class.
   10.14  
   10.15    Though this @{text eq} class is designed to get rarely in
   10.16 -  the way, a subtlety
   10.17 -  enters the stage when definitions of overloaded constants
   10.18 -  are dependent on operational equality.  For example, let
   10.19 -  us define a lexicographic ordering on tuples
   10.20 -  (also see theory @{theory Product_ord}):
   10.21 -*}
   10.22 -
   10.23 -instantiation %quote "*" :: (order, order) order
   10.24 -begin
   10.25 -
   10.26 -definition %quote [code del]:
   10.27 -  "x \<le> y \<longleftrightarrow> fst x < fst y \<or> fst x = fst y \<and> snd x \<le> snd y"
   10.28 -
   10.29 -definition %quote [code del]:
   10.30 -  "x < y \<longleftrightarrow> fst x < fst y \<or> fst x = fst y \<and> snd x < snd y"
   10.31 -
   10.32 -instance %quote proof
   10.33 -qed (auto simp: less_eq_prod_def less_prod_def intro: order_less_trans)
   10.34 -
   10.35 -end %quote
   10.36 -
   10.37 -lemma %quote order_prod [code]:
   10.38 -  "(x1 \<Colon> 'a\<Colon>order, y1 \<Colon> 'b\<Colon>order) < (x2, y2) \<longleftrightarrow>
   10.39 -     x1 < x2 \<or> x1 = x2 \<and> y1 < y2"
   10.40 -  "(x1 \<Colon> 'a\<Colon>order, y1 \<Colon> 'b\<Colon>order) \<le> (x2, y2) \<longleftrightarrow>
   10.41 -     x1 < x2 \<or> x1 = x2 \<and> y1 \<le> y2"
   10.42 -  by (simp_all add: less_prod_def less_eq_prod_def)
   10.43 -
   10.44 -text {*
   10.45 -  \noindent Then code generation will fail.  Why?  The definition
   10.46 -  of @{term "op \<le>"} depends on equality on both arguments,
   10.47 -  which are polymorphic and impose an additional @{class eq}
   10.48 -  class constraint, which the preprocessor does not propagate
   10.49 -  (for technical reasons).
   10.50 -
   10.51 -  The solution is to add @{class eq} explicitly to the first sort arguments in the
   10.52 -  code theorems:
   10.53 -*}
   10.54 -
   10.55 -lemma %quote order_prod_code [code]:
   10.56 -  "(x1 \<Colon> 'a\<Colon>{order, eq}, y1 \<Colon> 'b\<Colon>order) < (x2, y2) \<longleftrightarrow>
   10.57 -     x1 < x2 \<or> x1 = x2 \<and> y1 < y2"
   10.58 -  "(x1 \<Colon> 'a\<Colon>{order, eq}, y1 \<Colon> 'b\<Colon>order) \<le> (x2, y2) \<longleftrightarrow>
   10.59 -     x1 < x2 \<or> x1 = x2 \<and> y1 \<le> y2"
   10.60 -  by (simp_all add: less_prod_def less_eq_prod_def)
   10.61 -
   10.62 -text {*
   10.63 -  \noindent Then code generation succeeds:
   10.64 -*}
   10.65 -
   10.66 -text %quote {*@{code_stmts "op \<le> \<Colon> _ \<times> _ \<Rightarrow> _ \<times> _ \<Rightarrow> bool" (SML)}*}
   10.67 -
   10.68 -text {*
   10.69 -  In some cases, the automatically derived code equations
   10.70 +  the way, in some cases the automatically derived code equations
   10.71    for equality on a particular type may not be appropriate.
   10.72    As example, watch the following datatype representing
   10.73    monomorphic parametric types (where type constructors
    11.1 --- a/doc-src/Codegen/Thy/ROOT.ML	Mon May 11 09:39:53 2009 +0200
    11.2 +++ b/doc-src/Codegen/Thy/ROOT.ML	Mon May 11 17:20:52 2009 +0200
    11.3 @@ -4,6 +4,6 @@
    11.4  
    11.5  use_thy "Introduction";
    11.6  use_thy "Program";
    11.7 -use_thy "Adaption";
    11.8 +use_thy "Adaptation";
    11.9  use_thy "Further";
   11.10  use_thy "ML";
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/doc-src/Codegen/Thy/document/Adaptation.tex	Mon May 11 17:20:52 2009 +0200
    12.3 @@ -0,0 +1,642 @@
    12.4 +%
    12.5 +\begin{isabellebody}%
    12.6 +\def\isabellecontext{Adaptation}%
    12.7 +%
    12.8 +\isadelimtheory
    12.9 +%
   12.10 +\endisadelimtheory
   12.11 +%
   12.12 +\isatagtheory
   12.13 +\isacommand{theory}\isamarkupfalse%
   12.14 +\ Adaptation\isanewline
   12.15 +\isakeyword{imports}\ Setup\isanewline
   12.16 +\isakeyword{begin}%
   12.17 +\endisatagtheory
   12.18 +{\isafoldtheory}%
   12.19 +%
   12.20 +\isadelimtheory
   12.21 +\isanewline
   12.22 +%
   12.23 +\endisadelimtheory
   12.24 +%
   12.25 +\isadeliminvisible
   12.26 +\isanewline
   12.27 +%
   12.28 +\endisadeliminvisible
   12.29 +%
   12.30 +\isataginvisible
   12.31 +\isacommand{setup}\isamarkupfalse%
   12.32 +\ {\isacharverbatimopen}\ Code{\isacharunderscore}Target{\isachardot}extend{\isacharunderscore}target\ {\isacharparenleft}{\isachardoublequote}{\isasymSML}{\isachardoublequote}{\isacharcomma}\ {\isacharparenleft}{\isachardoublequote}SML{\isachardoublequote}{\isacharcomma}\ K\ I{\isacharparenright}{\isacharparenright}\ {\isacharverbatimclose}%
   12.33 +\endisataginvisible
   12.34 +{\isafoldinvisible}%
   12.35 +%
   12.36 +\isadeliminvisible
   12.37 +%
   12.38 +\endisadeliminvisible
   12.39 +%
   12.40 +\isamarkupsection{Adaptation to target languages \label{sec:adaptation}%
   12.41 +}
   12.42 +\isamarkuptrue%
   12.43 +%
   12.44 +\isamarkupsubsection{Adapting code generation%
   12.45 +}
   12.46 +\isamarkuptrue%
   12.47 +%
   12.48 +\begin{isamarkuptext}%
   12.49 +The aspects of code generation introduced so far have two aspects
   12.50 +  in common:
   12.51 +
   12.52 +  \begin{itemize}
   12.53 +    \item They act uniformly, without reference to a specific
   12.54 +       target language.
   12.55 +    \item They are \emph{safe} in the sense that as long as you trust
   12.56 +       the code generator meta theory and implementation, you cannot
   12.57 +       produce programs that yield results which are not derivable
   12.58 +       in the logic.
   12.59 +  \end{itemize}
   12.60 +
   12.61 +  \noindent In this section we will introduce means to \emph{adapt} the serialiser
   12.62 +  to a specific target language, i.e.~to print program fragments
   12.63 +  in a way which accommodates \qt{already existing} ingredients of
   12.64 +  a target language environment, for three reasons:
   12.65 +
   12.66 +  \begin{itemize}
   12.67 +    \item improving readability and aesthetics of generated code
   12.68 +    \item gaining efficiency
   12.69 +    \item interface with language parts which have no direct counterpart
   12.70 +      in \isa{HOL} (say, imperative data structures)
   12.71 +  \end{itemize}
   12.72 +
   12.73 +  \noindent Generally, you should avoid using those features yourself
   12.74 +  \emph{at any cost}:
   12.75 +
   12.76 +  \begin{itemize}
   12.77 +    \item The safe configuration methods act uniformly on every target language,
   12.78 +      whereas for adaptation you have to treat each target language separate.
   12.79 +    \item Application is extremely tedious since there is no abstraction
   12.80 +      which would allow for a static check, making it easy to produce garbage.
   12.81 +    \item More or less subtle errors can be introduced unconsciously.
   12.82 +  \end{itemize}
   12.83 +
   12.84 +  \noindent However, even if you ought refrain from setting up adaptation
   12.85 +  yourself, already the \isa{HOL} comes with some reasonable default
   12.86 +  adaptations (say, using target language list syntax).  There also some
   12.87 +  common adaptation cases which you can setup by importing particular
   12.88 +  library theories.  In order to understand these, we provide some clues here;
   12.89 +  these however are not supposed to replace a careful study of the sources.%
   12.90 +\end{isamarkuptext}%
   12.91 +\isamarkuptrue%
   12.92 +%
   12.93 +\isamarkupsubsection{The adaptation principle%
   12.94 +}
   12.95 +\isamarkuptrue%
   12.96 +%
   12.97 +\begin{isamarkuptext}%
   12.98 +Figure \ref{fig:adaptation} illustrates what \qt{adaptation} is conceptually
   12.99 +  supposed to be:
  12.100 +
  12.101 +  \begin{figure}[here]
  12.102 +    \includegraphics{adaptation}
  12.103 +    \caption{The adaptation principle}
  12.104 +    \label{fig:adaptation}
  12.105 +  \end{figure}
  12.106 +
  12.107 +  \noindent In the tame view, code generation acts as broker between
  12.108 +  \isa{logic}, \isa{intermediate\ language} and
  12.109 +  \isa{target\ language} by means of \isa{translation} and
  12.110 +  \isa{serialisation};  for the latter, the serialiser has to observe
  12.111 +  the structure of the \isa{language} itself plus some \isa{reserved}
  12.112 +  keywords which have to be avoided for generated code.
  12.113 +  However, if you consider \isa{adaptation} mechanisms, the code generated
  12.114 +  by the serializer is just the tip of the iceberg:
  12.115 +
  12.116 +  \begin{itemize}
  12.117 +    \item \isa{serialisation} can be \emph{parametrised} such that
  12.118 +      logical entities are mapped to target-specific ones
  12.119 +      (e.g. target-specific list syntax,
  12.120 +        see also \secref{sec:adaptation_mechanisms})
  12.121 +    \item Such parametrisations can involve references to a
  12.122 +      target-specific standard \isa{library} (e.g. using
  12.123 +      the \isa{Haskell} \verb|Maybe| type instead
  12.124 +      of the \isa{HOL} \isa{option} type);
  12.125 +      if such are used, the corresponding identifiers
  12.126 +      (in our example, \verb|Maybe|, \verb|Nothing|
  12.127 +      and \verb|Just|) also have to be considered \isa{reserved}.
  12.128 +    \item Even more, the user can enrich the library of the
  12.129 +      target-language by providing code snippets
  12.130 +      (\qt{\isa{includes}}) which are prepended to
  12.131 +      any generated code (see \secref{sec:include});  this typically
  12.132 +      also involves further \isa{reserved} identifiers.
  12.133 +  \end{itemize}
  12.134 +
  12.135 +  \noindent As figure \ref{fig:adaptation} illustrates, all these adaptation mechanisms
  12.136 +  have to act consistently;  it is at the discretion of the user
  12.137 +  to take care for this.%
  12.138 +\end{isamarkuptext}%
  12.139 +\isamarkuptrue%
  12.140 +%
  12.141 +\isamarkupsubsection{Common adaptation patterns%
  12.142 +}
  12.143 +\isamarkuptrue%
  12.144 +%
  12.145 +\begin{isamarkuptext}%
  12.146 +The \hyperlink{theory.HOL}{\mbox{\isa{HOL}}} \hyperlink{theory.Main}{\mbox{\isa{Main}}} theory already provides a code
  12.147 +  generator setup
  12.148 +  which should be suitable for most applications.  Common extensions
  12.149 +  and modifications are available by certain theories of the \isa{HOL}
  12.150 +  library; beside being useful in applications, they may serve
  12.151 +  as a tutorial for customising the code generator setup (see below
  12.152 +  \secref{sec:adaptation_mechanisms}).
  12.153 +
  12.154 +  \begin{description}
  12.155 +
  12.156 +    \item[\hyperlink{theory.Code-Integer}{\mbox{\isa{Code{\isacharunderscore}Integer}}}] represents \isa{HOL} integers by big
  12.157 +       integer literals in target languages.
  12.158 +    \item[\hyperlink{theory.Code-Char}{\mbox{\isa{Code{\isacharunderscore}Char}}}] represents \isa{HOL} characters by 
  12.159 +       character literals in target languages.
  12.160 +    \item[\hyperlink{theory.Code-Char-chr}{\mbox{\isa{Code{\isacharunderscore}Char{\isacharunderscore}chr}}}] like \isa{Code{\isacharunderscore}Char},
  12.161 +       but also offers treatment of character codes; includes
  12.162 +       \hyperlink{theory.Code-Char}{\mbox{\isa{Code{\isacharunderscore}Char}}}.
  12.163 +    \item[\hyperlink{theory.Efficient-Nat}{\mbox{\isa{Efficient{\isacharunderscore}Nat}}}] \label{eff_nat} implements natural numbers by integers,
  12.164 +       which in general will result in higher efficiency; pattern
  12.165 +       matching with \isa{{\isadigit{0}}} / \isa{Suc}
  12.166 +       is eliminated;  includes \hyperlink{theory.Code-Integer}{\mbox{\isa{Code{\isacharunderscore}Integer}}}
  12.167 +       and \hyperlink{theory.Code-Index}{\mbox{\isa{Code{\isacharunderscore}Index}}}.
  12.168 +    \item[\hyperlink{theory.Code-Index}{\mbox{\isa{Code{\isacharunderscore}Index}}}] provides an additional datatype
  12.169 +       \isa{index} which is mapped to target-language built-in integers.
  12.170 +       Useful for code setups which involve e.g. indexing of
  12.171 +       target-language arrays.
  12.172 +    \item[\hyperlink{theory.Code-Message}{\mbox{\isa{Code{\isacharunderscore}Message}}}] provides an additional datatype
  12.173 +       \isa{message{\isacharunderscore}string} which is isomorphic to strings;
  12.174 +       \isa{message{\isacharunderscore}string}s are mapped to target-language strings.
  12.175 +       Useful for code setups which involve e.g. printing (error) messages.
  12.176 +
  12.177 +  \end{description}
  12.178 +
  12.179 +  \begin{warn}
  12.180 +    When importing any of these theories, they should form the last
  12.181 +    items in an import list.  Since these theories adapt the
  12.182 +    code generator setup in a non-conservative fashion,
  12.183 +    strange effects may occur otherwise.
  12.184 +  \end{warn}%
  12.185 +\end{isamarkuptext}%
  12.186 +\isamarkuptrue%
  12.187 +%
  12.188 +\isamarkupsubsection{Parametrising serialisation \label{sec:adaptation_mechanisms}%
  12.189 +}
  12.190 +\isamarkuptrue%
  12.191 +%
  12.192 +\begin{isamarkuptext}%
  12.193 +Consider the following function and its corresponding
  12.194 +  SML code:%
  12.195 +\end{isamarkuptext}%
  12.196 +\isamarkuptrue%
  12.197 +%
  12.198 +\isadelimquote
  12.199 +%
  12.200 +\endisadelimquote
  12.201 +%
  12.202 +\isatagquote
  12.203 +\isacommand{primrec}\isamarkupfalse%
  12.204 +\ in{\isacharunderscore}interval\ {\isacharcolon}{\isacharcolon}\ {\isachardoublequoteopen}nat\ {\isasymtimes}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\ \isakeyword{where}\isanewline
  12.205 +\ \ {\isachardoublequoteopen}in{\isacharunderscore}interval\ {\isacharparenleft}k{\isacharcomma}\ l{\isacharparenright}\ n\ {\isasymlongleftrightarrow}\ k\ {\isasymle}\ n\ {\isasymand}\ n\ {\isasymle}\ l{\isachardoublequoteclose}%
  12.206 +\endisatagquote
  12.207 +{\isafoldquote}%
  12.208 +%
  12.209 +\isadelimquote
  12.210 +%
  12.211 +\endisadelimquote
  12.212 +%
  12.213 +\isadeliminvisible
  12.214 +%
  12.215 +\endisadeliminvisible
  12.216 +%
  12.217 +\isataginvisible
  12.218 +%
  12.219 +\endisataginvisible
  12.220 +{\isafoldinvisible}%
  12.221 +%
  12.222 +\isadeliminvisible
  12.223 +%
  12.224 +\endisadeliminvisible
  12.225 +%
  12.226 +\isadelimquote
  12.227 +%
  12.228 +\endisadelimquote
  12.229 +%
  12.230 +\isatagquote
  12.231 +%
  12.232 +\begin{isamarkuptext}%
  12.233 +\isatypewriter%
  12.234 +\noindent%
  12.235 +\hspace*{0pt}structure Example = \\
  12.236 +\hspace*{0pt}struct\\
  12.237 +\hspace*{0pt}\\
  12.238 +\hspace*{0pt}datatype nat = Zero{\char95}nat | Suc of nat;\\
  12.239 +\hspace*{0pt}\\
  12.240 +\hspace*{0pt}datatype boola = True | False;\\
  12.241 +\hspace*{0pt}\\
  12.242 +\hspace*{0pt}fun anda x True = x\\
  12.243 +\hspace*{0pt} ~| anda x False = False\\
  12.244 +\hspace*{0pt} ~| anda True x = x\\
  12.245 +\hspace*{0pt} ~| anda False x = False;\\
  12.246 +\hspace*{0pt}\\
  12.247 +\hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
  12.248 +\hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = False\\
  12.249 +\hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
  12.250 +\hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = True;\\
  12.251 +\hspace*{0pt}\\
  12.252 +\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.253 +\hspace*{0pt}\\
  12.254 +\hspace*{0pt}end;~(*struct Example*)%
  12.255 +\end{isamarkuptext}%
  12.256 +\isamarkuptrue%
  12.257 +%
  12.258 +\endisatagquote
  12.259 +{\isafoldquote}%
  12.260 +%
  12.261 +\isadelimquote
  12.262 +%
  12.263 +\endisadelimquote
  12.264 +%
  12.265 +\begin{isamarkuptext}%
  12.266 +\noindent Though this is correct code, it is a little bit unsatisfactory:
  12.267 +  boolean values and operators are materialised as distinguished
  12.268 +  entities with have nothing to do with the SML-built-in notion
  12.269 +  of \qt{bool}.  This results in less readable code;
  12.270 +  additionally, eager evaluation may cause programs to
  12.271 +  loop or break which would perfectly terminate when
  12.272 +  the existing SML \verb|bool| would be used.  To map
  12.273 +  the HOL \isa{bool} on SML \verb|bool|, we may use
  12.274 +  \qn{custom serialisations}:%
  12.275 +\end{isamarkuptext}%
  12.276 +\isamarkuptrue%
  12.277 +%
  12.278 +\isadelimquotett
  12.279 +%
  12.280 +\endisadelimquotett
  12.281 +%
  12.282 +\isatagquotett
  12.283 +\isacommand{code{\isacharunderscore}type}\isamarkupfalse%
  12.284 +\ bool\isanewline
  12.285 +\ \ {\isacharparenleft}SML\ {\isachardoublequoteopen}bool{\isachardoublequoteclose}{\isacharparenright}\isanewline
  12.286 +\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  12.287 +\ True\ \isakeyword{and}\ False\ \isakeyword{and}\ {\isachardoublequoteopen}op\ {\isasymand}{\isachardoublequoteclose}\isanewline
  12.288 +\ \ {\isacharparenleft}SML\ {\isachardoublequoteopen}true{\isachardoublequoteclose}\ \isakeyword{and}\ {\isachardoublequoteopen}false{\isachardoublequoteclose}\ \isakeyword{and}\ {\isachardoublequoteopen}{\isacharunderscore}\ andalso\ {\isacharunderscore}{\isachardoublequoteclose}{\isacharparenright}%
  12.289 +\endisatagquotett
  12.290 +{\isafoldquotett}%
  12.291 +%
  12.292 +\isadelimquotett
  12.293 +%
  12.294 +\endisadelimquotett
  12.295 +%
  12.296 +\begin{isamarkuptext}%
  12.297 +\noindent The \hyperlink{command.code-type}{\mbox{\isa{\isacommand{code{\isacharunderscore}type}}}} command takes a type constructor
  12.298 +  as arguments together with a list of custom serialisations.
  12.299 +  Each custom serialisation starts with a target language
  12.300 +  identifier followed by an expression, which during
  12.301 +  code serialisation is inserted whenever the type constructor
  12.302 +  would occur.  For constants, \hyperlink{command.code-const}{\mbox{\isa{\isacommand{code{\isacharunderscore}const}}}} implements
  12.303 +  the corresponding mechanism.  Each ``\verb|_|'' in
  12.304 +  a serialisation expression is treated as a placeholder
  12.305 +  for the type constructor's (the constant's) arguments.%
  12.306 +\end{isamarkuptext}%
  12.307 +\isamarkuptrue%
  12.308 +%
  12.309 +\isadelimquote
  12.310 +%
  12.311 +\endisadelimquote
  12.312 +%
  12.313 +\isatagquote
  12.314 +%
  12.315 +\begin{isamarkuptext}%
  12.316 +\isatypewriter%
  12.317 +\noindent%
  12.318 +\hspace*{0pt}structure Example = \\
  12.319 +\hspace*{0pt}struct\\
  12.320 +\hspace*{0pt}\\
  12.321 +\hspace*{0pt}datatype nat = Zero{\char95}nat | Suc of nat;\\
  12.322 +\hspace*{0pt}\\
  12.323 +\hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
  12.324 +\hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = false\\
  12.325 +\hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
  12.326 +\hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = true;\\
  12.327 +\hspace*{0pt}\\
  12.328 +\hspace*{0pt}fun in{\char95}interval (k,~l) n = (less{\char95}eq{\char95}nat k n) andalso (less{\char95}eq{\char95}nat n l);\\
  12.329 +\hspace*{0pt}\\
  12.330 +\hspace*{0pt}end;~(*struct Example*)%
  12.331 +\end{isamarkuptext}%
  12.332 +\isamarkuptrue%
  12.333 +%
  12.334 +\endisatagquote
  12.335 +{\isafoldquote}%
  12.336 +%
  12.337 +\isadelimquote
  12.338 +%
  12.339 +\endisadelimquote
  12.340 +%
  12.341 +\begin{isamarkuptext}%
  12.342 +\noindent This still is not perfect: the parentheses
  12.343 +  around the \qt{andalso} expression are superfluous.
  12.344 +  Though the serialiser
  12.345 +  by no means attempts to imitate the rich Isabelle syntax
  12.346 +  framework, it provides some common idioms, notably
  12.347 +  associative infixes with precedences which may be used here:%
  12.348 +\end{isamarkuptext}%
  12.349 +\isamarkuptrue%
  12.350 +%
  12.351 +\isadelimquotett
  12.352 +%
  12.353 +\endisadelimquotett
  12.354 +%
  12.355 +\isatagquotett
  12.356 +\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  12.357 +\ {\isachardoublequoteopen}op\ {\isasymand}{\isachardoublequoteclose}\isanewline
  12.358 +\ \ {\isacharparenleft}SML\ \isakeyword{infixl}\ {\isadigit{1}}\ {\isachardoublequoteopen}andalso{\isachardoublequoteclose}{\isacharparenright}%
  12.359 +\endisatagquotett
  12.360 +{\isafoldquotett}%
  12.361 +%
  12.362 +\isadelimquotett
  12.363 +%
  12.364 +\endisadelimquotett
  12.365 +%
  12.366 +\isadelimquote
  12.367 +%
  12.368 +\endisadelimquote
  12.369 +%
  12.370 +\isatagquote
  12.371 +%
  12.372 +\begin{isamarkuptext}%
  12.373 +\isatypewriter%
  12.374 +\noindent%
  12.375 +\hspace*{0pt}structure Example = \\
  12.376 +\hspace*{0pt}struct\\
  12.377 +\hspace*{0pt}\\
  12.378 +\hspace*{0pt}datatype nat = Zero{\char95}nat | Suc of nat;\\
  12.379 +\hspace*{0pt}\\
  12.380 +\hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
  12.381 +\hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = false\\
  12.382 +\hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
  12.383 +\hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = true;\\
  12.384 +\hspace*{0pt}\\
  12.385 +\hspace*{0pt}fun in{\char95}interval (k,~l) n = less{\char95}eq{\char95}nat k n andalso less{\char95}eq{\char95}nat n l;\\
  12.386 +\hspace*{0pt}\\
  12.387 +\hspace*{0pt}end;~(*struct Example*)%
  12.388 +\end{isamarkuptext}%
  12.389 +\isamarkuptrue%
  12.390 +%
  12.391 +\endisatagquote
  12.392 +{\isafoldquote}%
  12.393 +%
  12.394 +\isadelimquote
  12.395 +%
  12.396 +\endisadelimquote
  12.397 +%
  12.398 +\begin{isamarkuptext}%
  12.399 +\noindent The attentive reader may ask how we assert that no generated
  12.400 +  code will accidentally overwrite.  For this reason the serialiser has
  12.401 +  an internal table of identifiers which have to be avoided to be used
  12.402 +  for new declarations.  Initially, this table typically contains the
  12.403 +  keywords of the target language.  It can be extended manually, thus avoiding
  12.404 +  accidental overwrites, using the \hyperlink{command.code-reserved}{\mbox{\isa{\isacommand{code{\isacharunderscore}reserved}}}} command:%
  12.405 +\end{isamarkuptext}%
  12.406 +\isamarkuptrue%
  12.407 +%
  12.408 +\isadelimquote
  12.409 +%
  12.410 +\endisadelimquote
  12.411 +%
  12.412 +\isatagquote
  12.413 +\isacommand{code{\isacharunderscore}reserved}\isamarkupfalse%
  12.414 +\ {\isachardoublequoteopen}{\isasymSML}{\isachardoublequoteclose}\ bool\ true\ false\ andalso%
  12.415 +\endisatagquote
  12.416 +{\isafoldquote}%
  12.417 +%
  12.418 +\isadelimquote
  12.419 +%
  12.420 +\endisadelimquote
  12.421 +%
  12.422 +\begin{isamarkuptext}%
  12.423 +\noindent Next, we try to map HOL pairs to SML pairs, using the
  12.424 +  infix ``\verb|*|'' type constructor and parentheses:%
  12.425 +\end{isamarkuptext}%
  12.426 +\isamarkuptrue%
  12.427 +%
  12.428 +\isadeliminvisible
  12.429 +%
  12.430 +\endisadeliminvisible
  12.431 +%
  12.432 +\isataginvisible
  12.433 +%
  12.434 +\endisataginvisible
  12.435 +{\isafoldinvisible}%
  12.436 +%
  12.437 +\isadeliminvisible
  12.438 +%
  12.439 +\endisadeliminvisible
  12.440 +%
  12.441 +\isadelimquotett
  12.442 +%
  12.443 +\endisadelimquotett
  12.444 +%
  12.445 +\isatagquotett
  12.446 +\isacommand{code{\isacharunderscore}type}\isamarkupfalse%
  12.447 +\ {\isacharasterisk}\isanewline
  12.448 +\ \ {\isacharparenleft}SML\ \isakeyword{infix}\ {\isadigit{2}}\ {\isachardoublequoteopen}{\isacharasterisk}{\isachardoublequoteclose}{\isacharparenright}\isanewline
  12.449 +\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  12.450 +\ Pair\isanewline
  12.451 +\ \ {\isacharparenleft}SML\ {\isachardoublequoteopen}{\isacharbang}{\isacharparenleft}{\isacharparenleft}{\isacharunderscore}{\isacharparenright}{\isacharcomma}{\isacharslash}\ {\isacharparenleft}{\isacharunderscore}{\isacharparenright}{\isacharparenright}{\isachardoublequoteclose}{\isacharparenright}%
  12.452 +\endisatagquotett
  12.453 +{\isafoldquotett}%
  12.454 +%
  12.455 +\isadelimquotett
  12.456 +%
  12.457 +\endisadelimquotett
  12.458 +%
  12.459 +\begin{isamarkuptext}%
  12.460 +\noindent The initial bang ``\verb|!|'' tells the serialiser
  12.461 +  never to put
  12.462 +  parentheses around the whole expression (they are already present),
  12.463 +  while the parentheses around argument place holders
  12.464 +  tell not to put parentheses around the arguments.
  12.465 +  The slash ``\verb|/|'' (followed by arbitrary white space)
  12.466 +  inserts a space which may be used as a break if necessary
  12.467 +  during pretty printing.
  12.468 +
  12.469 +  These examples give a glimpse what mechanisms
  12.470 +  custom serialisations provide; however their usage
  12.471 +  requires careful thinking in order not to introduce
  12.472 +  inconsistencies -- or, in other words:
  12.473 +  custom serialisations are completely axiomatic.
  12.474 +
  12.475 +  A further noteworthy details is that any special
  12.476 +  character in a custom serialisation may be quoted
  12.477 +  using ``\verb|'|''; thus, in
  12.478 +  ``\verb|fn '_ => _|'' the first
  12.479 +  ``\verb|_|'' is a proper underscore while the
  12.480 +  second ``\verb|_|'' is a placeholder.%
  12.481 +\end{isamarkuptext}%
  12.482 +\isamarkuptrue%
  12.483 +%
  12.484 +\isamarkupsubsection{\isa{Haskell} serialisation%
  12.485 +}
  12.486 +\isamarkuptrue%
  12.487 +%
  12.488 +\begin{isamarkuptext}%
  12.489 +For convenience, the default
  12.490 +  \isa{HOL} setup for \isa{Haskell} maps the \isa{eq} class to
  12.491 +  its counterpart in \isa{Haskell}, giving custom serialisations
  12.492 +  for the class \isa{eq} (by command \hyperlink{command.code-class}{\mbox{\isa{\isacommand{code{\isacharunderscore}class}}}}) and its operation
  12.493 +  \isa{eq{\isacharunderscore}class{\isachardot}eq}%
  12.494 +\end{isamarkuptext}%
  12.495 +\isamarkuptrue%
  12.496 +%
  12.497 +\isadelimquotett
  12.498 +%
  12.499 +\endisadelimquotett
  12.500 +%
  12.501 +\isatagquotett
  12.502 +\isacommand{code{\isacharunderscore}class}\isamarkupfalse%
  12.503 +\ eq\isanewline
  12.504 +\ \ {\isacharparenleft}Haskell\ {\isachardoublequoteopen}Eq{\isachardoublequoteclose}{\isacharparenright}\isanewline
  12.505 +\isanewline
  12.506 +\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  12.507 +\ {\isachardoublequoteopen}op\ {\isacharequal}{\isachardoublequoteclose}\isanewline
  12.508 +\ \ {\isacharparenleft}Haskell\ \isakeyword{infixl}\ {\isadigit{4}}\ {\isachardoublequoteopen}{\isacharequal}{\isacharequal}{\isachardoublequoteclose}{\isacharparenright}%
  12.509 +\endisatagquotett
  12.510 +{\isafoldquotett}%
  12.511 +%
  12.512 +\isadelimquotett
  12.513 +%
  12.514 +\endisadelimquotett
  12.515 +%
  12.516 +\begin{isamarkuptext}%
  12.517 +\noindent A problem now occurs whenever a type which
  12.518 +  is an instance of \isa{eq} in \isa{HOL} is mapped
  12.519 +  on a \isa{Haskell}-built-in type which is also an instance
  12.520 +  of \isa{Haskell} \isa{Eq}:%
  12.521 +\end{isamarkuptext}%
  12.522 +\isamarkuptrue%
  12.523 +%
  12.524 +\isadelimquote
  12.525 +%
  12.526 +\endisadelimquote
  12.527 +%
  12.528 +\isatagquote
  12.529 +\isacommand{typedecl}\isamarkupfalse%
  12.530 +\ bar\isanewline
  12.531 +\isanewline
  12.532 +\isacommand{instantiation}\isamarkupfalse%
  12.533 +\ bar\ {\isacharcolon}{\isacharcolon}\ eq\isanewline
  12.534 +\isakeyword{begin}\isanewline
  12.535 +\isanewline
  12.536 +\isacommand{definition}\isamarkupfalse%
  12.537 +\ {\isachardoublequoteopen}eq{\isacharunderscore}class{\isachardot}eq\ {\isacharparenleft}x{\isasymColon}bar{\isacharparenright}\ y\ {\isasymlongleftrightarrow}\ x\ {\isacharequal}\ y{\isachardoublequoteclose}\isanewline
  12.538 +\isanewline
  12.539 +\isacommand{instance}\isamarkupfalse%
  12.540 +\ \isacommand{by}\isamarkupfalse%
  12.541 +\ default\ {\isacharparenleft}simp\ add{\isacharcolon}\ eq{\isacharunderscore}bar{\isacharunderscore}def{\isacharparenright}\isanewline
  12.542 +\isanewline
  12.543 +\isacommand{end}\isamarkupfalse%
  12.544 +%
  12.545 +\endisatagquote
  12.546 +{\isafoldquote}%
  12.547 +%
  12.548 +\isadelimquote
  12.549 +%
  12.550 +\endisadelimquote
  12.551 +%
  12.552 +\isadelimquotett
  12.553 +\ %
  12.554 +\endisadelimquotett
  12.555 +%
  12.556 +\isatagquotett
  12.557 +\isacommand{code{\isacharunderscore}type}\isamarkupfalse%
  12.558 +\ bar\isanewline
  12.559 +\ \ {\isacharparenleft}Haskell\ {\isachardoublequoteopen}Integer{\isachardoublequoteclose}{\isacharparenright}%
  12.560 +\endisatagquotett
  12.561 +{\isafoldquotett}%
  12.562 +%
  12.563 +\isadelimquotett
  12.564 +%
  12.565 +\endisadelimquotett
  12.566 +%
  12.567 +\begin{isamarkuptext}%
  12.568 +\noindent The code generator would produce
  12.569 +  an additional instance, which of course is rejected by the \isa{Haskell}
  12.570 +  compiler.
  12.571 +  To suppress this additional instance, use
  12.572 +  \isa{code{\isacharunderscore}instance}:%
  12.573 +\end{isamarkuptext}%
  12.574 +\isamarkuptrue%
  12.575 +%
  12.576 +\isadelimquotett
  12.577 +%
  12.578 +\endisadelimquotett
  12.579 +%
  12.580 +\isatagquotett
  12.581 +\isacommand{code{\isacharunderscore}instance}\isamarkupfalse%
  12.582 +\ bar\ {\isacharcolon}{\isacharcolon}\ eq\isanewline
  12.583 +\ \ {\isacharparenleft}Haskell\ {\isacharminus}{\isacharparenright}%
  12.584 +\endisatagquotett
  12.585 +{\isafoldquotett}%
  12.586 +%
  12.587 +\isadelimquotett
  12.588 +%
  12.589 +\endisadelimquotett
  12.590 +%
  12.591 +\isamarkupsubsection{Enhancing the target language context \label{sec:include}%
  12.592 +}
  12.593 +\isamarkuptrue%
  12.594 +%
  12.595 +\begin{isamarkuptext}%
  12.596 +In rare cases it is necessary to \emph{enrich} the context of a
  12.597 +  target language;  this is accomplished using the \hyperlink{command.code-include}{\mbox{\isa{\isacommand{code{\isacharunderscore}include}}}}
  12.598 +  command:%
  12.599 +\end{isamarkuptext}%
  12.600 +\isamarkuptrue%
  12.601 +%
  12.602 +\isadelimquotett
  12.603 +%
  12.604 +\endisadelimquotett
  12.605 +%
  12.606 +\isatagquotett
  12.607 +\isacommand{code{\isacharunderscore}include}\isamarkupfalse%
  12.608 +\ Haskell\ {\isachardoublequoteopen}Errno{\isachardoublequoteclose}\isanewline
  12.609 +{\isacharverbatimopen}errno\ i\ {\isacharequal}\ error\ {\isacharparenleft}{\isachardoublequote}Error\ number{\isacharcolon}\ {\isachardoublequote}\ {\isacharplus}{\isacharplus}\ show\ i{\isacharparenright}{\isacharverbatimclose}\isanewline
  12.610 +\isanewline
  12.611 +\isacommand{code{\isacharunderscore}reserved}\isamarkupfalse%
  12.612 +\ Haskell\ Errno%
  12.613 +\endisatagquotett
  12.614 +{\isafoldquotett}%
  12.615 +%
  12.616 +\isadelimquotett
  12.617 +%
  12.618 +\endisadelimquotett
  12.619 +%
  12.620 +\begin{isamarkuptext}%
  12.621 +\noindent Such named \isa{include}s are then prepended to every generated code.
  12.622 +  Inspect such code in order to find out how \hyperlink{command.code-include}{\mbox{\isa{\isacommand{code{\isacharunderscore}include}}}} behaves
  12.623 +  with respect to a particular target language.%
  12.624 +\end{isamarkuptext}%
  12.625 +\isamarkuptrue%
  12.626 +%
  12.627 +\isadelimtheory
  12.628 +%
  12.629 +\endisadelimtheory
  12.630 +%
  12.631 +\isatagtheory
  12.632 +\isacommand{end}\isamarkupfalse%
  12.633 +%
  12.634 +\endisatagtheory
  12.635 +{\isafoldtheory}%
  12.636 +%
  12.637 +\isadelimtheory
  12.638 +%
  12.639 +\endisadelimtheory
  12.640 +\isanewline
  12.641 +\end{isabellebody}%
  12.642 +%%% Local Variables:
  12.643 +%%% mode: latex
  12.644 +%%% TeX-master: "root"
  12.645 +%%% End:
    13.1 --- a/doc-src/Codegen/Thy/document/Adaption.tex	Mon May 11 09:39:53 2009 +0200
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,642 +0,0 @@
    13.4 -%
    13.5 -\begin{isabellebody}%
    13.6 -\def\isabellecontext{Adaption}%
    13.7 -%
    13.8 -\isadelimtheory
    13.9 -%
   13.10 -\endisadelimtheory
   13.11 -%
   13.12 -\isatagtheory
   13.13 -\isacommand{theory}\isamarkupfalse%
   13.14 -\ Adaption\isanewline
   13.15 -\isakeyword{imports}\ Setup\isanewline
   13.16 -\isakeyword{begin}%
   13.17 -\endisatagtheory
   13.18 -{\isafoldtheory}%
   13.19 -%
   13.20 -\isadelimtheory
   13.21 -\isanewline
   13.22 -%
   13.23 -\endisadelimtheory
   13.24 -%
   13.25 -\isadeliminvisible
   13.26 -\isanewline
   13.27 -%
   13.28 -\endisadeliminvisible
   13.29 -%
   13.30 -\isataginvisible
   13.31 -\isacommand{setup}\isamarkupfalse%
   13.32 -\ {\isacharverbatimopen}\ Code{\isacharunderscore}Target{\isachardot}extend{\isacharunderscore}target\ {\isacharparenleft}{\isachardoublequote}{\isasymSML}{\isachardoublequote}{\isacharcomma}\ {\isacharparenleft}{\isachardoublequote}SML{\isachardoublequote}{\isacharcomma}\ K\ I{\isacharparenright}{\isacharparenright}\ {\isacharverbatimclose}%
   13.33 -\endisataginvisible
   13.34 -{\isafoldinvisible}%
   13.35 -%
   13.36 -\isadeliminvisible
   13.37 -%
   13.38 -\endisadeliminvisible
   13.39 -%
   13.40 -\isamarkupsection{Adaption to target languages \label{sec:adaption}%
   13.41 -}
   13.42 -\isamarkuptrue%
   13.43 -%
   13.44 -\isamarkupsubsection{Adapting code generation%
   13.45 -}
   13.46 -\isamarkuptrue%
   13.47 -%
   13.48 -\begin{isamarkuptext}%
   13.49 -The aspects of code generation introduced so far have two aspects
   13.50 -  in common:
   13.51 -
   13.52 -  \begin{itemize}
   13.53 -    \item They act uniformly, without reference to a specific
   13.54 -       target language.
   13.55 -    \item They are \emph{safe} in the sense that as long as you trust
   13.56 -       the code generator meta theory and implementation, you cannot
   13.57 -       produce programs that yield results which are not derivable
   13.58 -       in the logic.
   13.59 -  \end{itemize}
   13.60 -
   13.61 -  \noindent In this section we will introduce means to \emph{adapt} the serialiser
   13.62 -  to a specific target language, i.e.~to print program fragments
   13.63 -  in a way which accommodates \qt{already existing} ingredients of
   13.64 -  a target language environment, for three reasons:
   13.65 -
   13.66 -  \begin{itemize}
   13.67 -    \item improving readability and aesthetics of generated code
   13.68 -    \item gaining efficiency
   13.69 -    \item interface with language parts which have no direct counterpart
   13.70 -      in \isa{HOL} (say, imperative data structures)
   13.71 -  \end{itemize}
   13.72 -
   13.73 -  \noindent Generally, you should avoid using those features yourself
   13.74 -  \emph{at any cost}:
   13.75 -
   13.76 -  \begin{itemize}
   13.77 -    \item The safe configuration methods act uniformly on every target language,
   13.78 -      whereas for adaption you have to treat each target language separate.
   13.79 -    \item Application is extremely tedious since there is no abstraction
   13.80 -      which would allow for a static check, making it easy to produce garbage.
   13.81 -    \item More or less subtle errors can be introduced unconsciously.
   13.82 -  \end{itemize}
   13.83 -
   13.84 -  \noindent However, even if you ought refrain from setting up adaption
   13.85 -  yourself, already the \isa{HOL} comes with some reasonable default
   13.86 -  adaptions (say, using target language list syntax).  There also some
   13.87 -  common adaption cases which you can setup by importing particular
   13.88 -  library theories.  In order to understand these, we provide some clues here;
   13.89 -  these however are not supposed to replace a careful study of the sources.%
   13.90 -\end{isamarkuptext}%
   13.91 -\isamarkuptrue%
   13.92 -%
   13.93 -\isamarkupsubsection{The adaption principle%
   13.94 -}
   13.95 -\isamarkuptrue%
   13.96 -%
   13.97 -\begin{isamarkuptext}%
   13.98 -Figure \ref{fig:adaption} illustrates what \qt{adaption} is conceptually
   13.99 -  supposed to be:
  13.100 -
  13.101 -  \begin{figure}[here]
  13.102 -    \includegraphics{adaption}
  13.103 -    \caption{The adaption principle}
  13.104 -    \label{fig:adaption}
  13.105 -  \end{figure}
  13.106 -
  13.107 -  \noindent In the tame view, code generation acts as broker between
  13.108 -  \isa{logic}, \isa{intermediate\ language} and
  13.109 -  \isa{target\ language} by means of \isa{translation} and
  13.110 -  \isa{serialisation};  for the latter, the serialiser has to observe
  13.111 -  the structure of the \isa{language} itself plus some \isa{reserved}
  13.112 -  keywords which have to be avoided for generated code.
  13.113 -  However, if you consider \isa{adaption} mechanisms, the code generated
  13.114 -  by the serializer is just the tip of the iceberg:
  13.115 -
  13.116 -  \begin{itemize}
  13.117 -    \item \isa{serialisation} can be \emph{parametrised} such that
  13.118 -      logical entities are mapped to target-specific ones
  13.119 -      (e.g. target-specific list syntax,
  13.120 -        see also \secref{sec:adaption_mechanisms})
  13.121 -    \item Such parametrisations can involve references to a
  13.122 -      target-specific standard \isa{library} (e.g. using
  13.123 -      the \isa{Haskell} \verb|Maybe| type instead
  13.124 -      of the \isa{HOL} \isa{option} type);
  13.125 -      if such are used, the corresponding identifiers
  13.126 -      (in our example, \verb|Maybe|, \verb|Nothing|
  13.127 -      and \verb|Just|) also have to be considered \isa{reserved}.
  13.128 -    \item Even more, the user can enrich the library of the
  13.129 -      target-language by providing code snippets
  13.130 -      (\qt{\isa{includes}}) which are prepended to
  13.131 -      any generated code (see \secref{sec:include});  this typically
  13.132 -      also involves further \isa{reserved} identifiers.
  13.133 -  \end{itemize}
  13.134 -
  13.135 -  \noindent As figure \ref{fig:adaption} illustrates, all these adaption mechanisms
  13.136 -  have to act consistently;  it is at the discretion of the user
  13.137 -  to take care for this.%
  13.138 -\end{isamarkuptext}%
  13.139 -\isamarkuptrue%
  13.140 -%
  13.141 -\isamarkupsubsection{Common adaption patterns%
  13.142 -}
  13.143 -\isamarkuptrue%
  13.144 -%
  13.145 -\begin{isamarkuptext}%
  13.146 -The \hyperlink{theory.HOL}{\mbox{\isa{HOL}}} \hyperlink{theory.Main}{\mbox{\isa{Main}}} theory already provides a code
  13.147 -  generator setup
  13.148 -  which should be suitable for most applications.  Common extensions
  13.149 -  and modifications are available by certain theories of the \isa{HOL}
  13.150 -  library; beside being useful in applications, they may serve
  13.151 -  as a tutorial for customising the code generator setup (see below
  13.152 -  \secref{sec:adaption_mechanisms}).
  13.153 -
  13.154 -  \begin{description}
  13.155 -
  13.156 -    \item[\hyperlink{theory.Code-Integer}{\mbox{\isa{Code{\isacharunderscore}Integer}}}] represents \isa{HOL} integers by big
  13.157 -       integer literals in target languages.
  13.158 -    \item[\hyperlink{theory.Code-Char}{\mbox{\isa{Code{\isacharunderscore}Char}}}] represents \isa{HOL} characters by 
  13.159 -       character literals in target languages.
  13.160 -    \item[\hyperlink{theory.Code-Char-chr}{\mbox{\isa{Code{\isacharunderscore}Char{\isacharunderscore}chr}}}] like \isa{Code{\isacharunderscore}Char},
  13.161 -       but also offers treatment of character codes; includes
  13.162 -       \hyperlink{theory.Code-Char}{\mbox{\isa{Code{\isacharunderscore}Char}}}.
  13.163 -    \item[\hyperlink{theory.Efficient-Nat}{\mbox{\isa{Efficient{\isacharunderscore}Nat}}}] \label{eff_nat} implements natural numbers by integers,
  13.164 -       which in general will result in higher efficiency; pattern
  13.165 -       matching with \isa{{\isadigit{0}}} / \isa{Suc}
  13.166 -       is eliminated;  includes \hyperlink{theory.Code-Integer}{\mbox{\isa{Code{\isacharunderscore}Integer}}}
  13.167 -       and \hyperlink{theory.Code-Index}{\mbox{\isa{Code{\isacharunderscore}Index}}}.
  13.168 -    \item[\hyperlink{theory.Code-Index}{\mbox{\isa{Code{\isacharunderscore}Index}}}] provides an additional datatype
  13.169 -       \isa{index} which is mapped to target-language built-in integers.
  13.170 -       Useful for code setups which involve e.g. indexing of
  13.171 -       target-language arrays.
  13.172 -    \item[\hyperlink{theory.Code-Message}{\mbox{\isa{Code{\isacharunderscore}Message}}}] provides an additional datatype
  13.173 -       \isa{message{\isacharunderscore}string} which is isomorphic to strings;
  13.174 -       \isa{message{\isacharunderscore}string}s are mapped to target-language strings.
  13.175 -       Useful for code setups which involve e.g. printing (error) messages.
  13.176 -
  13.177 -  \end{description}
  13.178 -
  13.179 -  \begin{warn}
  13.180 -    When importing any of these theories, they should form the last
  13.181 -    items in an import list.  Since these theories adapt the
  13.182 -    code generator setup in a non-conservative fashion,
  13.183 -    strange effects may occur otherwise.
  13.184 -  \end{warn}%
  13.185 -\end{isamarkuptext}%
  13.186 -\isamarkuptrue%
  13.187 -%
  13.188 -\isamarkupsubsection{Parametrising serialisation \label{sec:adaption_mechanisms}%
  13.189 -}
  13.190 -\isamarkuptrue%
  13.191 -%
  13.192 -\begin{isamarkuptext}%
  13.193 -Consider the following function and its corresponding
  13.194 -  SML code:%
  13.195 -\end{isamarkuptext}%
  13.196 -\isamarkuptrue%
  13.197 -%
  13.198 -\isadelimquote
  13.199 -%
  13.200 -\endisadelimquote
  13.201 -%
  13.202 -\isatagquote
  13.203 -\isacommand{primrec}\isamarkupfalse%
  13.204 -\ in{\isacharunderscore}interval\ {\isacharcolon}{\isacharcolon}\ {\isachardoublequoteopen}nat\ {\isasymtimes}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\ \isakeyword{where}\isanewline
  13.205 -\ \ {\isachardoublequoteopen}in{\isacharunderscore}interval\ {\isacharparenleft}k{\isacharcomma}\ l{\isacharparenright}\ n\ {\isasymlongleftrightarrow}\ k\ {\isasymle}\ n\ {\isasymand}\ n\ {\isasymle}\ l{\isachardoublequoteclose}%
  13.206 -\endisatagquote
  13.207 -{\isafoldquote}%
  13.208 -%
  13.209 -\isadelimquote
  13.210 -%
  13.211 -\endisadelimquote
  13.212 -%
  13.213 -\isadeliminvisible
  13.214 -%
  13.215 -\endisadeliminvisible
  13.216 -%
  13.217 -\isataginvisible
  13.218 -%
  13.219 -\endisataginvisible
  13.220 -{\isafoldinvisible}%
  13.221 -%
  13.222 -\isadeliminvisible
  13.223 -%
  13.224 -\endisadeliminvisible
  13.225 -%
  13.226 -\isadelimquote
  13.227 -%
  13.228 -\endisadelimquote
  13.229 -%
  13.230 -\isatagquote
  13.231 -%
  13.232 -\begin{isamarkuptext}%
  13.233 -\isatypewriter%
  13.234 -\noindent%
  13.235 -\hspace*{0pt}structure Example = \\
  13.236 -\hspace*{0pt}struct\\
  13.237 -\hspace*{0pt}\\
  13.238 -\hspace*{0pt}datatype nat = Zero{\char95}nat | Suc of nat;\\
  13.239 -\hspace*{0pt}\\
  13.240 -\hspace*{0pt}datatype boola = True | False;\\
  13.241 -\hspace*{0pt}\\
  13.242 -\hspace*{0pt}fun anda x True = x\\
  13.243 -\hspace*{0pt} ~| anda x False = False\\
  13.244 -\hspace*{0pt} ~| anda True x = x\\
  13.245 -\hspace*{0pt} ~| anda False x = False;\\
  13.246 -\hspace*{0pt}\\
  13.247 -\hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
  13.248 -\hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = False\\
  13.249 -\hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
  13.250 -\hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = True;\\
  13.251 -\hspace*{0pt}\\
  13.252 -\hspace*{0pt}fun in{\char95}interval (k,~l) n = anda (less{\char95}eq{\char95}nat k n) (less{\char95}eq{\char95}nat n l);\\
  13.253 -\hspace*{0pt}\\
  13.254 -\hspace*{0pt}end;~(*struct Example*)%
  13.255 -\end{isamarkuptext}%
  13.256 -\isamarkuptrue%
  13.257 -%
  13.258 -\endisatagquote
  13.259 -{\isafoldquote}%
  13.260 -%
  13.261 -\isadelimquote
  13.262 -%
  13.263 -\endisadelimquote
  13.264 -%
  13.265 -\begin{isamarkuptext}%
  13.266 -\noindent Though this is correct code, it is a little bit unsatisfactory:
  13.267 -  boolean values and operators are materialised as distinguished
  13.268 -  entities with have nothing to do with the SML-built-in notion
  13.269 -  of \qt{bool}.  This results in less readable code;
  13.270 -  additionally, eager evaluation may cause programs to
  13.271 -  loop or break which would perfectly terminate when
  13.272 -  the existing SML \verb|bool| would be used.  To map
  13.273 -  the HOL \isa{bool} on SML \verb|bool|, we may use
  13.274 -  \qn{custom serialisations}:%
  13.275 -\end{isamarkuptext}%
  13.276 -\isamarkuptrue%
  13.277 -%
  13.278 -\isadelimquotett
  13.279 -%
  13.280 -\endisadelimquotett
  13.281 -%
  13.282 -\isatagquotett
  13.283 -\isacommand{code{\isacharunderscore}type}\isamarkupfalse%
  13.284 -\ bool\isanewline
  13.285 -\ \ {\isacharparenleft}SML\ {\isachardoublequoteopen}bool{\isachardoublequoteclose}{\isacharparenright}\isanewline
  13.286 -\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  13.287 -\ True\ \isakeyword{and}\ False\ \isakeyword{and}\ {\isachardoublequoteopen}op\ {\isasymand}{\isachardoublequoteclose}\isanewline
  13.288 -\ \ {\isacharparenleft}SML\ {\isachardoublequoteopen}true{\isachardoublequoteclose}\ \isakeyword{and}\ {\isachardoublequoteopen}false{\isachardoublequoteclose}\ \isakeyword{and}\ {\isachardoublequoteopen}{\isacharunderscore}\ andalso\ {\isacharunderscore}{\isachardoublequoteclose}{\isacharparenright}%
  13.289 -\endisatagquotett
  13.290 -{\isafoldquotett}%
  13.291 -%
  13.292 -\isadelimquotett
  13.293 -%
  13.294 -\endisadelimquotett
  13.295 -%
  13.296 -\begin{isamarkuptext}%
  13.297 -\noindent The \hyperlink{command.code-type}{\mbox{\isa{\isacommand{code{\isacharunderscore}type}}}} command takes a type constructor
  13.298 -  as arguments together with a list of custom serialisations.
  13.299 -  Each custom serialisation starts with a target language
  13.300 -  identifier followed by an expression, which during
  13.301 -  code serialisation is inserted whenever the type constructor
  13.302 -  would occur.  For constants, \hyperlink{command.code-const}{\mbox{\isa{\isacommand{code{\isacharunderscore}const}}}} implements
  13.303 -  the corresponding mechanism.  Each ``\verb|_|'' in
  13.304 -  a serialisation expression is treated as a placeholder
  13.305 -  for the type constructor's (the constant's) arguments.%
  13.306 -\end{isamarkuptext}%
  13.307 -\isamarkuptrue%
  13.308 -%
  13.309 -\isadelimquote
  13.310 -%
  13.311 -\endisadelimquote
  13.312 -%
  13.313 -\isatagquote
  13.314 -%
  13.315 -\begin{isamarkuptext}%
  13.316 -\isatypewriter%
  13.317 -\noindent%
  13.318 -\hspace*{0pt}structure Example = \\
  13.319 -\hspace*{0pt}struct\\
  13.320 -\hspace*{0pt}\\
  13.321 -\hspace*{0pt}datatype nat = Zero{\char95}nat | Suc of nat;\\
  13.322 -\hspace*{0pt}\\
  13.323 -\hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
  13.324 -\hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = false\\
  13.325 -\hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
  13.326 -\hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = true;\\
  13.327 -\hspace*{0pt}\\
  13.328 -\hspace*{0pt}fun in{\char95}interval (k,~l) n = (less{\char95}eq{\char95}nat k n) andalso (less{\char95}eq{\char95}nat n l);\\
  13.329 -\hspace*{0pt}\\
  13.330 -\hspace*{0pt}end;~(*struct Example*)%
  13.331 -\end{isamarkuptext}%
  13.332 -\isamarkuptrue%
  13.333 -%
  13.334 -\endisatagquote
  13.335 -{\isafoldquote}%
  13.336 -%
  13.337 -\isadelimquote
  13.338 -%
  13.339 -\endisadelimquote
  13.340 -%
  13.341 -\begin{isamarkuptext}%
  13.342 -\noindent This still is not perfect: the parentheses
  13.343 -  around the \qt{andalso} expression are superfluous.
  13.344 -  Though the serialiser
  13.345 -  by no means attempts to imitate the rich Isabelle syntax
  13.346 -  framework, it provides some common idioms, notably
  13.347 -  associative infixes with precedences which may be used here:%
  13.348 -\end{isamarkuptext}%
  13.349 -\isamarkuptrue%
  13.350 -%
  13.351 -\isadelimquotett
  13.352 -%
  13.353 -\endisadelimquotett
  13.354 -%
  13.355 -\isatagquotett
  13.356 -\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  13.357 -\ {\isachardoublequoteopen}op\ {\isasymand}{\isachardoublequoteclose}\isanewline
  13.358 -\ \ {\isacharparenleft}SML\ \isakeyword{infixl}\ {\isadigit{1}}\ {\isachardoublequoteopen}andalso{\isachardoublequoteclose}{\isacharparenright}%
  13.359 -\endisatagquotett
  13.360 -{\isafoldquotett}%
  13.361 -%
  13.362 -\isadelimquotett
  13.363 -%
  13.364 -\endisadelimquotett
  13.365 -%
  13.366 -\isadelimquote
  13.367 -%
  13.368 -\endisadelimquote
  13.369 -%
  13.370 -\isatagquote
  13.371 -%
  13.372 -\begin{isamarkuptext}%
  13.373 -\isatypewriter%
  13.374 -\noindent%
  13.375 -\hspace*{0pt}structure Example = \\
  13.376 -\hspace*{0pt}struct\\
  13.377 -\hspace*{0pt}\\
  13.378 -\hspace*{0pt}datatype nat = Zero{\char95}nat | Suc of nat;\\
  13.379 -\hspace*{0pt}\\
  13.380 -\hspace*{0pt}fun less{\char95}nat m (Suc n) = less{\char95}eq{\char95}nat m n\\
  13.381 -\hspace*{0pt} ~| less{\char95}nat n Zero{\char95}nat = false\\
  13.382 -\hspace*{0pt}and less{\char95}eq{\char95}nat (Suc m) n = less{\char95}nat m n\\
  13.383 -\hspace*{0pt} ~| less{\char95}eq{\char95}nat Zero{\char95}nat n = true;\\
  13.384 -\hspace*{0pt}\\
  13.385 -\hspace*{0pt}fun in{\char95}interval (k,~l) n = less{\char95}eq{\char95}nat k n andalso less{\char95}eq{\char95}nat n l;\\
  13.386 -\hspace*{0pt}\\
  13.387 -\hspace*{0pt}end;~(*struct Example*)%
  13.388 -\end{isamarkuptext}%
  13.389 -\isamarkuptrue%
  13.390 -%
  13.391 -\endisatagquote
  13.392 -{\isafoldquote}%
  13.393 -%
  13.394 -\isadelimquote
  13.395 -%
  13.396 -\endisadelimquote
  13.397 -%
  13.398 -\begin{isamarkuptext}%
  13.399 -\noindent The attentive reader may ask how we assert that no generated
  13.400 -  code will accidentally overwrite.  For this reason the serialiser has
  13.401 -  an internal table of identifiers which have to be avoided to be used
  13.402 -  for new declarations.  Initially, this table typically contains the
  13.403 -  keywords of the target language.  It can be extended manually, thus avoiding
  13.404 -  accidental overwrites, using the \hyperlink{command.code-reserved}{\mbox{\isa{\isacommand{code{\isacharunderscore}reserved}}}} command:%
  13.405 -\end{isamarkuptext}%
  13.406 -\isamarkuptrue%
  13.407 -%
  13.408 -\isadelimquote
  13.409 -%
  13.410 -\endisadelimquote
  13.411 -%
  13.412 -\isatagquote
  13.413 -\isacommand{code{\isacharunderscore}reserved}\isamarkupfalse%
  13.414 -\ {\isachardoublequoteopen}{\isasymSML}{\isachardoublequoteclose}\ bool\ true\ false\ andalso%
  13.415 -\endisatagquote
  13.416 -{\isafoldquote}%
  13.417 -%
  13.418 -\isadelimquote
  13.419 -%
  13.420 -\endisadelimquote
  13.421 -%
  13.422 -\begin{isamarkuptext}%
  13.423 -\noindent Next, we try to map HOL pairs to SML pairs, using the
  13.424 -  infix ``\verb|*|'' type constructor and parentheses:%
  13.425 -\end{isamarkuptext}%
  13.426 -\isamarkuptrue%
  13.427 -%
  13.428 -\isadeliminvisible
  13.429 -%
  13.430 -\endisadeliminvisible
  13.431 -%
  13.432 -\isataginvisible
  13.433 -%
  13.434 -\endisataginvisible
  13.435 -{\isafoldinvisible}%
  13.436 -%
  13.437 -\isadeliminvisible
  13.438 -%
  13.439 -\endisadeliminvisible
  13.440 -%
  13.441 -\isadelimquotett
  13.442 -%
  13.443 -\endisadelimquotett
  13.444 -%
  13.445 -\isatagquotett
  13.446 -\isacommand{code{\isacharunderscore}type}\isamarkupfalse%
  13.447 -\ {\isacharasterisk}\isanewline
  13.448 -\ \ {\isacharparenleft}SML\ \isakeyword{infix}\ {\isadigit{2}}\ {\isachardoublequoteopen}{\isacharasterisk}{\isachardoublequoteclose}{\isacharparenright}\isanewline
  13.449 -\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  13.450 -\ Pair\isanewline
  13.451 -\ \ {\isacharparenleft}SML\ {\isachardoublequoteopen}{\isacharbang}{\isacharparenleft}{\isacharparenleft}{\isacharunderscore}{\isacharparenright}{\isacharcomma}{\isacharslash}\ {\isacharparenleft}{\isacharunderscore}{\isacharparenright}{\isacharparenright}{\isachardoublequoteclose}{\isacharparenright}%
  13.452 -\endisatagquotett
  13.453 -{\isafoldquotett}%
  13.454 -%
  13.455 -\isadelimquotett
  13.456 -%
  13.457 -\endisadelimquotett
  13.458 -%
  13.459 -\begin{isamarkuptext}%
  13.460 -\noindent The initial bang ``\verb|!|'' tells the serialiser
  13.461 -  never to put
  13.462 -  parentheses around the whole expression (they are already present),
  13.463 -  while the parentheses around argument place holders
  13.464 -  tell not to put parentheses around the arguments.
  13.465 -  The slash ``\verb|/|'' (followed by arbitrary white space)
  13.466 -  inserts a space which may be used as a break if necessary
  13.467 -  during pretty printing.
  13.468 -
  13.469 -  These examples give a glimpse what mechanisms
  13.470 -  custom serialisations provide; however their usage
  13.471 -  requires careful thinking in order not to introduce
  13.472 -  inconsistencies -- or, in other words:
  13.473 -  custom serialisations are completely axiomatic.
  13.474 -
  13.475 -  A further noteworthy details is that any special
  13.476 -  character in a custom serialisation may be quoted
  13.477 -  using ``\verb|'|''; thus, in
  13.478 -  ``\verb|fn '_ => _|'' the first
  13.479 -  ``\verb|_|'' is a proper underscore while the
  13.480 -  second ``\verb|_|'' is a placeholder.%
  13.481 -\end{isamarkuptext}%
  13.482 -\isamarkuptrue%
  13.483 -%
  13.484 -\isamarkupsubsection{\isa{Haskell} serialisation%
  13.485 -}
  13.486 -\isamarkuptrue%
  13.487 -%
  13.488 -\begin{isamarkuptext}%
  13.489 -For convenience, the default
  13.490 -  \isa{HOL} setup for \isa{Haskell} maps the \isa{eq} class to
  13.491 -  its counterpart in \isa{Haskell}, giving custom serialisations
  13.492 -  for the class \isa{eq} (by command \hyperlink{command.code-class}{\mbox{\isa{\isacommand{code{\isacharunderscore}class}}}}) and its operation
  13.493 -  \isa{eq{\isacharunderscore}class{\isachardot}eq}%
  13.494 -\end{isamarkuptext}%
  13.495 -\isamarkuptrue%
  13.496 -%
  13.497 -\isadelimquotett
  13.498 -%
  13.499 -\endisadelimquotett
  13.500 -%
  13.501 -\isatagquotett
  13.502 -\isacommand{code{\isacharunderscore}class}\isamarkupfalse%
  13.503 -\ eq\isanewline
  13.504 -\ \ {\isacharparenleft}Haskell\ {\isachardoublequoteopen}Eq{\isachardoublequoteclose}{\isacharparenright}\isanewline
  13.505 -\isanewline
  13.506 -\isacommand{code{\isacharunderscore}const}\isamarkupfalse%
  13.507 -\ {\isachardoublequoteopen}op\ {\isacharequal}{\isachardoublequoteclose}\isanewline
  13.508 -\ \ {\isacharparenleft}Haskell\ \isakeyword{infixl}\ {\isadigit{4}}\ {\isachardoublequoteopen}{\isacharequal}{\isacharequal}{\isachardoublequoteclose}{\isacharparenright}%
  13.509 -\endisatagquotett
  13.510 -{\isafoldquotett}%
  13.511 -%
  13.512 -\isadelimquotett
  13.513 -%
  13.514 -\endisadelimquotett
  13.515 -%
  13.516 -\begin{isamarkuptext}%
  13.517 -\noindent A problem now occurs whenever a type which
  13.518 -  is an instance of \isa{eq} in \isa{HOL} is mapped
  13.519 -  on a \isa{Haskell}-built-in type which is also an instance
  13.520 -  of \isa{Haskell} \isa{Eq}:%
  13.521 -\end{isamarkuptext}%
  13.522 -\isamarkuptrue%
  13.523 -%
  13.524 -\isadelimquote
  13.525 -%
  13.526 -\endisadelimquote
  13.527 -%
  13.528 -\isatagquote
  13.529 -\isacommand{typedecl}\isamarkupfalse%
  13.530 -\ bar\isanewline
  13.531 -\isanewline
  13.532 -\isacommand{instantiation}\isamarkupfalse%
  13.533 -\ bar\ {\isacharcolon}{\isacharcolon}\ eq\isanewline
  13.534 -\isakeyword{begin}\isanewline
  13.535 -\isanewline
  13.536 -\isacommand{definition}\isamarkupfalse%
  13.537 -\ {\isachardoublequoteopen}eq{\isacharunderscore}class{\isachardot}eq\ {\isacharparenleft}x{\isasymColon}bar{\isacharparenright}\ y\ {\isasymlongleftrightarrow}\ x\ {\isacharequal}\ y{\isachardoublequoteclose}\isanewline
  13.538 -\isanewline
  13.539 -\isacommand{instance}\isamarkupfalse%
  13.540 -\ \isacommand{by}\isamarkupfalse%
  13.541 -\ default\ {\isacharparenleft}simp\ add{\isacharcolon}\ eq{\isacharunderscore}bar{\isacharunderscore}def{\isacharparenright}\isanewline
  13.542 -\isanewline
  13.543 -\isacommand{end}\isamarkupfalse%
  13.544 -%
  13.545 -\endisatagquote
  13.546 -{\isafoldquote}%
  13.547 -%
  13.548 -\isadelimquote
  13.549 -%
  13.550 -\endisadelimquote
  13.551 -%
  13.552 -\isadelimquotett
  13.553 -\ %
  13.554 -\endisadelimquotett
  13.555 -%
  13.556 -\isatagquotett
  13.557 -\isacommand{code{\isacharunderscore}type}\isamarkupfalse%
  13.558 -\ bar\isanewline
  13.559 -\ \ {\isacharparenleft}Haskell\ {\isachardoublequoteopen}Integer{\isachardoublequoteclose}{\isacharparenright}%
  13.560 -\endisatagquotett
  13.561 -{\isafoldquotett}%
  13.562 -%
  13.563 -\isadelimquotett
  13.564 -%
  13.565 -\endisadelimquotett
  13.566 -%
  13.567 -\begin{isamarkuptext}%
  13.568 -\noindent The code generator would produce
  13.569 -  an additional instance, which of course is rejected by the \isa{Haskell}
  13.570 -  compiler.
  13.571 -  To suppress this additional instance, use
  13.572 -  \isa{code{\isacharunderscore}instance}:%
  13.573 -\end{isamarkuptext}%
  13.574 -\isamarkuptrue%
  13.575 -%
  13.576 -\isadelimquotett
  13.577 -%
  13.578 -\endisadelimquotett
  13.579 -%
  13.580 -\isatagquotett
  13.581 -\isacommand{code{\isacharunderscore}instance}\isamarkupfalse%
  13.582 -\ bar\ {\isacharcolon}{\isacharcolon}\ eq\isanewline
  13.583 -\ \ {\isacharparenleft}Haskell\ {\isacharminus}{\isacharparenright}%
  13.584 -\endisatagquotett
  13.585 -{\isafoldquotett}%
  13.586 -%
  13.587 -\isadelimquotett
  13.588 -%
  13.589 -\endisadelimquotett
  13.590 -%
  13.591 -\isamarkupsubsection{Enhancing the target language context \label{sec:include}%
  13.592 -}
  13.593 -\isamarkuptrue%
  13.594 -%
  13.595 -\begin{isamarkuptext}%
  13.596 -In rare cases it is necessary to \emph{enrich} the context of a
  13.597 -  target language;  this is accomplished using the \hyperlink{command.code-include}{\mbox{\isa{\isacommand{code{\isacharunderscore}include}}}}
  13.598 -  command:%
  13.599 -\end{isamarkuptext}%
  13.600 -\isamarkuptrue%
  13.601 -%
  13.602 -\isadelimquotett
  13.603 -%
  13.604 -\endisadelimquotett
  13.605 -%
  13.606 -\isatagquotett
  13.607 -\isacommand{code{\isacharunderscore}include}\isamarkupfalse%
  13.608 -\ Haskell\ {\isachardoublequoteopen}Errno{\isachardoublequoteclose}\isanewline
  13.609 -{\isacharverbatimopen}errno\ i\ {\isacharequal}\ error\ {\isacharparenleft}{\isachardoublequote}Error\ number{\isacharcolon}\ {\isachardoublequote}\ {\isacharplus}{\isacharplus}\ show\ i{\isacharparenright}{\isacharverbatimclose}\isanewline
  13.610 -\isanewline
  13.611 -\isacommand{code{\isacharunderscore}reserved}\isamarkupfalse%
  13.612 -\ Haskell\ Errno%
  13.613 -\endisatagquotett
  13.614 -{\isafoldquotett}%
  13.615 -%
  13.616 -\isadelimquotett
  13.617 -%
  13.618 -\endisadelimquotett
  13.619 -%
  13.620 -\begin{isamarkuptext}%
  13.621 -\noindent Such named \isa{include}s are then prepended to every generated code.
  13.622 -  Inspect such code in order to find out how \hyperlink{command.code-include}{\mbox{\isa{\isacommand{code{\isacharunderscore}include}}}} behaves
  13.623 -  with respect to a particular target language.%
  13.624 -\end{isamarkuptext}%
  13.625 -\isamarkuptrue%
  13.626 -%
  13.627 -\isadelimtheory
  13.628 -%
  13.629 -\endisadelimtheory
  13.630 -%
  13.631 -\isatagtheory
  13.632 -\isacommand{end}\isamarkupfalse%
  13.633 -%
  13.634 -\endisatagtheory
  13.635 -{\isafoldtheory}%
  13.636 -%
  13.637 -\isadelimtheory
  13.638 -%
  13.639 -\endisadelimtheory
  13.640 -\isanewline
  13.641 -\end{isabellebody}%
  13.642 -%%% Local Variables:
  13.643 -%%% mode: latex
  13.644 -%%% TeX-master: "root"
  13.645 -%%% End:
    14.1 --- a/doc-src/Codegen/Thy/document/Further.tex	Mon May 11 09:39:53 2009 +0200
    14.2 +++ b/doc-src/Codegen/Thy/document/Further.tex	Mon May 11 17:20:52 2009 +0200
    14.3 @@ -132,7 +132,7 @@
    14.4  \begin{isamarkuptext}%
    14.5  \noindent The soundness of the \hyperlink{method.eval}{\mbox{\isa{eval}}} method depends crucially 
    14.6    on the correctness of the code generator;  this is one of the reasons
    14.7 -  why you should not use adaption (see \secref{sec:adaption}) frivolously.%
    14.8 +  why you should not use adaptation (see \secref{sec:adaptation}) frivolously.%
    14.9  \end{isamarkuptext}%
   14.10  \isamarkuptrue%
   14.11  %
    15.1 --- a/doc-src/Codegen/Thy/document/Introduction.tex	Mon May 11 09:39:53 2009 +0200
    15.2 +++ b/doc-src/Codegen/Thy/document/Introduction.tex	Mon May 11 17:20:52 2009 +0200
    15.3 @@ -46,8 +46,8 @@
    15.4    This manifests in the structure of this tutorial: after a short
    15.5    conceptual introduction with an example (\secref{sec:intro}),
    15.6    we discuss the generic customisation facilities (\secref{sec:program}).
    15.7 -  A further section (\secref{sec:adaption}) is dedicated to the matter of
    15.8 -  \qn{adaption} to specific target language environments.  After some
    15.9 +  A further section (\secref{sec:adaptation}) is dedicated to the matter of
   15.10 +  \qn{adaptation} to specific target language environments.  After some
   15.11    further issues (\secref{sec:further}) we conclude with an overview
   15.12    of some ML programming interfaces (\secref{sec:ml}).
   15.13  
   15.14 @@ -229,7 +229,7 @@
   15.15  \hspace*{0pt}module Example where {\char123}\\
   15.16  \hspace*{0pt}\\
   15.17  \hspace*{0pt}\\
   15.18 -\hspace*{0pt}foldla ::~forall a b.~(a -> b -> a) -> a -> [b] -> a;\\
   15.19 +\hspace*{0pt}foldla ::~forall a{\char95}1 b{\char95}1.~(a{\char95}1 -> b{\char95}1 -> a{\char95}1) -> a{\char95}1 -> [b{\char95}1] -> a{\char95}1;\\
   15.20  \hspace*{0pt}foldla f a [] = a;\\
   15.21  \hspace*{0pt}foldla f a (x :~xs) = foldla f (f a x) xs;\\
   15.22  \hspace*{0pt}\\
    16.1 --- a/doc-src/Codegen/Thy/document/Program.tex	Mon May 11 09:39:53 2009 +0200
    16.2 +++ b/doc-src/Codegen/Thy/document/Program.tex	Mon May 11 17:20:52 2009 +0200
    16.3 @@ -714,7 +714,7 @@
    16.4  \end{isamarkuptext}%
    16.5  \isamarkuptrue%
    16.6  %
    16.7 -\isamarkupsubsection{Equality and wellsortedness%
    16.8 +\isamarkupsubsection{Equality%
    16.9  }
   16.10  \isamarkuptrue%
   16.11  %
   16.12 @@ -766,10 +766,10 @@
   16.13  \hspace*{0pt}type 'a eq = {\char123}eq :~'a -> 'a -> bool{\char125};\\
   16.14  \hspace*{0pt}fun eq (A{\char95}:'a eq) = {\char35}eq A{\char95};\\
   16.15  \hspace*{0pt}\\
   16.16 -\hspace*{0pt}fun eqop A{\char95}~a b = eq A{\char95}~a b;\\
   16.17 +\hspace*{0pt}fun eqa A{\char95}~a b = eq A{\char95}~a b;\\
   16.18  \hspace*{0pt}\\
   16.19  \hspace*{0pt}fun member A{\char95}~x [] = false\\
   16.20 -\hspace*{0pt} ~| member A{\char95}~x (y ::~ys) = eqop A{\char95}~x y orelse member A{\char95}~x ys;\\
   16.21 +\hspace*{0pt} ~| member A{\char95}~x (y ::~ys) = eqa A{\char95}~x y orelse member A{\char95}~x ys;\\
   16.22  \hspace*{0pt}\\
   16.23  \hspace*{0pt}fun collect{\char95}duplicates A{\char95}~xs ys [] = xs\\
   16.24  \hspace*{0pt} ~| collect{\char95}duplicates A{\char95}~xs ys (z ::~zs) =\\
   16.25 @@ -801,141 +801,7 @@
   16.26    manually like any other type class.
   16.27  
   16.28    Though this \isa{eq} class is designed to get rarely in
   16.29 -  the way, a subtlety
   16.30 -  enters the stage when definitions of overloaded constants
   16.31 -  are dependent on operational equality.  For example, let
   16.32 -  us define a lexicographic ordering on tuples
   16.33 -  (also see theory \hyperlink{theory.Product-ord}{\mbox{\isa{Product{\isacharunderscore}ord}}}):%
   16.34 -\end{isamarkuptext}%
   16.35 -\isamarkuptrue%
   16.36 -%
   16.37 -\isadelimquote
   16.38 -%
   16.39 -\endisadelimquote
   16.40 -%
   16.41 -\isatagquote
   16.42 -\isacommand{instantiation}\isamarkupfalse%
   16.43 -\ {\isachardoublequoteopen}{\isacharasterisk}{\isachardoublequoteclose}\ {\isacharcolon}{\isacharcolon}\ {\isacharparenleft}order{\isacharcomma}\ order{\isacharparenright}\ order\isanewline
   16.44 -\isakeyword{begin}\isanewline
   16.45 -\isanewline
   16.46 -\isacommand{definition}\isamarkupfalse%
   16.47 -\ {\isacharbrackleft}code\ del{\isacharbrackright}{\isacharcolon}\isanewline
   16.48 -\ \ {\isachardoublequoteopen}x\ {\isasymle}\ y\ {\isasymlongleftrightarrow}\ fst\ x\ {\isacharless}\ fst\ y\ {\isasymor}\ fst\ x\ {\isacharequal}\ fst\ y\ {\isasymand}\ snd\ x\ {\isasymle}\ snd\ y{\isachardoublequoteclose}\isanewline
   16.49 -\isanewline
   16.50 -\isacommand{definition}\isamarkupfalse%
   16.51 -\ {\isacharbrackleft}code\ del{\isacharbrackright}{\isacharcolon}\isanewline
   16.52 -\ \ {\isachardoublequoteopen}x\ {\isacharless}\ y\ {\isasymlongleftrightarrow}\ fst\ x\ {\isacharless}\ fst\ y\ {\isasymor}\ fst\ x\ {\isacharequal}\ fst\ y\ {\isasymand}\ snd\ x\ {\isacharless}\ snd\ y{\isachardoublequoteclose}\isanewline
   16.53 -\isanewline
   16.54 -\isacommand{instance}\isamarkupfalse%
   16.55 -\ \isacommand{proof}\isamarkupfalse%
   16.56 -\isanewline
   16.57 -\isacommand{qed}\isamarkupfalse%
   16.58 -\ {\isacharparenleft}auto\ simp{\isacharcolon}\ less{\isacharunderscore}eq{\isacharunderscore}prod{\isacharunderscore}def\ less{\isacharunderscore}prod{\isacharunderscore}def\ intro{\isacharcolon}\ order{\isacharunderscore}less{\isacharunderscore}trans{\isacharparenright}\isanewline
   16.59 -\isanewline
   16.60 -\isacommand{end}\isamarkupfalse%
   16.61 -\isanewline
   16.62 -\isanewline
   16.63 -\isacommand{lemma}\isamarkupfalse%
   16.64 -\ order{\isacharunderscore}prod\ {\isacharbrackleft}code{\isacharbrackright}{\isacharcolon}\isanewline
   16.65 -\ \ {\isachardoublequoteopen}{\isacharparenleft}x{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}a{\isasymColon}order{\isacharcomma}\ y{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}b{\isasymColon}order{\isacharparenright}\ {\isacharless}\ {\isacharparenleft}x{\isadigit{2}}{\isacharcomma}\ y{\isadigit{2}}{\isacharparenright}\ {\isasymlongleftrightarrow}\isanewline
   16.66 -\ \ \ \ \ x{\isadigit{1}}\ {\isacharless}\ x{\isadigit{2}}\ {\isasymor}\ x{\isadigit{1}}\ {\isacharequal}\ x{\isadigit{2}}\ {\isasymand}\ y{\isadigit{1}}\ {\isacharless}\ y{\isadigit{2}}{\isachardoublequoteclose}\isanewline
   16.67 -\ \ {\isachardoublequoteopen}{\isacharparenleft}x{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}a{\isasymColon}order{\isacharcomma}\ y{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}b{\isasymColon}order{\isacharparenright}\ {\isasymle}\ {\isacharparenleft}x{\isadigit{2}}{\isacharcomma}\ y{\isadigit{2}}{\isacharparenright}\ {\isasymlongleftrightarrow}\isanewline
   16.68 -\ \ \ \ \ x{\isadigit{1}}\ {\isacharless}\ x{\isadigit{2}}\ {\isasymor}\ x{\isadigit{1}}\ {\isacharequal}\ x{\isadigit{2}}\ {\isasymand}\ y{\isadigit{1}}\ {\isasymle}\ y{\isadigit{2}}{\isachardoublequoteclose}\isanewline
   16.69 -\ \ \isacommand{by}\isamarkupfalse%
   16.70 -\ {\isacharparenleft}simp{\isacharunderscore}all\ add{\isacharcolon}\ less{\isacharunderscore}prod{\isacharunderscore}def\ less{\isacharunderscore}eq{\isacharunderscore}prod{\isacharunderscore}def{\isacharparenright}%
   16.71 -\endisatagquote
   16.72 -{\isafoldquote}%
   16.73 -%
   16.74 -\isadelimquote
   16.75 -%
   16.76 -\endisadelimquote
   16.77 -%
   16.78 -\begin{isamarkuptext}%
   16.79 -\noindent Then code generation will fail.  Why?  The definition
   16.80 -  of \isa{op\ {\isasymle}} depends on equality on both arguments,
   16.81 -  which are polymorphic and impose an additional \isa{eq}
   16.82 -  class constraint, which the preprocessor does not propagate
   16.83 -  (for technical reasons).
   16.84 -
   16.85 -  The solution is to add \isa{eq} explicitly to the first sort arguments in the
   16.86 -  code theorems:%
   16.87 -\end{isamarkuptext}%
   16.88 -\isamarkuptrue%
   16.89 -%
   16.90 -\isadelimquote
   16.91 -%
   16.92 -\endisadelimquote
   16.93 -%
   16.94 -\isatagquote
   16.95 -\isacommand{lemma}\isamarkupfalse%
   16.96 -\ order{\isacharunderscore}prod{\isacharunderscore}code\ {\isacharbrackleft}code{\isacharbrackright}{\isacharcolon}\isanewline
   16.97 -\ \ {\isachardoublequoteopen}{\isacharparenleft}x{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}a{\isasymColon}{\isacharbraceleft}order{\isacharcomma}\ eq{\isacharbraceright}{\isacharcomma}\ y{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}b{\isasymColon}order{\isacharparenright}\ {\isacharless}\ {\isacharparenleft}x{\isadigit{2}}{\isacharcomma}\ y{\isadigit{2}}{\isacharparenright}\ {\isasymlongleftrightarrow}\isanewline
   16.98 -\ \ \ \ \ x{\isadigit{1}}\ {\isacharless}\ x{\isadigit{2}}\ {\isasymor}\ x{\isadigit{1}}\ {\isacharequal}\ x{\isadigit{2}}\ {\isasymand}\ y{\isadigit{1}}\ {\isacharless}\ y{\isadigit{2}}{\isachardoublequoteclose}\isanewline
   16.99 -\ \ {\isachardoublequoteopen}{\isacharparenleft}x{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}a{\isasymColon}{\isacharbraceleft}order{\isacharcomma}\ eq{\isacharbraceright}{\isacharcomma}\ y{\isadigit{1}}\ {\isasymColon}\ {\isacharprime}b{\isasymColon}order{\isacharparenright}\ {\isasymle}\ {\isacharparenleft}x{\isadigit{2}}{\isacharcomma}\ y{\isadigit{2}}{\isacharparenright}\ {\isasymlongleftrightarrow}\isanewline
  16.100 -\ \ \ \ \ x{\isadigit{1}}\ {\isacharless}\ x{\isadigit{2}}\ {\isasymor}\ x{\isadigit{1}}\ {\isacharequal}\ x{\isadigit{2}}\ {\isasymand}\ y{\isadigit{1}}\ {\isasymle}\ y{\isadigit{2}}{\isachardoublequoteclose}\isanewline
  16.101 -\ \ \isacommand{by}\isamarkupfalse%
  16.102 -\ {\isacharparenleft}simp{\isacharunderscore}all\ add{\isacharcolon}\ less{\isacharunderscore}prod{\isacharunderscore}def\ less{\isacharunderscore}eq{\isacharunderscore}prod{\isacharunderscore}def{\isacharparenright}%
  16.103 -\endisatagquote
  16.104 -{\isafoldquote}%
  16.105 -%
  16.106 -\isadelimquote
  16.107 -%
  16.108 -\endisadelimquote
  16.109 -%
  16.110 -\begin{isamarkuptext}%
  16.111 -\noindent Then code generation succeeds:%
  16.112 -\end{isamarkuptext}%
  16.113 -\isamarkuptrue%
  16.114 -%
  16.115 -\isadelimquote
  16.116 -%
  16.117 -\endisadelimquote
  16.118 -%
  16.119 -\isatagquote
  16.120 -%
  16.121 -\begin{isamarkuptext}%
  16.122 -\isatypewriter%
  16.123 -\noindent%
  16.124 -\hspace*{0pt}structure Example = \\
  16.125 -\hspace*{0pt}struct\\
  16.126 -\hspace*{0pt}\\
  16.127 -\hspace*{0pt}type 'a eq = {\char123}eq :~'a -> 'a -> bool{\char125};\\
  16.128 -\hspace*{0pt}fun eq (A{\char95}:'a eq) = {\char35}eq A{\char95};\\
  16.129 -\hspace*{0pt}\\
  16.130 -\hspace*{0pt}type 'a ord = {\char123}less{\char95}eq :~'a -> 'a -> bool,~less :~'a -> 'a -> bool{\char125};\\
  16.131 -\hspace*{0pt}fun less{\char95}eq (A{\char95}:'a ord) = {\char35}less{\char95}eq A{\char95};\\
  16.132 -\hspace*{0pt}fun less (A{\char95}:'a ord) = {\char35}less A{\char95};\\
  16.133 -\hspace*{0pt}\\
  16.134 -\hspace*{0pt}fun eqop A{\char95}~a b = eq A{\char95}~a b;\\
  16.135 -\hspace*{0pt}\\
  16.136 -\hspace*{0pt}type 'a preorder = {\char123}Orderings{\char95}{\char95}ord{\char95}preorder :~'a ord{\char125};\\
  16.137 -\hspace*{0pt}fun ord{\char95}preorder (A{\char95}:'a preorder) = {\char35}Orderings{\char95}{\char95}ord{\char95}preorder A{\char95};\\
  16.138 -\hspace*{0pt}\\
  16.139 -\hspace*{0pt}type 'a order = {\char123}Orderings{\char95}{\char95}preorder{\char95}order :~'a preorder{\char125};\\
  16.140 -\hspace*{0pt}fun preorder{\char95}order (A{\char95}:'a order) = {\char35}Orderings{\char95}{\char95}preorder{\char95}order A{\char95};\\
  16.141 -\hspace*{0pt}\\
  16.142 -\hspace*{0pt}fun less{\char95}eqa (A1{\char95},~A2{\char95}) B{\char95}~(x1,~y1) (x2,~y2) =\\
  16.143 -\hspace*{0pt} ~less ((ord{\char95}preorder o preorder{\char95}order) A2{\char95}) x1 x2 orelse\\
  16.144 -\hspace*{0pt} ~~~eqop A1{\char95}~x1 x2 andalso\\
  16.145 -\hspace*{0pt} ~~~~~less{\char95}eq ((ord{\char95}preorder o preorder{\char95}order) B{\char95}) y1 y2\\
  16.146 -\hspace*{0pt} ~| less{\char95}eqa (A1{\char95},~A2{\char95}) B{\char95}~(x1,~y1) (x2,~y2) =\\
  16.147 -\hspace*{0pt} ~~~less ((ord{\char95}preorder o preorder{\char95}order) A2{\char95}) x1 x2 orelse\\
  16.148 -\hspace*{0pt} ~~~~~eqop A1{\char95}~x1 x2 andalso\\
  16.149 -\hspace*{0pt} ~~~~~~~less{\char95}eq ((ord{\char95}preorder o preorder{\char95}order) B{\char95}) y1 y2;\\
  16.150 -\hspace*{0pt}\\
  16.151 -\hspace*{0pt}end;~(*struct Example*)%
  16.152 -\end{isamarkuptext}%
  16.153 -\isamarkuptrue%
  16.154 -%
  16.155 -\endisatagquote
  16.156 -{\isafoldquote}%
  16.157 -%
  16.158 -\isadelimquote
  16.159 -%
  16.160 -\endisadelimquote
  16.161 -%
  16.162 -\begin{isamarkuptext}%
  16.163 -In some cases, the automatically derived code equations
  16.164 +  the way, in some cases the automatically derived code equations
  16.165    for equality on a particular type may not be appropriate.
  16.166    As example, watch the following datatype representing
  16.167    monomorphic parametric types (where type constructors
    17.1 --- a/doc-src/Codegen/Thy/examples/Example.hs	Mon May 11 09:39:53 2009 +0200
    17.2 +++ b/doc-src/Codegen/Thy/examples/Example.hs	Mon May 11 17:20:52 2009 +0200
    17.3 @@ -3,7 +3,7 @@
    17.4  module Example where {
    17.5  
    17.6  
    17.7 -foldla :: forall a b. (a -> b -> a) -> a -> [b] -> a;
    17.8 +foldla :: forall a_1 b_1. (a_1 -> b_1 -> a_1) -> a_1 -> [b_1] -> a_1;
    17.9  foldla f a [] = a;
   17.10  foldla f a (x : xs) = foldla f (f a x) xs;
   17.11  
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/doc-src/Codegen/Thy/pictures/adaptation.tex	Mon May 11 17:20:52 2009 +0200
    18.3 @@ -0,0 +1,52 @@
    18.4 +
    18.5 +\documentclass[12pt]{article}
    18.6 +\usepackage{tikz}
    18.7 +
    18.8 +\begin{document}
    18.9 +
   18.10 +\thispagestyle{empty}
   18.11 +\setlength{\fboxrule}{0.01pt}
   18.12 +\setlength{\fboxsep}{4pt}
   18.13 +
   18.14 +\fcolorbox{white}{white}{
   18.15 +
   18.16 +\begin{tikzpicture}[scale = 0.5]
   18.17 +  \tikzstyle water=[color = blue, thick]
   18.18 +  \tikzstyle ice=[color = black, very thick, cap = round, join = round, fill = white]
   18.19 +  \tikzstyle process=[color = green, semithick, ->]
   18.20 +  \tikzstyle adaptation=[color = red, semithick, ->]
   18.21 +  \tikzstyle target=[color = black]
   18.22 +  \foreach \x in {0, ..., 24}
   18.23 +    \draw[style=water] (\x, 0.25) sin + (0.25, 0.25) cos + (0.25, -0.25) sin
   18.24 +      + (0.25, -0.25) cos + (0.25, 0.25);
   18.25 +  \draw[style=ice] (1, 0) --
   18.26 +    (3, 6) node[above, fill=white] {logic} -- (5, 0) -- cycle;
   18.27 +  \draw[style=ice] (9, 0) --
   18.28 +    (11, 6) node[above, fill=white] {intermediate language} -- (13, 0) -- cycle;
   18.29 +  \draw[style=ice] (15, -6) --
   18.30 +    (19, 6) node[above, fill=white] {target language} -- (23, -6) -- cycle;
   18.31 +  \draw[style=process]
   18.32 +    (3.5, 3) .. controls (7, 5) .. node[fill=white] {translation} (10.5, 3);
   18.33 +  \draw[style=process]
   18.34 +    (11.5, 3) .. controls (15, 5) .. node[fill=white] (serialisation) {serialisation} (18.5, 3);
   18.35 +  \node (adaptation) at (11, -2) [style=adaptation] {adaptation};
   18.36 +  \node at (19, 3) [rotate=90] {generated};
   18.37 +  \node at (19.5, -5) {language};
   18.38 +  \node at (19.5, -3) {library};
   18.39 +  \node (includes) at (19.5, -1) {includes};
   18.40 +  \node (reserved) at (16.5, -3) [rotate=72] {reserved}; % proper 71.57
   18.41 +  \draw[style=process]
   18.42 +    (includes) -- (serialisation);
   18.43 +  \draw[style=process]
   18.44 +    (reserved) -- (serialisation);
   18.45 +  \draw[style=adaptation]
   18.46 +    (adaptation) -- (serialisation);
   18.47 +  \draw[style=adaptation]
   18.48 +    (adaptation) -- (includes);
   18.49 +  \draw[style=adaptation]
   18.50 +    (adaptation) -- (reserved);
   18.51 +\end{tikzpicture}
   18.52 +
   18.53 +}
   18.54 +
   18.55 +\end{document}
    19.1 --- a/doc-src/Codegen/Thy/pictures/adaption.tex	Mon May 11 09:39:53 2009 +0200
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,52 +0,0 @@
    19.4 -
    19.5 -\documentclass[12pt]{article}
    19.6 -\usepackage{tikz}
    19.7 -
    19.8 -\begin{document}
    19.9 -
   19.10 -\thispagestyle{empty}
   19.11 -\setlength{\fboxrule}{0.01pt}
   19.12 -\setlength{\fboxsep}{4pt}
   19.13 -
   19.14 -\fcolorbox{white}{white}{
   19.15 -
   19.16 -\begin{tikzpicture}[scale = 0.5]
   19.17 -  \tikzstyle water=[color = blue, thick]
   19.18 -  \tikzstyle ice=[color = black, very thick, cap = round, join = round, fill = white]
   19.19 -  \tikzstyle process=[color = green, semithick, ->]
   19.20 -  \tikzstyle adaption=[color = red, semithick, ->]
   19.21 -  \tikzstyle target=[color = black]
   19.22 -  \foreach \x in {0, ..., 24}
   19.23 -    \draw[style=water] (\x, 0.25) sin + (0.25, 0.25) cos + (0.25, -0.25) sin
   19.24 -      + (0.25, -0.25) cos + (0.25, 0.25);
   19.25 -  \draw[style=ice] (1, 0) --
   19.26 -    (3, 6) node[above, fill=white] {logic} -- (5, 0) -- cycle;
   19.27 -  \draw[style=ice] (9, 0) --
   19.28 -    (11, 6) node[above, fill=white] {intermediate language} -- (13, 0) -- cycle;
   19.29 -  \draw[style=ice] (15, -6) --
   19.30 -    (19, 6) node[above, fill=white] {target language} -- (23, -6) -- cycle;
   19.31 -  \draw[style=process]
   19.32 -    (3.5, 3) .. controls (7, 5) .. node[fill=white] {translation} (10.5, 3);
   19.33 -  \draw[style=process]
   19.34 -    (11.5, 3) .. controls (15, 5) .. node[fill=white] (serialisation) {serialisation} (18.5, 3);
   19.35 -  \node (adaption) at (11, -2) [style=adaption] {adaption};
   19.36 -  \node at (19, 3) [rotate=90] {generated};
   19.37 -  \node at (19.5, -5) {language};
   19.38 -  \node at (19.5, -3) {library};
   19.39 -  \node (includes) at (19.5, -1) {includes};
   19.40 -  \node (reserved) at (16.5, -3) [rotate=72] {reserved}; % proper 71.57
   19.41 -  \draw[style=process]
   19.42 -    (includes) -- (serialisation);
   19.43 -  \draw[style=process]
   19.44 -    (reserved) -- (serialisation);
   19.45 -  \draw[style=adaption]
   19.46 -    (adaption) -- (serialisation);
   19.47 -  \draw[style=adaption]
   19.48 -    (adaption) -- (includes);
   19.49 -  \draw[style=adaption]
   19.50 -    (adaption) -- (reserved);
   19.51 -\end{tikzpicture}
   19.52 -
   19.53 -}
   19.54 -
   19.55 -\end{document}
    20.1 --- a/doc-src/Codegen/codegen.tex	Mon May 11 09:39:53 2009 +0200
    20.2 +++ b/doc-src/Codegen/codegen.tex	Mon May 11 17:20:52 2009 +0200
    20.3 @@ -32,7 +32,7 @@
    20.4  
    20.5  \input{Thy/document/Introduction.tex}
    20.6  \input{Thy/document/Program.tex}
    20.7 -\input{Thy/document/Adaption.tex}
    20.8 +\input{Thy/document/Adaptation.tex}
    20.9  \input{Thy/document/Further.tex}
   20.10  \input{Thy/document/ML.tex}
   20.11  
    21.1 --- a/doc-src/IsarRef/Thy/Spec.thy	Mon May 11 09:39:53 2009 +0200
    21.2 +++ b/doc-src/IsarRef/Thy/Spec.thy	Mon May 11 17:20:52 2009 +0200
    21.3 @@ -752,7 +752,11 @@
    21.4  
    21.5  text {*
    21.6    Isabelle/Pure's definitional schemes support certain forms of
    21.7 -  overloading (see \secref{sec:consts}).  At most occassions
    21.8 +  overloading (see \secref{sec:consts}).  Overloading means that a
    21.9 +  constant being declared as @{text "c :: \<alpha> decl"} may be
   21.10 +  defined separately on type instances
   21.11 +  @{text "c :: (\<beta>\<^sub>1, \<dots>, \<beta>\<^sub>n) t decl"}
   21.12 +  for each type constructor @{text t}.  At most occassions
   21.13    overloading will be used in a Haskell-like fashion together with
   21.14    type classes by means of @{command "instantiation"} (see
   21.15    \secref{sec:class}).  Sometimes low-level overloading is desirable.
   21.16 @@ -782,7 +786,8 @@
   21.17  
   21.18    A @{text "(unchecked)"} option disables global dependency checks for
   21.19    the corresponding definition, which is occasionally useful for
   21.20 -  exotic overloading.  It is at the discretion of the user to avoid
   21.21 +  exotic overloading (see \secref{sec:consts} for a precise description).
   21.22 +  It is at the discretion of the user to avoid
   21.23    malformed theory specifications!
   21.24  
   21.25    \end{description}
   21.26 @@ -1065,10 +1070,7 @@
   21.27  
   21.28    \end{itemize}
   21.29  
   21.30 -  Overloading means that a constant being declared as @{text "c :: \<alpha>
   21.31 -  decl"} may be defined separately on type instances @{text "c ::
   21.32 -  (\<beta>\<^sub>1, \<dots>, \<beta>\<^sub>n) t decl"} for each type constructor @{text
   21.33 -  t}.  The right-hand side may mention overloaded constants
   21.34 +  The right-hand side of overloaded definitions may mention overloaded constants
   21.35    recursively at type instances corresponding to the immediate
   21.36    argument types @{text "\<beta>\<^sub>1, \<dots>, \<beta>\<^sub>n"}.  Incomplete
   21.37    specification patterns impose global constraints on all occurrences,
    22.1 --- a/doc-src/IsarRef/Thy/document/Spec.tex	Mon May 11 09:39:53 2009 +0200
    22.2 +++ b/doc-src/IsarRef/Thy/document/Spec.tex	Mon May 11 17:20:52 2009 +0200
    22.3 @@ -759,7 +759,11 @@
    22.4  %
    22.5  \begin{isamarkuptext}%
    22.6  Isabelle/Pure's definitional schemes support certain forms of
    22.7 -  overloading (see \secref{sec:consts}).  At most occassions
    22.8 +  overloading (see \secref{sec:consts}).  Overloading means that a
    22.9 +  constant being declared as \isa{{\isachardoublequote}c\ {\isacharcolon}{\isacharcolon}\ {\isasymalpha}\ decl{\isachardoublequote}} may be
   22.10 +  defined separately on type instances
   22.11 +  \isa{{\isachardoublequote}c\ {\isacharcolon}{\isacharcolon}\ {\isacharparenleft}{\isasymbeta}\isactrlsub {\isadigit{1}}{\isacharcomma}\ {\isasymdots}{\isacharcomma}\ {\isasymbeta}\isactrlsub n{\isacharparenright}\ t\ decl{\isachardoublequote}}
   22.12 +  for each type constructor \isa{t}.  At most occassions
   22.13    overloading will be used in a Haskell-like fashion together with
   22.14    type classes by means of \hyperlink{command.instantiation}{\mbox{\isa{\isacommand{instantiation}}}} (see
   22.15    \secref{sec:class}).  Sometimes low-level overloading is desirable.
   22.16 @@ -788,7 +792,8 @@
   22.17  
   22.18    A \isa{{\isachardoublequote}{\isacharparenleft}unchecked{\isacharparenright}{\isachardoublequote}} option disables global dependency checks for
   22.19    the corresponding definition, which is occasionally useful for
   22.20 -  exotic overloading.  It is at the discretion of the user to avoid
   22.21 +  exotic overloading (see \secref{sec:consts} for a precise description).
   22.22 +  It is at the discretion of the user to avoid
   22.23    malformed theory specifications!
   22.24  
   22.25    \end{description}%
   22.26 @@ -1092,7 +1097,7 @@
   22.27  
   22.28    \end{itemize}
   22.29  
   22.30 -  Overloading means that a constant being declared as \isa{{\isachardoublequote}c\ {\isacharcolon}{\isacharcolon}\ {\isasymalpha}\ decl{\isachardoublequote}} may be defined separately on type instances \isa{{\isachardoublequote}c\ {\isacharcolon}{\isacharcolon}\ {\isacharparenleft}{\isasymbeta}\isactrlsub {\isadigit{1}}{\isacharcomma}\ {\isasymdots}{\isacharcomma}\ {\isasymbeta}\isactrlsub n{\isacharparenright}\ t\ decl{\isachardoublequote}} for each type constructor \isa{t}.  The right-hand side may mention overloaded constants
   22.31 +  The right-hand side of overloaded definitions may mention overloaded constants
   22.32    recursively at type instances corresponding to the immediate
   22.33    argument types \isa{{\isachardoublequote}{\isasymbeta}\isactrlsub {\isadigit{1}}{\isacharcomma}\ {\isasymdots}{\isacharcomma}\ {\isasymbeta}\isactrlsub n{\isachardoublequote}}.  Incomplete
   22.34    specification patterns impose global constraints on all occurrences,
    23.1 --- a/doc-src/Main/Docs/Main_Doc.thy	Mon May 11 09:39:53 2009 +0200
    23.2 +++ b/doc-src/Main/Docs/Main_Doc.thy	Mon May 11 17:20:52 2009 +0200
    23.3 @@ -268,6 +268,7 @@
    23.4  @{const Transitive_Closure.rtrancl} & @{term_type_only Transitive_Closure.rtrancl "('a*'a)set\<Rightarrow>('a*'a)set"}\\
    23.5  @{const Transitive_Closure.trancl} & @{term_type_only Transitive_Closure.trancl "('a*'a)set\<Rightarrow>('a*'a)set"}\\
    23.6  @{const Transitive_Closure.reflcl} & @{term_type_only Transitive_Closure.reflcl "('a*'a)set\<Rightarrow>('a*'a)set"}\\
    23.7 +@{const compower} & @{term_type_only "op ^^ :: ('a*'a)set\<Rightarrow>nat\<Rightarrow>('a*'a)set" "('a*'a)set\<Rightarrow>nat\<Rightarrow>('a*'a)set"}\\
    23.8  \end{tabular}
    23.9  
   23.10  \subsubsection*{Syntax}
   23.11 @@ -318,7 +319,6 @@
   23.12  @{term "op + :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
   23.13  @{term "op - :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
   23.14  @{term "op * :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
   23.15 -@{term "op ^ :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
   23.16  @{term "op div :: nat \<Rightarrow> nat \<Rightarrow> nat"}&
   23.17  @{term "op mod :: nat \<Rightarrow> nat \<Rightarrow> nat"}&
   23.18  @{term "op dvd :: nat \<Rightarrow> nat \<Rightarrow> bool"}\\
   23.19 @@ -331,7 +331,9 @@
   23.20  \end{tabular}
   23.21  
   23.22  \begin{tabular}{@ {} l @ {~::~} l @ {}}
   23.23 -@{const Nat.of_nat} & @{typeof Nat.of_nat}
   23.24 +@{const Nat.of_nat} & @{typeof Nat.of_nat}\\
   23.25 +@{term "op ^^ :: ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"} &
   23.26 +  @{term_type_only "op ^^ :: ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a" "('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"}
   23.27  \end{tabular}
   23.28  
   23.29  \section{Int}
   23.30 @@ -450,14 +452,6 @@
   23.31  \end{tabular}
   23.32  
   23.33  
   23.34 -\section{Iterated Functions and Relations}
   23.35 -
   23.36 -Theory: @{theory Relation_Power}
   23.37 -
   23.38 -Iterated functions \ @{term[source]"(f::'a\<Rightarrow>'a) ^ n"} \
   23.39 -and relations \ @{term[source]"(r::('a\<times>'a)set) ^ n"}.
   23.40 -
   23.41 -
   23.42  \section{Option}
   23.43  
   23.44  @{datatype option}
    24.1 --- a/doc-src/Main/Docs/document/Main_Doc.tex	Mon May 11 09:39:53 2009 +0200
    24.2 +++ b/doc-src/Main/Docs/document/Main_Doc.tex	Mon May 11 17:20:52 2009 +0200
    24.3 @@ -279,6 +279,7 @@
    24.4  \isa{rtrancl} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
    24.5  \isa{trancl} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
    24.6  \isa{reflcl} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
    24.7 +\isa{op\ {\isacharcircum}{\isacharcircum}} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
    24.8  \end{tabular}
    24.9  
   24.10  \subsubsection*{Syntax}
   24.11 @@ -328,7 +329,6 @@
   24.12  \isa{op\ {\isacharplus}} &
   24.13  \isa{op\ {\isacharminus}} &
   24.14  \isa{op\ {\isacharasterisk}} &
   24.15 -\isa{op\ {\isacharcircum}} &
   24.16  \isa{op\ div}&
   24.17  \isa{op\ mod}&
   24.18  \isa{op\ dvd}\\
   24.19 @@ -341,7 +341,9 @@
   24.20  \end{tabular}
   24.21  
   24.22  \begin{tabular}{@ {} l @ {~::~} l @ {}}
   24.23 -\isa{of{\isacharunderscore}nat} & \isa{nat\ {\isasymRightarrow}\ {\isacharprime}a}
   24.24 +\isa{of{\isacharunderscore}nat} & \isa{nat\ {\isasymRightarrow}\ {\isacharprime}a}\\
   24.25 +\isa{op\ {\isacharcircum}{\isacharcircum}} &
   24.26 +  \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymRightarrow}\ {\isacharprime}a{\isacharparenright}\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ {\isacharprime}a\ {\isasymRightarrow}\ {\isacharprime}a}
   24.27  \end{tabular}
   24.28  
   24.29  \section{Int}
   24.30 @@ -460,14 +462,6 @@
   24.31  \end{tabular}
   24.32  
   24.33  
   24.34 -\section{Iterated Functions and Relations}
   24.35 -
   24.36 -Theory: \isa{Relation{\isacharunderscore}Power}
   24.37 -
   24.38 -Iterated functions \ \isa{{\isachardoublequote}{\isacharparenleft}f{\isacharcolon}{\isacharcolon}{\isacharprime}a{\isasymRightarrow}{\isacharprime}a{\isacharparenright}\ {\isacharcircum}\ n{\isachardoublequote}} \
   24.39 -and relations \ \isa{{\isachardoublequote}{\isacharparenleft}r{\isacharcolon}{\isacharcolon}{\isacharparenleft}{\isacharprime}a{\isasymtimes}{\isacharprime}a{\isacharparenright}set{\isacharparenright}\ {\isacharcircum}\ n{\isachardoublequote}}.
   24.40 -
   24.41 -
   24.42  \section{Option}
   24.43  
   24.44  \isa{\isacommand{datatype}\ {\isacharprime}a\ option\ {\isacharequal}\ None\ {\isacharbar}\ Some\ {\isacharprime}a}
    25.1 --- a/doc-src/TutorialI/tutorial.tex	Mon May 11 09:39:53 2009 +0200
    25.2 +++ b/doc-src/TutorialI/tutorial.tex	Mon May 11 17:20:52 2009 +0200
    25.3 @@ -39,10 +39,11 @@
    25.4  %University of Cambridge\\
    25.5  %Computer Laboratory
    25.6  }
    25.7 +\pagenumbering{roman}
    25.8  \maketitle
    25.9 +\newpage
   25.10  
   25.11 -\pagenumbering{roman}
   25.12 -\setcounter{page}{5}
   25.13 +%\setcounter{page}{5}
   25.14  %\vspace*{\fill}
   25.15  %\begin{center}
   25.16  %\LARGE In memoriam \\[1ex]
   25.17 @@ -52,6 +53,7 @@
   25.18  %\vspace*{\fill}
   25.19  %\vspace*{\fill}
   25.20  %\newpage
   25.21 +
   25.22  \include{preface}
   25.23  
   25.24  \tableofcontents
    26.1 --- a/doc-src/more_antiquote.ML	Mon May 11 09:39:53 2009 +0200
    26.2 +++ b/doc-src/more_antiquote.ML	Mon May 11 17:20:52 2009 +0200
    26.3 @@ -88,7 +88,7 @@
    26.4    let
    26.5      val thy = ProofContext.theory_of ctxt;
    26.6      val const = Code_Unit.check_const thy raw_const;
    26.7 -    val (_, funcgr) = Code_Wellsorted.make thy [const];
    26.8 +    val (_, funcgr) = Code_Wellsorted.obtain thy [const] [];
    26.9      fun holize thm = @{thm meta_eq_to_obj_eq} OF [thm];
   26.10      val thms = Code_Wellsorted.eqns funcgr const
   26.11        |> map_filter (fn (thm, linear) => if linear then SOME thm else NONE)
    27.1 --- a/etc/isar-keywords.el	Mon May 11 09:39:53 2009 +0200
    27.2 +++ b/etc/isar-keywords.el	Mon May 11 17:20:52 2009 +0200
    27.3 @@ -35,6 +35,7 @@
    27.4      "atp_info"
    27.5      "atp_kill"
    27.6      "atp_messages"
    27.7 +    "atp_minimize"
    27.8      "attribute_setup"
    27.9      "automaton"
   27.10      "ax_specification"
   27.11 @@ -340,6 +341,7 @@
   27.12      "atp_info"
   27.13      "atp_kill"
   27.14      "atp_messages"
   27.15 +    "atp_minimize"
   27.16      "cd"
   27.17      "class_deps"
   27.18      "code_deps"
    28.1 --- a/lib/jedit/isabelle.xml	Mon May 11 09:39:53 2009 +0200
    28.2 +++ b/lib/jedit/isabelle.xml	Mon May 11 17:20:52 2009 +0200
    28.3 @@ -60,6 +60,7 @@
    28.4        <LABEL>atp_info</LABEL>
    28.5        <LABEL>atp_kill</LABEL>
    28.6        <LABEL>atp_messages</LABEL>
    28.7 +      <LABEL>atp_minimize</LABEL>
    28.8        <KEYWORD4>attach</KEYWORD4>
    28.9        <OPERATOR>attribute_setup</OPERATOR>
   28.10        <OPERATOR>automaton</OPERATOR>
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/lib/scripts/SystemOnTPTP	Mon May 11 17:20:52 2009 +0200
    29.3 @@ -0,0 +1,120 @@
    29.4 +#!/usr/bin/env perl
    29.5 +#
    29.6 +# Wrapper for custom remote provers on SystemOnTPTP
    29.7 +# Author: Fabian Immler, TU Muenchen
    29.8 +#
    29.9 +
   29.10 +use warnings;
   29.11 +use strict;
   29.12 +use Getopt::Std;
   29.13 +use HTTP::Request::Common;
   29.14 +use LWP;
   29.15 +
   29.16 +my $SystemOnTPTPFormReplyURL = "http://www.cs.miami.edu/~tptp/cgi-bin/SystemOnTPTPFormReply";
   29.17 +
   29.18 +# default parameters
   29.19 +my %URLParameters = (
   29.20 +    "NoHTML" => 1,
   29.21 +    "QuietFlag" => "-q01",
   29.22 +    "X2TPTP" => "-S",
   29.23 +    "SubmitButton" => "RunSelectedSystems",
   29.24 +    "ProblemSource" => "UPLOAD",
   29.25 +    );
   29.26 +
   29.27 +#----Get format and transform options if specified
   29.28 +my %Options;
   29.29 +getopts("hws:t:c:",\%Options);
   29.30 +
   29.31 +#----Usage
   29.32 +sub usage() {
   29.33 +  print("Usage: remote [<options>] <File name>\n");
   29.34 +  print("    <options> are ...\n");
   29.35 +  print("    -h            - print this help\n");
   29.36 +  print("    -w            - list available ATP systems\n");
   29.37 +  print("    -s<system>    - specified system to use\n");
   29.38 +  print("    -t<timelimit> - CPU time limit for system\n");
   29.39 +  print("    -c<command>   - custom command for system\n");
   29.40 +  print("    <File name>   - TPTP problem file\n");
   29.41 +  exit(0);
   29.42 +}
   29.43 +if (exists($Options{'h'})) {
   29.44 +  usage();
   29.45 +}
   29.46 +#----What systems flag
   29.47 +if (exists($Options{'w'})) {
   29.48 +    $URLParameters{"SubmitButton"} = "ListSystems";
   29.49 +    delete($URLParameters{"ProblemSource"});
   29.50 +}
   29.51 +#----Selected system
   29.52 +my $System;
   29.53 +if (exists($Options{'s'})) {
   29.54 +    $System = $Options{'s'};
   29.55 +} else {
   29.56 +    # use Vampire as default
   29.57 +    $System = "Vampire---9.0";
   29.58 +}
   29.59 +$URLParameters{"System___$System"} = $System;
   29.60 +
   29.61 +#----Time limit
   29.62 +if (exists($Options{'t'})) {
   29.63 +    $URLParameters{"TimeLimit___$System"} = $Options{'t'};
   29.64 +}
   29.65 +#----Custom command
   29.66 +if (exists($Options{'c'})) {
   29.67 +    $URLParameters{"Command___$System"} = $Options{'c'};
   29.68 +}
   29.69 +
   29.70 +#----Get single file name
   29.71 +if (exists($URLParameters{"ProblemSource"})) {
   29.72 +    if (scalar(@ARGV) >= 1) {
   29.73 +        $URLParameters{"UPLOADProblem"} = [shift(@ARGV)];
   29.74 +    } else {
   29.75 +      print("Missing problem file\n");
   29.76 +      usage();
   29.77 +      die;
   29.78 +    }
   29.79 +}
   29.80 +
   29.81 +# Query Server
   29.82 +my $Agent = LWP::UserAgent->new;
   29.83 +if (exists($Options{'t'})) {
   29.84 +  # give server more time to respond
   29.85 +  $Agent->timeout($Options{'t'} + 10);
   29.86 +}
   29.87 +my $Request = POST($SystemOnTPTPFormReplyURL,
   29.88 +	Content_Type => 'form-data',Content => \%URLParameters);
   29.89 +my $Response = $Agent->request($Request);
   29.90 +
   29.91 +#catch errors / failure
   29.92 +if(! $Response->is_success){
   29.93 +  print "HTTP-Error: " . $Response->message . "\n";
   29.94 +  exit(-1);
   29.95 +} elsif (exists($Options{'w'})) {
   29.96 +  print $Response->content;
   29.97 +  exit (0);
   29.98 +} elsif ($Response->content =~ /WARNING: (\S*) does not exist/) {
   29.99 +  print "Specified System $1 does not exist\n";
  29.100 +  exit(-1);
  29.101 +} elsif ($Response->content =~ /%\s*Result\s*:\s*Unsatisfiable.*\n%\s*Output\s*:\s*(CNF)?Refutation.*\n%/) {
  29.102 +  my @lines = split( /\n/, $Response->content);
  29.103 +  my $extract = "";
  29.104 +  foreach my $line (@lines){
  29.105 +      #ignore comments
  29.106 +      if ($line !~ /^%/ && !($line eq "")) {
  29.107 +          $extract .= "$line";
  29.108 +      }
  29.109 +  }
  29.110 +  # insert newlines after ').'
  29.111 +  $extract =~ s/\s//g;
  29.112 +  $extract =~ s/\)\.cnf/\)\.\ncnf/g;
  29.113 +
  29.114 +  # orientation for res_reconstruct.ML
  29.115 +  print "# SZS output start CNFRefutation.\n";
  29.116 +  print "$extract\n";
  29.117 +  print "# SZS output end CNFRefutation.\n";
  29.118 +  exit(0);
  29.119 +} else {
  29.120 +  print "Remote-script could not extract proof:\n".$Response->content;
  29.121 +  exit(-1);
  29.122 +}
  29.123 +
    30.1 --- a/src/HOL/ATP_Linkup.thy	Mon May 11 09:39:53 2009 +0200
    30.2 +++ b/src/HOL/ATP_Linkup.thy	Mon May 11 17:20:52 2009 +0200
    30.3 @@ -17,6 +17,7 @@
    30.4    ("Tools/res_atp.ML")
    30.5    ("Tools/atp_manager.ML")
    30.6    ("Tools/atp_wrapper.ML")
    30.7 +  ("Tools/atp_minimal.ML")
    30.8    "~~/src/Tools/Metis/metis.ML"
    30.9    ("Tools/metis_tools.ML")
   30.10  begin
   30.11 @@ -98,6 +99,8 @@
   30.12  use "Tools/atp_manager.ML"
   30.13  use "Tools/atp_wrapper.ML"
   30.14  
   30.15 +use "Tools/atp_minimal.ML"
   30.16 +
   30.17  text {* basic provers *}
   30.18  setup {* AtpManager.add_prover "spass" AtpWrapper.spass *}
   30.19  setup {* AtpManager.add_prover "vampire" AtpWrapper.vampire *}
    31.1 --- a/src/HOL/Algebra/abstract/Ring2.thy	Mon May 11 09:39:53 2009 +0200
    31.2 +++ b/src/HOL/Algebra/abstract/Ring2.thy	Mon May 11 17:20:52 2009 +0200
    31.3 @@ -12,7 +12,7 @@
    31.4  
    31.5  subsection {* Ring axioms *}
    31.6  
    31.7 -class ring = zero + one + plus + minus + uminus + times + inverse + power + Ring_and_Field.dvd +
    31.8 +class ring = zero + one + plus + minus + uminus + times + inverse + power + dvd +
    31.9    assumes a_assoc:      "(a + b) + c = a + (b + c)"
   31.10    and l_zero:           "0 + a = a"
   31.11    and l_neg:            "(-a) + a = 0"
   31.12 @@ -28,8 +28,6 @@
   31.13    assumes minus_def:    "a - b = a + (-b)"
   31.14    and inverse_def:      "inverse a = (if a dvd 1 then THE x. a*x = 1 else 0)"
   31.15    and divide_def:       "a / b = a * inverse b"
   31.16 -  and power_0 [simp]:   "a ^ 0 = 1"
   31.17 -  and power_Suc [simp]: "a ^ Suc n = a ^ n * a"
   31.18  begin
   31.19  
   31.20  definition assoc :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "assoc" 50) where
    32.1 --- a/src/HOL/Algebra/poly/LongDiv.thy	Mon May 11 09:39:53 2009 +0200
    32.2 +++ b/src/HOL/Algebra/poly/LongDiv.thy	Mon May 11 17:20:52 2009 +0200
    32.3 @@ -1,6 +1,5 @@
    32.4  (*
    32.5      Experimental theory: long division of polynomials
    32.6 -    $Id$
    32.7      Author: Clemens Ballarin, started 23 June 1999
    32.8  *)
    32.9  
   32.10 @@ -133,9 +132,9 @@
   32.11      delsimprocs [ring_simproc]) 1 *})
   32.12    apply (tactic {* asm_simp_tac (@{simpset} delsimprocs [ring_simproc]) 1 *})
   32.13    apply (tactic {* simp_tac (@{simpset} addsimps [thm "minus_def", thm "smult_r_distr",
   32.14 -    thm "smult_r_minus", thm "monom_mult_smult", thm "smult_assoc1", thm "smult_assoc2"]
   32.15 +    thm "smult_r_minus", thm "monom_mult_smult", thm "smult_assoc2"]
   32.16      delsimprocs [ring_simproc]) 1 *})
   32.17 -  apply simp
   32.18 +  apply (simp add: smult_assoc1 [symmetric])
   32.19    done
   32.20  
   32.21  ML {*
    33.1 --- a/src/HOL/Algebra/poly/UnivPoly2.thy	Mon May 11 09:39:53 2009 +0200
    33.2 +++ b/src/HOL/Algebra/poly/UnivPoly2.thy	Mon May 11 17:20:52 2009 +0200
    33.3 @@ -155,16 +155,6 @@
    33.4  
    33.5  end
    33.6  
    33.7 -instantiation up :: ("{times, one, comm_monoid_add}") power
    33.8 -begin
    33.9 -
   33.10 -primrec power_up where
   33.11 -  "(a \<Colon> 'a up) ^ 0 = 1"
   33.12 -  | "(a \<Colon> 'a up) ^ Suc n = a ^ n * a"
   33.13 -
   33.14 -instance ..
   33.15 -
   33.16 -end
   33.17  
   33.18  subsection {* Effect of operations on coefficients *}
   33.19  
   33.20 @@ -328,8 +318,9 @@
   33.21    qed
   33.22    show "(p + q) * r = p * r + q * r"
   33.23      by (rule up_eqI) simp
   33.24 -  show "p * q = q * p"
   33.25 +  show "\<And>q. p * q = q * p"
   33.26    proof (rule up_eqI)
   33.27 +    fix q
   33.28      fix n 
   33.29      {
   33.30        fix k
   33.31 @@ -354,9 +345,6 @@
   33.32      by (simp add: up_inverse_def)
   33.33    show "p / q = p * inverse q"
   33.34      by (simp add: up_divide_def)
   33.35 -  fix n
   33.36 -  show "p ^ 0 = 1" by simp
   33.37 -  show "p ^ Suc n = p ^ n * p" by simp
   33.38  qed
   33.39  
   33.40  (* Further properties of monom *)
    34.1 --- a/src/HOL/Bali/Trans.thy	Mon May 11 09:39:53 2009 +0200
    34.2 +++ b/src/HOL/Bali/Trans.thy	Mon May 11 17:20:52 2009 +0200
    34.3 @@ -359,7 +359,7 @@
    34.4  
    34.5  abbreviation
    34.6    stepn:: "[prog, term \<times> state,nat,term \<times> state] \<Rightarrow> bool" ("_\<turnstile>_ \<mapsto>_ _"[61,82,82] 81)
    34.7 -  where "G\<turnstile>p \<mapsto>n p' \<equiv> (p,p') \<in> {(x, y). step G x y}^n"
    34.8 +  where "G\<turnstile>p \<mapsto>n p' \<equiv> (p,p') \<in> {(x, y). step G x y}^^n"
    34.9  
   34.10  abbreviation
   34.11    steptr:: "[prog,term \<times> state,term \<times> state] \<Rightarrow> bool" ("_\<turnstile>_ \<mapsto>* _"[61,82,82] 81)
   34.12 @@ -370,25 +370,6 @@
   34.13    Smallstep zu Bigstep, nur wenn nicht die Ausdrücke Callee, FinA ,\<dots>
   34.14  *)
   34.15  
   34.16 -lemma rtrancl_imp_rel_pow: "p \<in> R^* \<Longrightarrow> \<exists>n. p \<in> R^n"
   34.17 -proof -
   34.18 -  assume "p \<in> R\<^sup>*"
   34.19 -  moreover obtain x y where p: "p = (x,y)" by (cases p)
   34.20 -  ultimately have "(x,y) \<in> R\<^sup>*" by hypsubst
   34.21 -  hence "\<exists>n. (x,y) \<in> R^n"
   34.22 -  proof induct
   34.23 -    fix a have "(a,a) \<in> R^0" by simp
   34.24 -    thus "\<exists>n. (a,a) \<in> R ^ n" ..
   34.25 -  next
   34.26 -    fix a b c assume "\<exists>n. (a,b) \<in> R ^ n"
   34.27 -    then obtain n where "(a,b) \<in> R^n" ..
   34.28 -    moreover assume "(b,c) \<in> R"
   34.29 -    ultimately have "(a,c) \<in> R^(Suc n)" by auto
   34.30 -    thus "\<exists>n. (a,c) \<in> R^n" ..
   34.31 -  qed
   34.32 -  with p show ?thesis by hypsubst
   34.33 -qed  
   34.34 -
   34.35  (*
   34.36  lemma imp_eval_trans:
   34.37    assumes eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)" 
    35.1 --- a/src/HOL/Code_Eval.thy	Mon May 11 09:39:53 2009 +0200
    35.2 +++ b/src/HOL/Code_Eval.thy	Mon May 11 17:20:52 2009 +0200
    35.3 @@ -23,7 +23,7 @@
    35.4  code_datatype Const App
    35.5  
    35.6  class term_of = typerep +
    35.7 -  fixes term_of :: "'a::{} \<Rightarrow> term"
    35.8 +  fixes term_of :: "'a \<Rightarrow> term"
    35.9  
   35.10  lemma term_of_anything: "term_of x \<equiv> t"
   35.11    by (rule eq_reflection) (cases "term_of x", cases t, simp)
   35.12 @@ -33,7 +33,7 @@
   35.13  struct
   35.14  
   35.15  fun mk_term f g (Const (c, ty)) =
   35.16 -      @{term Const} $ Message_String.mk c $ g ty
   35.17 +      @{term Const} $ HOLogic.mk_message_string c $ g ty
   35.18    | mk_term f g (t1 $ t2) =
   35.19        @{term App} $ mk_term f g t1 $ mk_term f g t2
   35.20    | mk_term f g (Free v) = f v
   35.21 @@ -67,18 +67,19 @@
   35.22        |> Class.prove_instantiation_instance (K (Class.intro_classes_tac []))
   35.23        |> LocalTheory.exit_global
   35.24      end;
   35.25 -  fun interpretator (tyco, (raw_vs, _)) thy =
   35.26 -    let
   35.27 -      val has_inst = can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of};
   35.28 -      val constrain_sort =
   35.29 -        curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort term_of};
   35.30 -      val vs = (map o apsnd) constrain_sort raw_vs;
   35.31 -      val ty = Type (tyco, map TFree vs);
   35.32 -    in
   35.33 -      thy
   35.34 -      |> Typerep.perhaps_add_def tyco
   35.35 -      |> not has_inst ? add_term_of_def ty vs tyco
   35.36 -    end;
   35.37 +  fun interpretator ("prop", (raw_vs, _)) thy = thy
   35.38 +    | interpretator (tyco, (raw_vs, _)) thy =
   35.39 +        let
   35.40 +          val has_inst = can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of};
   35.41 +          val constrain_sort =
   35.42 +            curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort term_of};
   35.43 +          val vs = (map o apsnd) constrain_sort raw_vs;
   35.44 +          val ty = Type (tyco, map TFree vs);
   35.45 +        in
   35.46 +          thy
   35.47 +          |> Typerep.perhaps_add_def tyco
   35.48 +          |> not has_inst ? add_term_of_def ty vs tyco
   35.49 +        end;
   35.50  in
   35.51    Code.type_interpretation interpretator
   35.52  end
   35.53 @@ -105,21 +106,22 @@
   35.54        thy
   35.55        |> Code.add_eqn thm
   35.56      end;
   35.57 -  fun interpretator (tyco, (raw_vs, raw_cs)) thy =
   35.58 -    let
   35.59 -      val constrain_sort =
   35.60 -        curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort term_of};
   35.61 -      val vs = (map o apsnd) constrain_sort raw_vs;
   35.62 -      val cs = (map o apsnd o map o map_atyps)
   35.63 -        (fn TFree (v, sort) => TFree (v, constrain_sort sort)) raw_cs;
   35.64 -      val ty = Type (tyco, map TFree vs);
   35.65 -      val eqs = map (mk_term_of_eq ty vs tyco) cs;
   35.66 -      val const = AxClass.param_of_inst thy (@{const_name term_of}, tyco);
   35.67 -    in
   35.68 -      thy
   35.69 -      |> Code.del_eqns const
   35.70 -      |> fold (prove_term_of_eq ty) eqs
   35.71 -    end;
   35.72 +  fun interpretator ("prop", (raw_vs, _)) thy = thy
   35.73 +    | interpretator (tyco, (raw_vs, raw_cs)) thy =
   35.74 +        let
   35.75 +          val constrain_sort =
   35.76 +            curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort term_of};
   35.77 +          val vs = (map o apsnd) constrain_sort raw_vs;
   35.78 +          val cs = (map o apsnd o map o map_atyps)
   35.79 +            (fn TFree (v, sort) => TFree (v, constrain_sort sort)) raw_cs;
   35.80 +          val ty = Type (tyco, map TFree vs);
   35.81 +          val eqs = map (mk_term_of_eq ty vs tyco) cs;
   35.82 +          val const = AxClass.param_of_inst thy (@{const_name term_of}, tyco);
   35.83 +        in
   35.84 +          thy
   35.85 +          |> Code.del_eqns const
   35.86 +          |> fold (prove_term_of_eq ty) eqs
   35.87 +        end;
   35.88  in
   35.89    Code.type_interpretation interpretator
   35.90  end
   35.91 @@ -146,13 +148,15 @@
   35.92    by (subst term_of_anything) rule 
   35.93  
   35.94  code_type "term"
   35.95 -  (SML "Term.term")
   35.96 +  (Eval "Term.term")
   35.97  
   35.98  code_const Const and App
   35.99 -  (SML "Term.Const/ (_, _)" and "Term.$/ (_, _)")
  35.100 +  (Eval "Term.Const/ (_, _)" and "Term.$/ (_, _)")
  35.101  
  35.102  code_const "term_of \<Colon> message_string \<Rightarrow> term"
  35.103 -  (SML "Message'_String.mk")
  35.104 +  (Eval "HOLogic.mk'_message'_string")
  35.105 +
  35.106 +code_reserved Eval HOLogic
  35.107  
  35.108  
  35.109  subsection {* Evaluation setup *}
  35.110 @@ -161,6 +165,7 @@
  35.111  signature EVAL =
  35.112  sig
  35.113    val mk_term: ((string * typ) -> term) -> (typ -> term) -> term -> term
  35.114 +  val mk_term_of: typ -> term -> term
  35.115    val eval_ref: (unit -> term) option ref
  35.116    val eval_term: theory -> term -> term
  35.117  end;
  35.118 @@ -175,8 +180,7 @@
  35.119  fun eval_term thy t =
  35.120    t 
  35.121    |> Eval.mk_term_of (fastype_of t)
  35.122 -  |> (fn t => Code_ML.eval_term ("Eval.eval_ref", eval_ref) thy t [])
  35.123 -  |> Code.postprocess_term thy;
  35.124 +  |> (fn t => Code_ML.eval NONE ("Eval.eval_ref", eval_ref) I thy t []);
  35.125  
  35.126  end;
  35.127  *}
    36.1 --- a/src/HOL/Code_Message.thy	Mon May 11 09:39:53 2009 +0200
    36.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.3 @@ -1,58 +0,0 @@
    36.4 -(*  ID:         $Id$
    36.5 -    Author:     Florian Haftmann, TU Muenchen
    36.6 -*)
    36.7 -
    36.8 -header {* Monolithic strings (message strings) for code generation *}
    36.9 -
   36.10 -theory Code_Message
   36.11 -imports Plain "~~/src/HOL/List"
   36.12 -begin
   36.13 -
   36.14 -subsection {* Datatype of messages *}
   36.15 -
   36.16 -datatype message_string = STR string
   36.17 -
   36.18 -lemmas [code del] = message_string.recs message_string.cases
   36.19 -
   36.20 -lemma [code]: "size (s\<Colon>message_string) = 0"
   36.21 -  by (cases s) simp_all
   36.22 -
   36.23 -lemma [code]: "message_string_size (s\<Colon>message_string) = 0"
   36.24 -  by (cases s) simp_all
   36.25 -
   36.26 -subsection {* ML interface *}
   36.27 -
   36.28 -ML {*
   36.29 -structure Message_String =
   36.30 -struct
   36.31 -
   36.32 -fun mk s = @{term STR} $ HOLogic.mk_string s;
   36.33 -
   36.34 -end;
   36.35 -*}
   36.36 -
   36.37 -
   36.38 -subsection {* Code serialization *}
   36.39 -
   36.40 -code_type message_string
   36.41 -  (SML "string")
   36.42 -  (OCaml "string")
   36.43 -  (Haskell "String")
   36.44 -
   36.45 -setup {*
   36.46 -  fold (fn target => add_literal_message @{const_name STR} target)
   36.47 -    ["SML", "OCaml", "Haskell"]
   36.48 -*}
   36.49 -
   36.50 -code_reserved SML string
   36.51 -code_reserved OCaml string
   36.52 -
   36.53 -code_instance message_string :: eq
   36.54 -  (Haskell -)
   36.55 -
   36.56 -code_const "eq_class.eq \<Colon> message_string \<Rightarrow> message_string \<Rightarrow> bool"
   36.57 -  (SML "!((_ : string) = _)")
   36.58 -  (OCaml "!((_ : string) = _)")
   36.59 -  (Haskell infixl 4 "==")
   36.60 -
   36.61 -end
    37.1 --- a/src/HOL/Code_Setup.thy	Mon May 11 09:39:53 2009 +0200
    37.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.3 @@ -1,253 +0,0 @@
    37.4 -(*  Title:      HOL/Code_Setup.thy
    37.5 -    ID:         $Id$
    37.6 -    Author:     Florian Haftmann
    37.7 -*)
    37.8 -
    37.9 -header {* Setup of code generators and related tools *}
   37.10 -
   37.11 -theory Code_Setup
   37.12 -imports HOL
   37.13 -begin
   37.14 -
   37.15 -subsection {* Generic code generator foundation *}
   37.16 -
   37.17 -text {* Datatypes *}
   37.18 -
   37.19 -code_datatype True False
   37.20 -
   37.21 -code_datatype "TYPE('a\<Colon>{})"
   37.22 -
   37.23 -code_datatype Trueprop "prop"
   37.24 -
   37.25 -text {* Code equations *}
   37.26 -
   37.27 -lemma [code]:
   37.28 -  shows "(True \<Longrightarrow> PROP P) \<equiv> PROP P" 
   37.29 -    and "(False \<Longrightarrow> Q) \<equiv> Trueprop True" 
   37.30 -    and "(PROP P \<Longrightarrow> True) \<equiv> Trueprop True" 
   37.31 -    and "(Q \<Longrightarrow> False) \<equiv> Trueprop (\<not> Q)" by (auto intro!: equal_intr_rule)
   37.32 -
   37.33 -lemma [code]:
   37.34 -  shows "False \<and> x \<longleftrightarrow> False"
   37.35 -    and "True \<and> x \<longleftrightarrow> x"
   37.36 -    and "x \<and> False \<longleftrightarrow> False"
   37.37 -    and "x \<and> True \<longleftrightarrow> x" by simp_all
   37.38 -
   37.39 -lemma [code]:
   37.40 -  shows "False \<or> x \<longleftrightarrow> x"
   37.41 -    and "True \<or> x \<longleftrightarrow> True"
   37.42 -    and "x \<or> False \<longleftrightarrow> x"
   37.43 -    and "x \<or> True \<longleftrightarrow> True" by simp_all
   37.44 -
   37.45 -lemma [code]:
   37.46 -  shows "\<not> True \<longleftrightarrow> False"
   37.47 -    and "\<not> False \<longleftrightarrow> True" by (rule HOL.simp_thms)+
   37.48 -
   37.49 -lemmas [code] = Let_def if_True if_False
   37.50 -
   37.51 -lemmas [code, code unfold, symmetric, code post] = imp_conv_disj
   37.52 -
   37.53 -text {* Equality *}
   37.54 -
   37.55 -context eq
   37.56 -begin
   37.57 -
   37.58 -lemma equals_eq [code inline, code]: "op = \<equiv> eq"
   37.59 -  by (rule eq_reflection) (rule ext, rule ext, rule sym, rule eq_equals)
   37.60 -
   37.61 -declare eq [code unfold, code inline del]
   37.62 -
   37.63 -declare equals_eq [symmetric, code post]
   37.64 -
   37.65 -end
   37.66 -
   37.67 -declare simp_thms(6) [code nbe]
   37.68 -
   37.69 -hide (open) const eq
   37.70 -hide const eq
   37.71 -
   37.72 -setup {*
   37.73 -  Code_Unit.add_const_alias @{thm equals_eq}
   37.74 -*}
   37.75 -
   37.76 -text {* Cases *}
   37.77 -
   37.78 -lemma Let_case_cert:
   37.79 -  assumes "CASE \<equiv> (\<lambda>x. Let x f)"
   37.80 -  shows "CASE x \<equiv> f x"
   37.81 -  using assms by simp_all
   37.82 -
   37.83 -lemma If_case_cert:
   37.84 -  assumes "CASE \<equiv> (\<lambda>b. If b f g)"
   37.85 -  shows "(CASE True \<equiv> f) &&& (CASE False \<equiv> g)"
   37.86 -  using assms by simp_all
   37.87 -
   37.88 -setup {*
   37.89 -  Code.add_case @{thm Let_case_cert}
   37.90 -  #> Code.add_case @{thm If_case_cert}
   37.91 -  #> Code.add_undefined @{const_name undefined}
   37.92 -*}
   37.93 -
   37.94 -code_abort undefined
   37.95 -
   37.96 -
   37.97 -subsection {* Generic code generator preprocessor *}
   37.98 -
   37.99 -setup {*
  37.100 -  Code.map_pre (K HOL_basic_ss)
  37.101 -  #> Code.map_post (K HOL_basic_ss)
  37.102 -*}
  37.103 -
  37.104 -
  37.105 -subsection {* Generic code generator target languages *}
  37.106 -
  37.107 -text {* type bool *}
  37.108 -
  37.109 -code_type bool
  37.110 -  (SML "bool")
  37.111 -  (OCaml "bool")
  37.112 -  (Haskell "Bool")
  37.113 -
  37.114 -code_const True and False and Not and "op &" and "op |" and If
  37.115 -  (SML "true" and "false" and "not"
  37.116 -    and infixl 1 "andalso" and infixl 0 "orelse"
  37.117 -    and "!(if (_)/ then (_)/ else (_))")
  37.118 -  (OCaml "true" and "false" and "not"
  37.119 -    and infixl 4 "&&" and infixl 2 "||"
  37.120 -    and "!(if (_)/ then (_)/ else (_))")
  37.121 -  (Haskell "True" and "False" and "not"
  37.122 -    and infixl 3 "&&" and infixl 2 "||"
  37.123 -    and "!(if (_)/ then (_)/ else (_))")
  37.124 -
  37.125 -code_reserved SML
  37.126 -  bool true false not
  37.127 -
  37.128 -code_reserved OCaml
  37.129 -  bool not
  37.130 -
  37.131 -text {* using built-in Haskell equality *}
  37.132 -
  37.133 -code_class eq
  37.134 -  (Haskell "Eq")
  37.135 -
  37.136 -code_const "eq_class.eq"
  37.137 -  (Haskell infixl 4 "==")
  37.138 -
  37.139 -code_const "op ="
  37.140 -  (Haskell infixl 4 "==")
  37.141 -
  37.142 -text {* undefined *}
  37.143 -
  37.144 -code_const undefined
  37.145 -  (SML "!(raise/ Fail/ \"undefined\")")
  37.146 -  (OCaml "failwith/ \"undefined\"")
  37.147 -  (Haskell "error/ \"undefined\"")
  37.148 -
  37.149 -
  37.150 -subsection {* SML code generator setup *}
  37.151 -
  37.152 -types_code
  37.153 -  "bool"  ("bool")
  37.154 -attach (term_of) {*
  37.155 -fun term_of_bool b = if b then HOLogic.true_const else HOLogic.false_const;
  37.156 -*}
  37.157 -attach (test) {*
  37.158 -fun gen_bool i =
  37.159 -  let val b = one_of [false, true]
  37.160 -  in (b, fn () => term_of_bool b) end;
  37.161 -*}
  37.162 -  "prop"  ("bool")
  37.163 -attach (term_of) {*
  37.164 -fun term_of_prop b =
  37.165 -  HOLogic.mk_Trueprop (if b then HOLogic.true_const else HOLogic.false_const);
  37.166 -*}
  37.167 -
  37.168 -consts_code
  37.169 -  "Trueprop" ("(_)")
  37.170 -  "True"    ("true")
  37.171 -  "False"   ("false")
  37.172 -  "Not"     ("Bool.not")
  37.173 -  "op |"    ("(_ orelse/ _)")
  37.174 -  "op &"    ("(_ andalso/ _)")
  37.175 -  "If"      ("(if _/ then _/ else _)")
  37.176 -
  37.177 -setup {*
  37.178 -let
  37.179 -
  37.180 -fun eq_codegen thy defs dep thyname b t gr =
  37.181 -    (case strip_comb t of
  37.182 -       (Const ("op =", Type (_, [Type ("fun", _), _])), _) => NONE
  37.183 -     | (Const ("op =", _), [t, u]) =>
  37.184 -          let
  37.185 -            val (pt, gr') = Codegen.invoke_codegen thy defs dep thyname false t gr;
  37.186 -            val (pu, gr'') = Codegen.invoke_codegen thy defs dep thyname false u gr';
  37.187 -            val (_, gr''') = Codegen.invoke_tycodegen thy defs dep thyname false HOLogic.boolT gr'';
  37.188 -          in
  37.189 -            SOME (Codegen.parens
  37.190 -              (Pretty.block [pt, Codegen.str " =", Pretty.brk 1, pu]), gr''')
  37.191 -          end
  37.192 -     | (t as Const ("op =", _), ts) => SOME (Codegen.invoke_codegen
  37.193 -         thy defs dep thyname b (Codegen.eta_expand t ts 2) gr)
  37.194 -     | _ => NONE);
  37.195 -
  37.196 -in
  37.197 -  Codegen.add_codegen "eq_codegen" eq_codegen
  37.198 -end
  37.199 -*}
  37.200 -
  37.201 -
  37.202 -subsection {* Evaluation and normalization by evaluation *}
  37.203 -
  37.204 -setup {*
  37.205 -  Value.add_evaluator ("SML", Codegen.eval_term o ProofContext.theory_of)
  37.206 -*}
  37.207 -
  37.208 -ML {*
  37.209 -structure Eval_Method =
  37.210 -struct
  37.211 -
  37.212 -val eval_ref : (unit -> bool) option ref = ref NONE;
  37.213 -
  37.214 -end;
  37.215 -*}
  37.216 -
  37.217 -oracle eval_oracle = {* fn ct =>
  37.218 -  let
  37.219 -    val thy = Thm.theory_of_cterm ct;
  37.220 -    val t = Thm.term_of ct;
  37.221 -    val dummy = @{cprop True};
  37.222 -  in case try HOLogic.dest_Trueprop t
  37.223 -   of SOME t' => if Code_ML.eval_term
  37.224 -         ("Eval_Method.eval_ref", Eval_Method.eval_ref) thy t' [] 
  37.225 -       then Thm.capply (Thm.capply @{cterm "op \<equiv> \<Colon> prop \<Rightarrow> prop \<Rightarrow> prop"} ct) dummy
  37.226 -       else dummy
  37.227 -    | NONE => dummy
  37.228 -  end
  37.229 -*}
  37.230 -
  37.231 -ML {*
  37.232 -fun gen_eval_method conv ctxt = SIMPLE_METHOD'
  37.233 -  (CONVERSION (Conv.params_conv (~1) (K (Conv.concl_conv (~1) conv)) ctxt)
  37.234 -    THEN' rtac TrueI)
  37.235 -*}
  37.236 -
  37.237 -method_setup eval = {* Scan.succeed (gen_eval_method eval_oracle) *}
  37.238 -  "solve goal by evaluation"
  37.239 -
  37.240 -method_setup evaluation = {* Scan.succeed (gen_eval_method Codegen.evaluation_conv) *}
  37.241 -  "solve goal by evaluation"
  37.242 -
  37.243 -method_setup normalization = {*
  37.244 -  Scan.succeed (K (SIMPLE_METHOD' (CONVERSION Nbe.norm_conv THEN' (fn k => TRY (rtac TrueI k)))))
  37.245 -*} "solve goal by normalization"
  37.246 -
  37.247 -
  37.248 -subsection {* Quickcheck *}
  37.249 -
  37.250 -setup {*
  37.251 -  Quickcheck.add_generator ("SML", Codegen.test_term)
  37.252 -*}
  37.253 -
  37.254 -quickcheck_params [size = 5, iterations = 50]
  37.255 -
  37.256 -end
    38.1 --- a/src/HOL/Complex.thy	Mon May 11 09:39:53 2009 +0200
    38.2 +++ b/src/HOL/Complex.thy	Mon May 11 17:20:52 2009 +0200
    38.3 @@ -157,23 +157,6 @@
    38.4  end
    38.5  
    38.6  
    38.7 -subsection {* Exponentiation *}
    38.8 -
    38.9 -instantiation complex :: recpower
   38.10 -begin
   38.11 -
   38.12 -primrec power_complex where
   38.13 -  "z ^ 0     = (1\<Colon>complex)"
   38.14 -| "z ^ Suc n = (z\<Colon>complex) * z ^ n"
   38.15 -
   38.16 -instance proof
   38.17 -qed simp_all
   38.18 -
   38.19 -declare power_complex.simps [simp del]
   38.20 -
   38.21 -end
   38.22 -
   38.23 -
   38.24  subsection {* Numerals and Arithmetic *}
   38.25  
   38.26  instantiation complex :: number_ring
    39.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Mon May 11 09:39:53 2009 +0200
    39.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Mon May 11 17:20:52 2009 +0200
    39.3 @@ -23,8 +23,8 @@
    39.4  qed
    39.5  
    39.6  lemma horner_schema: fixes f :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat" and F :: "nat \<Rightarrow> nat"
    39.7 -  assumes f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
    39.8 -  shows "horner F G n ((F^j') s) (f j') x = (\<Sum> j = 0..< n. -1^j * (1 / real (f (j' + j))) * x^j)"
    39.9 +  assumes f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   39.10 +  shows "horner F G n ((F ^^ j') s) (f j') x = (\<Sum> j = 0..< n. -1 ^ j * (1 / real (f (j' + j))) * x ^ j)"
   39.11  proof (induct n arbitrary: i k j')
   39.12    case (Suc n)
   39.13  
   39.14 @@ -33,13 +33,13 @@
   39.15  qed auto
   39.16  
   39.17  lemma horner_bounds':
   39.18 -  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
   39.19 +  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   39.20    and lb_0: "\<And> i k x. lb 0 i k x = 0"
   39.21    and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 (int k) - x * (ub n (F i) (G i k) x)"
   39.22    and ub_0: "\<And> i k x. ub 0 i k x = 0"
   39.23    and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 (int k) - x * (lb n (F i) (G i k) x)"
   39.24 -  shows "Ifloat (lb n ((F^j') s) (f j') x) \<le> horner F G n ((F^j') s) (f j') (Ifloat x) \<and> 
   39.25 -         horner F G n ((F^j') s) (f j') (Ifloat x) \<le> Ifloat (ub n ((F^j') s) (f j') x)"
   39.26 +  shows "Ifloat (lb n ((F ^^ j') s) (f j') x) \<le> horner F G n ((F ^^ j') s) (f j') (Ifloat x) \<and> 
   39.27 +         horner F G n ((F ^^ j') s) (f j') (Ifloat x) \<le> Ifloat (ub n ((F ^^ j') s) (f j') x)"
   39.28    (is "?lb n j' \<le> ?horner n j' \<and> ?horner n j' \<le> ?ub n j'")
   39.29  proof (induct n arbitrary: j')
   39.30    case 0 thus ?case unfolding lb_0 ub_0 horner.simps by auto
   39.31 @@ -49,15 +49,15 @@
   39.32    proof (rule add_mono)
   39.33      show "Ifloat (lapprox_rat prec 1 (int (f j'))) \<le> 1 / real (f j')" using lapprox_rat[of prec 1  "int (f j')"] by auto
   39.34      from Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc, THEN conjunct2] `0 \<le> Ifloat x`
   39.35 -    show "- Ifloat (x * ub n (F ((F ^ j') s)) (G ((F ^ j') s) (f j')) x) \<le> - (Ifloat x * horner F G n (F ((F ^ j') s)) (G ((F ^ j') s) (f j')) (Ifloat x))"
   39.36 +    show "- Ifloat (x * ub n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x) \<le> - (Ifloat x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) (Ifloat x))"
   39.37        unfolding Ifloat_mult neg_le_iff_le by (rule mult_left_mono)
   39.38    qed
   39.39    moreover have "?horner (Suc n) j' \<le> ?ub (Suc n) j'" unfolding ub_Suc ub_Suc horner.simps Ifloat_sub diff_def
   39.40    proof (rule add_mono)
   39.41      show "1 / real (f j') \<le> Ifloat (rapprox_rat prec 1 (int (f j')))" using rapprox_rat[of 1 "int (f j')" prec] by auto
   39.42      from Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc, THEN conjunct1] `0 \<le> Ifloat x`
   39.43 -    show "- (Ifloat x * horner F G n (F ((F ^ j') s)) (G ((F ^ j') s) (f j')) (Ifloat x)) \<le> 
   39.44 -          - Ifloat (x * lb n (F ((F ^ j') s)) (G ((F ^ j') s) (f j')) x)"
   39.45 +    show "- (Ifloat x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) (Ifloat x)) \<le> 
   39.46 +          - Ifloat (x * lb n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x)"
   39.47        unfolding Ifloat_mult neg_le_iff_le by (rule mult_left_mono)
   39.48    qed
   39.49    ultimately show ?case by blast
   39.50 @@ -73,13 +73,13 @@
   39.51  *}
   39.52  
   39.53  lemma horner_bounds: fixes F :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   39.54 -  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
   39.55 +  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   39.56    and lb_0: "\<And> i k x. lb 0 i k x = 0"
   39.57    and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 (int k) - x * (ub n (F i) (G i k) x)"
   39.58    and ub_0: "\<And> i k x. ub 0 i k x = 0"
   39.59    and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 (int k) - x * (lb n (F i) (G i k) x)"
   39.60 -  shows "Ifloat (lb n ((F^j') s) (f j') x) \<le> (\<Sum>j=0..<n. -1^j * (1 / real (f (j' + j))) * (Ifloat x)^j)" (is "?lb") and 
   39.61 -        "(\<Sum>j=0..<n. -1^j * (1 / real (f (j' + j))) * (Ifloat x)^j) \<le> Ifloat (ub n ((F^j') s) (f j') x)" (is "?ub")
   39.62 +  shows "Ifloat (lb n ((F ^^ j') s) (f j') x) \<le> (\<Sum>j=0..<n. -1 ^ j * (1 / real (f (j' + j))) * Ifloat x ^ j)" (is "?lb") and 
   39.63 +    "(\<Sum>j=0..<n. -1 ^ j * (1 / real (f (j' + j))) * (Ifloat x ^ j)) \<le> Ifloat (ub n ((F ^^ j') s) (f j') x)" (is "?ub")
   39.64  proof -
   39.65    have "?lb  \<and> ?ub" 
   39.66      using horner_bounds'[where lb=lb, OF `0 \<le> Ifloat x` f_Suc lb_0 lb_Suc ub_0 ub_Suc]
   39.67 @@ -88,29 +88,29 @@
   39.68  qed
   39.69  
   39.70  lemma horner_bounds_nonpos: fixes F :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   39.71 -  assumes "Ifloat x \<le> 0" and f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
   39.72 +  assumes "Ifloat x \<le> 0" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   39.73    and lb_0: "\<And> i k x. lb 0 i k x = 0"
   39.74    and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 (int k) + x * (ub n (F i) (G i k) x)"
   39.75    and ub_0: "\<And> i k x. ub 0 i k x = 0"
   39.76    and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 (int k) + x * (lb n (F i) (G i k) x)"
   39.77 -  shows "Ifloat (lb n ((F^j') s) (f j') x) \<le> (\<Sum>j=0..<n. (1 / real (f (j' + j))) * (Ifloat x)^j)" (is "?lb") and 
   39.78 -        "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * (Ifloat x)^j) \<le> Ifloat (ub n ((F^j') s) (f j') x)" (is "?ub")
   39.79 +  shows "Ifloat (lb n ((F ^^ j') s) (f j') x) \<le> (\<Sum>j=0..<n. (1 / real (f (j' + j))) * Ifloat x ^ j)" (is "?lb") and 
   39.80 +    "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * (Ifloat x ^ j)) \<le> Ifloat (ub n ((F ^^ j') s) (f j') x)" (is "?ub")
   39.81  proof -
   39.82    { fix x y z :: float have "x - y * z = x + - y * z"
   39.83 -      by (cases x, cases y, cases z, simp add: plus_float.simps minus_float.simps uminus_float.simps times_float.simps algebra_simps)
   39.84 +      by (cases x, cases y, cases z, simp add: plus_float.simps minus_float_def uminus_float.simps times_float.simps algebra_simps)
   39.85    } note diff_mult_minus = this
   39.86  
   39.87    { fix x :: float have "- (- x) = x" by (cases x, auto simp add: uminus_float.simps) } note minus_minus = this
   39.88  
   39.89    have move_minus: "Ifloat (-x) = -1 * Ifloat x" by auto
   39.90  
   39.91 -  have sum_eq: "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * (Ifloat x)^j) = 
   39.92 +  have sum_eq: "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * Ifloat x ^ j) = 
   39.93      (\<Sum>j = 0..<n. -1 ^ j * (1 / real (f (j' + j))) * Ifloat (- x) ^ j)"
   39.94    proof (rule setsum_cong, simp)
   39.95      fix j assume "j \<in> {0 ..< n}"
   39.96      show "1 / real (f (j' + j)) * Ifloat x ^ j = -1 ^ j * (1 / real (f (j' + j))) * Ifloat (- x) ^ j"
   39.97        unfolding move_minus power_mult_distrib real_mult_assoc[symmetric]
   39.98 -      unfolding real_mult_commute unfolding real_mult_assoc[of "-1^j", symmetric] power_mult_distrib[symmetric]
   39.99 +      unfolding real_mult_commute unfolding real_mult_assoc[of "-1 ^ j", symmetric] power_mult_distrib[symmetric]
  39.100        by auto
  39.101    qed
  39.102  
  39.103 @@ -160,21 +160,21 @@
  39.104                                              else (0, (max (-l) u) ^ n))"
  39.105  
  39.106  lemma float_power_bnds: assumes "(l1, u1) = float_power_bnds n l u" and "x \<in> {Ifloat l .. Ifloat u}"
  39.107 -  shows "x^n \<in> {Ifloat l1..Ifloat u1}"
  39.108 +  shows "x ^ n \<in> {Ifloat l1..Ifloat u1}"
  39.109  proof (cases "even n")
  39.110    case True 
  39.111    show ?thesis
  39.112    proof (cases "0 < l")
  39.113      case True hence "odd n \<or> 0 < l" and "0 \<le> Ifloat l" unfolding less_float_def by auto
  39.114      have u1: "u1 = u ^ n" and l1: "l1 = l ^ n" using assms unfolding float_power_bnds_def if_P[OF `odd n \<or> 0 < l`] by auto
  39.115 -    have "Ifloat l^n \<le> x^n" and "x^n \<le> Ifloat u^n " using `0 \<le> Ifloat l` and assms unfolding atLeastAtMost_iff using power_mono[of "Ifloat l" x] power_mono[of x "Ifloat u"] by auto
  39.116 +    have "Ifloat l ^ n \<le> x ^ n" and "x ^ n \<le> Ifloat u ^ n " using `0 \<le> Ifloat l` and assms unfolding atLeastAtMost_iff using power_mono[of "Ifloat l" x] power_mono[of x "Ifloat u"] by auto
  39.117      thus ?thesis using assms `0 < l` unfolding atLeastAtMost_iff l1 u1 float_power less_float_def by auto
  39.118    next
  39.119      case False hence P: "\<not> (odd n \<or> 0 < l)" using `even n` by auto
  39.120      show ?thesis
  39.121      proof (cases "u < 0")
  39.122        case True hence "0 \<le> - Ifloat u" and "- Ifloat u \<le> - x" and "0 \<le> - x" and "-x \<le> - Ifloat l" using assms unfolding less_float_def by auto
  39.123 -      hence "Ifloat u^n \<le> x^n" and "x^n \<le> Ifloat l^n" using power_mono[of  "-x" "-Ifloat l" n] power_mono[of "-Ifloat u" "-x" n] 
  39.124 +      hence "Ifloat u ^ n \<le> x ^ n" and "x ^ n \<le> Ifloat l ^ n" using power_mono[of  "-x" "-Ifloat l" n] power_mono[of "-Ifloat u" "-x" n] 
  39.125  	unfolding power_minus_even[OF `even n`] by auto
  39.126        moreover have u1: "u1 = l ^ n" and l1: "l1 = u ^ n" using assms unfolding float_power_bnds_def if_not_P[OF P] if_P[OF True] by auto
  39.127        ultimately show ?thesis using float_power by auto
  39.128 @@ -194,11 +194,11 @@
  39.129  next
  39.130    case False hence "odd n \<or> 0 < l" by auto
  39.131    have u1: "u1 = u ^ n" and l1: "l1 = l ^ n" using assms unfolding float_power_bnds_def if_P[OF `odd n \<or> 0 < l`] by auto
  39.132 -  have "Ifloat l^n \<le> x^n" and "x^n \<le> Ifloat u^n " using assms unfolding atLeastAtMost_iff using power_mono_odd[OF False] by auto
  39.133 +  have "Ifloat l ^ n \<le> x ^ n" and "x ^ n \<le> Ifloat u ^ n " using assms unfolding atLeastAtMost_iff using power_mono_odd[OF False] by auto
  39.134    thus ?thesis unfolding atLeastAtMost_iff l1 u1 float_power less_float_def by auto
  39.135  qed
  39.136  
  39.137 -lemma bnds_power: "\<forall> x l u. (l1, u1) = float_power_bnds n l u \<and> x \<in> {Ifloat l .. Ifloat u} \<longrightarrow> Ifloat l1 \<le> x^n \<and> x^n \<le> Ifloat u1"
  39.138 +lemma bnds_power: "\<forall> x l u. (l1, u1) = float_power_bnds n l u \<and> x \<in> {Ifloat l .. Ifloat u} \<longrightarrow> Ifloat l1 \<le> x ^ n \<and> x ^ n \<le> Ifloat u1"
  39.139    using float_power_bnds by auto
  39.140  
  39.141  section "Square root"
  39.142 @@ -794,8 +794,8 @@
  39.143    let "?f n" = "fact (2 * n)"
  39.144  
  39.145    { fix n 
  39.146 -    have F: "\<And>m. ((\<lambda>i. i + 2) ^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  39.147 -    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^ n) 1 * (((\<lambda>i. i + 2) ^ n) 1 + 1)"
  39.148 +    have F: "\<And>m. ((\<lambda>i. i + 2) ^^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  39.149 +    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^^ n) 1 * (((\<lambda>i. i + 2) ^^ n) 1 + 1)"
  39.150        unfolding F by auto } note f_eq = this
  39.151      
  39.152    from horner_bounds[where lb="lb_sin_cos_aux prec" and ub="ub_sin_cos_aux prec" and j'=0, 
  39.153 @@ -811,7 +811,7 @@
  39.154    have "0 < x * x" using `0 < x` unfolding less_float_def Ifloat_mult Ifloat_0
  39.155      using mult_pos_pos[where a="Ifloat x" and b="Ifloat x"] by auto
  39.156  
  39.157 -  { fix x n have "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * x^(2 * i))
  39.158 +  { fix x n have "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * x ^ (2 * i))
  39.159      = (\<Sum> i = 0 ..< 2 * n. (if even(i) then (-1 ^ (i div 2))/(real (fact i)) else 0) * x ^ i)" (is "?sum = ?ifsum")
  39.160    proof -
  39.161      have "?sum = ?sum + (\<Sum> j = 0 ..< n. 0)" by auto
  39.162 @@ -905,8 +905,8 @@
  39.163    let "?f n" = "fact (2 * n + 1)"
  39.164  
  39.165    { fix n 
  39.166 -    have F: "\<And>m. ((\<lambda>i. i + 2) ^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  39.167 -    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^ n) 2 * (((\<lambda>i. i + 2) ^ n) 2 + 1)"
  39.168 +    have F: "\<And>m. ((\<lambda>i. i + 2) ^^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  39.169 +    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^^ n) 2 * (((\<lambda>i. i + 2) ^^ n) 2 + 1)"
  39.170        unfolding F by auto } note f_eq = this
  39.171      
  39.172    from horner_bounds[where lb="lb_sin_cos_aux prec" and ub="ub_sin_cos_aux prec" and j'=0,
  39.173 @@ -1382,8 +1382,8 @@
  39.174    shows "exp (Ifloat x) \<in> { Ifloat (lb_exp_horner prec (get_even n) 1 1 x) .. Ifloat (ub_exp_horner prec (get_odd n) 1 1 x) }"
  39.175  proof -
  39.176    { fix n
  39.177 -    have F: "\<And> m. ((\<lambda>i. i + 1) ^ n) m = n + m" by (induct n, auto)
  39.178 -    have "fact (Suc n) = fact n * ((\<lambda>i. i + 1) ^ n) 1" unfolding F by auto } note f_eq = this
  39.179 +    have F: "\<And> m. ((\<lambda>i. i + 1) ^^ n) m = n + m" by (induct n, auto)
  39.180 +    have "fact (Suc n) = fact n * ((\<lambda>i. i + 1) ^^ n) 1" unfolding F by auto } note f_eq = this
  39.181      
  39.182    note bounds = horner_bounds_nonpos[where f="fact" and lb="lb_exp_horner prec" and ub="ub_exp_horner prec" and j'=0 and s=1,
  39.183      OF assms f_eq lb_exp_horner.simps ub_exp_horner.simps]
  39.184 @@ -1462,7 +1462,8 @@
  39.185      finally have "0 < Ifloat ((?horner x) ^ num)" .
  39.186    }
  39.187    ultimately show ?thesis
  39.188 -    unfolding lb_exp.simps if_not_P[OF `\<not> 0 < x`] Let_def by (cases "floor_fl x", cases "x < - 1", auto simp add: le_float_def less_float_def normfloat) 
  39.189 +    unfolding lb_exp.simps if_not_P[OF `\<not> 0 < x`] Let_def
  39.190 +    by (cases "floor_fl x", cases "x < - 1", auto simp add: float_power le_float_def less_float_def)
  39.191  qed
  39.192  
  39.193  lemma exp_boundaries': assumes "x \<le> 0"
  39.194 @@ -1631,10 +1632,10 @@
  39.195  
  39.196  lemma ln_bounds:
  39.197    assumes "0 \<le> x" and "x < 1"
  39.198 -  shows "(\<Sum>i=0..<2*n. -1^i * (1 / real (i + 1)) * x^(Suc i)) \<le> ln (x + 1)" (is "?lb")
  39.199 -  and "ln (x + 1) \<le> (\<Sum>i=0..<2*n + 1. -1^i * (1 / real (i + 1)) * x^(Suc i))" (is "?ub")
  39.200 +  shows "(\<Sum>i=0..<2*n. -1^i * (1 / real (i + 1)) * x ^ (Suc i)) \<le> ln (x + 1)" (is "?lb")
  39.201 +  and "ln (x + 1) \<le> (\<Sum>i=0..<2*n + 1. -1^i * (1 / real (i + 1)) * x ^ (Suc i))" (is "?ub")
  39.202  proof -
  39.203 -  let "?a n" = "(1/real (n +1)) * x^(Suc n)"
  39.204 +  let "?a n" = "(1/real (n +1)) * x ^ (Suc n)"
  39.205  
  39.206    have ln_eq: "(\<Sum> i. -1^i * ?a i) = ln (x + 1)"
  39.207      using ln_series[of "x + 1"] `0 \<le> x` `x < 1` by auto
  39.208 @@ -2479,7 +2480,7 @@
  39.209      fun lift_var (Free (varname, _)) = (case AList.lookup (op =) bound_eqs varname of
  39.210                                            SOME bound => bound
  39.211                                          | NONE => raise TERM ("No bound equations found for " ^ varname, []))
  39.212 -      | lift_var t = raise TERM ("Can not convert expression " ^ 
  39.213 +      | lift_var t = raise TERM ("Can not convert expression " ^
  39.214                                   (Syntax.string_of_term ctxt t), [t])
  39.215  
  39.216      val _ $ vs = HOLogic.dest_Trueprop (Logic.strip_imp_concl goal')
    40.1 --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Mon May 11 09:39:53 2009 +0200
    40.2 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Mon May 11 17:20:52 2009 +0200
    40.3 @@ -639,7 +639,7 @@
    40.4  
    40.5  interpretation class_ordered_field_dense_linear_order: constr_dense_linear_order
    40.6   "op <=" "op <"
    40.7 -   "\<lambda> x y. 1/2 * ((x::'a::{ordered_field,recpower,number_ring}) + y)"
    40.8 +   "\<lambda> x y. 1/2 * ((x::'a::{ordered_field,number_ring}) + y)"
    40.9  proof (unfold_locales, dlo, dlo, auto)
   40.10    fix x y::'a assume lt: "x < y"
   40.11    from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
    41.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Mon May 11 09:39:53 2009 +0200
    41.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Mon May 11 17:20:52 2009 +0200
    41.3 @@ -76,14 +76,14 @@
    41.4  				  @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
    41.5  				  Suc_plus1]
    41.6  			addsimps @{thms add_ac}
    41.7 -			addsimprocs [cancel_div_mod_proc]
    41.8 +			addsimprocs [cancel_div_mod_nat_proc, cancel_div_mod_int_proc]
    41.9      val simpset0 = HOL_basic_ss
   41.10        addsimps [mod_div_equality', Suc_plus1]
   41.11        addsimps comp_arith
   41.12        addsplits [split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
   41.13      (* Simp rules for changing (n::int) to int n *)
   41.14      val simpset1 = HOL_basic_ss
   41.15 -      addsimps [nat_number_of_def, zdvd_int] @ map (fn r => r RS sym)
   41.16 +      addsimps [@{thm nat_number_of_def}, zdvd_int] @ map (fn r => r RS sym)
   41.17          [@{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   41.18        addsplits [zdiff_int_split]
   41.19      (*simp rules for elimination of int n*)
    42.1 --- a/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Mon May 11 09:39:53 2009 +0200
    42.2 +++ b/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Mon May 11 17:20:52 2009 +0200
    42.3 @@ -7,147 +7,147 @@
    42.4  begin
    42.5  
    42.6  lemma
    42.7 -  "\<exists>(y::'a::{ordered_field,recpower,number_ring, division_by_zero}) <2. x + 3* y < 0 \<and> x - y >0"
    42.8 +  "\<exists>(y::'a::{ordered_field,number_ring, division_by_zero}) <2. x + 3* y < 0 \<and> x - y >0"
    42.9    by ferrack
   42.10  
   42.11 -lemma "~ (ALL x (y::'a::{ordered_field,recpower,number_ring, division_by_zero}). x < y --> 10*x < 11*y)"
   42.12 +lemma "~ (ALL x (y::'a::{ordered_field,number_ring, division_by_zero}). x < y --> 10*x < 11*y)"
   42.13    by ferrack
   42.14  
   42.15 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   42.16 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   42.17    by ferrack
   42.18  
   42.19 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. x ~= y --> x < y"
   42.20 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y. x ~= y --> x < y"
   42.21    by ferrack
   42.22  
   42.23 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   42.24 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   42.25    by ferrack
   42.26  
   42.27 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   42.28 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   42.29    by ferrack
   42.30  
   42.31 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX (y::'a::{ordered_field,recpower,number_ring, division_by_zero}). 4*x + 3*y <= 0 & 4*x + 3*y >= -1)"
   42.32 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX (y::'a::{ordered_field,number_ring, division_by_zero}). 4*x + 3*y <= 0 & 4*x + 3*y >= -1)"
   42.33    by ferrack
   42.34  
   42.35 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) < 0. (EX (y::'a::{ordered_field,recpower,number_ring, division_by_zero}) > 0. 7*x + y > 0 & x - y <= 9)"
   42.36 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) < 0. (EX (y::'a::{ordered_field,number_ring, division_by_zero}) > 0. 7*x + y > 0 & x - y <= 9)"
   42.37    by ferrack
   42.38  
   42.39 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   42.40 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   42.41    by ferrack
   42.42  
   42.43 -lemma "EX x. (ALL (y::'a::{ordered_field,recpower,number_ring, division_by_zero}). y < 2 -->  2*(y - x) \<le> 0 )"
   42.44 +lemma "EX x. (ALL (y::'a::{ordered_field,number_ring, division_by_zero}). y < 2 -->  2*(y - x) \<le> 0 )"
   42.45    by ferrack
   42.46  
   42.47 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   42.48 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   42.49    by ferrack
   42.50  
   42.51 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. x + y < z --> y >= z --> x < 0"
   42.52 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y z. x + y < z --> y >= z --> x < 0"
   42.53    by ferrack
   42.54  
   42.55 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   42.56 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   42.57    by ferrack
   42.58  
   42.59 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. abs (x + y) <= z --> (abs z = z)"
   42.60 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y z. abs (x + y) <= z --> (abs z = z)"
   42.61    by ferrack
   42.62  
   42.63 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   42.64 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   42.65    by ferrack
   42.66  
   42.67 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. (abs (5*x+3*y+z) <= 5*x+3*y+z & abs (5*x+3*y+z) >= - (5*x+3*y+z)) | (abs (5*x+3*y+z) >= 5*x+3*y+z & abs (5*x+3*y+z) <= - (5*x+3*y+z))"
   42.68 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y z. (abs (5*x+3*y+z) <= 5*x+3*y+z & abs (5*x+3*y+z) >= - (5*x+3*y+z)) | (abs (5*x+3*y+z) >= 5*x+3*y+z & abs (5*x+3*y+z) <= - (5*x+3*y+z))"
   42.69    by ferrack
   42.70  
   42.71 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. x < y --> (EX z>0. x+z = y)"
   42.72 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. x < y --> (EX z>0. x+z = y)"
   42.73    by ferrack
   42.74  
   42.75 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. x < y --> (EX z>0. x+z = y)"
   42.76 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. x < y --> (EX z>0. x+z = y)"
   42.77    by ferrack
   42.78  
   42.79 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (EX z>0. abs (x - y) <= z )"
   42.80 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. (EX z>0. abs (x - y) <= z )"
   42.81    by ferrack
   42.82  
   42.83 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   42.84 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   42.85    by ferrack
   42.86  
   42.87 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   42.88 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   42.89    by ferrack
   42.90  
   42.91 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   42.92 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   42.93    by ferrack
   42.94  
   42.95 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero})>0. (ALL y. (EX z. 13* abs z \<noteq> abs (12*y - x) & 5*x - 3*(abs y) <= 7*z))"
   42.96 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero})>0. (ALL y. (EX z. 13* abs z \<noteq> abs (12*y - x) & 5*x - 3*(abs y) <= 7*z))"
   42.97    by ferrack
   42.98  
   42.99 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). abs (4*x + 17) < 4 & (ALL y . abs (x*34 - 34*y - 9) \<noteq> 0 \<longrightarrow> (EX z. 5*x - 3*abs y <= 7*z))"
  42.100 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}). abs (4*x + 17) < 4 & (ALL y . abs (x*34 - 34*y - 9) \<noteq> 0 \<longrightarrow> (EX z. 5*x - 3*abs y <= 7*z))"
  42.101    by ferrack
  42.102  
  42.103 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y > abs (23*x - 9). (ALL z > abs (3*y - 19* abs x). x+z > 2*y))"
  42.104 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y > abs (23*x - 9). (ALL z > abs (3*y - 19* abs x). x+z > 2*y))"
  42.105    by ferrack
  42.106  
  42.107 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y< abs (3*x - 1). (ALL z >= (3*abs x - 1). abs (12*x - 13*y + 19*z) > abs (23*x) ))"
  42.108 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y< abs (3*x - 1). (ALL z >= (3*abs x - 1). abs (12*x - 13*y + 19*z) > abs (23*x) ))"
  42.109    by ferrack
  42.110  
  42.111 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). abs x < 100 & (ALL y > x. (EX z<2*y - x. 5*x - 3*y <= 7*z))"
  42.112 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}). abs x < 100 & (ALL y > x. (EX z<2*y - x. 5*x - 3*y <= 7*z))"
  42.113    by ferrack
  42.114  
  42.115 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z w. 7*x<3*y --> 5*y < 7*z --> z < 2*w --> 7*(2*w-x) > 2*y"
  42.116 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y z w. 7*x<3*y --> 5*y < 7*z --> z < 2*w --> 7*(2*w-x) > 2*y"
  42.117    by ferrack
  42.118  
  42.119 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
  42.120 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
  42.121    by ferrack
  42.122  
  42.123 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z w. 5*x + 3*z - 17*w + 7* (y - 8*x + z) <= max y (7*z - x + w)"
  42.124 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z w. 5*x + 3*z - 17*w + 7* (y - 8*x + z) <= max y (7*z - x + w)"
  42.125    by ferrack
  42.126  
  42.127 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  42.128 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  42.129    by ferrack
  42.130  
  42.131 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
  42.132 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
  42.133    by ferrack
  42.134  
  42.135 -lemma "~(ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y z w. 3* x + z*4 = 3*y & x + y < z & x> w & 3*x < w + y))"
  42.136 +lemma "~(ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y z w. 3* x + z*4 = 3*y & x + y < z & x> w & 3*x < w + y))"
  42.137    by ferrack
  42.138  
  42.139 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
  42.140 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
  42.141    by ferrack
  42.142  
  42.143 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w))"
  42.144 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w))"
  42.145    by ferrack
  42.146  
  42.147 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
  42.148 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
  42.149    by ferrack
  42.150  
  42.151 -lemma "EX z. (ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
  42.152 +lemma "EX z. (ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
  42.153    by ferrack
  42.154  
  42.155 -lemma "EX z. (ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) < abs z. (EX y w. x< y & x < z & x> w & 3*x < w + y))"
  42.156 +lemma "EX z. (ALL (x::'a::{ordered_field,number_ring, division_by_zero}) < abs z. (EX y w. x< y & x < z & x> w & 3*x < w + y))"
  42.157    by ferrack
  42.158  
  42.159 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
  42.160 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
  42.161    by ferrack
  42.162  
  42.163 -lemma "EX y. (ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)))"
  42.164 +lemma "EX y. (ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)))"
  42.165    by ferrack
  42.166  
  42.167 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
  42.168 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
  42.169    by ferrack
  42.170  
  42.171 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (ALL y < x. (EX z > (x+y).
  42.172 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}). (ALL y < x. (EX z > (x+y).
  42.173    (ALL w. 5*w + 10*x - z >= y --> w + 7*x + 3*z >= 2*y)))"
  42.174    by ferrack
  42.175  
  42.176 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (ALL y. (EX z > y.
  42.177 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}). (ALL y. (EX z > y.
  42.178    (ALL w . w < 13 --> w + 10*x - z >= y --> 5*w + 7*x + 13*z >= 2*y)))"
  42.179    by ferrack
  42.180  
  42.181 -lemma "EX (x::'a::{ordered_field,recpower,number_ring, division_by_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  42.182 +lemma "EX (x::'a::{ordered_field,number_ring, division_by_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  42.183    by ferrack
  42.184  
  42.185 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
  42.186 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
  42.187    by ferrack
  42.188  
  42.189 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
  42.190 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
  42.191    by ferrack
  42.192  
  42.193 -lemma "ALL (x::'a::{ordered_field,recpower,number_ring, division_by_zero}). (EX y. abs y ~= abs x & (ALL z> max x y. (EX w. w ~= y & w ~= z & 3*w - z >= x + y)))"
  42.194 +lemma "ALL (x::'a::{ordered_field,number_ring, division_by_zero}). (EX y. abs y ~= abs x & (ALL z> max x y. (EX w. w ~= y & w ~= z & 3*w - z >= x + y)))"
  42.195    by ferrack
  42.196  
  42.197  end
    43.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Mon May 11 09:39:53 2009 +0200
    43.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Mon May 11 17:20:52 2009 +0200
    43.3 @@ -99,7 +99,7 @@
    43.4                                    @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
    43.5                                    @{thm "Suc_plus1"}]
    43.6                          addsimps @{thms add_ac}
    43.7 -                        addsimprocs [cancel_div_mod_proc]
    43.8 +                        addsimprocs [cancel_div_mod_nat_proc, cancel_div_mod_int_proc]
    43.9      val simpset0 = HOL_basic_ss
   43.10        addsimps [mod_div_equality', Suc_plus1]
   43.11        addsimps comp_ths
    44.1 --- a/src/HOL/Deriv.thy	Mon May 11 09:39:53 2009 +0200
    44.2 +++ b/src/HOL/Deriv.thy	Mon May 11 17:20:52 2009 +0200
    44.3 @@ -1,5 +1,4 @@
    44.4  (*  Title       : Deriv.thy
    44.5 -    ID          : $Id$
    44.6      Author      : Jacques D. Fleuriot
    44.7      Copyright   : 1998  University of Cambridge
    44.8      Conversion to Isar and new proofs by Lawrence C Paulson, 2004
    44.9 @@ -197,7 +196,7 @@
   44.10  done
   44.11  
   44.12  lemma DERIV_power_Suc:
   44.13 -  fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,recpower}"
   44.14 +  fixes f :: "'a \<Rightarrow> 'a::{real_normed_field}"
   44.15    assumes f: "DERIV f x :> D"
   44.16    shows "DERIV (\<lambda>x. f x ^ Suc n) x :> (1 + of_nat n) * (D * f x ^ n)"
   44.17  proof (induct n)
   44.18 @@ -211,7 +210,7 @@
   44.19  qed
   44.20  
   44.21  lemma DERIV_power:
   44.22 -  fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,recpower}"
   44.23 +  fixes f :: "'a \<Rightarrow> 'a::{real_normed_field}"
   44.24    assumes f: "DERIV f x :> D"
   44.25    shows "DERIV (\<lambda>x. f x ^ n) x :> of_nat n * (D * f x ^ (n - Suc 0))"
   44.26  by (cases "n", simp, simp add: DERIV_power_Suc f del: power_Suc)
   44.27 @@ -287,20 +286,20 @@
   44.28  text{*Power of -1*}
   44.29  
   44.30  lemma DERIV_inverse:
   44.31 -  fixes x :: "'a::{real_normed_field,recpower}"
   44.32 +  fixes x :: "'a::{real_normed_field}"
   44.33    shows "x \<noteq> 0 ==> DERIV (%x. inverse(x)) x :> (-(inverse x ^ Suc (Suc 0)))"
   44.34  by (drule DERIV_inverse' [OF DERIV_ident]) simp
   44.35  
   44.36  text{*Derivative of inverse*}
   44.37  lemma DERIV_inverse_fun:
   44.38 -  fixes x :: "'a::{real_normed_field,recpower}"
   44.39 +  fixes x :: "'a::{real_normed_field}"
   44.40    shows "[| DERIV f x :> d; f(x) \<noteq> 0 |]
   44.41        ==> DERIV (%x. inverse(f x)) x :> (- (d * inverse(f(x) ^ Suc (Suc 0))))"
   44.42  by (drule (1) DERIV_inverse') (simp add: mult_ac nonzero_inverse_mult_distrib)
   44.43  
   44.44  text{*Derivative of quotient*}
   44.45  lemma DERIV_quotient:
   44.46 -  fixes x :: "'a::{real_normed_field,recpower}"
   44.47 +  fixes x :: "'a::{real_normed_field}"
   44.48    shows "[| DERIV f x :> d; DERIV g x :> e; g(x) \<noteq> 0 |]
   44.49         ==> DERIV (%y. f(y) / (g y)) x :> (d*g(x) - (e*f(x))) / (g(x) ^ Suc (Suc 0))"
   44.50  by (drule (2) DERIV_divide) (simp add: mult_commute)
   44.51 @@ -404,7 +403,7 @@
   44.52    unfolding divide_inverse using prems by simp
   44.53  
   44.54  lemma differentiable_power [simp]:
   44.55 -  fixes f :: "'a::{recpower,real_normed_field} \<Rightarrow> 'a"
   44.56 +  fixes f :: "'a::{real_normed_field} \<Rightarrow> 'a"
   44.57    assumes "f differentiable x"
   44.58    shows "(\<lambda>x. f x ^ n) differentiable x"
   44.59    by (induct n, simp, simp add: prems)
    45.1 --- a/src/HOL/Divides.thy	Mon May 11 09:39:53 2009 +0200
    45.2 +++ b/src/HOL/Divides.thy	Mon May 11 17:20:52 2009 +0200
    45.3 @@ -1,5 +1,4 @@
    45.4  (*  Title:      HOL/Divides.thy
    45.5 -    ID:         $Id$
    45.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    45.7      Copyright   1999  University of Cambridge
    45.8  *)
    45.9 @@ -20,11 +19,12 @@
   45.10  
   45.11  subsection {* Abstract division in commutative semirings. *}
   45.12  
   45.13 -class semiring_div = comm_semiring_1_cancel + div +
   45.14 +class semiring_div = comm_semiring_1_cancel + no_zero_divisors + div +
   45.15    assumes mod_div_equality: "a div b * b + a mod b = a"
   45.16      and div_by_0 [simp]: "a div 0 = 0"
   45.17      and div_0 [simp]: "0 div a = 0"
   45.18      and div_mult_self1 [simp]: "b \<noteq> 0 \<Longrightarrow> (a + c * b) div b = c + a div b"
   45.19 +    and div_mult_mult1 [simp]: "c \<noteq> 0 \<Longrightarrow> (c * a) div (c * b) = a div b"
   45.20  begin
   45.21  
   45.22  text {* @{const div} and @{const mod} *}
   45.23 @@ -38,16 +38,16 @@
   45.24    by (simp only: add_ac)
   45.25  
   45.26  lemma div_mod_equality: "((a div b) * b + a mod b) + c = a + c"
   45.27 -by (simp add: mod_div_equality)
   45.28 +  by (simp add: mod_div_equality)
   45.29  
   45.30  lemma div_mod_equality2: "(b * (a div b) + a mod b) + c = a + c"
   45.31 -by (simp add: mod_div_equality2)
   45.32 +  by (simp add: mod_div_equality2)
   45.33  
   45.34  lemma mod_by_0 [simp]: "a mod 0 = a"
   45.35 -using mod_div_equality [of a zero] by simp
   45.36 +  using mod_div_equality [of a zero] by simp
   45.37  
   45.38  lemma mod_0 [simp]: "0 mod a = 0"
   45.39 -using mod_div_equality [of zero a] div_0 by simp
   45.40 +  using mod_div_equality [of zero a] div_0 by simp
   45.41  
   45.42  lemma div_mult_self2 [simp]:
   45.43    assumes "b \<noteq> 0"
   45.44 @@ -72,7 +72,7 @@
   45.45  qed
   45.46  
   45.47  lemma mod_mult_self2 [simp]: "(a + b * c) mod b = a mod b"
   45.48 -by (simp add: mult_commute [of b])
   45.49 +  by (simp add: mult_commute [of b])
   45.50  
   45.51  lemma div_mult_self1_is_id [simp]: "b \<noteq> 0 \<Longrightarrow> b * a div b = a"
   45.52    using div_mult_self2 [of b 0 a] by simp
   45.53 @@ -238,9 +238,9 @@
   45.54      by (simp only: mod_add_eq [symmetric])
   45.55  qed
   45.56  
   45.57 -lemma div_add[simp]: "z dvd x \<Longrightarrow> z dvd y
   45.58 +lemma div_add [simp]: "z dvd x \<Longrightarrow> z dvd y
   45.59    \<Longrightarrow> (x + y) div z = x div z + y div z"
   45.60 -by(cases "z=0", simp, unfold dvd_def, auto simp add: algebra_simps)
   45.61 +by (cases "z = 0", simp, unfold dvd_def, auto simp add: algebra_simps)
   45.62  
   45.63  text {* Multiplication respects modular equivalence. *}
   45.64  
   45.65 @@ -297,24 +297,45 @@
   45.66    finally show ?thesis .
   45.67  qed
   45.68  
   45.69 +lemma div_mult_div_if_dvd:
   45.70 +  "y dvd x \<Longrightarrow> z dvd w \<Longrightarrow> (x div y) * (w div z) = (x * w) div (y * z)"
   45.71 +  apply (cases "y = 0", simp)
   45.72 +  apply (cases "z = 0", simp)
   45.73 +  apply (auto elim!: dvdE simp add: algebra_simps)
   45.74 +  apply (subst mult_assoc [symmetric])
   45.75 +  apply (simp add: no_zero_divisors)
   45.76 +  done
   45.77 +
   45.78 +lemma div_mult_mult2 [simp]:
   45.79 +  "c \<noteq> 0 \<Longrightarrow> (a * c) div (b * c) = a div b"
   45.80 +  by (drule div_mult_mult1) (simp add: mult_commute)
   45.81 +
   45.82 +lemma div_mult_mult1_if [simp]:
   45.83 +  "(c * a) div (c * b) = (if c = 0 then 0 else a div b)"
   45.84 +  by simp_all
   45.85 +
   45.86 +lemma mod_mult_mult1:
   45.87 +  "(c * a) mod (c * b) = c * (a mod b)"
   45.88 +proof (cases "c = 0")
   45.89 +  case True then show ?thesis by simp
   45.90 +next
   45.91 +  case False
   45.92 +  from mod_div_equality
   45.93 +  have "((c * a) div (c * b)) * (c * b) + (c * a) mod (c * b) = c * a" .
   45.94 +  with False have "c * ((a div b) * b + a mod b) + (c * a) mod (c * b)
   45.95 +    = c * a + c * (a mod b)" by (simp add: algebra_simps)
   45.96 +  with mod_div_equality show ?thesis by simp 
   45.97 +qed
   45.98 +  
   45.99 +lemma mod_mult_mult2:
  45.100 +  "(a * c) mod (b * c) = (a mod b) * c"
  45.101 +  using mod_mult_mult1 [of c a b] by (simp add: mult_commute)
  45.102 +
  45.103  end
  45.104  
  45.105 -lemma div_mult_div_if_dvd: "(y::'a::{semiring_div,no_zero_divisors}) dvd x \<Longrightarrow> 
  45.106 -  z dvd w \<Longrightarrow> (x div y) * (w div z) = (x * w) div (y * z)"
  45.107 -unfolding dvd_def
  45.108 -  apply clarify
  45.109 -  apply (case_tac "y = 0")
  45.110 -  apply simp
  45.111 -  apply (case_tac "z = 0")
  45.112 -  apply simp
  45.113 -  apply (simp add: algebra_simps)
  45.114 -  apply (subst mult_assoc [symmetric])
  45.115 -  apply (simp add: no_zero_divisors)
  45.116 -done
  45.117 -
  45.118 -
  45.119 -lemma div_power: "(y::'a::{semiring_div,no_zero_divisors,recpower}) dvd x \<Longrightarrow>
  45.120 -    (x div y)^n = x^n div y^n"
  45.121 +lemma div_power:
  45.122 +  "(y::'a::{semiring_div,no_zero_divisors,power}) dvd x \<Longrightarrow>
  45.123 +    (x div y) ^ n = x ^ n div y ^ n"
  45.124  apply (induct n)
  45.125   apply simp
  45.126  apply(simp add: div_mult_div_if_dvd dvd_power_same)
  45.127 @@ -398,15 +419,17 @@
  45.128    @{term "q\<Colon>nat"}(uotient) and @{term "r\<Colon>nat"}(emainder).
  45.129  *}
  45.130  
  45.131 -definition divmod_rel :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
  45.132 -  "divmod_rel m n q r \<longleftrightarrow> m = q * n + r \<and> (if n > 0 then 0 \<le> r \<and> r < n else q = 0)"
  45.133 +definition divmod_rel :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat \<Rightarrow> bool" where
  45.134 +  "divmod_rel m n qr \<longleftrightarrow>
  45.135 +    m = fst qr * n + snd qr \<and>
  45.136 +      (if n = 0 then fst qr = 0 else if n > 0 then 0 \<le> snd qr \<and> snd qr < n else n < snd qr \<and> snd qr \<le> 0)"
  45.137  
  45.138  text {* @{const divmod_rel} is total: *}
  45.139  
  45.140  lemma divmod_rel_ex:
  45.141 -  obtains q r where "divmod_rel m n q r"
  45.142 +  obtains q r where "divmod_rel m n (q, r)"
  45.143  proof (cases "n = 0")
  45.144 -  case True with that show thesis
  45.145 +  case True  with that show thesis
  45.146      by (auto simp add: divmod_rel_def)
  45.147  next
  45.148    case False
  45.149 @@ -436,13 +459,14 @@
  45.150  
  45.151  text {* @{const divmod_rel} is injective: *}
  45.152  
  45.153 -lemma divmod_rel_unique_div:
  45.154 -  assumes "divmod_rel m n q r"
  45.155 -    and "divmod_rel m n q' r'"
  45.156 -  shows "q = q'"
  45.157 +lemma divmod_rel_unique:
  45.158 +  assumes "divmod_rel m n qr"
  45.159 +    and "divmod_rel m n qr'"
  45.160 +  shows "qr = qr'"
  45.161  proof (cases "n = 0")
  45.162    case True with assms show ?thesis
  45.163 -    by (simp add: divmod_rel_def)
  45.164 +    by (cases qr, cases qr')
  45.165 +      (simp add: divmod_rel_def)
  45.166  next
  45.167    case False
  45.168    have aux: "\<And>q r q' r'. q' * n + r' = q * n + r \<Longrightarrow> r < n \<Longrightarrow> q' \<le> (q\<Colon>nat)"
  45.169 @@ -450,18 +474,11 @@
  45.170    apply (subst less_iff_Suc_add)
  45.171    apply (auto simp add: add_mult_distrib)
  45.172    done
  45.173 -  from `n \<noteq> 0` assms show ?thesis
  45.174 -    by (auto simp add: divmod_rel_def
  45.175 -      intro: order_antisym dest: aux sym)
  45.176 -qed
  45.177 -
  45.178 -lemma divmod_rel_unique_mod:
  45.179 -  assumes "divmod_rel m n q r"
  45.180 -    and "divmod_rel m n q' r'"
  45.181 -  shows "r = r'"
  45.182 -proof -
  45.183 -  from assms have "q = q'" by (rule divmod_rel_unique_div)
  45.184 -  with assms show ?thesis by (simp add: divmod_rel_def)
  45.185 +  from `n \<noteq> 0` assms have "fst qr = fst qr'"
  45.186 +    by (auto simp add: divmod_rel_def intro: order_antisym dest: aux sym)
  45.187 +  moreover from this assms have "snd qr = snd qr'"
  45.188 +    by (simp add: divmod_rel_def)
  45.189 +  ultimately show ?thesis by (cases qr, cases qr') simp
  45.190  qed
  45.191  
  45.192  text {*
  45.193 @@ -473,7 +490,21 @@
  45.194  begin
  45.195  
  45.196  definition divmod :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat" where
  45.197 -  [code del]: "divmod m n = (THE (q, r). divmod_rel m n q r)"
  45.198 +  [code del]: "divmod m n = (THE qr. divmod_rel m n qr)"
  45.199 +
  45.200 +lemma divmod_rel_divmod:
  45.201 +  "divmod_rel m n (divmod m n)"
  45.202 +proof -
  45.203 +  from divmod_rel_ex
  45.204 +    obtain qr where rel: "divmod_rel m n qr" .
  45.205 +  then show ?thesis
  45.206 +  by (auto simp add: divmod_def intro: theI elim: divmod_rel_unique)
  45.207 +qed
  45.208 +
  45.209 +lemma divmod_eq:
  45.210 +  assumes "divmod_rel m n qr" 
  45.211 +  shows "divmod m n = qr"
  45.212 +  using assms by (auto intro: divmod_rel_unique divmod_rel_divmod)
  45.213  
  45.214  definition div_nat where
  45.215    "m div n = fst (divmod m n)"
  45.216 @@ -485,30 +516,18 @@
  45.217    "divmod m n = (m div n, m mod n)"
  45.218    unfolding div_nat_def mod_nat_def by simp
  45.219  
  45.220 -lemma divmod_eq:
  45.221 -  assumes "divmod_rel m n q r" 
  45.222 -  shows "divmod m n = (q, r)"
  45.223 -  using assms by (auto simp add: divmod_def
  45.224 -    dest: divmod_rel_unique_div divmod_rel_unique_mod)
  45.225 -
  45.226  lemma div_eq:
  45.227 -  assumes "divmod_rel m n q r" 
  45.228 +  assumes "divmod_rel m n (q, r)" 
  45.229    shows "m div n = q"
  45.230 -  using assms by (auto dest: divmod_eq simp add: div_nat_def)
  45.231 +  using assms by (auto dest: divmod_eq simp add: divmod_div_mod)
  45.232  
  45.233  lemma mod_eq:
  45.234 -  assumes "divmod_rel m n q r" 
  45.235 +  assumes "divmod_rel m n (q, r)" 
  45.236    shows "m mod n = r"
  45.237 -  using assms by (auto dest: divmod_eq simp add: mod_nat_def)
  45.238 +  using assms by (auto dest: divmod_eq simp add: divmod_div_mod)
  45.239  
  45.240 -lemma divmod_rel: "divmod_rel m n (m div n) (m mod n)"
  45.241 -proof -
  45.242 -  from divmod_rel_ex
  45.243 -    obtain q r where rel: "divmod_rel m n q r" .
  45.244 -  moreover with div_eq mod_eq have "m div n = q" and "m mod n = r"
  45.245 -    by simp_all
  45.246 -  ultimately show ?thesis by simp
  45.247 -qed
  45.248 +lemma divmod_rel: "divmod_rel m n (m div n, m mod n)"
  45.249 +  by (simp add: div_nat_def mod_nat_def divmod_rel_divmod)
  45.250  
  45.251  lemma divmod_zero:
  45.252    "divmod m 0 = (0, m)"
  45.253 @@ -531,10 +550,10 @@
  45.254    assumes "0 < n" and "n \<le> m"
  45.255    shows "divmod m n = (Suc ((m - n) div n), (m - n) mod n)"
  45.256  proof -
  45.257 -  from divmod_rel have divmod_m_n: "divmod_rel m n (m div n) (m mod n)" .
  45.258 +  from divmod_rel have divmod_m_n: "divmod_rel m n (m div n, m mod n)" .
  45.259    with assms have m_div_n: "m div n \<ge> 1"
  45.260      by (cases "m div n") (auto simp add: divmod_rel_def)
  45.261 -  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0) (m mod n)"
  45.262 +  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0, m mod n)"
  45.263      by (cases "m div n") (auto simp add: divmod_rel_def)
  45.264    with divmod_eq have "divmod (m - n) n = (m div n - Suc 0, m mod n)" by simp
  45.265    moreover from divmod_div_mod have "divmod (m - n) n = ((m - n) div n, (m - n) mod n)" .
  45.266 @@ -569,55 +588,74 @@
  45.267    shows "m mod n = (m - n) mod n"
  45.268    using assms divmod_step divmod_div_mod by (cases "n = 0") simp_all
  45.269  
  45.270 -instance proof
  45.271 -  fix m n :: nat show "m div n * n + m mod n = m"
  45.272 -    using divmod_rel [of m n] by (simp add: divmod_rel_def)
  45.273 -next
  45.274 -  fix n :: nat show "n div 0 = 0"
  45.275 -    using divmod_zero divmod_div_mod [of n 0] by simp
  45.276 -next
  45.277 -  fix n :: nat show "0 div n = 0"
  45.278 -    using divmod_rel [of 0 n] by (cases n) (simp_all add: divmod_rel_def)
  45.279 -next
  45.280 -  fix m n q :: nat assume "n \<noteq> 0" then show "(q + m * n) div n = m + q div n"
  45.281 -    by (induct m) (simp_all add: le_div_geq)
  45.282 +instance proof -
  45.283 +  have [simp]: "\<And>n::nat. n div 0 = 0"
  45.284 +    by (simp add: div_nat_def divmod_zero)
  45.285 +  have [simp]: "\<And>n::nat. 0 div n = 0"
  45.286 +  proof -
  45.287 +    fix n :: nat
  45.288 +    show "0 div n = 0"
  45.289 +      by (cases "n = 0") simp_all
  45.290 +  qed
  45.291 +  show "OFCLASS(nat, semiring_div_class)" proof
  45.292 +    fix m n :: nat
  45.293 +    show "m div n * n + m mod n = m"
  45.294 +      using divmod_rel [of m n] by (simp add: divmod_rel_def)
  45.295 +  next
  45.296 +    fix m n q :: nat
  45.297 +    assume "n \<noteq> 0"
  45.298 +    then show "(q + m * n) div n = m + q div n"
  45.299 +      by (induct m) (simp_all add: le_div_geq)
  45.300 +  next
  45.301 +    fix m n q :: nat
  45.302 +    assume "m \<noteq> 0"
  45.303 +    then show "(m * n) div (m * q) = n div q"
  45.304 +    proof (cases "n \<noteq> 0 \<and> q \<noteq> 0")
  45.305 +      case False then show ?thesis by auto
  45.306 +    next
  45.307 +      case True with `m \<noteq> 0`
  45.308 +        have "m > 0" and "n > 0" and "q > 0" by auto
  45.309 +      then have "\<And>a b. divmod_rel n q (a, b) \<Longrightarrow> divmod_rel (m * n) (m * q) (a, m * b)"
  45.310 +        by (auto simp add: divmod_rel_def) (simp_all add: algebra_simps)
  45.311 +      moreover from divmod_rel have "divmod_rel n q (n div q, n mod q)" .
  45.312 +      ultimately have "divmod_rel (m * n) (m * q) (n div q, m * (n mod q))" .
  45.313 +      then show ?thesis by (simp add: div_eq)
  45.314 +    qed
  45.315 +  qed simp_all
  45.316  qed
  45.317  
  45.318  end
  45.319  
  45.320  text {* Simproc for cancelling @{const div} and @{const mod} *}
  45.321  
  45.322 -(*lemmas mod_div_equality_nat = semiring_div_class.times_div_mod_plus_zero_one.mod_div_equality [of "m\<Colon>nat" n, standard]
  45.323 -lemmas mod_div_equality2_nat = mod_div_equality2 [of "n\<Colon>nat" m, standard*)
  45.324 +ML {*
  45.325 +local
  45.326 +
  45.327 +structure CancelDivMod = CancelDivModFun(struct
  45.328  
  45.329 -ML {*
  45.330 -structure CancelDivModData =
  45.331 -struct
  45.332 -
  45.333 -val div_name = @{const_name div};
  45.334 -val mod_name = @{const_name mod};
  45.335 -val mk_binop = HOLogic.mk_binop;
  45.336 -val mk_sum = Nat_Arith.mk_sum;
  45.337 -val dest_sum = Nat_Arith.dest_sum;
  45.338 +  val div_name = @{const_name div};
  45.339 +  val mod_name = @{const_name mod};
  45.340 +  val mk_binop = HOLogic.mk_binop;
  45.341 +  val mk_sum = Nat_Arith.mk_sum;
  45.342 +  val dest_sum = Nat_Arith.dest_sum;
  45.343  
  45.344 -(*logic*)
  45.345 +  val div_mod_eqs = map mk_meta_eq [@{thm div_mod_equality}, @{thm div_mod_equality2}];
  45.346  
  45.347 -val div_mod_eqs = map mk_meta_eq [@{thm div_mod_equality}, @{thm div_mod_equality2}]
  45.348 -
  45.349 -val trans = trans
  45.350 +  val trans = trans;
  45.351  
  45.352 -val prove_eq_sums =
  45.353 -  let val simps = @{thm add_0} :: @{thm add_0_right} :: @{thms add_ac}
  45.354 -  in Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac simps) end;
  45.355 +  val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac
  45.356 +    (@{thm monoid_add_class.add_0_left} :: @{thm monoid_add_class.add_0_right} :: @{thms add_ac}))
  45.357  
  45.358 -end;
  45.359 +end)
  45.360  
  45.361 -structure CancelDivMod = CancelDivModFun(CancelDivModData);
  45.362 +in
  45.363  
  45.364 -val cancel_div_mod_proc = Simplifier.simproc (the_context ())
  45.365 +val cancel_div_mod_nat_proc = Simplifier.simproc (the_context ())
  45.366    "cancel_div_mod" ["(m::nat) + n"] (K CancelDivMod.proc);
  45.367  
  45.368 -Addsimprocs[cancel_div_mod_proc];
  45.369 +val _ = Addsimprocs [cancel_div_mod_nat_proc];
  45.370 +
  45.371 +end
  45.372  *}
  45.373  
  45.374  text {* code generator setup *}
  45.375 @@ -658,7 +696,7 @@
  45.376    fixes m n :: nat
  45.377    assumes "n > 0"
  45.378    shows "m mod n < (n::nat)"
  45.379 -  using assms divmod_rel unfolding divmod_rel_def by auto
  45.380 +  using assms divmod_rel [of m n] unfolding divmod_rel_def by auto
  45.381  
  45.382  lemma mod_less_eq_dividend [simp]:
  45.383    fixes m n :: nat
  45.384 @@ -700,18 +738,19 @@
  45.385  subsubsection {* Quotient and Remainder *}
  45.386  
  45.387  lemma divmod_rel_mult1_eq:
  45.388 -  "[| divmod_rel b c q r; c > 0 |]
  45.389 -   ==> divmod_rel (a*b) c (a*q + a*r div c) (a*r mod c)"
  45.390 +  "divmod_rel b c (q, r) \<Longrightarrow> c > 0
  45.391 +   \<Longrightarrow> divmod_rel (a * b) c (a * q + a * r div c, a * r mod c)"
  45.392  by (auto simp add: split_ifs divmod_rel_def algebra_simps)
  45.393  
  45.394 -lemma div_mult1_eq: "(a*b) div c = a*(b div c) + a*(b mod c) div (c::nat)"
  45.395 +lemma div_mult1_eq:
  45.396 +  "(a * b) div c = a * (b div c) + a * (b mod c) div (c::nat)"
  45.397  apply (cases "c = 0", simp)
  45.398  apply (blast intro: divmod_rel [THEN divmod_rel_mult1_eq, THEN div_eq])
  45.399  done
  45.400  
  45.401  lemma divmod_rel_add1_eq:
  45.402 -  "[| divmod_rel a c aq ar; divmod_rel b c bq br;  c > 0 |]
  45.403 -   ==> divmod_rel (a + b) c (aq + bq + (ar+br) div c) ((ar + br) mod c)"
  45.404 +  "divmod_rel a c (aq, ar) \<Longrightarrow> divmod_rel b c (bq, br) \<Longrightarrow>  c > 0
  45.405 +   \<Longrightarrow> divmod_rel (a + b) c (aq + bq + (ar + br) div c, (ar + br) mod c)"
  45.406  by (auto simp add: split_ifs divmod_rel_def algebra_simps)
  45.407  
  45.408  (*NOT suitable for rewriting: the RHS has an instance of the LHS*)
  45.409 @@ -728,8 +767,9 @@
  45.410    apply (simp add: add_mult_distrib2)
  45.411    done
  45.412  
  45.413 -lemma divmod_rel_mult2_eq: "[| divmod_rel a b q r;  0 < b;  0 < c |]
  45.414 -      ==> divmod_rel a (b*c) (q div c) (b*(q mod c) + r)"
  45.415 +lemma divmod_rel_mult2_eq:
  45.416 +  "divmod_rel a b (q, r) \<Longrightarrow> 0 < b \<Longrightarrow> 0 < c
  45.417 +   \<Longrightarrow> divmod_rel a (b * c) (q div c, b *(q mod c) + r)"
  45.418  by (auto simp add: mult_ac divmod_rel_def add_mult_distrib2 [symmetric] mod_lemma)
  45.419  
  45.420  lemma div_mult2_eq: "a div (b*c) = (a div b) div (c::nat)"
  45.421 @@ -745,23 +785,6 @@
  45.422    done
  45.423  
  45.424  
  45.425 -subsubsection{*Cancellation of Common Factors in Division*}
  45.426 -
  45.427 -lemma div_mult_mult_lemma:
  45.428 -    "[| (0::nat) < b;  0 < c |] ==> (c*a) div (c*b) = a div b"
  45.429 -by (auto simp add: div_mult2_eq)
  45.430 -
  45.431 -lemma div_mult_mult1 [simp]: "(0::nat) < c ==> (c*a) div (c*b) = a div b"
  45.432 -  apply (cases "b = 0")
  45.433 -  apply (auto simp add: linorder_neq_iff [of b] div_mult_mult_lemma)
  45.434 -  done
  45.435 -
  45.436 -lemma div_mult_mult2 [simp]: "(0::nat) < c ==> (a*c) div (b*c) = a div b"
  45.437 -  apply (drule div_mult_mult1)
  45.438 -  apply (auto simp add: mult_commute)
  45.439 -  done
  45.440 -
  45.441 -
  45.442  subsubsection{*Further Facts about Quotient and Remainder*}
  45.443  
  45.444  lemma div_1 [simp]: "m div Suc 0 = m"
  45.445 @@ -769,7 +792,7 @@
  45.446  
  45.447  
  45.448  (* Monotonicity of div in first argument *)
  45.449 -lemma div_le_mono [rule_format]:
  45.450 +lemma div_le_mono [rule_format (no_asm)]:
  45.451      "\<forall>m::nat. m \<le> n --> (m div k) \<le> (n div k)"
  45.452  apply (case_tac "k=0", simp)
  45.453  apply (induct "n" rule: nat_less_induct, clarify)
  45.454 @@ -824,12 +847,6 @@
  45.455    apply (simp_all)
  45.456  done
  45.457  
  45.458 -lemma nat_div_eq_0 [simp]: "(n::nat) > 0 ==> ((m div n) = 0) = (m < n)"
  45.459 -by(auto, subst mod_div_equality [of m n, symmetric], auto)
  45.460 -
  45.461 -lemma nat_div_gt_0 [simp]: "(n::nat) > 0 ==> ((m div n) > 0) = (m >= n)"
  45.462 -by (subst neq0_conv [symmetric], auto)
  45.463 -
  45.464  declare div_less_dividend [simp]
  45.465  
  45.466  text{*A fact for the mutilated chess board*}
  45.467 @@ -915,21 +932,13 @@
  45.468    done
  45.469  
  45.470  lemma dvd_imp_le: "[| k dvd n; 0 < n |] ==> k \<le> (n::nat)"
  45.471 -by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  45.472 -
  45.473 -lemma nat_dvd_not_less: "(0::nat) < m \<Longrightarrow> m < n \<Longrightarrow> \<not> n dvd m"
  45.474 -by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  45.475 +  by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  45.476  
  45.477  lemma dvd_mult_div_cancel: "n dvd m ==> n * (m div n) = (m::nat)"
  45.478 -  apply (subgoal_tac "m mod n = 0")
  45.479 -   apply (simp add: mult_div_cancel)
  45.480 -  apply (simp only: dvd_eq_mod_eq_0)
  45.481 -  done
  45.482 +  by (simp add: dvd_eq_mod_eq_0 mult_div_cancel)
  45.483  
  45.484 -lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
  45.485 -  by (induct n) auto
  45.486 -
  45.487 -lemma power_dvd_imp_le: "[|i^m dvd i^n;  (1::nat) < i|] ==> m \<le> n"
  45.488 +lemma power_dvd_imp_le:
  45.489 +  "i ^ m dvd i ^ n \<Longrightarrow> (1::nat) < i \<Longrightarrow> m \<le> n"
  45.490    apply (rule power_le_imp_le_exp, assumption)
  45.491    apply (erule dvd_imp_le, simp)
  45.492    done
  45.493 @@ -1001,9 +1010,11 @@
  45.494    from A B show ?lhs ..
  45.495  next
  45.496    assume P: ?lhs
  45.497 -  then have "divmod_rel m n q (m - n * q)"
  45.498 +  then have "divmod_rel m n (q, m - n * q)"
  45.499      unfolding divmod_rel_def by (auto simp add: mult_ac)
  45.500 -  then show ?rhs using divmod_rel by (rule divmod_rel_unique_div)
  45.501 +  with divmod_rel_unique divmod_rel [of m n]
  45.502 +  have "(q, m - n * q) = (m div n, m mod n)" by auto
  45.503 +  then show ?rhs by simp
  45.504  qed
  45.505  
  45.506  theorem split_div':
  45.507 @@ -1155,4 +1166,9 @@
  45.508    with j show ?thesis by blast
  45.509  qed
  45.510  
  45.511 +lemma nat_dvd_not_less:
  45.512 +  fixes m n :: nat
  45.513 +  shows "0 < m \<Longrightarrow> m < n \<Longrightarrow> \<not> n dvd m"
  45.514 +by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  45.515 +
  45.516  end
    46.1 --- a/src/HOL/Finite_Set.thy	Mon May 11 09:39:53 2009 +0200
    46.2 +++ b/src/HOL/Finite_Set.thy	Mon May 11 17:20:52 2009 +0200
    46.3 @@ -365,6 +365,29 @@
    46.4  lemma finite_Plus: "[| finite A; finite B |] ==> finite (A <+> B)"
    46.5  by (simp add: Plus_def)
    46.6  
    46.7 +lemma finite_PlusD: 
    46.8 +  fixes A :: "'a set" and B :: "'b set"
    46.9 +  assumes fin: "finite (A <+> B)"
   46.10 +  shows "finite A" "finite B"
   46.11 +proof -
   46.12 +  have "Inl ` A \<subseteq> A <+> B" by auto
   46.13 +  hence "finite (Inl ` A :: ('a + 'b) set)" using fin by(rule finite_subset)
   46.14 +  thus "finite A" by(rule finite_imageD)(auto intro: inj_onI)
   46.15 +next
   46.16 +  have "Inr ` B \<subseteq> A <+> B" by auto
   46.17 +  hence "finite (Inr ` B :: ('a + 'b) set)" using fin by(rule finite_subset)
   46.18 +  thus "finite B" by(rule finite_imageD)(auto intro: inj_onI)
   46.19 +qed
   46.20 +
   46.21 +lemma finite_Plus_iff[simp]: "finite (A <+> B) \<longleftrightarrow> finite A \<and> finite B"
   46.22 +by(auto intro: finite_PlusD finite_Plus)
   46.23 +
   46.24 +lemma finite_Plus_UNIV_iff[simp]:
   46.25 +  "finite (UNIV :: ('a + 'b) set) =
   46.26 +  (finite (UNIV :: 'a set) & finite (UNIV :: 'b set))"
   46.27 +by(subst UNIV_Plus_UNIV[symmetric])(rule finite_Plus_iff)
   46.28 +
   46.29 +
   46.30  text {* Sigma of finite sets *}
   46.31  
   46.32  lemma finite_SigmaI [simp]:
   46.33 @@ -1563,6 +1586,20 @@
   46.34  qed
   46.35  
   46.36  
   46.37 +lemma setsum_Plus:
   46.38 +  fixes A :: "'a set" and B :: "'b set"
   46.39 +  assumes fin: "finite A" "finite B"
   46.40 +  shows "setsum f (A <+> B) = setsum (f \<circ> Inl) A + setsum (f \<circ> Inr) B"
   46.41 +proof -
   46.42 +  have "A <+> B = Inl ` A \<union> Inr ` B" by auto
   46.43 +  moreover from fin have "finite (Inl ` A :: ('a + 'b) set)" "finite (Inr ` B :: ('a + 'b) set)"
   46.44 +    by(auto intro: finite_imageI)
   46.45 +  moreover have "Inl ` A \<inter> Inr ` B = ({} :: ('a + 'b) set)" by auto
   46.46 +  moreover have "inj_on (Inl :: 'a \<Rightarrow> 'a + 'b) A" "inj_on (Inr :: 'b \<Rightarrow> 'a + 'b) B" by(auto intro: inj_onI)
   46.47 +  ultimately show ?thesis using fin by(simp add: setsum_Un_disjoint setsum_reindex)
   46.48 +qed
   46.49 +
   46.50 +
   46.51  text {* Commuting outer and inner summation *}
   46.52  
   46.53  lemma swap_inj_on:
   46.54 @@ -2047,14 +2084,14 @@
   46.55  apply (auto simp add: algebra_simps)
   46.56  done
   46.57  
   46.58 -lemma setprod_constant: "finite A ==> (\<Prod>x\<in> A. (y::'a::{recpower, comm_monoid_mult})) = y^(card A)"
   46.59 +lemma setprod_constant: "finite A ==> (\<Prod>x\<in> A. (y::'a::{comm_monoid_mult})) = y^(card A)"
   46.60  apply (erule finite_induct)
   46.61  apply (auto simp add: power_Suc)
   46.62  done
   46.63  
   46.64  lemma setprod_gen_delta:
   46.65    assumes fS: "finite S"
   46.66 -  shows "setprod (\<lambda>k. if k=a then b k else c) S = (if a \<in> S then (b a ::'a::{comm_monoid_mult, recpower}) * c^ (card S - 1) else c^ card S)"
   46.67 +  shows "setprod (\<lambda>k. if k=a then b k else c) S = (if a \<in> S then (b a ::'a::{comm_monoid_mult}) * c^ (card S - 1) else c^ card S)"
   46.68  proof-
   46.69    let ?f = "(\<lambda>k. if k=a then b k else c)"
   46.70    {assume a: "a \<notin> S"
   46.71 @@ -2091,6 +2128,10 @@
   46.72  qed
   46.73  
   46.74  
   46.75 +lemma card_UNIV_unit: "card (UNIV :: unit set) = 1"
   46.76 +  unfolding UNIV_unit by simp
   46.77 +
   46.78 +
   46.79  subsubsection {* Cardinality of unions *}
   46.80  
   46.81  lemma card_UN_disjoint:
   46.82 @@ -2201,6 +2242,10 @@
   46.83      by (simp add: card_Un_disjoint card_image)
   46.84  qed
   46.85  
   46.86 +lemma card_Plus_conv_if:
   46.87 +  "card (A <+> B) = (if finite A \<and> finite B then card(A) + card(B) else 0)"
   46.88 +by(auto simp: card_def setsum_Plus simp del: setsum_constant)
   46.89 +
   46.90  
   46.91  subsubsection {* Cardinality of the Powerset *}
   46.92  
    47.1 --- a/src/HOL/Fun.thy	Mon May 11 09:39:53 2009 +0200
    47.2 +++ b/src/HOL/Fun.thy	Mon May 11 17:20:52 2009 +0200
    47.3 @@ -412,6 +412,9 @@
    47.4       "f(x:=y) ` A = (if x \<in> A then insert y (f ` (A-{x})) else f ` A)"
    47.5  by auto
    47.6  
    47.7 +lemma fun_upd_comp: "f \<circ> (g(x := y)) = (f \<circ> g)(x := f y)"
    47.8 +by(auto intro: ext)
    47.9 +
   47.10  
   47.11  subsection {* @{text override_on} *}
   47.12  
    48.1 --- a/src/HOL/Groebner_Basis.thy	Mon May 11 09:39:53 2009 +0200
    48.2 +++ b/src/HOL/Groebner_Basis.thy	Mon May 11 17:20:52 2009 +0200
    48.3 @@ -5,7 +5,7 @@
    48.4  header {* Semiring normalization and Groebner Bases *}
    48.5  
    48.6  theory Groebner_Basis
    48.7 -imports NatBin
    48.8 +imports Nat_Numeral
    48.9  uses
   48.10    "Tools/Groebner_Basis/misc.ML"
   48.11    "Tools/Groebner_Basis/normalizer_data.ML"
   48.12 @@ -164,7 +164,7 @@
   48.13  end
   48.14  
   48.15  interpretation class_semiring: gb_semiring
   48.16 -    "op +" "op *" "op ^" "0::'a::{comm_semiring_1, recpower}" "1"
   48.17 +    "op +" "op *" "op ^" "0::'a::{comm_semiring_1}" "1"
   48.18    proof qed (auto simp add: algebra_simps power_Suc)
   48.19  
   48.20  lemmas nat_arith =
   48.21 @@ -242,7 +242,7 @@
   48.22  
   48.23  
   48.24  interpretation class_ring: gb_ring "op +" "op *" "op ^"
   48.25 -    "0::'a::{comm_semiring_1,recpower,number_ring}" 1 "op -" "uminus"
   48.26 +    "0::'a::{comm_semiring_1,number_ring}" 1 "op -" "uminus"
   48.27    proof qed simp_all
   48.28  
   48.29  
   48.30 @@ -349,9 +349,9 @@
   48.31  qed
   48.32  
   48.33  interpretation class_ringb: ringb
   48.34 -  "op +" "op *" "op ^" "0::'a::{idom,recpower,number_ring}" "1" "op -" "uminus"
   48.35 +  "op +" "op *" "op ^" "0::'a::{idom,number_ring}" "1" "op -" "uminus"
   48.36  proof(unfold_locales, simp add: algebra_simps power_Suc, auto)
   48.37 -  fix w x y z ::"'a::{idom,recpower,number_ring}"
   48.38 +  fix w x y z ::"'a::{idom,number_ring}"
   48.39    assume p: "w * y + x * z = w * z + x * y" and ynz: "y \<noteq> z"
   48.40    hence ynz': "y - z \<noteq> 0" by simp
   48.41    from p have "w * y + x* z - w*z - x*y = 0" by simp
   48.42 @@ -471,7 +471,7 @@
   48.43  subsection{* Groebner Bases for fields *}
   48.44  
   48.45  interpretation class_fieldgb:
   48.46 -  fieldgb "op +" "op *" "op ^" "0::'a::{field,recpower,number_ring}" "1" "op -" "uminus" "op /" "inverse" apply (unfold_locales) by (simp_all add: divide_inverse)
   48.47 +  fieldgb "op +" "op *" "op ^" "0::'a::{field,number_ring}" "1" "op -" "uminus" "op /" "inverse" apply (unfold_locales) by (simp_all add: divide_inverse)
   48.48  
   48.49  lemma divide_Numeral1: "(x::'a::{field,number_ring}) / Numeral1 = x" by simp
   48.50  lemma divide_Numeral0: "(x::'a::{field,number_ring, division_by_zero}) / Numeral0 = 0"
   48.51 @@ -635,7 +635,7 @@
   48.52  val comp_conv = (Simplifier.rewrite
   48.53  (HOL_basic_ss addsimps @{thms "Groebner_Basis.comp_arith"}
   48.54                addsimps ths addsimps simp_thms
   48.55 -              addsimprocs field_cancel_numeral_factors
   48.56 +              addsimprocs Numeral_Simprocs.field_cancel_numeral_factors
   48.57                 addsimprocs [add_frac_frac_simproc, add_frac_num_simproc,
   48.58                              ord_frac_simproc]
   48.59                  addcongs [@{thm "if_weak_cong"}]))
    49.1 --- a/src/HOL/HOL.thy	Mon May 11 09:39:53 2009 +0200
    49.2 +++ b/src/HOL/HOL.thy	Mon May 11 17:20:52 2009 +0200
    49.3 @@ -5,9 +5,10 @@
    49.4  header {* The basis of Higher-Order Logic *}
    49.5  
    49.6  theory HOL
    49.7 -imports Pure
    49.8 +imports Pure "~~/src/Tools/Code_Generator"
    49.9  uses
   49.10    ("Tools/hologic.ML")
   49.11 +  "~~/src/Tools/auto_solve.ML"
   49.12    "~~/src/Tools/IsaPlanner/zipper.ML"
   49.13    "~~/src/Tools/IsaPlanner/isand.ML"
   49.14    "~~/src/Tools/IsaPlanner/rw_tools.ML"
   49.15 @@ -27,16 +28,6 @@
   49.16    "~~/src/Tools/atomize_elim.ML"
   49.17    "~~/src/Tools/induct.ML"
   49.18    ("~~/src/Tools/induct_tacs.ML")
   49.19 -  "~~/src/Tools/value.ML"
   49.20 -  "~~/src/Tools/code/code_name.ML"
   49.21 -  "~~/src/Tools/code/code_funcgr.ML" (*formal dependency*)
   49.22 -  "~~/src/Tools/code/code_wellsorted.ML" 
   49.23 -  "~~/src/Tools/code/code_thingol.ML"
   49.24 -  "~~/src/Tools/code/code_printer.ML"
   49.25 -  "~~/src/Tools/code/code_target.ML"
   49.26 -  "~~/src/Tools/code/code_ml.ML"
   49.27 -  "~~/src/Tools/code/code_haskell.ML"
   49.28 -  "~~/src/Tools/nbe.ML"
   49.29    ("Tools/recfun_codegen.ML")
   49.30  begin
   49.31  
   49.32 @@ -1577,6 +1568,56 @@
   49.33  setup Coherent.setup
   49.34  
   49.35  
   49.36 +subsubsection {* Reorienting equalities *}
   49.37 +
   49.38 +ML {*
   49.39 +signature REORIENT_PROC =
   49.40 +sig
   49.41 +  val init : theory -> theory
   49.42 +  val add : (term -> bool) -> theory -> theory
   49.43 +  val proc : morphism -> simpset -> cterm -> thm option
   49.44 +end;
   49.45 +
   49.46 +structure ReorientProc : REORIENT_PROC =
   49.47 +struct
   49.48 +  structure Data = TheoryDataFun
   49.49 +  (
   49.50 +    type T = term -> bool;
   49.51 +    val empty = (fn _ => false);
   49.52 +    val copy = I;
   49.53 +    val extend = I;
   49.54 +    fun merge _ (m1, m2) = (fn t => m1 t orelse m2 t);
   49.55 +  )
   49.56 +
   49.57 +  val init = Data.init;
   49.58 +  fun add m = Data.map (fn matches => fn t => matches t orelse m t);
   49.59 +  val meta_reorient = @{thm eq_commute [THEN eq_reflection]};
   49.60 +  fun proc phi ss ct =
   49.61 +    let
   49.62 +      val ctxt = Simplifier.the_context ss;
   49.63 +      val thy = ProofContext.theory_of ctxt;
   49.64 +      val matches = Data.get thy;
   49.65 +    in
   49.66 +      case Thm.term_of ct of
   49.67 +        (_ $ t $ u) => if matches u then NONE else SOME meta_reorient
   49.68 +      | _ => NONE
   49.69 +    end;
   49.70 +end;
   49.71 +*}
   49.72 +
   49.73 +setup ReorientProc.init
   49.74 +
   49.75 +setup {*
   49.76 +  ReorientProc.add
   49.77 +    (fn Const(@{const_name HOL.zero}, _) => true
   49.78 +      | Const(@{const_name HOL.one}, _) => true
   49.79 +      | _ => false)
   49.80 +*}
   49.81 +
   49.82 +simproc_setup reorient_zero ("0 = x") = ReorientProc.proc
   49.83 +simproc_setup reorient_one ("1 = x") = ReorientProc.proc
   49.84 +
   49.85 +
   49.86  subsection {* Other simple lemmas and lemma duplicates *}
   49.87  
   49.88  lemma Let_0 [simp]: "Let 0 f = f 0"
   49.89 @@ -1674,37 +1715,264 @@
   49.90  *}
   49.91  
   49.92  
   49.93 -subsection {* Code generator basics -- see further theory @{text "Code_Setup"} *}
   49.94 +subsection {* Code generator setup *}
   49.95 +
   49.96 +subsubsection {* SML code generator setup *}
   49.97 +
   49.98 +use "Tools/recfun_codegen.ML"
   49.99 +
  49.100 +setup {*
  49.101 +  Codegen.setup
  49.102 +  #> RecfunCodegen.setup
  49.103 +*}
  49.104 +
  49.105 +types_code
  49.106 +  "bool"  ("bool")
  49.107 +attach (term_of) {*
  49.108 +fun term_of_bool b = if b then HOLogic.true_const else HOLogic.false_const;
  49.109 +*}
  49.110 +attach (test) {*
  49.111 +fun gen_bool i =
  49.112 +  let val b = one_of [false, true]
  49.113 +  in (b, fn () => term_of_bool b) end;
  49.114 +*}
  49.115 +  "prop"  ("bool")
  49.116 +attach (term_of) {*
  49.117 +fun term_of_prop b =
  49.118 +  HOLogic.mk_Trueprop (if b then HOLogic.true_const else HOLogic.false_const);
  49.119 +*}
  49.120  
  49.121 -text {* Equality *}
  49.122 +consts_code
  49.123 +  "Trueprop" ("(_)")
  49.124 +  "True"    ("true")
  49.125 +  "False"   ("false")
  49.126 +  "Not"     ("Bool.not")
  49.127 +  "op |"    ("(_ orelse/ _)")
  49.128 +  "op &"    ("(_ andalso/ _)")
  49.129 +  "If"      ("(if _/ then _/ else _)")
  49.130 +
  49.131 +setup {*
  49.132 +let
  49.133 +
  49.134 +fun eq_codegen thy defs dep thyname b t gr =
  49.135 +    (case strip_comb t of
  49.136 +       (Const ("op =", Type (_, [Type ("fun", _), _])), _) => NONE
  49.137 +     | (Const ("op =", _), [t, u]) =>
  49.138 +          let
  49.139 +            val (pt, gr') = Codegen.invoke_codegen thy defs dep thyname false t gr;
  49.140 +            val (pu, gr'') = Codegen.invoke_codegen thy defs dep thyname false u gr';
  49.141 +            val (_, gr''') = Codegen.invoke_tycodegen thy defs dep thyname false HOLogic.boolT gr'';
  49.142 +          in
  49.143 +            SOME (Codegen.parens
  49.144 +              (Pretty.block [pt, Codegen.str " =", Pretty.brk 1, pu]), gr''')
  49.145 +          end
  49.146 +     | (t as Const ("op =", _), ts) => SOME (Codegen.invoke_codegen
  49.147 +         thy defs dep thyname b (Codegen.eta_expand t ts 2) gr)
  49.148 +     | _ => NONE);
  49.149 +
  49.150 +in
  49.151 +  Codegen.add_codegen "eq_codegen" eq_codegen
  49.152 +end
  49.153 +*}
  49.154 +
  49.155 +subsubsection {* Equality *}
  49.156  
  49.157  class eq =
  49.158    fixes eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  49.159    assumes eq_equals: "eq x y \<longleftrightarrow> x = y"
  49.160  begin
  49.161  
  49.162 -lemma eq: "eq = (op =)"
  49.163 +lemma eq [code unfold, code inline del]: "eq = (op =)"
  49.164    by (rule ext eq_equals)+
  49.165  
  49.166  lemma eq_refl: "eq x x \<longleftrightarrow> True"
  49.167    unfolding eq by rule+
  49.168  
  49.169 +lemma equals_eq [code inline]: "(op =) \<equiv> eq"
  49.170 +  by (rule eq_reflection) (rule ext, rule ext, rule sym, rule eq_equals)
  49.171 +
  49.172 +declare equals_eq [symmetric, code post]
  49.173 +
  49.174  end
  49.175  
  49.176 -text {* Module setup *}
  49.177 +declare equals_eq [code]
  49.178 +
  49.179 +
  49.180 +subsubsection {* Generic code generator foundation *}
  49.181 +
  49.182 +text {* Datatypes *}
  49.183 +
  49.184 +code_datatype True False
  49.185 +
  49.186 +code_datatype "TYPE('a\<Colon>{})"
  49.187 +
  49.188 +code_datatype Trueprop "prop"
  49.189 +
  49.190 +text {* Code equations *}
  49.191 +
  49.192 +lemma [code]:
  49.193 +  shows "(True \<Longrightarrow> PROP P) \<equiv> PROP P" 
  49.194 +    and "(False \<Longrightarrow> Q) \<equiv> Trueprop True" 
  49.195 +    and "(PROP P \<Longrightarrow> True) \<equiv> Trueprop True" 
  49.196 +    and "(Q \<Longrightarrow> False) \<equiv> Trueprop (\<not> Q)" by (auto intro!: equal_intr_rule)
  49.197 +
  49.198 +lemma [code]:
  49.199 +  shows "False \<and> x \<longleftrightarrow> False"
  49.200 +    and "True \<and> x \<longleftrightarrow> x"
  49.201 +    and "x \<and> False \<longleftrightarrow> False"
  49.202 +    and "x \<and> True \<longleftrightarrow> x" by simp_all
  49.203 +
  49.204 +lemma [code]:
  49.205 +  shows "False \<or> x \<longleftrightarrow> x"
  49.206 +    and "True \<or> x \<longleftrightarrow> True"
  49.207 +    and "x \<or> False \<longleftrightarrow> x"
  49.208 +    and "x \<or> True \<longleftrightarrow> True" by simp_all
  49.209 +
  49.210 +lemma [code]:
  49.211 +  shows "\<not> True \<longleftrightarrow> False"
  49.212 +    and "\<not> False \<longleftrightarrow> True" by (rule HOL.simp_thms)+
  49.213  
  49.214 -use "Tools/recfun_codegen.ML"
  49.215 +lemmas [code] = Let_def if_True if_False
  49.216 +
  49.217 +lemmas [code, code unfold, symmetric, code post] = imp_conv_disj
  49.218 +
  49.219 +text {* Equality *}
  49.220 +
  49.221 +declare simp_thms(6) [code nbe]
  49.222 +
  49.223 +hide (open) const eq
  49.224 +hide const eq
  49.225 +
  49.226 +setup {*
  49.227 +  Code_Unit.add_const_alias @{thm equals_eq}
  49.228 +*}
  49.229 +
  49.230 +text {* Cases *}
  49.231 +
  49.232 +lemma Let_case_cert:
  49.233 +  assumes "CASE \<equiv> (\<lambda>x. Let x f)"
  49.234 +  shows "CASE x \<equiv> f x"
  49.235 +  using assms by simp_all
  49.236 +
  49.237 +lemma If_case_cert:
  49.238 +  assumes "CASE \<equiv> (\<lambda>b. If b f g)"
  49.239 +  shows "(CASE True \<equiv> f) &&& (CASE False \<equiv> g)"
  49.240 +  using assms by simp_all
  49.241 +
  49.242 +setup {*
  49.243 +  Code.add_case @{thm Let_case_cert}
  49.244 +  #> Code.add_case @{thm If_case_cert}
  49.245 +  #> Code.add_undefined @{const_name undefined}
  49.246 +*}
  49.247 +
  49.248 +code_abort undefined
  49.249 +
  49.250 +subsubsection {* Generic code generator preprocessor *}
  49.251  
  49.252  setup {*
  49.253 -  Code_ML.setup
  49.254 -  #> Code_Haskell.setup
  49.255 -  #> Nbe.setup
  49.256 -  #> Codegen.setup
  49.257 -  #> RecfunCodegen.setup
  49.258 +  Code.map_pre (K HOL_basic_ss)
  49.259 +  #> Code.map_post (K HOL_basic_ss)
  49.260  *}
  49.261  
  49.262 +subsubsection {* Generic code generator target languages *}
  49.263  
  49.264 -subsection {* Nitpick hooks *}
  49.265 +text {* type bool *}
  49.266 +
  49.267 +code_type bool
  49.268 +  (SML "bool")
  49.269 +  (OCaml "bool")
  49.270 +  (Haskell "Bool")
  49.271 +
  49.272 +code_const True and False and Not and "op &" and "op |" and If
  49.273 +  (SML "true" and "false" and "not"
  49.274 +    and infixl 1 "andalso" and infixl 0 "orelse"
  49.275 +    and "!(if (_)/ then (_)/ else (_))")
  49.276 +  (OCaml "true" and "false" and "not"
  49.277 +    and infixl 4 "&&" and infixl 2 "||"
  49.278 +    and "!(if (_)/ then (_)/ else (_))")
  49.279 +  (Haskell "True" and "False" and "not"
  49.280 +    and infixl 3 "&&" and infixl 2 "||"
  49.281 +    and "!(if (_)/ then (_)/ else (_))")
  49.282 +
  49.283 +code_reserved SML
  49.284 +  bool true false not
  49.285 +
  49.286 +code_reserved OCaml
  49.287 +  bool not
  49.288 +
  49.289 +text {* using built-in Haskell equality *}
  49.290 +
  49.291 +code_class eq
  49.292 +  (Haskell "Eq")
  49.293 +
  49.294 +code_const "eq_class.eq"
  49.295 +  (Haskell infixl 4 "==")
  49.296 +
  49.297 +code_const "op ="
  49.298 +  (Haskell infixl 4 "==")
  49.299 +
  49.300 +text {* undefined *}
  49.301 +
  49.302 +code_const undefined
  49.303 +  (SML "!(raise/ Fail/ \"undefined\")")
  49.304 +  (OCaml "failwith/ \"undefined\"")
  49.305 +  (Haskell "error/ \"undefined\"")
  49.306 +
  49.307 +subsubsection {* Evaluation and normalization by evaluation *}
  49.308 +
  49.309 +setup {*
  49.310 +  Value.add_evaluator ("SML", Codegen.eval_term o ProofContext.theory_of)
  49.311 +*}
  49.312 +
  49.313 +ML {*
  49.314 +structure Eval_Method =
  49.315 +struct
  49.316 +
  49.317 +val eval_ref : (unit -> bool) option ref = ref NONE;
  49.318 +
  49.319 +end;
  49.320 +*}
  49.321 +
  49.322 +oracle eval_oracle = {* fn ct =>
  49.323 +  let
  49.324 +    val thy = Thm.theory_of_cterm ct;
  49.325 +    val t = Thm.term_of ct;
  49.326 +    val dummy = @{cprop True};
  49.327 +  in case try HOLogic.dest_Trueprop t
  49.328 +   of SOME t' => if Code_ML.eval NONE
  49.329 +         ("Eval_Method.eval_ref", Eval_Method.eval_ref) (K I) thy t' [] 
  49.330 +       then Thm.capply (Thm.capply @{cterm "op \<equiv> \<Colon> prop \<Rightarrow> prop \<Rightarrow> prop"} ct) dummy
  49.331 +       else dummy
  49.332 +    | NONE => dummy
  49.333 +  end
  49.334 +*}
  49.335 +
  49.336 +ML {*
  49.337 +fun gen_eval_method conv ctxt = SIMPLE_METHOD'
  49.338 +  (CONVERSION (Conv.params_conv (~1) (K (Conv.concl_conv (~1) conv)) ctxt)
  49.339 +    THEN' rtac TrueI)
  49.340 +*}
  49.341 +
  49.342 +method_setup eval = {* Scan.succeed (gen_eval_method eval_oracle) *}
  49.343 +  "solve goal by evaluation"
  49.344 +
  49.345 +method_setup evaluation = {* Scan.succeed (gen_eval_method Codegen.evaluation_conv) *}
  49.346 +  "solve goal by evaluation"
  49.347 +
  49.348 +method_setup normalization = {*
  49.349 +  Scan.succeed (K (SIMPLE_METHOD' (CONVERSION Nbe.norm_conv THEN' (fn k => TRY (rtac TrueI k)))))
  49.350 +*} "solve goal by normalization"
  49.351 +
  49.352 +subsubsection {* Quickcheck *}
  49.353 +
  49.354 +setup {*
  49.355 +  Quickcheck.add_generator ("SML", Codegen.test_term)
  49.356 +*}
  49.357 +
  49.358 +quickcheck_params [size = 5, iterations = 50]
  49.359 +
  49.360 +
  49.361 +subsection {* Nitpick setup *}
  49.362  
  49.363  text {* This will be relocated once Nitpick is moved to HOL. *}
  49.364  
  49.365 @@ -1730,10 +1998,14 @@
  49.366    val description = "introduction rules for (co)inductive predicates as needed by Nitpick"
  49.367  )
  49.368  *}
  49.369 -setup {* Nitpick_Const_Def_Thms.setup
  49.370 -         #> Nitpick_Const_Simp_Thms.setup
  49.371 -         #> Nitpick_Const_Psimp_Thms.setup
  49.372 -         #> Nitpick_Ind_Intro_Thms.setup *}
  49.373 +
  49.374 +setup {*
  49.375 +  Nitpick_Const_Def_Thms.setup
  49.376 +  #> Nitpick_Const_Simp_Thms.setup
  49.377 +  #> Nitpick_Const_Psimp_Thms.setup
  49.378 +  #> Nitpick_Ind_Intro_Thms.setup
  49.379 +*}
  49.380 +
  49.381  
  49.382  subsection {* Legacy tactics and ML bindings *}
  49.383  
    50.1 --- a/src/HOL/HoareParallel/Graph.thy	Mon May 11 09:39:53 2009 +0200
    50.2 +++ b/src/HOL/HoareParallel/Graph.thy	Mon May 11 17:20:52 2009 +0200
    50.3 @@ -172,9 +172,9 @@
    50.4   prefer 2 apply arith
    50.5   apply(drule_tac n = "Suc nata" in Compl_lemma)
    50.6   apply clarify
    50.7 - using [[fast_arith_split_limit = 0]]
    50.8 + using [[linarith_split_limit = 0]]
    50.9   apply force
   50.10 - using [[fast_arith_split_limit = 9]]
   50.11 + using [[linarith_split_limit = 9]]
   50.12  apply(drule leI)
   50.13  apply(subgoal_tac "Suc (length path - Suc m + nata)=(length path - Suc 0) - (m - Suc nata)")
   50.14   apply(erule_tac x = "m - (Suc nata)" in allE)
    51.1 --- a/src/HOL/HoareParallel/OG_Tran.thy	Mon May 11 09:39:53 2009 +0200
    51.2 +++ b/src/HOL/HoareParallel/OG_Tran.thy	Mon May 11 17:20:52 2009 +0200
    51.3 @@ -74,7 +74,7 @@
    51.4  abbreviation
    51.5    ann_transition_n :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a) 
    51.6                             \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)  where
    51.7 -  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition^n"
    51.8 +  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition ^^ n"
    51.9  
   51.10  abbreviation
   51.11    ann_transitions :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
   51.12 @@ -84,7 +84,7 @@
   51.13  abbreviation
   51.14    transition_n :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  
   51.15                            ("_ -P_\<rightarrow> _"[81,81,81] 100)  where
   51.16 -  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition^n"
   51.17 +  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition ^^ n"
   51.18  
   51.19  subsection {* Definition of Semantics *}
   51.20  
    52.1 --- a/src/HOL/IMP/Compiler0.thy	Mon May 11 09:39:53 2009 +0200
    52.2 +++ b/src/HOL/IMP/Compiler0.thy	Mon May 11 17:20:52 2009 +0200
    52.3 @@ -45,7 +45,7 @@
    52.4  abbreviation
    52.5    stepan :: "[instr list,state,nat,nat,state,nat] \<Rightarrow> bool"
    52.6      ("_ \<turnstile>/ (3\<langle>_,_\<rangle>/ -(_)\<rightarrow> \<langle>_,_\<rangle>)" [50,0,0,0,0,0] 50)  where
    52.7 -  "P \<turnstile> \<langle>s,m\<rangle> -(i)\<rightarrow> \<langle>t,n\<rangle> == ((s,m),t,n) : ((stepa1 P)^i)"
    52.8 +  "P \<turnstile> \<langle>s,m\<rangle> -(i)\<rightarrow> \<langle>t,n\<rangle> == ((s,m),t,n) : (stepa1 P ^^ i)"
    52.9  
   52.10  subsection "The compiler"
   52.11  
    53.1 --- a/src/HOL/IMP/Machines.thy	Mon May 11 09:39:53 2009 +0200
    53.2 +++ b/src/HOL/IMP/Machines.thy	Mon May 11 17:20:52 2009 +0200
    53.3 @@ -1,7 +1,6 @@
    53.4 -
    53.5 -(* $Id$ *)
    53.6 -
    53.7 -theory Machines imports Natural begin
    53.8 +theory Machines
    53.9 +imports Natural
   53.10 +begin
   53.11  
   53.12  lemma rtrancl_eq: "R^* = Id \<union> (R O R^*)"
   53.13    by (fast intro: rtrancl_into_rtrancl elim: rtranclE)
   53.14 @@ -11,20 +10,22 @@
   53.15  
   53.16  lemmas converse_rel_powE = rel_pow_E2
   53.17  
   53.18 -lemma R_O_Rn_commute: "R O R^n = R^n O R"
   53.19 +lemma R_O_Rn_commute: "R O R ^^ n = R ^^ n O R"
   53.20    by (induct n) (simp, simp add: O_assoc [symmetric])
   53.21  
   53.22  lemma converse_in_rel_pow_eq:
   53.23 -  "((x,z) \<in> R^n) = (n=0 \<and> z=x \<or> (\<exists>m y. n = Suc m \<and> (x,y) \<in> R \<and> (y,z) \<in> R^m))"
   53.24 +  "((x,z) \<in> R ^^ n) = (n=0 \<and> z=x \<or> (\<exists>m y. n = Suc m \<and> (x,y) \<in> R \<and> (y,z) \<in> R ^^ m))"
   53.25  apply(rule iffI)
   53.26   apply(blast elim:converse_rel_powE)
   53.27  apply (fastsimp simp add:gr0_conv_Suc R_O_Rn_commute)
   53.28  done
   53.29  
   53.30 -lemma rel_pow_plus: "R^(m+n) = R^n O R^m"
   53.31 +lemma rel_pow_plus:
   53.32 +  "R ^^ (m+n) = R ^^ n O R ^^ m"
   53.33    by (induct n) (simp, simp add: O_assoc)
   53.34  
   53.35 -lemma rel_pow_plusI: "\<lbrakk> (x,y) \<in> R^m; (y,z) \<in> R^n \<rbrakk> \<Longrightarrow> (x,z) \<in> R^(m+n)"
   53.36 +lemma rel_pow_plusI:
   53.37 +  "\<lbrakk> (x,y) \<in> R ^^ m; (y,z) \<in> R ^^ n \<rbrakk> \<Longrightarrow> (x,z) \<in> R ^^ (m+n)"
   53.38    by (simp add: rel_pow_plus rel_compI)
   53.39  
   53.40  subsection "Instructions"
   53.41 @@ -57,7 +58,7 @@
   53.42  abbreviation
   53.43    exec0n :: "[instrs, nat,state, nat, nat,state] \<Rightarrow> bool"
   53.44      ("(_/ \<turnstile> (1\<langle>_,/_\<rangle>)/ -_\<rightarrow> (1\<langle>_,/_\<rangle>))" [50,0,0,0,0] 50)  where
   53.45 -  "p \<turnstile> \<langle>i,s\<rangle> -n\<rightarrow> \<langle>j,t\<rangle> == ((i,s),j,t) : (exec01 p)^n"
   53.46 +  "p \<turnstile> \<langle>i,s\<rangle> -n\<rightarrow> \<langle>j,t\<rangle> == ((i,s),j,t) : (exec01 p)^^n"
   53.47  
   53.48  subsection "M0 with lists"
   53.49  
   53.50 @@ -89,7 +90,7 @@
   53.51  abbreviation
   53.52    stepan :: "[instrs,instrs,state, nat, instrs,instrs,state] \<Rightarrow> bool"
   53.53      ("((1\<langle>_,/_,/_\<rangle>)/ -_\<rightarrow> (1\<langle>_,/_,/_\<rangle>))" 50) where
   53.54 -  "\<langle>p,q,s\<rangle> -i\<rightarrow> \<langle>p',q',t\<rangle> == ((p,q,s),p',q',t) : (stepa1^i)"
   53.55 +  "\<langle>p,q,s\<rangle> -i\<rightarrow> \<langle>p',q',t\<rangle> == ((p,q,s),p',q',t) : (stepa1^^i)"
   53.56  
   53.57  inductive_cases execE: "((i#is,p,s), (is',p',s')) : stepa1"
   53.58  
    54.1 --- a/src/HOL/IMP/Transition.thy	Mon May 11 09:39:53 2009 +0200
    54.2 +++ b/src/HOL/IMP/Transition.thy	Mon May 11 17:20:52 2009 +0200
    54.3 @@ -1,5 +1,4 @@
    54.4  (*  Title:        HOL/IMP/Transition.thy
    54.5 -    ID:           $Id$
    54.6      Author:       Tobias Nipkow & Robert Sandner, TUM
    54.7      Isar Version: Gerwin Klein, 2001
    54.8      Copyright     1996 TUM
    54.9 @@ -69,7 +68,7 @@
   54.10  abbreviation
   54.11    evalcn :: "[(com option\<times>state),nat,(com option\<times>state)] \<Rightarrow> bool"
   54.12      ("_ -_\<rightarrow>\<^sub>1 _" [60,60,60] 60)  where
   54.13 -  "cs -n\<rightarrow>\<^sub>1 cs' == (cs,cs') \<in> evalc1^n"
   54.14 +  "cs -n\<rightarrow>\<^sub>1 cs' == (cs,cs') \<in> evalc1^^n"
   54.15  
   54.16  abbreviation
   54.17    evalc' :: "[(com option\<times>state),(com option\<times>state)] \<Rightarrow> bool"
   54.18 @@ -77,28 +76,9 @@
   54.19    "cs \<longrightarrow>\<^sub>1\<^sup>* cs' == (cs,cs') \<in> evalc1^*"
   54.20  
   54.21  (*<*)
   54.22 -(* fixme: move to Relation_Power.thy *)
   54.23 -lemma rel_pow_Suc_E2 [elim!]:
   54.24 -  "[| (x, z) \<in> R ^ Suc n; !!y. [| (x, y) \<in> R; (y, z) \<in> R ^ n |] ==> P |] ==> P"
   54.25 -  by (blast dest: rel_pow_Suc_D2)
   54.26 +declare rel_pow_Suc_E2 [elim!]
   54.27 +(*>*)
   54.28  
   54.29 -lemma rtrancl_imp_rel_pow: "p \<in> R^* \<Longrightarrow> \<exists>n. p \<in> R^n"
   54.30 -proof (induct p)
   54.31 -  fix x y
   54.32 -  assume "(x, y) \<in> R\<^sup>*"
   54.33 -  thus "\<exists>n. (x, y) \<in> R^n"
   54.34 -  proof induct
   54.35 -    fix a have "(a, a) \<in> R^0" by simp
   54.36 -    thus "\<exists>n. (a, a) \<in> R ^ n" ..
   54.37 -  next
   54.38 -    fix a b c assume "\<exists>n. (a, b) \<in> R ^ n"
   54.39 -    then obtain n where "(a, b) \<in> R^n" ..
   54.40 -    moreover assume "(b, c) \<in> R"
   54.41 -    ultimately have "(a, c) \<in> R^(Suc n)" by auto
   54.42 -    thus "\<exists>n. (a, c) \<in> R^n" ..
   54.43 -  qed
   54.44 -qed
   54.45 -(*>*)
   54.46  text {*
   54.47    As for the big step semantics you can read these rules in a
   54.48    syntax directed way:
   54.49 @@ -189,8 +169,8 @@
   54.50  (*<*)
   54.51  (* FIXME: relpow.simps don't work *)
   54.52  lemmas [simp del] = relpow.simps
   54.53 -lemma rel_pow_0 [simp]: "!!R::('a*'a) set. R^0 = Id" by (simp add: relpow.simps)
   54.54 -lemma rel_pow_Suc_0 [simp]: "!!R::('a*'a) set. R^(Suc 0) = R" by (simp add: relpow.simps)
   54.55 +lemma rel_pow_0 [simp]: "!!R::('a*'a) set. R ^^ 0 = Id" by (simp add: relpow.simps)
   54.56 +lemma rel_pow_Suc_0 [simp]: "!!R::('a*'a) set. R ^^ Suc 0 = R" by (simp add: relpow.simps)
   54.57  
   54.58  (*>*)
   54.59  lemma evalc1_None_0 [simp]: "\<langle>s\<rangle> -n\<rightarrow>\<^sub>1 y = (n = 0 \<and> y = \<langle>s\<rangle>)"
    55.1 --- a/src/HOL/Imperative_HOL/Heap_Monad.thy	Mon May 11 09:39:53 2009 +0200
    55.2 +++ b/src/HOL/Imperative_HOL/Heap_Monad.thy	Mon May 11 17:20:52 2009 +0200
    55.3 @@ -317,7 +317,7 @@
    55.4        val dummy_type = ITyVar dummy_name;
    55.5        val dummy_case_term = IVar dummy_name;
    55.6        (*assumption: dummy values are not relevant for serialization*)
    55.7 -      val unitt = IConst (unit', ([], []));
    55.8 +      val unitt = IConst (unit', (([], []), []));
    55.9        fun dest_abs ((v, ty) `|-> t, _) = ((v, ty), t)
   55.10          | dest_abs (t, ty) =
   55.11              let
   55.12 @@ -353,10 +353,10 @@
   55.13      | imp_monad_bind bind' return' unit' (ICase (((t, ty), pats), t0)) = ICase
   55.14          (((imp_monad_bind bind' return' unit' t, ty), (map o pairself) (imp_monad_bind bind' return' unit') pats), imp_monad_bind bind' return' unit' t0);
   55.15  
   55.16 -   fun imp_program naming = (Graph.map_nodes o map_terms_stmt)
   55.17 -     (imp_monad_bind (lookup naming @{const_name bindM})
   55.18 -       (lookup naming @{const_name return})
   55.19 -       (lookup naming @{const_name Unity}));
   55.20 +  fun imp_program naming = (Graph.map_nodes o map_terms_stmt)
   55.21 +    (imp_monad_bind (lookup naming @{const_name bindM})
   55.22 +      (lookup naming @{const_name return})
   55.23 +      (lookup naming @{const_name Unity}));
   55.24  
   55.25  in
   55.26  
    56.1 --- a/src/HOL/Import/HOL/HOL4Base.thy	Mon May 11 09:39:53 2009 +0200
    56.2 +++ b/src/HOL/Import/HOL/HOL4Base.thy	Mon May 11 17:20:52 2009 +0200
    56.3 @@ -2794,8 +2794,8 @@
    56.4    by (import numeral numeral_fact)
    56.5  
    56.6  lemma numeral_funpow: "ALL n::nat.
    56.7 -   ((f::'a::type => 'a::type) ^ n) (x::'a::type) =
    56.8 -   (if n = 0 then x else (f ^ (n - 1)) (f x))"
    56.9 +   ((f::'a::type => 'a::type) ^^ n) (x::'a::type) =
   56.10 +   (if n = 0 then x else (f ^^ (n - 1)) (f x))"
   56.11    by (import numeral numeral_funpow)
   56.12  
   56.13  ;end_setup
    57.1 --- a/src/HOL/Import/HOL/HOL4Word32.thy	Mon May 11 09:39:53 2009 +0200
    57.2 +++ b/src/HOL/Import/HOL/HOL4Word32.thy	Mon May 11 17:20:52 2009 +0200
    57.3 @@ -434,15 +434,15 @@
    57.4    by (import word32 EQUIV_QT)
    57.5  
    57.6  lemma FUNPOW_THM: "ALL (f::'a::type => 'a::type) (n::nat) x::'a::type.
    57.7 -   (f ^ n) (f x) = f ((f ^ n) x)"
    57.8 +   (f ^^ n) (f x) = f ((f ^^ n) x)"
    57.9    by (import word32 FUNPOW_THM)
   57.10  
   57.11  lemma FUNPOW_THM2: "ALL (f::'a::type => 'a::type) (n::nat) x::'a::type.
   57.12 -   (f ^ Suc n) x = f ((f ^ n) x)"
   57.13 +   (f ^^ Suc n) x = f ((f ^^ n) x)"
   57.14    by (import word32 FUNPOW_THM2)
   57.15  
   57.16  lemma FUNPOW_COMP: "ALL (f::'a::type => 'a::type) (m::nat) (n::nat) a::'a::type.
   57.17 -   (f ^ m) ((f ^ n) a) = (f ^ (m + n)) a"
   57.18 +   (f ^^ m) ((f ^^ n) a) = (f ^^ (m + n)) a"
   57.19    by (import word32 FUNPOW_COMP)
   57.20  
   57.21  lemma INw_MODw: "ALL n::nat. INw (MODw n)"
   57.22 @@ -1170,23 +1170,23 @@
   57.23  
   57.24  constdefs
   57.25    word_lsr :: "word32 => nat => word32" 
   57.26 -  "word_lsr == %(a::word32) n::nat. (word_lsr1 ^ n) a"
   57.27 +  "word_lsr == %(a::word32) n::nat. (word_lsr1 ^^ n) a"
   57.28  
   57.29 -lemma word_lsr: "ALL (a::word32) n::nat. word_lsr a n = (word_lsr1 ^ n) a"
   57.30 +lemma word_lsr: "ALL (a::word32) n::nat. word_lsr a n = (word_lsr1 ^^ n) a"
   57.31    by (import word32 word_lsr)
   57.32  
   57.33  constdefs
   57.34    word_asr :: "word32 => nat => word32" 
   57.35 -  "word_asr == %(a::word32) n::nat. (word_asr1 ^ n) a"
   57.36 +  "word_asr == %(a::word32) n::nat. (word_asr1 ^^ n) a"
   57.37  
   57.38 -lemma word_asr: "ALL (a::word32) n::nat. word_asr a n = (word_asr1 ^ n) a"
   57.39 +lemma word_asr: "ALL (a::word32) n::nat. word_asr a n = (word_asr1 ^^ n) a"
   57.40    by (import word32 word_asr)
   57.41  
   57.42  constdefs
   57.43    word_ror :: "word32 => nat => word32" 
   57.44 -  "word_ror == %(a::word32) n::nat. (word_ror1 ^ n) a"
   57.45 +  "word_ror == %(a::word32) n::nat. (word_ror1 ^^ n) a"
   57.46  
   57.47 -lemma word_ror: "ALL (a::word32) n::nat. word_ror a n = (word_ror1 ^ n) a"
   57.48 +lemma word_ror: "ALL (a::word32) n::nat. word_ror a n = (word_ror1 ^^ n) a"
   57.49    by (import word32 word_ror)
   57.50  
   57.51  consts
   57.52 @@ -1583,4 +1583,3 @@
   57.53  ;end_setup
   57.54  
   57.55  end
   57.56 -
    58.1 --- a/src/HOL/Import/HOL/arithmetic.imp	Mon May 11 09:39:53 2009 +0200
    58.2 +++ b/src/HOL/Import/HOL/arithmetic.imp	Mon May 11 17:20:52 2009 +0200
    58.3 @@ -43,7 +43,7 @@
    58.4    "TWO" > "HOL4Base.arithmetic.TWO"
    58.5    "TIMES2" > "NatSimprocs.nat_mult_2"
    58.6    "SUC_SUB1" > "HOL4Base.arithmetic.SUC_SUB1"
    58.7 -  "SUC_ONE_ADD" > "NatBin.Suc_eq_add_numeral_1_left"
    58.8 +  "SUC_ONE_ADD" > "Nat_Numeral.Suc_eq_add_numeral_1_left"
    58.9    "SUC_NOT" > "Nat.nat.simps_2"
   58.10    "SUC_ELIM_THM" > "HOL4Base.arithmetic.SUC_ELIM_THM"
   58.11    "SUC_ADD_SYM" > "HOL4Base.arithmetic.SUC_ADD_SYM"
   58.12 @@ -233,7 +233,7 @@
   58.13    "EVEN_AND_ODD" > "HOL4Base.arithmetic.EVEN_AND_ODD"
   58.14    "EVEN_ADD" > "HOL4Base.arithmetic.EVEN_ADD"
   58.15    "EVEN" > "HOL4Base.arithmetic.EVEN"
   58.16 -  "EQ_MULT_LCANCEL" > "NatBin.nat_mult_eq_cancel_disj"
   58.17 +  "EQ_MULT_LCANCEL" > "Nat_Numeral.nat_mult_eq_cancel_disj"
   58.18    "EQ_MONO_ADD_EQ" > "Nat.nat_add_right_cancel"
   58.19    "EQ_LESS_EQ" > "Orderings.order_eq_iff"
   58.20    "EQ_ADD_RCANCEL" > "Nat.nat_add_right_cancel"
    59.1 --- a/src/HOL/Import/HOL/real.imp	Mon May 11 09:39:53 2009 +0200
    59.2 +++ b/src/HOL/Import/HOL/real.imp	Mon May 11 17:20:52 2009 +0200
    59.3 @@ -99,7 +99,7 @@
    59.4    "REAL_POW_INV" > "Power.power_inverse"
    59.5    "REAL_POW_DIV" > "Power.power_divide"
    59.6    "REAL_POW_ADD" > "Power.power_add"
    59.7 -  "REAL_POW2_ABS" > "NatBin.power2_abs"
    59.8 +  "REAL_POW2_ABS" > "Nat_Numeral.power2_abs"
    59.9    "REAL_POS_NZ" > "HOL4Real.real.REAL_POS_NZ"
   59.10    "REAL_POS" > "RealDef.real_of_nat_ge_zero"
   59.11    "REAL_POASQ" > "HOL4Real.real.REAL_POASQ"
   59.12 @@ -210,7 +210,7 @@
   59.13    "REAL_LE_RDIV_EQ" > "Ring_and_Field.pos_le_divide_eq"
   59.14    "REAL_LE_RDIV" > "Ring_and_Field.mult_imp_le_div_pos"
   59.15    "REAL_LE_RADD" > "OrderedGroup.add_le_cancel_right"
   59.16 -  "REAL_LE_POW2" > "NatBin.zero_compare_simps_12"
   59.17 +  "REAL_LE_POW2" > "Nat_Numeral.zero_compare_simps_12"
   59.18    "REAL_LE_NEGTOTAL" > "HOL4Real.real.REAL_LE_NEGTOTAL"
   59.19    "REAL_LE_NEGR" > "OrderedGroup.le_minus_self_iff"
   59.20    "REAL_LE_NEGL" > "OrderedGroup.minus_le_self_iff"
   59.21 @@ -313,7 +313,7 @@
   59.22    "POW_ONE" > "Power.power_one"
   59.23    "POW_NZ" > "Power.field_power_not_zero"
   59.24    "POW_MUL" > "Power.power_mult_distrib"
   59.25 -  "POW_MINUS1" > "NatBin.power_minus1_even"
   59.26 +  "POW_MINUS1" > "Nat_Numeral.power_minus1_even"
   59.27    "POW_M1" > "HOL4Real.real.POW_M1"
   59.28    "POW_LT" > "HOL4Real.real.POW_LT"
   59.29    "POW_LE" > "Power.power_mono"
   59.30 @@ -323,7 +323,7 @@
   59.31    "POW_ABS" > "Power.power_abs"
   59.32    "POW_2_LT" > "RealPow.two_realpow_gt"
   59.33    "POW_2_LE1" > "RealPow.two_realpow_ge_one"
   59.34 -  "POW_2" > "NatBin.power2_eq_square"
   59.35 +  "POW_2" > "Nat_Numeral.power2_eq_square"
   59.36    "POW_1" > "Power.power_one_right"
   59.37    "POW_0" > "Power.power_0_Suc"
   59.38    "ABS_ZERO" > "OrderedGroup.abs_eq_0"
   59.39 @@ -335,7 +335,7 @@
   59.40    "ABS_SIGN2" > "HOL4Real.real.ABS_SIGN2"
   59.41    "ABS_SIGN" > "HOL4Real.real.ABS_SIGN"
   59.42    "ABS_REFL" > "HOL4Real.real.ABS_REFL"
   59.43 -  "ABS_POW2" > "NatBin.abs_power2"
   59.44 +  "ABS_POW2" > "Nat_Numeral.abs_power2"
   59.45    "ABS_POS" > "OrderedGroup.abs_ge_zero"
   59.46    "ABS_NZ" > "OrderedGroup.zero_less_abs_iff"
   59.47    "ABS_NEG" > "OrderedGroup.abs_minus_cancel"
    60.1 --- a/src/HOL/Import/HOL4Compat.thy	Mon May 11 09:39:53 2009 +0200
    60.2 +++ b/src/HOL/Import/HOL4Compat.thy	Mon May 11 17:20:52 2009 +0200
    60.3 @@ -202,19 +202,13 @@
    60.4  
    60.5  constdefs
    60.6    FUNPOW :: "('a => 'a) => nat => 'a => 'a"
    60.7 -  "FUNPOW f n == f ^ n"
    60.8 +  "FUNPOW f n == f ^^ n"
    60.9  
   60.10 -lemma FUNPOW: "(ALL f x. (f ^ 0) x = x) &
   60.11 -  (ALL f n x. (f ^ Suc n) x = (f ^ n) (f x))"
   60.12 -proof auto
   60.13 -  fix f n x
   60.14 -  have "ALL x. f ((f ^ n) x) = (f ^ n) (f x)"
   60.15 -    by (induct n,auto)
   60.16 -  thus "f ((f ^ n) x) = (f ^ n) (f x)"
   60.17 -    ..
   60.18 -qed
   60.19 +lemma FUNPOW: "(ALL f x. (f ^^ 0) x = x) &
   60.20 +  (ALL f n x. (f ^^ Suc n) x = (f ^^ n) (f x))"
   60.21 +  by (simp add: funpow_swap1)
   60.22  
   60.23 -lemma [hol4rew]: "FUNPOW f n = f ^ n"
   60.24 +lemma [hol4rew]: "FUNPOW f n = f ^^ n"
   60.25    by (simp add: FUNPOW_def)
   60.26  
   60.27  lemma ADD: "(!n. (0::nat) + n = n) & (!m n. Suc m + n = Suc (m + n))"
   60.28 @@ -224,7 +218,7 @@
   60.29    by simp
   60.30  
   60.31  lemma SUB: "(!m. (0::nat) - m = 0) & (!m n. (Suc m) - n = (if m < n then 0 else Suc (m - n)))"
   60.32 -  by (simp, arith)
   60.33 +  by (simp) arith
   60.34  
   60.35  lemma MAX_DEF: "max (m::nat) n = (if m < n then n else m)"
   60.36    by (simp add: max_def)
    61.1 --- a/src/HOL/Import/HOLLight/hollight.imp	Mon May 11 09:39:53 2009 +0200
    61.2 +++ b/src/HOL/Import/HOLLight/hollight.imp	Mon May 11 17:20:52 2009 +0200
    61.3 @@ -1515,7 +1515,7 @@
    61.4    "EQ_REFL_T" > "HOL.simp_thms_6"
    61.5    "EQ_REFL" > "Presburger.fm_modd_pinf"
    61.6    "EQ_MULT_RCANCEL" > "Nat.mult_cancel2"
    61.7 -  "EQ_MULT_LCANCEL" > "NatBin.nat_mult_eq_cancel_disj"
    61.8 +  "EQ_MULT_LCANCEL" > "Nat_Numeral.nat_mult_eq_cancel_disj"
    61.9    "EQ_IMP_LE" > "HOLLight.hollight.EQ_IMP_LE"
   61.10    "EQ_EXT" > "HOL.meta_eq_to_obj_eq"
   61.11    "EQ_CLAUSES" > "HOLLight.hollight.EQ_CLAUSES"
    62.1 --- a/src/HOL/Int.thy	Mon May 11 09:39:53 2009 +0200
    62.2 +++ b/src/HOL/Int.thy	Mon May 11 17:20:52 2009 +0200
    62.3 @@ -12,10 +12,13 @@
    62.4  uses
    62.5    ("Tools/numeral.ML")
    62.6    ("Tools/numeral_syntax.ML")
    62.7 +  ("Tools/int_arith.ML")
    62.8    "~~/src/Provers/Arith/assoc_fold.ML"
    62.9    "~~/src/Provers/Arith/cancel_numerals.ML"
   62.10    "~~/src/Provers/Arith/combine_numerals.ML"
   62.11 -  ("Tools/int_arith.ML")
   62.12 +  "~~/src/Provers/Arith/cancel_numeral_factor.ML"
   62.13 +  "~~/src/Provers/Arith/extract_common_term.ML"
   62.14 +  ("Tools/numeral_simprocs.ML")
   62.15  begin
   62.16  
   62.17  subsection {* The equivalence relation underlying the integers *}
   62.18 @@ -292,9 +295,7 @@
   62.19  context ring_1
   62.20  begin
   62.21  
   62.22 -definition
   62.23 -  of_int :: "int \<Rightarrow> 'a"
   62.24 -where
   62.25 +definition of_int :: "int \<Rightarrow> 'a" where
   62.26    [code del]: "of_int z = contents (\<Union>(i, j) \<in> Rep_Integ z. { of_nat i - of_nat j })"
   62.27  
   62.28  lemma of_int: "of_int (Abs_Integ (intrel `` {(i,j)})) = of_nat i - of_nat j"
   62.29 @@ -330,6 +331,10 @@
   62.30  lemma of_int_of_nat_eq [simp]: "of_int (of_nat n) = of_nat n"
   62.31  by (induct n) auto
   62.32  
   62.33 +lemma of_int_power:
   62.34 +  "of_int (z ^ n) = of_int z ^ n"
   62.35 +  by (induct n) simp_all
   62.36 +
   62.37  end
   62.38  
   62.39  context ordered_idom
   62.40 @@ -1266,14 +1271,9 @@
   62.41  definition Ints  :: "'a set" where
   62.42    [code del]: "Ints = range of_int"
   62.43  
   62.44 -end
   62.45 -
   62.46  notation (xsymbols)
   62.47    Ints  ("\<int>")
   62.48  
   62.49 -context ring_1
   62.50 -begin
   62.51 -
   62.52  lemma Ints_0 [simp]: "0 \<in> \<int>"
   62.53  apply (simp add: Ints_def)
   62.54  apply (rule range_eqI)
   62.55 @@ -1518,9 +1518,18 @@
   62.56    of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
   62.57    of_int_0 of_int_1 of_int_add of_int_mult
   62.58  
   62.59 +use "Tools/numeral_simprocs.ML"
   62.60 +
   62.61  use "Tools/int_arith.ML"
   62.62  declaration {* K Int_Arith.setup *}
   62.63  
   62.64 +setup {*
   62.65 +  ReorientProc.add
   62.66 +    (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
   62.67 +*}
   62.68 +
   62.69 +simproc_setup reorient_numeral ("number_of w = x") = ReorientProc.proc
   62.70 +
   62.71  
   62.72  subsection{*Lemmas About Small Numerals*}
   62.73  
   62.74 @@ -1536,7 +1545,7 @@
   62.75  by (simp add: abs_if)
   62.76  
   62.77  lemma abs_power_minus_one [simp]:
   62.78 -     "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
   62.79 +  "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring})"
   62.80  by (simp add: power_abs)
   62.81  
   62.82  lemma of_int_number_of_eq [simp]:
   62.83 @@ -1846,49 +1855,6 @@
   62.84  qed
   62.85  
   62.86  
   62.87 -subsection {* Integer Powers *} 
   62.88 -
   62.89 -instantiation int :: recpower
   62.90 -begin
   62.91 -
   62.92 -primrec power_int where
   62.93 -  "p ^ 0 = (1\<Colon>int)"
   62.94 -  | "p ^ (Suc n) = (p\<Colon>int) * (p ^ n)"
   62.95 -
   62.96 -instance proof
   62.97 -  fix z :: int
   62.98 -  fix n :: nat
   62.99 -  show "z ^ 0 = 1" by simp
  62.100 -  show "z ^ Suc n = z * (z ^ n)" by simp
  62.101 -qed
  62.102 -
  62.103 -declare power_int.simps [simp del]
  62.104 -
  62.105 -end
  62.106 -
  62.107 -lemma zpower_zadd_distrib: "x ^ (y + z) = ((x ^ y) * (x ^ z)::int)"
  62.108 -  by (rule Power.power_add)
  62.109 -
  62.110 -lemma zpower_zpower: "(x ^ y) ^ z = (x ^ (y * z)::int)"
  62.111 -  by (rule Power.power_mult [symmetric])
  62.112 -
  62.113 -lemma zero_less_zpower_abs_iff [simp]:
  62.114 -  "(0 < abs x ^ n) \<longleftrightarrow> (x \<noteq> (0::int) | n = 0)"
  62.115 -  by (induct n) (auto simp add: zero_less_mult_iff)
  62.116 -
  62.117 -lemma zero_le_zpower_abs [simp]: "(0::int) \<le> abs x ^ n"
  62.118 -  by (induct n) (auto simp add: zero_le_mult_iff)
  62.119 -
  62.120 -lemma of_int_power:
  62.121 -  "of_int (z ^ n) = (of_int z ^ n :: 'a::{recpower, ring_1})"
  62.122 -  by (induct n) simp_all
  62.123 -
  62.124 -lemma int_power: "int (m^n) = (int m) ^ n"
  62.125 -  by (rule of_nat_power)
  62.126 -
  62.127 -lemmas zpower_int = int_power [symmetric]
  62.128 -
  62.129 -
  62.130  subsection {* Further theorems on numerals *}
  62.131  
  62.132  subsubsection{*Special Simplification for Constants*}
  62.133 @@ -2278,4 +2244,25 @@
  62.134  lemmas zless_le = less_int_def
  62.135  lemmas int_eq_of_nat = TrueI
  62.136  
  62.137 +lemma zpower_zadd_distrib:
  62.138 +  "x ^ (y + z) = ((x ^ y) * (x ^ z)::int)"
  62.139 +  by (rule power_add)
  62.140 +
  62.141 +lemma zero_less_zpower_abs_iff:
  62.142 +  "(0 < abs x ^ n) \<longleftrightarrow> (x \<noteq> (0::int) | n = 0)"
  62.143 +  by (rule zero_less_power_abs_iff)
  62.144 +
  62.145 +lemma zero_le_zpower_abs: "(0::int) \<le> abs x ^ n"
  62.146 +  by (rule zero_le_power_abs)
  62.147 +
  62.148 +lemma zpower_zpower:
  62.149 +  "(x ^ y) ^ z = (x ^ (y * z)::int)"
  62.150 +  by (rule power_mult [symmetric])
  62.151 +
  62.152 +lemma int_power:
  62.153 +  "int (m ^ n) = int m ^ n"
  62.154 +  by (rule of_nat_power)
  62.155 +
  62.156 +lemmas zpower_int = int_power [symmetric]
  62.157 +
  62.158  end
    63.1 --- a/src/HOL/IntDiv.thy	Mon May 11 09:39:53 2009 +0200
    63.2 +++ b/src/HOL/IntDiv.thy	Mon May 11 17:20:52 2009 +0200
    63.3 @@ -8,10 +8,6 @@
    63.4  
    63.5  theory IntDiv
    63.6  imports Int Divides FunDef
    63.7 -uses
    63.8 -  "~~/src/Provers/Arith/cancel_numeral_factor.ML"
    63.9 -  "~~/src/Provers/Arith/extract_common_term.ML"
   63.10 -  ("Tools/int_factor_simprocs.ML")
   63.11  begin
   63.12  
   63.13  definition divmod_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" where
   63.14 @@ -249,33 +245,33 @@
   63.15  text {* Tool setup *}
   63.16  
   63.17  ML {*
   63.18 -local 
   63.19 +local
   63.20  
   63.21 -structure CancelDivMod = CancelDivModFun(
   63.22 -struct
   63.23 -  val div_name = @{const_name Divides.div};
   63.24 -  val mod_name = @{const_name Divides.mod};
   63.25 +structure CancelDivMod = CancelDivModFun(struct
   63.26 +
   63.27 +  val div_name = @{const_name div};
   63.28 +  val mod_name = @{const_name mod};
   63.29    val mk_binop = HOLogic.mk_binop;
   63.30 -  val mk_sum = Int_Numeral_Simprocs.mk_sum HOLogic.intT;
   63.31 -  val dest_sum = Int_Numeral_Simprocs.dest_sum;
   63.32 -  val div_mod_eqs =
   63.33 -    map mk_meta_eq [@{thm zdiv_zmod_equality},
   63.34 -      @{thm zdiv_zmod_equality2}];
   63.35 +  val mk_sum = Numeral_Simprocs.mk_sum HOLogic.intT;
   63.36 +  val dest_sum = Numeral_Simprocs.dest_sum;
   63.37 +
   63.38 +  val div_mod_eqs = map mk_meta_eq [@{thm zdiv_zmod_equality}, @{thm zdiv_zmod_equality2}];
   63.39 +
   63.40    val trans = trans;
   63.41 -  val prove_eq_sums =
   63.42 -    let
   63.43 -      val simps = @{thm diff_int_def} :: Int_Numeral_Simprocs.add_0s @ @{thms zadd_ac}
   63.44 -    in Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac simps) end;
   63.45 +
   63.46 +  val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac 
   63.47 +    (@{thm diff_minus} :: @{thms add_0s} @ @{thms add_ac}))
   63.48 +
   63.49  end)
   63.50  
   63.51  in
   63.52  
   63.53 -val cancel_zdiv_zmod_proc = Simplifier.simproc (the_context ())
   63.54 -  "cancel_zdiv_zmod" ["(m::int) + n"] (K CancelDivMod.proc)
   63.55 +val cancel_div_mod_int_proc = Simplifier.simproc (the_context ())
   63.56 +  "cancel_zdiv_zmod" ["(k::int) + l"] (K CancelDivMod.proc);
   63.57  
   63.58 -end;
   63.59 +val _ = Addsimprocs [cancel_div_mod_int_proc];
   63.60  
   63.61 -Addsimprocs [cancel_zdiv_zmod_proc]
   63.62 +end
   63.63  *}
   63.64  
   63.65  lemma pos_mod_conj : "(0::int) < b ==> 0 \<le> a mod b & a mod b < b"
   63.66 @@ -711,6 +707,25 @@
   63.67    show "(a + c * b) div b = c + a div b"
   63.68      unfolding zdiv_zadd1_eq [of a "c * b"] using not0 
   63.69        by (simp add: zmod_zmult1_eq zmod_zdiv_trivial zdiv_zmult1_eq)
   63.70 +next
   63.71 +  fix a b c :: int
   63.72 +  assume "a \<noteq> 0"
   63.73 +  then show "(a * b) div (a * c) = b div c"
   63.74 +  proof (cases "b \<noteq> 0 \<and> c \<noteq> 0")
   63.75 +    case False then show ?thesis by auto
   63.76 +  next
   63.77 +    case True then have "b \<noteq> 0" and "c \<noteq> 0" by auto
   63.78 +    with `a \<noteq> 0`
   63.79 +    have "\<And>q r. divmod_rel b c (q, r) \<Longrightarrow> divmod_rel (a * b) (a * c) (q, a * r)"
   63.80 +      apply (auto simp add: divmod_rel_def) 
   63.81 +      apply (auto simp add: algebra_simps)
   63.82 +      apply (auto simp add: zero_less_mult_iff zero_le_mult_iff mult_le_0_iff)
   63.83 +      done
   63.84 +    moreover with `c \<noteq> 0` divmod_rel_div_mod have "divmod_rel b c (b div c, b mod c)" by auto
   63.85 +    ultimately have "divmod_rel (a * b) (a * c) (b div c, a * (b mod c))" .
   63.86 +    moreover from  `a \<noteq> 0` `c \<noteq> 0` have "a * c \<noteq> 0" by simp
   63.87 +    ultimately show ?thesis by (rule divmod_rel_div)
   63.88 +  qed
   63.89  qed auto
   63.90  
   63.91  lemma posDivAlg_div_mod:
   63.92 @@ -808,52 +823,6 @@
   63.93  done
   63.94  
   63.95  
   63.96 -subsection{*Cancellation of Common Factors in div*}
   63.97 -
   63.98 -lemma zdiv_zmult_zmult1_aux1:
   63.99 -     "[| (0::int) < b;  c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
  63.100 -by (subst zdiv_zmult2_eq, auto)
  63.101 -
  63.102 -lemma zdiv_zmult_zmult1_aux2:
  63.103 -     "[| b < (0::int);  c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
  63.104 -apply (subgoal_tac " (c * (-a)) div (c * (-b)) = (-a) div (-b) ")
  63.105 -apply (rule_tac [2] zdiv_zmult_zmult1_aux1, auto)
  63.106 -done
  63.107 -
  63.108 -lemma zdiv_zmult_zmult1: "c \<noteq> (0::int) ==> (c*a) div (c*b) = a div b"
  63.109 -apply (case_tac "b = 0", simp)
  63.110 -apply (auto simp add: linorder_neq_iff zdiv_zmult_zmult1_aux1 zdiv_zmult_zmult1_aux2)
  63.111 -done
  63.112 -
  63.113 -lemma zdiv_zmult_zmult1_if[simp]:
  63.114 -  "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)"
  63.115 -by (simp add:zdiv_zmult_zmult1)
  63.116 -
  63.117 -
  63.118 -subsection{*Distribution of Factors over mod*}
  63.119 -
  63.120 -lemma zmod_zmult_zmult1_aux1:
  63.121 -     "[| (0::int) < b;  c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
  63.122 -by (subst zmod_zmult2_eq, auto)
  63.123 -
  63.124 -lemma zmod_zmult_zmult1_aux2:
  63.125 -     "[| b < (0::int);  c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
  63.126 -apply (subgoal_tac " (c * (-a)) mod (c * (-b)) = c * ((-a) mod (-b))")
  63.127 -apply (rule_tac [2] zmod_zmult_zmult1_aux1, auto)
  63.128 -done
  63.129 -
  63.130 -lemma zmod_zmult_zmult1: "(c*a) mod (c*b) = (c::int) * (a mod b)"
  63.131 -apply (case_tac "b = 0", simp)
  63.132 -apply (case_tac "c = 0", simp)
  63.133 -apply (auto simp add: linorder_neq_iff zmod_zmult_zmult1_aux1 zmod_zmult_zmult1_aux2)
  63.134 -done
  63.135 -
  63.136 -lemma zmod_zmult_zmult2: "(a*c) mod (b*c) = (a mod b) * (c::int)"
  63.137 -apply (cut_tac c = c in zmod_zmult_zmult1)
  63.138 -apply (auto simp add: mult_commute)
  63.139 -done
  63.140 -
  63.141 -
  63.142  subsection {*Splitting Rules for div and mod*}
  63.143  
  63.144  text{*The proofs of the two lemmas below are essentially identical*}
  63.145 @@ -937,7 +906,7 @@
  63.146                    right_distrib) 
  63.147    thus ?thesis
  63.148      by (subst zdiv_zadd1_eq,
  63.149 -        simp add: zdiv_zmult_zmult1 zmod_zmult_zmult1 one_less_a2
  63.150 +        simp add: mod_mult_mult1 one_less_a2
  63.151                    div_pos_pos_trivial)
  63.152  qed
  63.153  
  63.154 @@ -961,7 +930,7 @@
  63.155             then number_of v div (number_of w)     
  63.156             else (number_of v + (1::int)) div (number_of w))"
  63.157  apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) 
  63.158 -apply (simp add: zdiv_zmult_zmult1 pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac)
  63.159 +apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac)
  63.160  done
  63.161  
  63.162  
  63.163 @@ -977,7 +946,7 @@
  63.164  apply (auto simp add: add_commute [of 1] mult_commute add1_zle_eq 
  63.165                        pos_mod_bound)
  63.166  apply (subst mod_add_eq)
  63.167 -apply (simp add: zmod_zmult_zmult2 mod_pos_pos_trivial)
  63.168 +apply (simp add: mod_mult_mult2 mod_pos_pos_trivial)
  63.169  apply (rule mod_pos_pos_trivial)
  63.170  apply (auto simp add: mod_pos_pos_trivial ring_distribs)
  63.171  apply (subgoal_tac "0 \<le> b mod a", arith, simp)
  63.172 @@ -998,7 +967,7 @@
  63.173       "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =  
  63.174        (2::int) * (number_of v mod number_of w)"
  63.175  apply (simp only: number_of_eq numeral_simps) 
  63.176 -apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2 
  63.177 +apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  63.178                   neg_zmod_mult_2 add_ac)
  63.179  done
  63.180  
  63.181 @@ -1008,7 +977,7 @@
  63.182                  then 2 * (number_of v mod number_of w) + 1     
  63.183                  else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
  63.184  apply (simp only: number_of_eq numeral_simps) 
  63.185 -apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2 
  63.186 +apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  63.187                   neg_zmod_mult_2 add_ac)
  63.188  done
  63.189  
  63.190 @@ -1090,9 +1059,7 @@
  63.191  done
  63.192  
  63.193  lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
  63.194 -  apply (simp add: dvd_def)
  63.195 -  apply (auto simp add: zmod_zmult_zmult1)
  63.196 -  done
  63.197 +  by (auto elim!: dvdE simp add: mod_mult_mult1)
  63.198  
  63.199  lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
  63.200    apply (subgoal_tac "k dvd n * (m div n) + m mod n")
  63.201 @@ -1106,8 +1073,6 @@
  63.202     prefer 2
  63.203     apply (blast intro: order_less_trans)
  63.204    apply (simp add: zero_less_mult_iff)
  63.205 -  apply (subgoal_tac "n * k < n * 1")
  63.206 -   apply (drule mult_less_cancel_left [THEN iffD1], auto)
  63.207    done
  63.208  
  63.209  lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)"
  63.210 @@ -1247,9 +1212,9 @@
  63.211  lemmas zmod_simps =
  63.212    mod_add_left_eq  [symmetric]
  63.213    mod_add_right_eq [symmetric]
  63.214 -  IntDiv.zmod_zmult1_eq     [symmetric]
  63.215 -  mod_mult_left_eq          [symmetric]
  63.216 -  IntDiv.zpower_zmod
  63.217 +  zmod_zmult1_eq   [symmetric]
  63.218 +  mod_mult_left_eq [symmetric]
  63.219 +  zpower_zmod
  63.220    zminus_zmod zdiff_zmod_left zdiff_zmod_right
  63.221  
  63.222  text {* Distributive laws for function @{text nat}. *}
  63.223 @@ -1362,11 +1327,6 @@
  63.224  qed
  63.225  
  63.226  
  63.227 -subsection {* Simproc setup *}
  63.228 -
  63.229 -use "Tools/int_factor_simprocs.ML"
  63.230 -
  63.231 -
  63.232  subsection {* Code generation *}
  63.233  
  63.234  definition pdivmod :: "int \<Rightarrow> int \<Rightarrow> int \<times> int" where
    64.1 --- a/src/HOL/IsaMakefile	Mon May 11 09:39:53 2009 +0200
    64.2 +++ b/src/HOL/IsaMakefile	Mon May 11 17:20:52 2009 +0200
    64.3 @@ -89,10 +89,9 @@
    64.4    $(SRC)/Tools/IsaPlanner/rw_tools.ML \
    64.5    $(SRC)/Tools/IsaPlanner/zipper.ML \
    64.6    $(SRC)/Tools/atomize_elim.ML \
    64.7 -  $(SRC)/Tools/code/code_funcgr.ML \
    64.8 +  $(SRC)/Tools/auto_solve.ML \
    64.9    $(SRC)/Tools/code/code_haskell.ML \
   64.10    $(SRC)/Tools/code/code_ml.ML \
   64.11 -  $(SRC)/Tools/code/code_name.ML \
   64.12    $(SRC)/Tools/code/code_printer.ML \
   64.13    $(SRC)/Tools/code/code_target.ML \
   64.14    $(SRC)/Tools/code/code_thingol.ML \
   64.15 @@ -103,10 +102,11 @@
   64.16    $(SRC)/Tools/intuitionistic.ML \
   64.17    $(SRC)/Tools/induct_tacs.ML \
   64.18    $(SRC)/Tools/nbe.ML \
   64.19 +  $(SRC)/Tools/quickcheck.ML \
   64.20    $(SRC)/Tools/project_rule.ML \
   64.21    $(SRC)/Tools/random_word.ML \
   64.22    $(SRC)/Tools/value.ML \
   64.23 -  Code_Setup.thy \
   64.24 +  $(SRC)/Tools/Code_Generator.thy \
   64.25    HOL.thy \
   64.26    Tools/hologic.ML \
   64.27    Tools/recfun_codegen.ML \
   64.28 @@ -206,7 +206,6 @@
   64.29  MAIN_DEPENDENCIES = $(PLAIN_DEPENDENCIES) \
   64.30    ATP_Linkup.thy \
   64.31    Code_Eval.thy \
   64.32 -  Code_Message.thy \
   64.33    Equiv_Relations.thy \
   64.34    Groebner_Basis.thy \
   64.35    Hilbert_Choice.thy \
   64.36 @@ -216,29 +215,30 @@
   64.37    List.thy \
   64.38    Main.thy \
   64.39    Map.thy \
   64.40 -  NatBin.thy \
   64.41 +  Nat_Numeral.thy \
   64.42    Presburger.thy \
   64.43    Recdef.thy \
   64.44 -  Relation_Power.thy \
   64.45    SetInterval.thy \
   64.46 +  String.thy \
   64.47    $(SRC)/Provers/Arith/assoc_fold.ML \
   64.48    $(SRC)/Provers/Arith/cancel_numeral_factor.ML \
   64.49    $(SRC)/Provers/Arith/cancel_numerals.ML \
   64.50    $(SRC)/Provers/Arith/combine_numerals.ML \
   64.51    $(SRC)/Provers/Arith/extract_common_term.ML \
   64.52    $(SRC)/Tools/Metis/metis.ML \
   64.53 -  Tools/int_arith.ML \
   64.54 -  Tools/int_factor_simprocs.ML \
   64.55 -  Tools/nat_simprocs.ML \
   64.56    Tools/Groebner_Basis/groebner.ML \
   64.57    Tools/Groebner_Basis/misc.ML \
   64.58    Tools/Groebner_Basis/normalizer_data.ML \
   64.59    Tools/Groebner_Basis/normalizer.ML \
   64.60    Tools/atp_manager.ML \
   64.61    Tools/atp_wrapper.ML \
   64.62 +  Tools/int_arith.ML \
   64.63 +  Tools/list_code.ML \
   64.64    Tools/meson.ML \
   64.65    Tools/metis_tools.ML \
   64.66 +  Tools/nat_numeral_simprocs.ML \
   64.67    Tools/numeral.ML \
   64.68 +  Tools/numeral_simprocs.ML \
   64.69    Tools/numeral_syntax.ML \
   64.70    Tools/polyhash.ML \
   64.71    Tools/Qelim/cooper_data.ML \
   64.72 @@ -253,6 +253,7 @@
   64.73    Tools/res_hol_clause.ML \
   64.74    Tools/res_reconstruct.ML \
   64.75    Tools/specification_package.ML \
   64.76 +  Tools/string_code.ML \
   64.77    Tools/string_syntax.ML \
   64.78    Tools/TFL/casesplit.ML \
   64.79    Tools/TFL/dcterm.ML \
   64.80 @@ -341,6 +342,7 @@
   64.81    Library/Random.thy Library/Quickcheck.thy	\
   64.82    Library/Poly_Deriv.thy \
   64.83    Library/Polynomial.thy \
   64.84 +  Library/Preorder.thy \
   64.85    Library/Product_plus.thy \
   64.86    Library/Product_Vector.thy \
   64.87    Library/Enum.thy Library/Float.thy $(SRC)/Tools/float.ML $(SRC)/HOL/Tools/float_arith.ML \
    65.1 --- a/src/HOL/Library/Binomial.thy	Mon May 11 09:39:53 2009 +0200
    65.2 +++ b/src/HOL/Library/Binomial.thy	Mon May 11 17:20:52 2009 +0200
    65.3 @@ -292,7 +292,7 @@
    65.4  
    65.5  subsection{* Generalized binomial coefficients *}
    65.6  
    65.7 -definition gbinomial :: "'a::{field, recpower,ring_char_0} \<Rightarrow> nat \<Rightarrow> 'a" (infixl "gchoose" 65)
    65.8 +definition gbinomial :: "'a::{field, ring_char_0} \<Rightarrow> nat \<Rightarrow> 'a" (infixl "gchoose" 65)
    65.9    where "a gchoose n = (if n = 0 then 1 else (setprod (\<lambda>i. a - of_nat i) {0 .. n - 1}) / of_nat (fact n))"
   65.10  
   65.11  lemma gbinomial_0[simp]: "a gchoose 0 = 1" "0 gchoose (Suc n) = 0"
   65.12 @@ -420,16 +420,16 @@
   65.13    by (simp add: gbinomial_def)
   65.14   
   65.15  lemma gbinomial_mult_fact:
   65.16 -  "(of_nat (fact (Suc k)) :: 'a) * ((a::'a::{field, ring_char_0,recpower}) gchoose (Suc k)) = (setprod (\<lambda>i. a - of_nat i) {0 .. k})"
   65.17 +  "(of_nat (fact (Suc k)) :: 'a) * ((a::'a::{field, ring_char_0}) gchoose (Suc k)) = (setprod (\<lambda>i. a - of_nat i) {0 .. k})"
   65.18    unfolding gbinomial_Suc
   65.19    by (simp_all add: field_simps del: fact_Suc)
   65.20  
   65.21  lemma gbinomial_mult_fact':
   65.22 -  "((a::'a::{field, ring_char_0,recpower}) gchoose (Suc k)) * (of_nat (fact (Suc k)) :: 'a) = (setprod (\<lambda>i. a - of_nat i) {0 .. k})"
   65.23 +  "((a::'a::{field, ring_char_0}) gchoose (Suc k)) * (of_nat (fact (Suc k)) :: 'a) = (setprod (\<lambda>i. a - of_nat i) {0 .. k})"
   65.24    using gbinomial_mult_fact[of k a]
   65.25    apply (subst mult_commute) .
   65.26  
   65.27 -lemma gbinomial_Suc_Suc: "((a::'a::{field,recpower, ring_char_0}) + 1) gchoose (Suc k) = a gchoose k + (a gchoose (Suc k))"
   65.28 +lemma gbinomial_Suc_Suc: "((a::'a::{field, ring_char_0}) + 1) gchoose (Suc k) = a gchoose k + (a gchoose (Suc k))"
   65.29  proof-
   65.30    {assume "k = 0" then have ?thesis by simp}
   65.31    moreover
    66.1 --- a/src/HOL/Library/Code_Char.thy	Mon May 11 09:39:53 2009 +0200
    66.2 +++ b/src/HOL/Library/Code_Char.thy	Mon May 11 17:20:52 2009 +0200
    66.3 @@ -14,8 +14,8 @@
    66.4    (Haskell "Char")
    66.5  
    66.6  setup {*
    66.7 -  fold (fn target => add_literal_char target) ["SML", "OCaml", "Haskell"] 
    66.8 -  #> add_literal_list_string "Haskell"
    66.9 +  fold String_Code.add_literal_char ["SML", "OCaml", "Haskell"] 
   66.10 +  #> String_Code.add_literal_list_string "Haskell"
   66.11  *}
   66.12  
   66.13  code_instance char :: eq
   66.14 @@ -33,6 +33,6 @@
   66.15    (Haskell infixl 4 "==")
   66.16  
   66.17  code_const "Code_Eval.term_of \<Colon> char \<Rightarrow> term"
   66.18 -  (SML "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))")
   66.19 +  (Eval "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))")
   66.20  
   66.21  end
    67.1 --- a/src/HOL/Library/Code_Index.thy	Mon May 11 09:39:53 2009 +0200
    67.2 +++ b/src/HOL/Library/Code_Index.thy	Mon May 11 17:20:52 2009 +0200
    67.3 @@ -144,7 +144,7 @@
    67.4  
    67.5  subsection {* Basic arithmetic *}
    67.6  
    67.7 -instantiation index :: "{minus, ordered_semidom, Divides.div, linorder}"
    67.8 +instantiation index :: "{minus, ordered_semidom, semiring_div, linorder}"
    67.9  begin
   67.10  
   67.11  definition [simp, code del]:
   67.12 @@ -172,7 +172,7 @@
   67.13    "n < m \<longleftrightarrow> nat_of n < nat_of m"
   67.14  
   67.15  instance proof
   67.16 -qed (auto simp add: left_distrib)
   67.17 +qed (auto simp add: index left_distrib div_mult_self1)
   67.18  
   67.19  end
   67.20  
    68.1 --- a/src/HOL/Library/Coinductive_List.thy	Mon May 11 09:39:53 2009 +0200
    68.2 +++ b/src/HOL/Library/Coinductive_List.thy	Mon May 11 17:20:52 2009 +0200
    68.3 @@ -786,7 +786,7 @@
    68.4  
    68.5  lemma funpow_lmap:
    68.6    fixes f :: "'a \<Rightarrow> 'a"
    68.7 -  shows "(lmap f ^ n) (LCons b l) = LCons ((f ^ n) b) ((lmap f ^ n) l)"
    68.8 +  shows "(lmap f ^^ n) (LCons b l) = LCons ((f ^^ n) b) ((lmap f ^^ n) l)"
    68.9    by (induct n) simp_all
   68.10  
   68.11  
   68.12 @@ -796,35 +796,35 @@
   68.13  proof
   68.14    fix x
   68.15    have "(h x, iterates f x) \<in>
   68.16 -      {((lmap f ^ n) (h u), (lmap f ^ n) (iterates f u)) | u n. True}"
   68.17 +      {((lmap f ^^ n) (h u), (lmap f ^^ n) (iterates f u)) | u n. True}"
   68.18    proof -
   68.19 -    have "(h x, iterates f x) = ((lmap f ^ 0) (h x), (lmap f ^ 0) (iterates f x))"
   68.20 +    have "(h x, iterates f x) = ((lmap f ^^ 0) (h x), (lmap f ^^ 0) (iterates f x))"
   68.21        by simp
   68.22      then show ?thesis by blast
   68.23    qed
   68.24    then show "h x = iterates f x"
   68.25    proof (coinduct rule: llist_equalityI)
   68.26      case (Eqllist q)
   68.27 -    then obtain u n where "q = ((lmap f ^ n) (h u), (lmap f ^ n) (iterates f u))"
   68.28 +    then obtain u n where "q = ((lmap f ^^ n) (h u), (lmap f ^^ n) (iterates f u))"
   68.29          (is "_ = (?q1, ?q2)")
   68.30        by auto
   68.31 -    also have "?q1 = LCons ((f ^ n) u) ((lmap f ^ Suc n) (h u))"
   68.32 +    also have "?q1 = LCons ((f ^^ n) u) ((lmap f ^^ Suc n) (h u))"
   68.33      proof -
   68.34 -      have "?q1 = (lmap f ^ n) (LCons u (lmap f (h u)))"
   68.35 +      have "?q1 = (lmap f ^^ n) (LCons u (lmap f (h u)))"
   68.36          by (subst h) rule
   68.37 -      also have "\<dots> = LCons ((f ^ n) u) ((lmap f ^ n) (lmap f (h u)))"
   68.38 +      also have "\<dots> = LCons ((f ^^ n) u) ((lmap f ^^ n) (lmap f (h u)))"
   68.39          by (rule funpow_lmap)
   68.40 -      also have "(lmap f ^ n) (lmap f (h u)) = (lmap f ^ Suc n) (h u)"
   68.41 +      also have "(lmap f ^^ n) (lmap f (h u)) = (lmap f ^^ Suc n) (h u)"
   68.42          by (simp add: funpow_swap1)
   68.43        finally show ?thesis .
   68.44      qed
   68.45 -    also have "?q2 = LCons ((f ^ n) u) ((lmap f ^ Suc n) (iterates f u))"
   68.46 +    also have "?q2 = LCons ((f ^^ n) u) ((lmap f ^^ Suc n) (iterates f u))"
   68.47      proof -
   68.48 -      have "?q2 = (lmap f ^ n) (LCons u (iterates f (f u)))"
   68.49 +      have "?q2 = (lmap f ^^ n) (LCons u (iterates f (f u)))"
   68.50          by (subst iterates) rule
   68.51 -      also have "\<dots> = LCons ((f ^ n) u) ((lmap f ^ n) (iterates f (f u)))"
   68.52 +      also have "\<dots> = LCons ((f ^^ n) u) ((lmap f ^^ n) (iterates f (f u)))"
   68.53          by (rule funpow_lmap)
   68.54 -      also have "(lmap f ^ n) (iterates f (f u)) = (lmap f ^ Suc n) (iterates f u)"
   68.55 +      also have "(lmap f ^^ n) (iterates f (f u)) = (lmap f ^^ Suc n) (iterates f u)"
   68.56          by (simp add: lmap_iterates funpow_swap1)
   68.57        finally show ?thesis .
   68.58      qed
    69.1 --- a/src/HOL/Library/Commutative_Ring.thy	Mon May 11 09:39:53 2009 +0200
    69.2 +++ b/src/HOL/Library/Commutative_Ring.thy	Mon May 11 17:20:52 2009 +0200
    69.3 @@ -27,15 +27,15 @@
    69.4  
    69.5  text {* Interpretation functions for the shadow syntax. *}
    69.6  
    69.7 -fun
    69.8 -  Ipol :: "'a::{comm_ring,recpower} list \<Rightarrow> 'a pol \<Rightarrow> 'a"
    69.9 +primrec
   69.10 +  Ipol :: "'a::{comm_ring_1} list \<Rightarrow> 'a pol \<Rightarrow> 'a"
   69.11  where
   69.12      "Ipol l (Pc c) = c"
   69.13    | "Ipol l (Pinj i P) = Ipol (drop i l) P"
   69.14    | "Ipol l (PX P x Q) = Ipol l P * (hd l)^x + Ipol (drop 1 l) Q"
   69.15  
   69.16 -fun
   69.17 -  Ipolex :: "'a::{comm_ring,recpower} list \<Rightarrow> 'a polex \<Rightarrow> 'a"
   69.18 +primrec
   69.19 +  Ipolex :: "'a::{comm_ring_1} list \<Rightarrow> 'a polex \<Rightarrow> 'a"
   69.20  where
   69.21      "Ipolex l (Pol P) = Ipol l P"
   69.22    | "Ipolex l (Add P Q) = Ipolex l P + Ipolex l Q"
   69.23 @@ -54,7 +54,7 @@
   69.24      PX p1 y p2 \<Rightarrow> Pinj x P)"
   69.25  
   69.26  definition
   69.27 -  mkPX :: "'a::{comm_ring,recpower} pol \<Rightarrow> nat \<Rightarrow> 'a pol \<Rightarrow> 'a pol" where
   69.28 +  mkPX :: "'a::{comm_ring} pol \<Rightarrow> nat \<Rightarrow> 'a pol \<Rightarrow> 'a pol" where
   69.29    "mkPX P i Q = (case P of
   69.30      Pc c \<Rightarrow> (if (c = 0) then (mkPinj 1 Q) else (PX P i Q)) |
   69.31      Pinj j R \<Rightarrow> PX P i Q |
   69.32 @@ -63,7 +63,7 @@
   69.33  text {* Defining the basic ring operations on normalized polynomials *}
   69.34  
   69.35  function
   69.36 -  add :: "'a::{comm_ring,recpower} pol \<Rightarrow> 'a pol \<Rightarrow> 'a pol" (infixl "\<oplus>" 65)
   69.37 +  add :: "'a::{comm_ring} pol \<Rightarrow> 'a pol \<Rightarrow> 'a pol" (infixl "\<oplus>" 65)
   69.38  where
   69.39      "Pc a \<oplus> Pc b = Pc (a + b)"
   69.40    | "Pc c \<oplus> Pinj i P = Pinj i (P \<oplus> Pc c)"
   69.41 @@ -90,7 +90,7 @@
   69.42  termination by (relation "measure (\<lambda>(x, y). size x + size y)") auto
   69.43  
   69.44  function
   69.45 -  mul :: "'a::{comm_ring,recpower} pol \<Rightarrow> 'a pol \<Rightarrow> 'a pol" (infixl "\<otimes>" 70)
   69.46 +  mul :: "'a::{comm_ring} pol \<Rightarrow> 'a pol \<Rightarrow> 'a pol" (infixl "\<otimes>" 70)
   69.47  where
   69.48      "Pc a \<otimes> Pc b = Pc (a * b)"
   69.49    | "Pc c \<otimes> Pinj i P =
   69.50 @@ -122,8 +122,8 @@
   69.51    (auto simp add: mkPinj_def split: pol.split)
   69.52  
   69.53  text {* Negation*}
   69.54 -fun
   69.55 -  neg :: "'a::{comm_ring,recpower} pol \<Rightarrow> 'a pol"
   69.56 +primrec
   69.57 +  neg :: "'a::{comm_ring} pol \<Rightarrow> 'a pol"
   69.58  where
   69.59      "neg (Pc c) = Pc (-c)"
   69.60    | "neg (Pinj i P) = Pinj i (neg P)"
   69.61 @@ -131,13 +131,13 @@
   69.62  
   69.63  text {* Substraction *}
   69.64  definition
   69.65 -  sub :: "'a::{comm_ring,recpower} pol \<Rightarrow> 'a pol \<Rightarrow> 'a pol" (infixl "\<ominus>" 65)
   69.66 +  sub :: "'a::{comm_ring} pol \<Rightarrow> 'a pol \<Rightarrow> 'a pol" (infixl "\<ominus>" 65)
   69.67  where
   69.68    "sub P Q = P \<oplus> neg Q"
   69.69  
   69.70  text {* Square for Fast Exponentation *}
   69.71 -fun
   69.72 -  sqr :: "'a::{comm_ring,recpower} pol \<Rightarrow> 'a pol"
   69.73 +primrec
   69.74 +  sqr :: "'a::{comm_ring_1} pol \<Rightarrow> 'a pol"
   69.75  where
   69.76      "sqr (Pc c) = Pc (c * c)"
   69.77    | "sqr (Pinj i P) = mkPinj i (sqr P)"
   69.78 @@ -146,7 +146,7 @@
   69.79  
   69.80  text {* Fast Exponentation *}
   69.81  fun
   69.82 -  pow :: "nat \<Rightarrow> 'a::{comm_ring,recpower} pol \<Rightarrow> 'a pol"
   69.83 +  pow :: "nat \<Rightarrow> 'a::{comm_ring_1} pol \<Rightarrow> 'a pol"
   69.84  where
   69.85      "pow 0 P = Pc 1"
   69.86    | "pow n P = (if even n then pow (n div 2) (sqr P)
   69.87 @@ -161,8 +161,8 @@
   69.88  
   69.89  text {* Normalization of polynomial expressions *}
   69.90  
   69.91 -fun
   69.92 -  norm :: "'a::{comm_ring,recpower} polex \<Rightarrow> 'a pol"
   69.93 +primrec
   69.94 +  norm :: "'a::{comm_ring_1} polex \<Rightarrow> 'a pol"
   69.95  where
   69.96      "norm (Pol P) = P"
   69.97    | "norm (Add P Q) = norm P \<oplus> norm Q"
    70.1 --- a/src/HOL/Library/Continuity.thy	Mon May 11 09:39:53 2009 +0200
    70.2 +++ b/src/HOL/Library/Continuity.thy	Mon May 11 17:20:52 2009 +0200
    70.3 @@ -5,7 +5,7 @@
    70.4  header {* Continuity and iterations (of set transformers) *}
    70.5  
    70.6  theory Continuity
    70.7 -imports Relation_Power Main
    70.8 +imports Transitive_Closure Main
    70.9  begin
   70.10  
   70.11  subsection {* Continuity for complete lattices *}
   70.12 @@ -48,25 +48,25 @@
   70.13  qed
   70.14  
   70.15  lemma continuous_lfp:
   70.16 - assumes "continuous F" shows "lfp F = (SUP i. (F^i) bot)"
   70.17 + assumes "continuous F" shows "lfp F = (SUP i. (F ^^ i) bot)"
   70.18  proof -
   70.19    note mono = continuous_mono[OF `continuous F`]
   70.20 -  { fix i have "(F^i) bot \<le> lfp F"
   70.21 +  { fix i have "(F ^^ i) bot \<le> lfp F"
   70.22      proof (induct i)
   70.23 -      show "(F^0) bot \<le> lfp F" by simp
   70.24 +      show "(F ^^ 0) bot \<le> lfp F" by simp
   70.25      next
   70.26        case (Suc i)
   70.27 -      have "(F^(Suc i)) bot = F((F^i) bot)" by simp
   70.28 +      have "(F ^^ Suc i) bot = F((F ^^ i) bot)" by simp
   70.29        also have "\<dots> \<le> F(lfp F)" by(rule monoD[OF mono Suc])
   70.30        also have "\<dots> = lfp F" by(simp add:lfp_unfold[OF mono, symmetric])
   70.31        finally show ?case .
   70.32      qed }
   70.33 -  hence "(SUP i. (F^i) bot) \<le> lfp F" by (blast intro!:SUP_leI)
   70.34 -  moreover have "lfp F \<le> (SUP i. (F^i) bot)" (is "_ \<le> ?U")
   70.35 +  hence "(SUP i. (F ^^ i) bot) \<le> lfp F" by (blast intro!:SUP_leI)
   70.36 +  moreover have "lfp F \<le> (SUP i. (F ^^ i) bot)" (is "_ \<le> ?U")
   70.37    proof (rule lfp_lowerbound)
   70.38 -    have "chain(%i. (F^i) bot)"
   70.39 +    have "chain(%i. (F ^^ i) bot)"
   70.40      proof -
   70.41 -      { fix i have "(F^i) bot \<le> (F^(Suc i)) bot"
   70.42 +      { fix i have "(F ^^ i) bot \<le> (F ^^ (Suc i)) bot"
   70.43  	proof (induct i)
   70.44  	  case 0 show ?case by simp
   70.45  	next
   70.46 @@ -74,7 +74,7 @@
   70.47  	qed }
   70.48        thus ?thesis by(auto simp add:chain_def)
   70.49      qed
   70.50 -    hence "F ?U = (SUP i. (F^(i+1)) bot)" using `continuous F` by (simp add:continuous_def)
   70.51 +    hence "F ?U = (SUP i. (F ^^ (i+1)) bot)" using `continuous F` by (simp add:continuous_def)
   70.52      also have "\<dots> \<le> ?U" by(fast intro:SUP_leI le_SUPI)
   70.53      finally show "F ?U \<le> ?U" .
   70.54    qed
   70.55 @@ -193,7 +193,7 @@
   70.56  
   70.57  definition
   70.58    up_iterate :: "('a set => 'a set) => nat => 'a set" where
   70.59 -  "up_iterate f n = (f^n) {}"
   70.60 +  "up_iterate f n = (f ^^ n) {}"
   70.61  
   70.62  lemma up_iterate_0 [simp]: "up_iterate f 0 = {}"
   70.63    by (simp add: up_iterate_def)
   70.64 @@ -245,7 +245,7 @@
   70.65  
   70.66  definition
   70.67    down_iterate :: "('a set => 'a set) => nat => 'a set" where
   70.68 -  "down_iterate f n = (f^n) UNIV"
   70.69 +  "down_iterate f n = (f ^^ n) UNIV"
   70.70  
   70.71  lemma down_iterate_0 [simp]: "down_iterate f 0 = UNIV"
   70.72    by (simp add: down_iterate_def)
    71.1 --- a/src/HOL/Library/Efficient_Nat.thy	Mon May 11 09:39:53 2009 +0200
    71.2 +++ b/src/HOL/Library/Efficient_Nat.thy	Mon May 11 17:20:52 2009 +0200
    71.3 @@ -179,10 +179,8 @@
    71.4         else NONE
    71.5    end;
    71.6  
    71.7 -fun eqn_suc_preproc thy = map fst
    71.8 -  #> gen_eqn_suc_preproc
    71.9 -      @{thm Suc_if_eq} I (fst o Logic.dest_equals) thy
   71.10 -  #> (Option.map o map) (Code_Unit.mk_eqn thy);
   71.11 +val eqn_suc_preproc = Code.simple_functrans (gen_eqn_suc_preproc
   71.12 +  @{thm Suc_if_eq} I (fst o Logic.dest_equals));
   71.13  
   71.14  fun eqn_suc_preproc' thy thms = gen_eqn_suc_preproc
   71.15    @{thm Suc_if_eq'} (snd o Thm.dest_comb) (fst o HOLogic.dest_eq o HOLogic.dest_Trueprop) thy thms
    72.1 --- a/src/HOL/Library/Euclidean_Space.thy	Mon May 11 09:39:53 2009 +0200
    72.2 +++ b/src/HOL/Library/Euclidean_Space.thy	Mon May 11 17:20:52 2009 +0200
    72.3 @@ -253,13 +253,6 @@
    72.4    "vector_power x 0 = 1"
    72.5    | "vector_power x (Suc n) = x * vector_power x n"
    72.6  
    72.7 -instantiation "^" :: (recpower,type) recpower
    72.8 -begin
    72.9 -  definition vec_power_def: "op ^ \<equiv> vector_power"
   72.10 -  instance
   72.11 -  apply (intro_classes) by (simp_all add: vec_power_def)
   72.12 -end
   72.13 -
   72.14  instance "^" :: (semiring,type) semiring
   72.15    apply (intro_classes) by (vector ring_simps)+
   72.16  
   72.17 @@ -600,7 +593,7 @@
   72.18    from insert.prems have Fx: "f x \<ge> 0" and Fp: "\<forall> a \<in> F. f a \<ge> 0" by simp_all
   72.19    from insert.hyps Fp setsum_nonneg[OF Fp]
   72.20    have h: "setsum f F = 0 \<longleftrightarrow> (\<forall>a \<in>F. f a = 0)" by metis
   72.21 -  from sum_nonneg_eq_zero_iff[OF Fx  setsum_nonneg[OF Fp]] insert.hyps(1,2)
   72.22 +  from add_nonneg_eq_0_iff[OF Fx  setsum_nonneg[OF Fp]] insert.hyps(1,2)
   72.23    show ?case by (simp add: h)
   72.24  qed
   72.25  
   72.26 @@ -2762,7 +2755,7 @@
   72.27  (* Geometric progression.                                                    *)
   72.28  (* ------------------------------------------------------------------------- *)
   72.29  
   72.30 -lemma sum_gp_basic: "((1::'a::{field, recpower}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))"
   72.31 +lemma sum_gp_basic: "((1::'a::{field}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))"
   72.32    (is "?lhs = ?rhs")
   72.33  proof-
   72.34    {assume x1: "x = 1" hence ?thesis by simp}
   72.35 @@ -2780,7 +2773,7 @@
   72.36  qed
   72.37  
   72.38  lemma sum_gp_multiplied: assumes mn: "m <= n"
   72.39 -  shows "((1::'a::{field, recpower}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n"
   72.40 +  shows "((1::'a::{field}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n"
   72.41    (is "?lhs = ?rhs")
   72.42  proof-
   72.43    let ?S = "{0..(n - m)}"
   72.44 @@ -2797,7 +2790,7 @@
   72.45      by (simp add: ring_simps power_add[symmetric])
   72.46  qed
   72.47  
   72.48 -lemma sum_gp: "setsum (op ^ (x::'a::{field, recpower})) {m .. n} =
   72.49 +lemma sum_gp: "setsum (op ^ (x::'a::{field})) {m .. n} =
   72.50     (if n < m then 0 else if x = 1 then of_nat ((n + 1) - m)
   72.51                      else (x^ m - x^ (Suc n)) / (1 - x))"
   72.52  proof-
   72.53 @@ -2813,7 +2806,7 @@
   72.54    ultimately show ?thesis by metis
   72.55  qed
   72.56  
   72.57 -lemma sum_gp_offset: "setsum (op ^ (x::'a::{field,recpower})) {m .. m+n} =
   72.58 +lemma sum_gp_offset: "setsum (op ^ (x::'a::{field})) {m .. m+n} =
   72.59    (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
   72.60    unfolding sum_gp[of x m "m + n"] power_Suc
   72.61    by (simp add: ring_simps power_add)
    73.1 --- a/src/HOL/Library/Eval_Witness.thy	Mon May 11 09:39:53 2009 +0200
    73.2 +++ b/src/HOL/Library/Eval_Witness.thy	Mon May 11 17:20:52 2009 +0200
    73.3 @@ -68,7 +68,7 @@
    73.4      | dest_exs _ _ = sys_error "dest_exs";
    73.5    val t = dest_exs (length ws) (HOLogic.dest_Trueprop goal);
    73.6  in
    73.7 -  if Code_ML.eval_term ("Eval_Witness_Method.eval_ref", Eval_Witness_Method.eval_ref) thy t ws
    73.8 +  if Code_ML.eval NONE ("Eval_Witness_Method.eval_ref", Eval_Witness_Method.eval_ref) (K I) thy t ws
    73.9    then Thm.cterm_of thy goal
   73.10    else @{cprop True} (*dummy*)
   73.11  end
    74.1 --- a/src/HOL/Library/Float.thy	Mon May 11 09:39:53 2009 +0200
    74.2 +++ b/src/HOL/Library/Float.thy	Mon May 11 17:20:52 2009 +0200
    74.3 @@ -15,8 +15,8 @@
    74.4  
    74.5  datatype float = Float int int
    74.6  
    74.7 -fun Ifloat :: "float \<Rightarrow> real" where
    74.8 -"Ifloat (Float a b) = real a * pow2 b"
    74.9 +primrec Ifloat :: "float \<Rightarrow> real" where
   74.10 +  "Ifloat (Float a b) = real a * pow2 b"
   74.11  
   74.12  instantiation float :: zero begin
   74.13  definition zero_float where "0 = Float 0 0" 
   74.14 @@ -33,11 +33,11 @@
   74.15  instance ..
   74.16  end
   74.17  
   74.18 -fun mantissa :: "float \<Rightarrow> int" where
   74.19 -"mantissa (Float a b) = a"
   74.20 +primrec mantissa :: "float \<Rightarrow> int" where
   74.21 +  "mantissa (Float a b) = a"
   74.22  
   74.23 -fun scale :: "float \<Rightarrow> int" where
   74.24 -"scale (Float a b) = b"
   74.25 +primrec scale :: "float \<Rightarrow> int" where
   74.26 +  "scale (Float a b) = b"
   74.27  
   74.28  lemma Ifloat_neg_exp: "e < 0 \<Longrightarrow> Ifloat (Float m e) = real m * inverse (2^nat (-e))" by auto
   74.29  lemma Ifloat_nge0_exp: "\<not> 0 \<le> e \<Longrightarrow> Ifloat (Float m e) = real m * inverse (2^nat (-e))" by auto
   74.30 @@ -320,12 +320,12 @@
   74.31  end
   74.32  
   74.33  instantiation float :: uminus begin
   74.34 -fun uminus_float where [simp del]: "uminus_float (Float m e) = Float (-m) e"
   74.35 +primrec uminus_float where [simp del]: "uminus_float (Float m e) = Float (-m) e"
   74.36  instance ..
   74.37  end
   74.38  
   74.39  instantiation float :: minus begin
   74.40 -fun minus_float where [simp del]: "(z::float) - w = z + (- w)"
   74.41 +definition minus_float where [simp del]: "(z::float) - w = z + (- w)"
   74.42  instance ..
   74.43  end
   74.44  
   74.45 @@ -334,11 +334,11 @@
   74.46  instance ..
   74.47  end
   74.48  
   74.49 -fun float_pprt :: "float \<Rightarrow> float" where
   74.50 -"float_pprt (Float a e) = (if 0 <= a then (Float a e) else 0)"
   74.51 +primrec float_pprt :: "float \<Rightarrow> float" where
   74.52 +  "float_pprt (Float a e) = (if 0 <= a then (Float a e) else 0)"
   74.53  
   74.54 -fun float_nprt :: "float \<Rightarrow> float" where
   74.55 -"float_nprt (Float a e) = (if 0 <= a then 0 else (Float a e))" 
   74.56 +primrec float_nprt :: "float \<Rightarrow> float" where
   74.57 +  "float_nprt (Float a e) = (if 0 <= a then 0 else (Float a e))" 
   74.58  
   74.59  instantiation float :: ord begin
   74.60  definition le_float_def: "z \<le> w \<equiv> Ifloat z \<le> Ifloat w"
   74.61 @@ -354,7 +354,7 @@
   74.62    by (cases a, simp add: uminus_float.simps)
   74.63  
   74.64  lemma Ifloat_sub[simp]: "Ifloat (a - b) = Ifloat a - Ifloat b" 
   74.65 -  by (cases a, cases b, simp add: minus_float.simps)
   74.66 +  by (cases a, cases b, simp add: minus_float_def)
   74.67  
   74.68  lemma Ifloat_mult[simp]: "Ifloat (a*b) = Ifloat a * Ifloat b"
   74.69    by (cases a, cases b, simp add: times_float.simps pow2_add)
   74.70 @@ -443,37 +443,8 @@
   74.71  lemma Ifloat_min: "Ifloat (min x y) = min (Ifloat x) (Ifloat y)" unfolding min_def le_float_def by auto
   74.72  lemma Ifloat_max: "Ifloat (max a b) = max (Ifloat a) (Ifloat b)" unfolding max_def le_float_def by auto
   74.73  
   74.74 -instantiation float :: power begin 
   74.75 -fun power_float where [simp del]: "(Float m e) ^ n = Float (m ^ n) (e * int n)"
   74.76 -instance ..
   74.77 -end
   74.78 -
   74.79 -instance float :: recpower
   74.80 -proof (intro_classes)
   74.81 -  fix a :: float show "a ^ 0 = 1" by (cases a, auto simp add: power_float.simps one_float_def)
   74.82 -next
   74.83 -  fix a :: float and n :: nat show "a ^ (Suc n) = a * a ^ n" 
   74.84 -  by (cases a, auto simp add: power_float.simps times_float.simps algebra_simps)
   74.85 -qed
   74.86 -
   74.87 -lemma float_power: "Ifloat (x ^ n) = (Ifloat x) ^ n"
   74.88 -proof (cases x)
   74.89 -  case (Float m e)
   74.90 -  
   74.91 -  have "pow2 e ^ n = pow2 (e * int n)"
   74.92 -  proof (cases "e >= 0")
   74.93 -    case True hence e_nat: "e = int (nat e)" by auto
   74.94 -    hence "pow2 e ^ n = (2 ^ nat e) ^ n" using pow2_int[of "nat e"] by auto
   74.95 -    thus ?thesis unfolding power_mult[symmetric] unfolding pow2_int[symmetric] int_mult e_nat[symmetric] .
   74.96 -  next
   74.97 -    case False hence e_minus: "-e = int (nat (-e))" by auto
   74.98 -    hence "pow2 (-e) ^ n = (2 ^ nat (-e)) ^ n" using pow2_int[of "nat (-e)"] by auto
   74.99 -    hence "pow2 (-e) ^ n = pow2 ((-e) * int n)" unfolding power_mult[symmetric] unfolding pow2_int[symmetric] int_mult e_minus[symmetric] zmult_zminus .
  74.100 -    thus ?thesis unfolding pow2_neg[of "-e"] pow2_neg[of "-e * int n"] unfolding zmult_zminus zminus_zminus nonzero_power_inverse[OF pow2_neq_zero, symmetric]
  74.101 -      using nonzero_inverse_eq_imp_eq[OF _ pow2_neq_zero pow2_neq_zero] by auto
  74.102 -  qed
  74.103 -  thus ?thesis by (auto simp add: Float power_mult_distrib Ifloat.simps power_float.simps)
  74.104 -qed
  74.105 +lemma float_power: "Ifloat (x ^ n) = Ifloat x ^ n"
  74.106 +  by (induct n) simp_all
  74.107  
  74.108  lemma zero_le_pow2[simp]: "0 \<le> pow2 s"
  74.109    apply (subgoal_tac "0 < pow2 s")
  74.110 @@ -1182,12 +1153,12 @@
  74.111      unfolding x_eq y_eq float_divr.simps Let_def le_float_def Ifloat_0 Ifloat_mult by (auto intro!: mult_nonneg_nonpos)
  74.112  qed
  74.113  
  74.114 -fun round_down :: "nat \<Rightarrow> float \<Rightarrow> float" where
  74.115 +primrec round_down :: "nat \<Rightarrow> float \<Rightarrow> float" where
  74.116  "round_down prec (Float m e) = (let d = bitlen m - int prec in
  74.117       if 0 < d then let P = 2^nat d ; n = m div P in Float n (e + d)
  74.118                else Float m e)"
  74.119  
  74.120 -fun round_up :: "nat \<Rightarrow> float \<Rightarrow> float" where
  74.121 +primrec round_up :: "nat \<Rightarrow> float \<Rightarrow> float" where
  74.122  "round_up prec (Float m e) = (let d = bitlen m - int prec in
  74.123    if 0 < d then let P = 2^nat d ; n = m div P ; r = m mod P in Float (n + (if r = 0 then 0 else 1)) (e + d) 
  74.124             else Float m e)"
  74.125 @@ -1314,8 +1285,8 @@
  74.126    finally show ?thesis .
  74.127  qed
  74.128  
  74.129 -fun float_abs :: "float \<Rightarrow> float" where
  74.130 -"float_abs (Float m e) = Float \<bar>m\<bar> e"
  74.131 +primrec float_abs :: "float \<Rightarrow> float" where
  74.132 +  "float_abs (Float m e) = Float \<bar>m\<bar> e"
  74.133  
  74.134  instantiation float :: abs begin
  74.135  definition abs_float_def: "\<bar>x\<bar> = float_abs x"
  74.136 @@ -1329,8 +1300,8 @@
  74.137    thus ?thesis unfolding Float abs_float_def float_abs.simps Ifloat.simps by auto
  74.138  qed
  74.139  
  74.140 -fun floor_fl :: "float \<Rightarrow> float" where
  74.141 -"floor_fl (Float m e) = (if 0 \<le> e then Float m e
  74.142 +primrec floor_fl :: "float \<Rightarrow> float" where
  74.143 +  "floor_fl (Float m e) = (if 0 \<le> e then Float m e
  74.144                                    else Float (m div (2 ^ (nat (-e)))) 0)"
  74.145  
  74.146  lemma floor_fl: "Ifloat (floor_fl x) \<le> Ifloat x"
  74.147 @@ -1358,8 +1329,8 @@
  74.148  
  74.149  declare floor_fl.simps[simp del]
  74.150  
  74.151 -fun ceiling_fl :: "float \<Rightarrow> float" where
  74.152 -"ceiling_fl (Float m e) = (if 0 \<le> e then Float m e
  74.153 +primrec ceiling_fl :: "float \<Rightarrow> float" where
  74.154 +  "ceiling_fl (Float m e) = (if 0 \<le> e then Float m e
  74.155                                      else Float (m div (2 ^ (nat (-e))) + 1) 0)"
  74.156  
  74.157  lemma ceiling_fl: "Ifloat x \<le> Ifloat (ceiling_fl x)"
    75.1 --- a/src/HOL/Library/Formal_Power_Series.thy	Mon May 11 09:39:53 2009 +0200
    75.2 +++ b/src/HOL/Library/Formal_Power_Series.thy	Mon May 11 17:20:52 2009 +0200
    75.3 @@ -680,30 +680,12 @@
    75.4  
    75.5  subsection {* Powers*}
    75.6  
    75.7 -instantiation fps :: (semiring_1) power
    75.8 -begin
    75.9 -
   75.10 -fun fps_pow :: "nat \<Rightarrow> 'a fps \<Rightarrow> 'a fps" where
   75.11 -  "fps_pow 0 f = 1"
   75.12 -| "fps_pow (Suc n) f = f * fps_pow n f"
   75.13 -
   75.14 -definition fps_power_def: "power (f::'a fps) n = fps_pow n f"
   75.15 -instance ..
   75.16 -end
   75.17 -
   75.18 -instantiation fps :: (comm_ring_1) recpower
   75.19 -begin
   75.20 -instance
   75.21 -  apply (intro_classes)
   75.22 -  by (simp_all add: fps_power_def)
   75.23 -end
   75.24 -
   75.25  lemma fps_power_zeroth_eq_one: "a$0 =1 \<Longrightarrow> a^n $ 0 = (1::'a::semiring_1)"
   75.26 -  by (induct n, auto simp add: fps_power_def expand_fps_eq fps_mult_nth)
   75.27 +  by (induct n, auto simp add: expand_fps_eq fps_mult_nth)
   75.28  
   75.29  lemma fps_power_first_eq: "(a:: 'a::comm_ring_1 fps)$0 =1 \<Longrightarrow> a^n $ 1 = of_nat n * a$1"
   75.30  proof(induct n)
   75.31 -  case 0 thus ?case by (simp add: fps_power_def)
   75.32 +  case 0 thus ?case by simp
   75.33  next
   75.34    case (Suc n)
   75.35    note h = Suc.hyps[OF `a$0 = 1`]
   75.36 @@ -712,16 +694,16 @@
   75.37  qed
   75.38  
   75.39  lemma startsby_one_power:"a $ 0 = (1::'a::comm_ring_1) \<Longrightarrow> a^n $ 0 = 1"
   75.40 -  by (induct n, auto simp add: fps_power_def fps_mult_nth)
   75.41 +  by (induct n, auto simp add: fps_mult_nth)
   75.42  
   75.43  lemma startsby_zero_power:"a $0 = (0::'a::comm_ring_1) \<Longrightarrow> n > 0 \<Longrightarrow> a^n $0 = 0"
   75.44 -  by (induct n, auto simp add: fps_power_def fps_mult_nth)
   75.45 +  by (induct n, auto simp add: fps_mult_nth)
   75.46  
   75.47 -lemma startsby_power:"a $0 = (v::'a::{comm_ring_1, recpower}) \<Longrightarrow> a^n $0 = v^n"
   75.48 -  by (induct n, auto simp add: fps_power_def fps_mult_nth power_Suc)
   75.49 +lemma startsby_power:"a $0 = (v::'a::{comm_ring_1}) \<Longrightarrow> a^n $0 = v^n"
   75.50 +  by (induct n, auto simp add: fps_mult_nth power_Suc)
   75.51  
   75.52  lemma startsby_zero_power_iff[simp]:
   75.53 -  "a^n $0 = (0::'a::{idom, recpower}) \<longleftrightarrow> (n \<noteq> 0 \<and> a$0 = 0)"
   75.54 +  "a^n $0 = (0::'a::{idom}) \<longleftrightarrow> (n \<noteq> 0 \<and> a$0 = 0)"
   75.55  apply (rule iffI)
   75.56  apply (induct n, auto simp add: power_Suc fps_mult_nth)
   75.57  by (rule startsby_zero_power, simp_all)
   75.58 @@ -764,7 +746,7 @@
   75.59    apply (rule startsby_zero_power_prefix[rule_format, OF a0])
   75.60    by arith
   75.61  
   75.62 -lemma startsby_zero_power_nth_same: assumes a0: "a$0 = (0::'a::{recpower, idom})"
   75.63 +lemma startsby_zero_power_nth_same: assumes a0: "a$0 = (0::'a::{idom})"
   75.64    shows "a^n $ n = (a$1) ^ n"
   75.65  proof(induct n)
   75.66    case 0 thus ?case by (simp add: power_0)
   75.67 @@ -785,7 +767,7 @@
   75.68  qed
   75.69  
   75.70  lemma fps_inverse_power:
   75.71 -  fixes a :: "('a::{field, recpower}) fps"
   75.72 +  fixes a :: "('a::{field}) fps"
   75.73    shows "inverse (a^n) = inverse a ^ n"
   75.74  proof-
   75.75    {assume a0: "a$0 = 0"
   75.76 @@ -874,7 +856,7 @@
   75.77  
   75.78  subsection{* The eXtractor series X*}
   75.79  
   75.80 -lemma minus_one_power_iff: "(- (1::'a :: {recpower, comm_ring_1})) ^ n = (if even n then 1 else - 1)"
   75.81 +lemma minus_one_power_iff: "(- (1::'a :: {comm_ring_1})) ^ n = (if even n then 1 else - 1)"
   75.82    by (induct n, auto)
   75.83  
   75.84  definition "X = Abs_fps (\<lambda>n. if n = 1 then 1 else 0)"
   75.85 @@ -901,7 +883,7 @@
   75.86  
   75.87  lemma X_power_iff: "X^k = Abs_fps (\<lambda>n. if n = k then (1::'a::comm_ring_1) else 0)"
   75.88  proof(induct k)
   75.89 -  case 0 thus ?case by (simp add: X_def fps_power_def fps_eq_iff)
   75.90 +  case 0 thus ?case by (simp add: X_def fps_eq_iff)
   75.91  next
   75.92    case (Suc k)
   75.93    {fix m
   75.94 @@ -931,7 +913,7 @@
   75.95    by (simp add: X_power_iff)
   75.96  
   75.97  lemma fps_inverse_X_plus1:
   75.98 -  "inverse (1 + X) = Abs_fps (\<lambda>n. (- (1::'a::{recpower, field})) ^ n)" (is "_ = ?r")
   75.99 +  "inverse (1 + X) = Abs_fps (\<lambda>n. (- (1::'a::{field})) ^ n)" (is "_ = ?r")
  75.100  proof-
  75.101    have eq: "(1 + X) * ?r = 1"
  75.102      unfolding minus_one_power_iff
  75.103 @@ -979,7 +961,7 @@
  75.104    (* {a_{n+k}}_0^infty Corresponds to (f - setsum (\<lambda>i. a_i * x^i))/x^h, for h>0*)
  75.105  
  75.106  lemma fps_power_mult_eq_shift:
  75.107 -  "X^Suc k * Abs_fps (\<lambda>n. a (n + Suc k)) = Abs_fps a - setsum (\<lambda>i. fps_const (a i :: 'a:: field) * X^i) {0 .. k}" (is "?lhs = ?rhs")
  75.108 +  "X^Suc k * Abs_fps (\<lambda>n. a (n + Suc k)) = Abs_fps a - setsum (\<lambda>i. fps_const (a i :: 'a:: comm_ring_1) * X^i) {0 .. k}" (is "?lhs = ?rhs")
  75.109  proof-
  75.110    {fix n:: nat
  75.111      have "?lhs $ n = (if n < Suc k then 0 else a n)"
  75.112 @@ -990,7 +972,7 @@
  75.113      next
  75.114        case (Suc k)
  75.115        note th = Suc.hyps[symmetric]
  75.116 -      have "(Abs_fps a - setsum (\<lambda>i. fps_const (a i :: 'a:: field) * X^i) {0 .. Suc k})$n = (Abs_fps a - setsum (\<lambda>i. fps_const (a i :: 'a:: field) * X^i) {0 .. k} - fps_const (a (Suc k)) * X^ Suc k) $ n" by (simp add: ring_simps)
  75.117 +      have "(Abs_fps a - setsum (\<lambda>i. fps_const (a i :: 'a) * X^i) {0 .. Suc k})$n = (Abs_fps a - setsum (\<lambda>i. fps_const (a i :: 'a) * X^i) {0 .. k} - fps_const (a (Suc k)) * X^ Suc k) $ n" by (simp add: ring_simps)
  75.118        also  have "\<dots> = (if n < Suc k then 0 else a n) - (fps_const (a (Suc k)) * X^ Suc k)$n"
  75.119  	using th
  75.120  	unfolding fps_sub_nth by simp
  75.121 @@ -1022,13 +1004,16 @@
  75.122  lemma XD_linear[simp]: "XD (fps_const c * a + fps_const d * b) = fps_const c * XD a + fps_const d * XD (b :: ('a::comm_ring_1) fps)"
  75.123    by simp
  75.124  
  75.125 -lemma XDN_linear: "(XD^n) (fps_const c * a + fps_const d * b) = fps_const c * (XD^n) a + fps_const d * (XD^n) (b :: ('a::comm_ring_1) fps)"
  75.126 +lemma XDN_linear:
  75.127 +  "(XD ^^ n) (fps_const c * a + fps_const d * b) = fps_const c * (XD ^^ n) a + fps_const d * (XD ^^ n) (b :: ('a::comm_ring_1) fps)"
  75.128    by (induct n, simp_all)
  75.129  
  75.130  lemma fps_mult_X_deriv_shift: "X* fps_deriv a = Abs_fps (\<lambda>n. of_nat n* a$n)" by (simp add: fps_eq_iff)
  75.131  
  75.132 -lemma fps_mult_XD_shift: "(XD ^k) (a:: ('a::{comm_ring_1, recpower, ring_char_0}) fps) = Abs_fps (\<lambda>n. (of_nat n ^ k) * a$n)"
  75.133 -by (induct k arbitrary: a) (simp_all add: power_Suc XD_def fps_eq_iff ring_simps del: One_nat_def)
  75.134 +
  75.135 +lemma fps_mult_XD_shift:
  75.136 +  "(XD ^^ k) (a:: ('a::{comm_ring_1}) fps) = Abs_fps (\<lambda>n. (of_nat n ^ k) * a$n)"
  75.137 +  by (induct k arbitrary: a) (simp_all add: power_Suc XD_def fps_eq_iff ring_simps del: One_nat_def)
  75.138  
  75.139  subsubsection{* Rule 3 is trivial and is given by @{text fps_times_def}*}
  75.140  subsubsection{* Rule 5 --- summation and "division" by (1 - X)*}
  75.141 @@ -1309,7 +1294,7 @@
  75.142    by (cases m, simp_all add: fps_power_nth_Suc del: power_Suc)
  75.143  
  75.144  lemma fps_nth_power_0:
  75.145 -  fixes m :: nat and a :: "('a::{comm_ring_1, recpower}) fps"
  75.146 +  fixes m :: nat and a :: "('a::{comm_ring_1}) fps"
  75.147    shows "(a ^m)$0 = (a$0) ^ m"
  75.148  proof-
  75.149    {assume "m=0" hence ?thesis by simp}
  75.150 @@ -1325,7 +1310,7 @@
  75.151  qed
  75.152  
  75.153  lemma fps_compose_inj_right:
  75.154 -  assumes a0: "a$0 = (0::'a::{recpower,idom})"
  75.155 +  assumes a0: "a$0 = (0::'a::{idom})"
  75.156    and a1: "a$1 \<noteq> 0"
  75.157    shows "(b oo a = c oo a) \<longleftrightarrow> b = c" (is "?lhs \<longleftrightarrow>?rhs")
  75.158  proof-
  75.159 @@ -1366,7 +1351,7 @@
  75.160  subsection {* Radicals *}
  75.161  
  75.162  declare setprod_cong[fundef_cong]
  75.163 -function radical :: "(nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> ('a::{field, recpower}) fps \<Rightarrow> nat \<Rightarrow> 'a" where
  75.164 +function radical :: "(nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> ('a::{field}) fps \<Rightarrow> nat \<Rightarrow> 'a" where
  75.165    "radical r 0 a 0 = 1"
  75.166  | "radical r 0 a (Suc n) = 0"
  75.167  | "radical r (Suc k) a 0 = r (Suc k) (a$0)"
  75.168 @@ -1454,7 +1439,68 @@
  75.169  qed
  75.170  
  75.171  lemma power_radical:
  75.172 -  fixes a:: "'a ::{field, ring_char_0, recpower} fps"
  75.173 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.174 +  assumes a0: "a$0 \<noteq> 0"
  75.175 +  shows "(r (Suc k) (a$0)) ^ Suc k = a$0 \<longleftrightarrow> (fps_radical r (Suc k) a) ^ (Suc k) = a"
  75.176 +proof-
  75.177 +  let ?r = "fps_radical r (Suc k) a"
  75.178 +  {assume r0: "(r (Suc k) (a$0)) ^ Suc k = a$0"
  75.179 +    from a0 r0 have r00: "r (Suc k) (a$0) \<noteq> 0" by auto
  75.180 +    {fix z have "?r ^ Suc k $ z = a$z"
  75.181 +      proof(induct z rule: nat_less_induct)
  75.182 +	fix n assume H: "\<forall>m<n. ?r ^ Suc k $ m = a$m"
  75.183 +	{assume "n = 0" hence "?r ^ Suc k $ n = a $n"
  75.184 +	    using fps_radical_power_nth[of r "Suc k" a, OF r0] by simp}
  75.185 +	moreover
  75.186 +	{fix n1 assume n1: "n = Suc n1"
  75.187 +	  have fK: "finite {0..k}" by simp
  75.188 +	  have nz: "n \<noteq> 0" using n1 by arith
  75.189 +	  let ?Pnk = "natpermute n (k + 1)"
  75.190 +	  let ?Pnkn = "{xs \<in> ?Pnk. n \<in> set xs}"
  75.191 +	  let ?Pnknn = "{xs \<in> ?Pnk. n \<notin> set xs}"
  75.192 +	  have eq: "?Pnkn \<union> ?Pnknn = ?Pnk" by blast
  75.193 +	  have d: "?Pnkn \<inter> ?Pnknn = {}" by blast
  75.194 +	  have f: "finite ?Pnkn" "finite ?Pnknn"
  75.195 +	    using finite_Un[of ?Pnkn ?Pnknn, unfolded eq]
  75.196 +	    by (metis natpermute_finite)+
  75.197 +	  let ?f = "\<lambda>v. \<Prod>j\<in>{0..k}. ?r $ v ! j"
  75.198 +	  have "setsum ?f ?Pnkn = setsum (\<lambda>v. ?r $ n * r (Suc k) (a $ 0) ^ k) ?Pnkn"
  75.199 +	  proof(rule setsum_cong2)
  75.200 +	    fix v assume v: "v \<in> {xs \<in> natpermute n (k + 1). n \<in> set xs}"
  75.201 +	    let ?ths = "(\<Prod>j\<in>{0..k}. fps_radical r (Suc k) a $ v ! j) = fps_radical r (Suc k) a $ n * r (Suc k) (a $ 0) ^ k"
  75.202 +	  from v obtain i where i: "i \<in> {0..k}" "v = replicate (k+1) 0 [i:= n]"
  75.203 +	    unfolding natpermute_contain_maximal by auto
  75.204 +	  have "(\<Prod>j\<in>{0..k}. fps_radical r (Suc k) a $ v ! j) = (\<Prod>j\<in>{0..k}. if j = i then fps_radical r (Suc k) a $ n else r (Suc k) (a$0))"
  75.205 +	    apply (rule setprod_cong, simp)
  75.206 +	    using i r0 by (simp del: replicate.simps)
  75.207 +	  also have "\<dots> = (fps_radical r (Suc k) a $ n) * r (Suc k) (a$0) ^ k"
  75.208 +	    unfolding setprod_gen_delta[OF fK] using i r0 by simp
  75.209 +	  finally show ?ths .
  75.210 +	qed
  75.211 +	then have "setsum ?f ?Pnkn = of_nat (k+1) * ?r $ n * r (Suc k) (a $ 0) ^ k"
  75.212 +	  by (simp add: natpermute_max_card[OF nz, simplified])
  75.213 +	also have "\<dots> = a$n - setsum ?f ?Pnknn"
  75.214 +	  unfolding n1 using r00 a0 by (simp add: field_simps fps_radical_def del: of_nat_Suc )
  75.215 +	finally have fn: "setsum ?f ?Pnkn = a$n - setsum ?f ?Pnknn" .
  75.216 +	have "(?r ^ Suc k)$n = setsum ?f ?Pnkn + setsum ?f ?Pnknn"
  75.217 +	  unfolding fps_power_nth_Suc setsum_Un_disjoint[OF f d, unfolded eq] ..
  75.218 +	also have "\<dots> = a$n" unfolding fn by simp
  75.219 +	finally have "?r ^ Suc k $ n = a $n" .}
  75.220 +      ultimately  show "?r ^ Suc k $ n = a $n" by (cases n, auto)
  75.221 +    qed }
  75.222 +  then have ?thesis using r0 by (simp add: fps_eq_iff)}
  75.223 +moreover 
  75.224 +{ assume h: "(fps_radical r (Suc k) a) ^ (Suc k) = a"
  75.225 +  hence "((fps_radical r (Suc k) a) ^ (Suc k))$0 = a$0" by simp
  75.226 +  then have "(r (Suc k) (a$0)) ^ Suc k = a$0"
  75.227 +    unfolding fps_power_nth_Suc
  75.228 +    by (simp add: setprod_constant del: replicate.simps)}
  75.229 +ultimately show ?thesis by blast
  75.230 +qed
  75.231 +
  75.232 +(*
  75.233 +lemma power_radical:
  75.234 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.235    assumes r0: "(r (Suc k) (a$0)) ^ Suc k = a$0" and a0: "a$0 \<noteq> 0"
  75.236    shows "(fps_radical r (Suc k) a) ^ (Suc k) = a"
  75.237  proof-
  75.238 @@ -1505,6 +1551,7 @@
  75.239    then show ?thesis by (simp add: fps_eq_iff)
  75.240  qed
  75.241  
  75.242 +*)
  75.243  lemma eq_divide_imp': assumes c0: "(c::'a::field) ~= 0" and eq: "a * c = b"
  75.244    shows "a = b / c"
  75.245  proof-
  75.246 @@ -1515,16 +1562,15 @@
  75.247  
  75.248  lemma radical_unique:
  75.249    assumes r0: "(r (Suc k) (b$0)) ^ Suc k = b$0"
  75.250 -  and a0: "r (Suc k) (b$0 ::'a::{field, ring_char_0, recpower}) = a$0" and b0: "b$0 \<noteq> 0"
  75.251 +  and a0: "r (Suc k) (b$0 ::'a::{field, ring_char_0}) = a$0" and b0: "b$0 \<noteq> 0"
  75.252    shows "a^(Suc k) = b \<longleftrightarrow> a = fps_radical r (Suc k) b"
  75.253  proof-
  75.254    let ?r = "fps_radical r (Suc k) b"
  75.255    have r00: "r (Suc k) (b$0) \<noteq> 0" using b0 r0 by auto
  75.256    {assume H: "a = ?r"
  75.257 -    from H have "a^Suc k = b" using power_radical[of r k, OF r0 b0] by simp}
  75.258 +    from H have "a^Suc k = b" using power_radical[OF b0, of r k, unfolded r0] by simp}
  75.259    moreover
  75.260    {assume H: "a^Suc k = b"
  75.261 -    (* Generally a$0 would need to be the k+1 st root of b$0 *)
  75.262      have ceq: "card {0..k} = Suc k" by simp
  75.263      have fk: "finite {0..k}" by simp
  75.264      from a0 have a0r0: "a$0 = ?r$0" by simp
  75.265 @@ -1610,7 +1656,7 @@
  75.266  
  75.267  lemma radical_power:
  75.268    assumes r0: "r (Suc k) ((a$0) ^ Suc k) = a$0"
  75.269 -  and a0: "(a$0 ::'a::{field, ring_char_0, recpower}) \<noteq> 0"
  75.270 +  and a0: "(a$0 ::'a::{field, ring_char_0}) \<noteq> 0"
  75.271    shows "(fps_radical r (Suc k) (a ^ Suc k)) = a"
  75.272  proof-
  75.273    let ?ak = "a^ Suc k"
  75.274 @@ -1622,7 +1668,7 @@
  75.275  qed
  75.276  
  75.277  lemma fps_deriv_radical:
  75.278 -  fixes a:: "'a ::{field, ring_char_0, recpower} fps"
  75.279 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.280    assumes r0: "(r (Suc k) (a$0)) ^ Suc k = a$0" and a0: "a$0 \<noteq> 0"
  75.281    shows "fps_deriv (fps_radical r (Suc k) a) = fps_deriv a / (fps_const (of_nat (Suc k)) * (fps_radical r (Suc k) a) ^ k)"
  75.282  proof-
  75.283 @@ -1632,7 +1678,7 @@
  75.284    from r0' have w0: "?w $ 0 \<noteq> 0" by (simp del: of_nat_Suc)
  75.285    note th0 = inverse_mult_eq_1[OF w0]
  75.286    let ?iw = "inverse ?w"
  75.287 -  from power_radical[of r, OF r0 a0]
  75.288 +  from iffD1[OF power_radical[of a r], OF a0 r0]
  75.289    have "fps_deriv (?r ^ Suc k) = fps_deriv a" by simp
  75.290    hence "fps_deriv ?r * ?w = fps_deriv a"
  75.291      by (simp add: fps_deriv_power mult_ac del: power_Suc)
  75.292 @@ -1643,11 +1689,45 @@
  75.293  qed
  75.294  
  75.295  lemma radical_mult_distrib:
  75.296 -  fixes a:: "'a ::{field, ring_char_0, recpower} fps"
  75.297 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.298    assumes
  75.299 -  ra0: "r (k) (a $ 0) ^ k = a $ 0"
  75.300 -  and rb0: "r (k) (b $ 0) ^ k = b $ 0"
  75.301 -  and r0': "r (k) ((a * b) $ 0) = r (k) (a $ 0) * r (k) (b $ 0)"
  75.302 +  k: "k > 0"
  75.303 +  and ra0: "r k (a $ 0) ^ k = a $ 0"
  75.304 +  and rb0: "r k (b $ 0) ^ k = b $ 0"
  75.305 +  and a0: "a$0 \<noteq> 0"
  75.306 +  and b0: "b$0 \<noteq> 0"
  75.307 +  shows "r k ((a * b) $ 0) = r k (a $ 0) * r k (b $ 0) \<longleftrightarrow> fps_radical r (k) (a*b) = fps_radical r (k) a * fps_radical r (k) (b)"
  75.308 +proof-
  75.309 +  {assume  r0': "r k ((a * b) $ 0) = r k (a $ 0) * r k (b $ 0)"
  75.310 +  from r0' have r0: "(r (k) ((a*b)$0)) ^ k = (a*b)$0"
  75.311 +    by (simp add: fps_mult_nth ra0 rb0 power_mult_distrib)
  75.312 +  {assume "k=0" hence ?thesis using r0' by simp}
  75.313 +  moreover
  75.314 +  {fix h assume k: "k = Suc h"
  75.315 +  let ?ra = "fps_radical r (Suc h) a"
  75.316 +  let ?rb = "fps_radical r (Suc h) b"
  75.317 +  have th0: "r (Suc h) ((a * b) $ 0) = (fps_radical r (Suc h) a * fps_radical r (Suc h) b) $ 0"
  75.318 +    using r0' k by (simp add: fps_mult_nth)
  75.319 +  have ab0: "(a*b) $ 0 \<noteq> 0" using a0 b0 by (simp add: fps_mult_nth)
  75.320 +  from radical_unique[of r h "a*b" "fps_radical r (Suc h) a * fps_radical r (Suc h) b", OF r0[unfolded k] th0 ab0, symmetric]
  75.321 +    iffD1[OF power_radical[of _ r], OF a0 ra0[unfolded k]] iffD1[OF power_radical[of _ r], OF b0 rb0[unfolded k]] k r0'
  75.322 +  have ?thesis by (auto simp add: power_mult_distrib simp del: power_Suc)}
  75.323 +ultimately have ?thesis by (cases k, auto)}
  75.324 +moreover
  75.325 +{assume h: "fps_radical r k (a*b) = fps_radical r k a * fps_radical r k b"
  75.326 +  hence "(fps_radical r k (a*b))$0 = (fps_radical r k a * fps_radical r k b)$0" by simp
  75.327 +  then have "r k ((a * b) $ 0) = r k (a $ 0) * r k (b $ 0)"
  75.328 +    using k by (simp add: fps_mult_nth)}
  75.329 +ultimately show ?thesis by blast
  75.330 +qed
  75.331 +
  75.332 +(*
  75.333 +lemma radical_mult_distrib:
  75.334 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.335 +  assumes
  75.336 +  ra0: "r k (a $ 0) ^ k = a $ 0"
  75.337 +  and rb0: "r k (b $ 0) ^ k = b $ 0"
  75.338 +  and r0': "r k ((a * b) $ 0) = r k (a $ 0) * r k (b $ 0)"
  75.339    and a0: "a$0 \<noteq> 0"
  75.340    and b0: "b$0 \<noteq> 0"
  75.341    shows "fps_radical r (k) (a*b) = fps_radical r (k) a * fps_radical r (k) (b)"
  75.342 @@ -1667,88 +1747,60 @@
  75.343    have ?thesis by (auto simp add: power_mult_distrib simp del: power_Suc)}
  75.344  ultimately show ?thesis by (cases k, auto)
  75.345  qed
  75.346 +*)
  75.347  
  75.348 -lemma radical_inverse:
  75.349 -  fixes a:: "'a ::{field, ring_char_0, recpower} fps"
  75.350 -  assumes
  75.351 -  ra0: "r (k) (a $ 0) ^ k = a $ 0"
  75.352 -  and ria0: "r (k) (inverse (a $ 0)) = inverse (r (k) (a $ 0))"
  75.353 -  and r1: "(r (k) 1) = 1"
  75.354 -  and a0: "a$0 \<noteq> 0"
  75.355 -  shows "fps_radical r (k) (inverse a) = inverse (fps_radical r (k) a)"
  75.356 -proof-
  75.357 -  {assume "k=0" then have ?thesis by simp}
  75.358 -  moreover
  75.359 -  {fix h assume k[simp]: "k = Suc h"
  75.360 -    let ?ra = "fps_radical r (Suc h) a"
  75.361 -    let ?ria = "fps_radical r (Suc h) (inverse a)"
  75.362 -    from ra0 a0 have th00: "r (Suc h) (a$0) \<noteq> 0" by auto
  75.363 -    have ria0': "r (Suc h) (inverse a $ 0) ^ Suc h = inverse a$0"
  75.364 -    using ria0 ra0 a0
  75.365 -    by (simp add: fps_inverse_def  nonzero_power_inverse[OF th00, symmetric]
  75.366 -             del: power_Suc)
  75.367 -  from inverse_mult_eq_1[OF a0] have th0: "a * inverse a = 1"
  75.368 -    by (simp add: mult_commute)
  75.369 -  from radical_unique[where a=1 and b=1 and r=r and k=h, simplified, OF r1[unfolded k]]
  75.370 -  have th01: "fps_radical r (Suc h) 1 = 1" .
  75.371 -  have th1: "r (Suc h) ((a * inverse a) $ 0) ^ Suc h = (a * inverse a) $ 0"
  75.372 -    "r (Suc h) ((a * inverse a) $ 0) =
  75.373 -r (Suc h) (a $ 0) * r (Suc h) (inverse a $ 0)"
  75.374 -    using r1 unfolding th0  apply (simp_all add: ria0[symmetric])
  75.375 -    apply (simp add: fps_inverse_def a0)
  75.376 -    unfolding ria0[unfolded k]
  75.377 -    using th00 by simp
  75.378 -  from nonzero_imp_inverse_nonzero[OF a0] a0
  75.379 -  have th2: "inverse a $ 0 \<noteq> 0" by (simp add: fps_inverse_def)
  75.380 -  from radical_mult_distrib[of r "Suc h" a "inverse a", OF ra0[unfolded k] ria0' th1(2) a0 th2]
  75.381 -  have th3: "?ra * ?ria = 1" unfolding th0 th01 by simp
  75.382 -  from th00 have ra0: "?ra $ 0 \<noteq> 0" by simp
  75.383 -  from fps_inverse_unique[OF ra0 th3] have ?thesis by simp}
  75.384 -ultimately show ?thesis by (cases k, auto)
  75.385 -qed
  75.386 -
  75.387 -lemma fps_divide_inverse: "(a::('a::field) fps) / b = a * inverse b"
  75.388 +lemma fps_divide_1[simp]: "(a:: ('a::field) fps) / 1 = a"
  75.389    by (simp add: fps_divide_def)
  75.390  
  75.391  lemma radical_divide:
  75.392 -  fixes a:: "'a ::{field, ring_char_0, recpower} fps"
  75.393 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.394    assumes
  75.395 -      ra0: "r k (a $ 0) ^ k = a $ 0"
  75.396 -  and rb0: "r k (b $ 0) ^ k = b $ 0"
  75.397 -  and r1: "r k 1 = 1"
  75.398 -  and rb0': "r k (inverse (b $ 0)) = inverse (r k (b $ 0))"
  75.399 -  and raib': "r k (a$0 / (b$0)) = r k (a$0) / r k (b$0)"
  75.400 +  kp: "k>0"
  75.401 +  and ra0: "(r k (a $ 0)) ^ k = a $ 0"
  75.402 +  and rb0: "(r k (b $ 0)) ^ k = b $ 0"
  75.403    and a0: "a$0 \<noteq> 0"
  75.404    and b0: "b$0 \<noteq> 0"
  75.405 -  shows "fps_radical r k (a/b) = fps_radical r k a / fps_radical r k b"
  75.406 +  shows "r k ((a $ 0) / (b$0)) = r k (a$0) / r k (b $ 0) \<longleftrightarrow> fps_radical r k (a/b) = fps_radical r k a / fps_radical r k b" (is "?lhs = ?rhs")
  75.407  proof-
  75.408 -  from raib'
  75.409 -  have raib: "r k (a$0 / (b$0)) = r k (a$0) * r k (inverse (b$0))"
  75.410 -    by (simp add: divide_inverse rb0'[symmetric])
  75.411 -
  75.412 -  {assume "k=0" hence ?thesis by (simp add: fps_divide_def)}
  75.413 -  moreover
  75.414 -  {assume k0: "k\<noteq> 0"
  75.415 -    from b0 k0 rb0 have rbn0: "r k (b $0) \<noteq> 0"
  75.416 -      by (auto simp add: power_0_left)
  75.417 +  let ?r = "fps_radical r k"
  75.418 +  from kp obtain h where k: "k = Suc h" by (cases k, auto)
  75.419 +  have ra0': "r k (a$0) \<noteq> 0" using a0 ra0 k by auto
  75.420 +  have rb0': "r k (b$0) \<noteq> 0" using b0 rb0 k by auto
  75.421  
  75.422 -    from rb0 rb0' have rib0: "(r k (inverse (b $ 0)))^k = inverse (b$0)"
  75.423 -    by (simp add: nonzero_power_inverse[OF rbn0, symmetric])
  75.424 -  from rib0 have th0: "r k (inverse b $ 0) ^ k = inverse b $ 0"
  75.425 -    by (simp add:fps_inverse_def b0)
  75.426 -  from raib
  75.427 -  have th1: "r k ((a * inverse b) $ 0) = r k (a $ 0) * r k (inverse b $ 0)"
  75.428 -    by (simp add: divide_inverse fps_inverse_def  b0 fps_mult_nth)
  75.429 -  from nonzero_imp_inverse_nonzero[OF b0] b0 have th2: "inverse b $ 0 \<noteq> 0"
  75.430 -    by (simp add: fps_inverse_def)
  75.431 -  from radical_mult_distrib[of r k a "inverse b", OF ra0 th0 th1 a0 th2]
  75.432 -  have th: "fps_radical r k (a/b) = fps_radical r k a * fps_radical r k (inverse b)"
  75.433 -    by (simp add: fps_divide_def)
  75.434 -  with radical_inverse[of r k b, OF rb0 rb0' r1 b0]
  75.435 -  have ?thesis by (simp add: fps_divide_def)}
  75.436 -ultimately show ?thesis by blast
  75.437 +  {assume ?rhs
  75.438 +    then have "?r (a/b) $ 0 = (?r a / ?r b)$0" by simp
  75.439 +    then have ?lhs using k a0 b0 rb0' 
  75.440 +      by (simp add: fps_divide_def fps_mult_nth fps_inverse_def divide_inverse) }
  75.441 +  moreover
  75.442 +  {assume h: ?lhs
  75.443 +    from a0 b0 have ab0[simp]: "(a/b)$0 = a$0 / b$0" 
  75.444 +      by (simp add: fps_divide_def fps_mult_nth divide_inverse fps_inverse_def)
  75.445 +    have th0: "r k ((a/b)$0) ^ k = (a/b)$0"
  75.446 +      by (simp add: h nonzero_power_divide[OF rb0'] ra0 rb0 del: k)
  75.447 +    from a0 b0 ra0' rb0' kp h 
  75.448 +    have th1: "r k ((a / b) $ 0) = (fps_radical r k a / fps_radical r k b) $ 0"
  75.449 +      by (simp add: fps_divide_def fps_mult_nth fps_inverse_def divide_inverse del: k)
  75.450 +    from a0 b0 ra0' rb0' kp have ab0': "(a / b) $ 0 \<noteq> 0"
  75.451 +      by (simp add: fps_divide_def fps_mult_nth fps_inverse_def nonzero_imp_inverse_nonzero)
  75.452 +    note tha[simp] = iffD1[OF power_radical[where r=r and k=h], OF a0 ra0[unfolded k], unfolded k[symmetric]]
  75.453 +    note thb[simp] = iffD1[OF power_radical[where r=r and k=h], OF b0 rb0[unfolded k], unfolded k[symmetric]]
  75.454 +    have th2: "(?r a / ?r b)^k = a/b"
  75.455 +      by (simp add: fps_divide_def power_mult_distrib fps_inverse_power[symmetric])
  75.456 +    from iffD1[OF radical_unique[where r=r and a="?r a / ?r b" and b="a/b" and k=h], symmetric, unfolded k[symmetric], OF th0 th1 ab0' th2] have ?rhs .}
  75.457 +  ultimately show ?thesis by blast
  75.458  qed
  75.459  
  75.460 +lemma radical_inverse:
  75.461 +  fixes a:: "'a ::{field, ring_char_0} fps"
  75.462 +  assumes
  75.463 +  k: "k>0"
  75.464 +  and ra0: "r k (a $ 0) ^ k = a $ 0"
  75.465 +  and r1: "(r k 1)^k = 1"
  75.466 +  and a0: "a$0 \<noteq> 0"
  75.467 +  shows "r k (inverse (a $ 0)) = r k 1 / (r k (a $ 0)) \<longleftrightarrow> fps_radical r k (inverse a) = fps_radical r k 1 / fps_radical r k a"
  75.468 +  using radical_divide[where k=k and r=r and a=1 and b=a, OF k ] ra0 r1 a0
  75.469 +  by (simp add: divide_inverse fps_divide_def)
  75.470 +
  75.471  subsection{* Derivative of composition *}
  75.472  
  75.473  lemma fps_compose_deriv:
  75.474 @@ -1831,7 +1883,7 @@
  75.475  subsection{* Compositional inverses *}
  75.476  
  75.477  
  75.478 -fun compinv :: "'a fps \<Rightarrow> nat \<Rightarrow> 'a::{recpower,field}" where
  75.479 +fun compinv :: "'a fps \<Rightarrow> nat \<Rightarrow> 'a::{field}" where
  75.480    "compinv a 0 = X$0"
  75.481  | "compinv a (Suc n) = (X$ Suc n - setsum (\<lambda>i. (compinv a i) * (a^i)$Suc n) {0 .. n}) / (a$1) ^ Suc n"
  75.482  
  75.483 @@ -1862,7 +1914,7 @@
  75.484  qed
  75.485  
  75.486  
  75.487 -fun gcompinv :: "'a fps \<Rightarrow> 'a fps \<Rightarrow> nat \<Rightarrow> 'a::{recpower,field}" where
  75.488 +fun gcompinv :: "'a fps \<Rightarrow> 'a fps \<Rightarrow> nat \<Rightarrow> 'a::{field}" where
  75.489    "gcompinv b a 0 = b$0"
  75.490  | "gcompinv b a (Suc n) = (b$ Suc n - setsum (\<lambda>i. (gcompinv b a i) * (a^i)$Suc n) {0 .. n}) / (a$1) ^ Suc n"
  75.491  
  75.492 @@ -1901,19 +1953,16 @@
  75.493    done
  75.494  
  75.495  lemma fps_compose_1[simp]: "1 oo a = 1"
  75.496 -  by (simp add: fps_eq_iff fps_compose_nth fps_power_def mult_delta_left setsum_delta)
  75.497 +  by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
  75.498  
  75.499  lemma fps_compose_0[simp]: "0 oo a = 0"
  75.500    by (simp add: fps_eq_iff fps_compose_nth)
  75.501  
  75.502 -lemma fps_pow_0: "fps_pow n 0 = (if n = 0 then 1 else 0)"
  75.503 -  by (induct n, simp_all)
  75.504 -
  75.505  lemma fps_compose_0_right[simp]: "a oo 0 = fps_const (a$0)"
  75.506 -  by (auto simp add: fps_eq_iff fps_compose_nth fps_power_def fps_pow_0 setsum_0')
  75.507 +  by (auto simp add: fps_eq_iff fps_compose_nth power_0_left setsum_0')
  75.508  
  75.509  lemma fps_compose_add_distrib: "(a + b) oo c = (a oo c) + (b oo c)"
  75.510 -  by (simp add: fps_eq_iff fps_compose_nth  ring_simps setsum_addf)
  75.511 +  by (simp add: fps_eq_iff fps_compose_nth ring_simps setsum_addf)
  75.512  
  75.513  lemma fps_compose_setsum_distrib: "(setsum f S) oo a = setsum (\<lambda>i. f i oo a) S"
  75.514  proof-
  75.515 @@ -2118,7 +2167,7 @@
  75.516  qed
  75.517  
  75.518  lemma fps_inv_deriv:
  75.519 -  assumes a0:"a$0 = (0::'a::{recpower,field})" and a1: "a$1 \<noteq> 0"
  75.520 +  assumes a0:"a$0 = (0::'a::{field})" and a1: "a$1 \<noteq> 0"
  75.521    shows "fps_deriv (fps_inv a) = inverse (fps_deriv a oo fps_inv a)"
  75.522  proof-
  75.523    let ?ia = "fps_inv a"
  75.524 @@ -2138,7 +2187,7 @@
  75.525  subsubsection{* Exponential series *}
  75.526  definition "E x = Abs_fps (\<lambda>n. x^n / of_nat (fact n))"
  75.527  
  75.528 -lemma E_deriv[simp]: "fps_deriv (E a) = fps_const (a::'a::{field, recpower, ring_char_0}) * E a" (is "?l = ?r")
  75.529 +lemma E_deriv[simp]: "fps_deriv (E a) = fps_const (a::'a::{field, ring_char_0}) * E a" (is "?l = ?r")
  75.530  proof-
  75.531    {fix n
  75.532      have "?l$n = ?r $ n"
  75.533 @@ -2148,7 +2197,7 @@
  75.534  qed
  75.535  
  75.536  lemma E_unique_ODE:
  75.537 -  "fps_deriv a = fps_const c * a \<longleftrightarrow> a = fps_const (a$0) * E (c :: 'a::{field, ring_char_0, recpower})"
  75.538 +  "fps_deriv a = fps_const c * a \<longleftrightarrow> a = fps_const (a$0) * E (c :: 'a::{field, ring_char_0})"
  75.539    (is "?lhs \<longleftrightarrow> ?rhs")
  75.540  proof-
  75.541    {assume d: ?lhs
  75.542 @@ -2175,7 +2224,7 @@
  75.543  ultimately show ?thesis by blast
  75.544  qed
  75.545  
  75.546 -lemma E_add_mult: "E (a + b) = E (a::'a::{ring_char_0, field, recpower}) * E b" (is "?l = ?r")
  75.547 +lemma E_add_mult: "E (a + b) = E (a::'a::{ring_char_0, field}) * E b" (is "?l = ?r")
  75.548  proof-
  75.549    have "fps_deriv (?r) = fps_const (a+b) * ?r"
  75.550      by (simp add: fps_const_add[symmetric] ring_simps del: fps_const_add)
  75.551 @@ -2187,10 +2236,10 @@
  75.552  lemma E_nth[simp]: "E a $ n = a^n / of_nat (fact n)"
  75.553    by (simp add: E_def)
  75.554  
  75.555 -lemma E0[simp]: "E (0::'a::{field, recpower}) = 1"
  75.556 +lemma E0[simp]: "E (0::'a::{field}) = 1"
  75.557    by (simp add: fps_eq_iff power_0_left)
  75.558  
  75.559 -lemma E_neg: "E (- a) = inverse (E (a::'a::{ring_char_0, field, recpower}))"
  75.560 +lemma E_neg: "E (- a) = inverse (E (a::'a::{ring_char_0, field}))"
  75.561  proof-
  75.562    from E_add_mult[of a "- a"] have th0: "E a * E (- a) = 1"
  75.563      by (simp )
  75.564 @@ -2198,7 +2247,7 @@
  75.565    from fps_inverse_unique[OF th1 th0] show ?thesis by simp
  75.566  qed
  75.567  
  75.568 -lemma E_nth_deriv[simp]: "fps_nth_deriv n (E (a::'a::{field, recpower, ring_char_0})) = (fps_const a)^n * (E a)"
  75.569 +lemma E_nth_deriv[simp]: "fps_nth_deriv n (E (a::'a::{field, ring_char_0})) = (fps_const a)^n * (E a)"
  75.570    by (induct n, auto simp add: power_Suc)
  75.571  
  75.572  lemma fps_compose_uminus: "- (a::'a::ring_1 fps) oo c = - (a oo c)"
  75.573 @@ -2211,7 +2260,7 @@
  75.574  lemma X_fps_compose:"X oo a = Abs_fps (\<lambda>n. if n = 0 then (0::'a::comm_ring_1) else a$n)"
  75.575    by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta power_Suc)
  75.576  
  75.577 -lemma X_compose_E[simp]: "X oo E (a::'a::{field, recpower}) = E a - 1"
  75.578 +lemma X_compose_E[simp]: "X oo E (a::'a::{field}) = E a - 1"
  75.579    by (simp add: fps_eq_iff X_fps_compose)
  75.580  
  75.581  lemma LE_compose:
  75.582 @@ -2233,7 +2282,7 @@
  75.583  
  75.584  
  75.585  lemma inverse_one_plus_X:
  75.586 -  "inverse (1 + X) = Abs_fps (\<lambda>n. (- 1 ::'a::{field, recpower})^n)"
  75.587 +  "inverse (1 + X) = Abs_fps (\<lambda>n. (- 1 ::'a::{field})^n)"
  75.588    (is "inverse ?l = ?r")
  75.589  proof-
  75.590    have th: "?l * ?r = 1"
  75.591 @@ -2244,11 +2293,11 @@
  75.592    from fps_inverse_unique[OF th' th] show ?thesis .
  75.593  qed
  75.594  
  75.595 -lemma E_power_mult: "(E (c::'a::{field,recpower,ring_char_0}))^n = E (of_nat n * c)"
  75.596 +lemma E_power_mult: "(E (c::'a::{field,ring_char_0}))^n = E (of_nat n * c)"
  75.597    by (induct n, auto simp add: ring_simps E_add_mult power_Suc)
  75.598  
  75.599  subsubsection{* Logarithmic series *}
  75.600 -definition "(L::'a::{field, ring_char_0,recpower} fps)
  75.601 +definition "(L::'a::{field, ring_char_0} fps)
  75.602    = Abs_fps (\<lambda>n. (- 1) ^ Suc n / of_nat n)"
  75.603  
  75.604  lemma fps_deriv_L: "fps_deriv L = inverse (1 + X)"
  75.605 @@ -2259,7 +2308,7 @@
  75.606    by (simp add: L_def)
  75.607  
  75.608  lemma L_E_inv:
  75.609 -  assumes a: "a\<noteq> (0::'a::{field,division_by_zero,ring_char_0,recpower})"
  75.610 +  assumes a: "a\<noteq> (0::'a::{field,division_by_zero,ring_char_0})"
  75.611    shows "L = fps_const a * fps_inv (E a - 1)" (is "?l = ?r")
  75.612  proof-
  75.613    let ?b = "E a - 1"
  75.614 @@ -2283,10 +2332,10 @@
  75.615  
  75.616  subsubsection{* Formal trigonometric functions  *}
  75.617  
  75.618 -definition "fps_sin (c::'a::{field, recpower, ring_char_0}) =
  75.619 +definition "fps_sin (c::'a::{field, ring_char_0}) =
  75.620    Abs_fps (\<lambda>n. if even n then 0 else (- 1) ^((n - 1) div 2) * c^n /(of_nat (fact n)))"
  75.621  
  75.622 -definition "fps_cos (c::'a::{field, recpower, ring_char_0}) = Abs_fps (\<lambda>n. if even n then (- 1) ^ (n div 2) * c^n / (of_nat (fact n)) else 0)"
  75.623 +definition "fps_cos (c::'a::{field, ring_char_0}) = Abs_fps (\<lambda>n. if even n then (- 1) ^ (n div 2) * c^n / (of_nat (fact n)) else 0)"
  75.624  
  75.625  lemma fps_sin_deriv:
  75.626    "fps_deriv (fps_sin c) = fps_const c * fps_cos c"
  75.627 @@ -2341,11 +2390,11 @@
  75.628  proof-
  75.629    have "fps_deriv ?lhs = 0"
  75.630      apply (simp add:  fps_deriv_power fps_sin_deriv fps_cos_deriv power_Suc)
  75.631 -    by (simp add: fps_power_def ring_simps fps_const_neg[symmetric] del: fps_const_neg)
  75.632 +    by (simp add: ring_simps fps_const_neg[symmetric] del: fps_const_neg)
  75.633    then have "?lhs = fps_const (?lhs $ 0)"
  75.634      unfolding fps_deriv_eq_0_iff .
  75.635    also have "\<dots> = 1"
  75.636 -    by (auto simp add: fps_eq_iff fps_power_def numeral_2_eq_2 fps_mult_nth fps_cos_def fps_sin_def)
  75.637 +    by (auto simp add: fps_eq_iff numeral_2_eq_2 fps_mult_nth fps_cos_def fps_sin_def)
  75.638    finally show ?thesis .
  75.639  qed
  75.640  
    76.1 --- a/src/HOL/Library/FrechetDeriv.thy	Mon May 11 09:39:53 2009 +0200
    76.2 +++ b/src/HOL/Library/FrechetDeriv.thy	Mon May 11 17:20:52 2009 +0200
    76.3 @@ -382,7 +382,7 @@
    76.4  subsection {* Powers *}
    76.5  
    76.6  lemma FDERIV_power_Suc:
    76.7 -  fixes x :: "'a::{real_normed_algebra,recpower,comm_ring_1}"
    76.8 +  fixes x :: "'a::{real_normed_algebra,comm_ring_1}"
    76.9    shows "FDERIV (\<lambda>x. x ^ Suc n) x :> (\<lambda>h. (1 + of_nat n) * x ^ n * h)"
   76.10   apply (induct n)
   76.11    apply (simp add: power_Suc FDERIV_ident)
   76.12 @@ -392,7 +392,7 @@
   76.13  done
   76.14  
   76.15  lemma FDERIV_power:
   76.16 -  fixes x :: "'a::{real_normed_algebra,recpower,comm_ring_1}"
   76.17 +  fixes x :: "'a::{real_normed_algebra,comm_ring_1}"
   76.18    shows "FDERIV (\<lambda>x. x ^ n) x :> (\<lambda>h. of_nat n * x ^ (n - 1) * h)"
   76.19    apply (cases n)
   76.20     apply (simp add: FDERIV_const)
    77.1 --- a/src/HOL/Library/Fundamental_Theorem_Algebra.thy	Mon May 11 09:39:53 2009 +0200
    77.2 +++ b/src/HOL/Library/Fundamental_Theorem_Algebra.thy	Mon May 11 17:20:52 2009 +0200
    77.3 @@ -560,14 +560,14 @@
    77.4    done
    77.5  
    77.6  lemma poly_replicate_append:
    77.7 -  "poly (monom 1 n * p) (x::'a::{recpower, comm_ring_1}) = x^n * poly p x"
    77.8 +  "poly (monom 1 n * p) (x::'a::{comm_ring_1}) = x^n * poly p x"
    77.9    by (simp add: poly_monom)
   77.10  
   77.11  text {* Decomposition of polynomial, skipping zero coefficients
   77.12    after the first.  *}
   77.13  
   77.14  lemma poly_decompose_lemma:
   77.15 - assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
   77.16 + assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{idom}))"
   77.17    shows "\<exists>k a q. a\<noteq>0 \<and> Suc (psize q + k) = psize p \<and>
   77.18                   (\<forall>z. poly p z = z^k * poly (pCons a q) z)"
   77.19  unfolding psize_def
   77.20 @@ -595,7 +595,7 @@
   77.21  
   77.22  lemma poly_decompose:
   77.23    assumes nc: "~constant(poly p)"
   77.24 -  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
   77.25 +  shows "\<exists>k a q. a\<noteq>(0::'a::{idom}) \<and> k\<noteq>0 \<and>
   77.26                 psize q + k + 1 = psize p \<and>
   77.27                (\<forall>z. poly p z = poly p 0 + z^k * poly (pCons a q) z)"
   77.28  using nc
    78.1 --- a/src/HOL/Library/Library.thy	Mon May 11 09:39:53 2009 +0200
    78.2 +++ b/src/HOL/Library/Library.thy	Mon May 11 17:20:52 2009 +0200
    78.3 @@ -42,6 +42,7 @@
    78.4    Pocklington
    78.5    Poly_Deriv
    78.6    Polynomial
    78.7 +  Preorder
    78.8    Primes
    78.9    Product_Vector
   78.10    Quickcheck
    79.1 --- a/src/HOL/Library/Nat_Infinity.thy	Mon May 11 09:39:53 2009 +0200
    79.2 +++ b/src/HOL/Library/Nat_Infinity.thy	Mon May 11 17:20:52 2009 +0200
    79.3 @@ -24,6 +24,13 @@
    79.4    Infty  ("\<infinity>")
    79.5  
    79.6  
    79.7 +lemma not_Infty_eq[iff]: "(x ~= Infty) = (EX i. x = Fin i)"
    79.8 +by (cases x) auto
    79.9 +
   79.10 +lemma not_Fin_eq [iff]: "(ALL y. x ~= Fin y) = (x = Infty)"
   79.11 +by (cases x) auto
   79.12 +
   79.13 +
   79.14  subsection {* Constructors and numbers *}
   79.15  
   79.16  instantiation inat :: "{zero, one, number}"
   79.17 @@ -261,6 +268,9 @@
   79.18  
   79.19  end
   79.20  
   79.21 +instance inat :: linorder
   79.22 +by intro_classes (auto simp add: less_eq_inat_def split: inat.splits)
   79.23 +
   79.24  instance inat :: pordered_comm_semiring
   79.25  proof
   79.26    fix a b c :: inat
   79.27 @@ -413,4 +423,8 @@
   79.28  
   79.29  lemmas inat_splits = inat.splits
   79.30  
   79.31 +
   79.32 +instance inat :: linorder
   79.33 +by intro_classes (auto simp add: inat_defs split: inat.splits)
   79.34 +
   79.35  end
    80.1 --- a/src/HOL/Library/Numeral_Type.thy	Mon May 11 09:39:53 2009 +0200
    80.2 +++ b/src/HOL/Library/Numeral_Type.thy	Mon May 11 17:20:52 2009 +0200
    80.3 @@ -55,7 +55,7 @@
    80.4    unfolding UNIV_Plus_UNIV [symmetric] by (simp only: finite card_Plus)
    80.5  
    80.6  lemma card_option [simp]: "CARD('a option) = Suc CARD('a::finite)"
    80.7 -  unfolding insert_None_conv_UNIV [symmetric]
    80.8 +  unfolding UNIV_option_conv
    80.9    apply (subgoal_tac "(None::'a option) \<notin> range Some")
   80.10    apply (simp add: card_image)
   80.11    apply fast
   80.12 @@ -154,8 +154,8 @@
   80.13  
   80.14  locale mod_type =
   80.15    fixes n :: int
   80.16 -  and Rep :: "'a::{zero,one,plus,times,uminus,minus,power} \<Rightarrow> int"
   80.17 -  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus,power}"
   80.18 +  and Rep :: "'a::{zero,one,plus,times,uminus,minus} \<Rightarrow> int"
   80.19 +  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus}"
   80.20    assumes type: "type_definition Rep Abs {0..<n}"
   80.21    and size1: "1 < n"
   80.22    and zero_def: "0 = Abs 0"
   80.23 @@ -164,14 +164,13 @@
   80.24    and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
   80.25    and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
   80.26    and minus_def: "- x = Abs ((- Rep x) mod n)"
   80.27 -  and power_def: "x ^ k = Abs (Rep x ^ k mod n)"
   80.28  begin
   80.29  
   80.30  lemma size0: "0 < n"
   80.31  by (cut_tac size1, simp)
   80.32  
   80.33  lemmas definitions =
   80.34 -  zero_def one_def add_def mult_def minus_def diff_def power_def
   80.35 +  zero_def one_def add_def mult_def minus_def diff_def
   80.36  
   80.37  lemma Rep_less_n: "Rep x < n"
   80.38  by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])
   80.39 @@ -217,18 +216,12 @@
   80.40  apply (simp_all add: Rep_simps zmod_simps ring_simps)
   80.41  done
   80.42  
   80.43 -lemma recpower: "OFCLASS('a, recpower_class)"
   80.44 -apply (intro_classes, unfold definitions)
   80.45 -apply (simp_all add: Rep_simps zmod_simps add_ac mult_assoc
   80.46 -                     mod_pos_pos_trivial size1)
   80.47 -done
   80.48 -
   80.49  end
   80.50  
   80.51  locale mod_ring = mod_type +
   80.52    constrains n :: int
   80.53 -  and Rep :: "'a::{number_ring,power} \<Rightarrow> int"
   80.54 -  and Abs :: "int \<Rightarrow> 'a::{number_ring,power}"
   80.55 +  and Rep :: "'a::{number_ring} \<Rightarrow> int"
   80.56 +  and Abs :: "int \<Rightarrow> 'a::{number_ring}"
   80.57  begin
   80.58  
   80.59  lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
   80.60 @@ -272,7 +265,7 @@
   80.61    @{typ num1}, since 0 and 1 are not distinct.
   80.62  *}
   80.63  
   80.64 -instantiation num1 :: "{comm_ring,comm_monoid_mult,number,recpower}"
   80.65 +instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
   80.66  begin
   80.67  
   80.68  lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
   80.69 @@ -284,7 +277,7 @@
   80.70  end
   80.71  
   80.72  instantiation
   80.73 -  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus,power}"
   80.74 +  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus}"
   80.75  begin
   80.76  
   80.77  definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
   80.78 @@ -299,7 +292,6 @@
   80.79  definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
   80.80  definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
   80.81  definition "- x = Abs_bit0' (- Rep_bit0 x)"
   80.82 -definition "x ^ k = Abs_bit0' (Rep_bit0 x ^ k)"
   80.83  
   80.84  definition "0 = Abs_bit1 0"
   80.85  definition "1 = Abs_bit1 1"
   80.86 @@ -307,7 +299,6 @@
   80.87  definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
   80.88  definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
   80.89  definition "- x = Abs_bit1' (- Rep_bit1 x)"
   80.90 -definition "x ^ k = Abs_bit1' (Rep_bit1 x ^ k)"
   80.91  
   80.92  instance ..
   80.93  
   80.94 @@ -326,7 +317,6 @@
   80.95  apply (rule times_bit0_def [unfolded Abs_bit0'_def])
   80.96  apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
   80.97  apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
   80.98 -apply (rule power_bit0_def [unfolded Abs_bit0'_def])
   80.99  done
  80.100  
  80.101  interpretation bit1:
  80.102 @@ -342,14 +332,13 @@
  80.103  apply (rule times_bit1_def [unfolded Abs_bit1'_def])
  80.104  apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
  80.105  apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
  80.106 -apply (rule power_bit1_def [unfolded Abs_bit1'_def])
  80.107  done
  80.108  
  80.109 -instance bit0 :: (finite) "{comm_ring_1,recpower}"
  80.110 -  by (rule bit0.comm_ring_1 bit0.recpower)+
  80.111 +instance bit0 :: (finite) comm_ring_1
  80.112 +  by (rule bit0.comm_ring_1)+
  80.113  
  80.114 -instance bit1 :: (finite) "{comm_ring_1,recpower}"
  80.115 -  by (rule bit1.comm_ring_1 bit1.recpower)+
  80.116 +instance bit1 :: (finite) comm_ring_1
  80.117 +  by (rule bit1.comm_ring_1)+
  80.118  
  80.119  instantiation bit0 and bit1 :: (finite) number_ring
  80.120  begin
  80.121 @@ -386,9 +375,6 @@
  80.122  lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
  80.123  lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
  80.124  
  80.125 -declare power_Suc [where ?'a="'a::finite bit0", standard, simp]
  80.126 -declare power_Suc [where ?'a="'a::finite bit1", standard, simp]
  80.127 -
  80.128  
  80.129  subsection {* Syntax *}
  80.130  
    81.1 --- a/src/HOL/Library/Pocklington.thy	Mon May 11 09:39:53 2009 +0200
    81.2 +++ b/src/HOL/Library/Pocklington.thy	Mon May 11 17:20:52 2009 +0200
    81.3 @@ -568,7 +568,7 @@
    81.4  
    81.5  lemma nproduct_cmul:
    81.6    assumes fS:"finite S"
    81.7 -  shows "setprod (\<lambda>m. (c::'a::{comm_monoid_mult,recpower})* a(m)) S = c ^ (card S) * setprod a S"
    81.8 +  shows "setprod (\<lambda>m. (c::'a::{comm_monoid_mult})* a(m)) S = c ^ (card S) * setprod a S"
    81.9  unfolding setprod_timesf setprod_constant[OF fS, of c] ..
   81.10  
   81.11  lemma coprime_nproduct:
    82.1 --- a/src/HOL/Library/Polynomial.thy	Mon May 11 09:39:53 2009 +0200
    82.2 +++ b/src/HOL/Library/Polynomial.thy	Mon May 11 17:20:52 2009 +0200
    82.3 @@ -632,20 +632,6 @@
    82.4    shows "a \<noteq> 0 \<Longrightarrow> p dvd smult a q \<longleftrightarrow> p dvd q"
    82.5    by (safe elim!: dvd_smult dvd_smult_cancel)
    82.6  
    82.7 -instantiation poly :: (comm_semiring_1) recpower
    82.8 -begin
    82.9 -
   82.10 -primrec power_poly where
   82.11 -  "(p::'a poly) ^ 0 = 1"
   82.12 -| "(p::'a poly) ^ (Suc n) = p * p ^ n"
   82.13 -
   82.14 -instance
   82.15 -  by default simp_all
   82.16 -
   82.17 -declare power_poly.simps [simp del]
   82.18 -
   82.19 -end
   82.20 -
   82.21  lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
   82.22  by (induct n, simp, auto intro: order_trans degree_mult_le)
   82.23  
   82.24 @@ -987,6 +973,30 @@
   82.25      by (simp add: pdivmod_rel_def left_distrib)
   82.26    thus "(x + z * y) div y = z + x div y"
   82.27      by (rule div_poly_eq)
   82.28 +next
   82.29 +  fix x y z :: "'a poly"
   82.30 +  assume "x \<noteq> 0"
   82.31 +  show "(x * y) div (x * z) = y div z"
   82.32 +  proof (cases "y \<noteq> 0 \<and> z \<noteq> 0")
   82.33 +    have "\<And>x::'a poly. pdivmod_rel x 0 0 x"
   82.34 +      by (rule pdivmod_rel_by_0)
   82.35 +    then have [simp]: "\<And>x::'a poly. x div 0 = 0"
   82.36 +      by (rule div_poly_eq)
   82.37 +    have "\<And>x::'a poly. pdivmod_rel 0 x 0 0"
   82.38 +      by (rule pdivmod_rel_0)
   82.39 +    then have [simp]: "\<And>x::'a poly. 0 div x = 0"
   82.40 +      by (rule div_poly_eq)
   82.41 +    case False then show ?thesis by auto
   82.42 +  next
   82.43 +    case True then have "y \<noteq> 0" and "z \<noteq> 0" by auto
   82.44 +    with `x \<noteq> 0`
   82.45 +    have "\<And>q r. pdivmod_rel y z q r \<Longrightarrow> pdivmod_rel (x * y) (x * z) q (x * r)"
   82.46 +      by (auto simp add: pdivmod_rel_def algebra_simps)
   82.47 +        (rule classical, simp add: degree_mult_eq)
   82.48 +    moreover from pdivmod_rel have "pdivmod_rel y z (y div z) (y mod z)" .
   82.49 +    ultimately have "pdivmod_rel (x * y) (x * z) (y div z) (x * (y mod z))" .
   82.50 +    then show ?thesis by (simp add: div_poly_eq)
   82.51 +  qed
   82.52  qed
   82.53  
   82.54  end
   82.55 @@ -1108,7 +1118,7 @@
   82.56    unfolding one_poly_def by simp
   82.57  
   82.58  lemma poly_monom:
   82.59 -  fixes a x :: "'a::{comm_semiring_1,recpower}"
   82.60 +  fixes a x :: "'a::{comm_semiring_1}"
   82.61    shows "poly (monom a n) x = a * x ^ n"
   82.62    by (induct n, simp add: monom_0, simp add: monom_Suc power_Suc mult_ac)
   82.63  
   82.64 @@ -1137,7 +1147,7 @@
   82.65    by (induct p, simp_all, simp add: algebra_simps)
   82.66  
   82.67  lemma poly_power [simp]:
   82.68 -  fixes p :: "'a::{comm_semiring_1,recpower} poly"
   82.69 +  fixes p :: "'a::{comm_semiring_1} poly"
   82.70    shows "poly (p ^ n) x = poly p x ^ n"
   82.71    by (induct n, simp, simp add: power_Suc)
   82.72  
    83.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    83.2 +++ b/src/HOL/Library/Preorder.thy	Mon May 11 17:20:52 2009 +0200
    83.3 @@ -0,0 +1,65 @@
    83.4 +(* Author: Florian Haftmann, TU Muenchen *)
    83.5 +
    83.6 +header {* Preorders with explicit equivalence relation *}
    83.7 +
    83.8 +theory Preorder
    83.9 +imports Orderings
   83.10 +begin
   83.11 +
   83.12 +class preorder_equiv = preorder
   83.13 +begin
   83.14 +
   83.15 +definition equiv :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
   83.16 +  "equiv x y \<longleftrightarrow> x \<le> y \<and> y \<le> x"
   83.17 +
   83.18 +notation
   83.19 +  equiv ("op ~~") and
   83.20 +  equiv ("(_/ ~~ _)" [51, 51] 50)
   83.21 +  
   83.22 +notation (xsymbols)
   83.23 +  equiv ("op \<approx>") and
   83.24 +  equiv ("(_/ \<approx> _)"  [51, 51] 50)
   83.25 +
   83.26 +notation (HTML output)
   83.27 +  equiv ("op \<approx>") and
   83.28 +  equiv ("(_/ \<approx> _)"  [51, 51] 50)
   83.29 +
   83.30 +lemma refl [iff]:
   83.31 +  "x \<approx> x"
   83.32 +  unfolding equiv_def by simp
   83.33 +
   83.34 +lemma trans:
   83.35 +  "x \<approx> y \<Longrightarrow> y \<approx> z \<Longrightarrow> x \<approx> z"
   83.36 +  unfolding equiv_def by (auto intro: order_trans)
   83.37 +
   83.38 +lemma antisym:
   83.39 +  "x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x \<approx> y"
   83.40 +  unfolding equiv_def ..
   83.41 +
   83.42 +lemma less_le: "x < y \<longleftrightarrow> x \<le> y \<and> \<not> x \<approx> y"
   83.43 +  by (auto simp add: equiv_def less_le_not_le)
   83.44 +
   83.45 +lemma le_less: "x \<le> y \<longleftrightarrow> x < y \<or> x \<approx> y"
   83.46 +  by (auto simp add: equiv_def less_le)
   83.47 +
   83.48 +lemma le_imp_less_or_eq: "x \<le> y \<Longrightarrow> x < y \<or> x \<approx> y"
   83.49 +  by (simp add: less_le)
   83.50 +
   83.51 +lemma less_imp_not_eq: "x < y \<Longrightarrow> x \<approx> y \<longleftrightarrow> False"
   83.52 +  by (simp add: less_le)
   83.53 +
   83.54 +lemma less_imp_not_eq2: "x < y \<Longrightarrow> y \<approx> x \<longleftrightarrow> False"
   83.55 +  by (simp add: equiv_def less_le)
   83.56 +
   83.57 +lemma neq_le_trans: "\<not> a \<approx> b \<Longrightarrow> a \<le> b \<Longrightarrow> a < b"
   83.58 +  by (simp add: less_le)
   83.59 +
   83.60 +lemma le_neq_trans: "a \<le> b \<Longrightarrow> \<not> a \<approx> b \<Longrightarrow> a < b"
   83.61 +  by (simp add: less_le)
   83.62 +
   83.63 +lemma antisym_conv: "y \<le> x \<Longrightarrow> x \<le> y \<longleftrightarrow> x \<approx> y"
   83.64 +  by (simp add: equiv_def)
   83.65 +
   83.66 +end
   83.67 +
   83.68 +end
    84.1 --- a/src/HOL/Library/Primes.thy	Mon May 11 09:39:53 2009 +0200
    84.2 +++ b/src/HOL/Library/Primes.thy	Mon May 11 17:20:52 2009 +0200
    84.3 @@ -454,19 +454,11 @@
    84.4  qed
    84.5  
    84.6  lemma euclid: "\<exists>p. prime p \<and> p > n" using euclid_bound by auto
    84.7 +
    84.8  lemma primes_infinite: "\<not> (finite {p. prime p})"
    84.9 -proof (auto simp add: finite_conv_nat_seg_image)
   84.10 -  fix n f 
   84.11 -  assume H: "Collect prime = f ` {i. i < (n::nat)}"
   84.12 -  let ?P = "Collect prime"
   84.13 -  let ?m = "Max ?P"
   84.14 -  have P0: "?P \<noteq> {}" using two_is_prime by auto
   84.15 -  from H have fP: "finite ?P" using finite_conv_nat_seg_image by blast 
   84.16 -  from Max_in [OF fP P0] have "?m \<in> ?P" . 
   84.17 -  from Max_ge [OF fP] have contr: "\<forall> p. prime p \<longrightarrow> p \<le> ?m" by blast
   84.18 -  from euclid [of ?m] obtain q where q: "prime q" "q > ?m" by blast
   84.19 -  with contr show False by auto
   84.20 -qed
   84.21 +apply(simp add: finite_nat_set_iff_bounded_le)
   84.22 +apply (metis euclid linorder_not_le)
   84.23 +done
   84.24  
   84.25  lemma coprime_prime: assumes ab: "coprime a b"
   84.26    shows "~(prime p \<and> p dvd a \<and> p dvd b)"
    85.1 --- a/src/HOL/Library/Product_ord.thy	Mon May 11 09:39:53 2009 +0200
    85.2 +++ b/src/HOL/Library/Product_ord.thy	Mon May 11 17:20:52 2009 +0200
    85.3 @@ -12,25 +12,28 @@
    85.4  begin
    85.5  
    85.6  definition
    85.7 -  prod_le_def [code del]: "x \<le> y \<longleftrightarrow> fst x < fst y \<or> fst x = fst y \<and> snd x \<le> snd y"
    85.8 +  prod_le_def [code del]: "x \<le> y \<longleftrightarrow> fst x < fst y \<or> fst x \<le> fst y \<and> snd x \<le> snd y"
    85.9  
   85.10  definition
   85.11 -  prod_less_def [code del]: "x < y \<longleftrightarrow> fst x < fst y \<or> fst x = fst y \<and> snd x < snd y"
   85.12 +  prod_less_def [code del]: "x < y \<longleftrightarrow> fst x < fst y \<or> fst x \<le> fst y \<and> snd x < snd y"
   85.13  
   85.14  instance ..
   85.15  
   85.16  end
   85.17  
   85.18  lemma [code]:
   85.19 -  "(x1\<Colon>'a\<Colon>{ord, eq}, y1) \<le> (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 = x2 \<and> y1 \<le> y2"
   85.20 -  "(x1\<Colon>'a\<Colon>{ord, eq}, y1) < (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 = x2 \<and> y1 < y2"
   85.21 +  "(x1\<Colon>'a\<Colon>{ord, eq}, y1) \<le> (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 \<le> x2 \<and> y1 \<le> y2"
   85.22 +  "(x1\<Colon>'a\<Colon>{ord, eq}, y1) < (x2, y2) \<longleftrightarrow> x1 < x2 \<or> x1 \<le> x2 \<and> y1 < y2"
   85.23    unfolding prod_le_def prod_less_def by simp_all
   85.24  
   85.25 -instance * :: (order, order) order
   85.26 -  by default (auto simp: prod_le_def prod_less_def intro: order_less_trans)
   85.27 +instance * :: (preorder, preorder) preorder proof
   85.28 +qed (auto simp: prod_le_def prod_less_def less_le_not_le intro: order_trans)
   85.29  
   85.30 -instance * :: (linorder, linorder) linorder
   85.31 -  by default (auto simp: prod_le_def)
   85.32 +instance * :: (order, order) order proof
   85.33 +qed (auto simp add: prod_le_def)
   85.34 +
   85.35 +instance * :: (linorder, linorder) linorder proof
   85.36 +qed (auto simp: prod_le_def)
   85.37  
   85.38  instantiation * :: (linorder, linorder) distrib_lattice
   85.39  begin
   85.40 @@ -41,9 +44,30 @@
   85.41  definition
   85.42    sup_prod_def: "(sup \<Colon> 'a \<times> 'b \<Rightarrow> _ \<Rightarrow> _) = max"
   85.43  
   85.44 -instance
   85.45 -  by intro_classes
   85.46 -    (auto simp add: inf_prod_def sup_prod_def min_max.sup_inf_distrib1)
   85.47 +instance proof
   85.48 +qed (auto simp add: inf_prod_def sup_prod_def min_max.sup_inf_distrib1)
   85.49 +
   85.50 +end
   85.51 +
   85.52 +instantiation * :: (bot, bot) bot
   85.53 +begin
   85.54 +
   85.55 +definition
   85.56 +  bot_prod_def: "bot = (bot, bot)"
   85.57 +
   85.58 +instance proof
   85.59 +qed (auto simp add: bot_prod_def prod_le_def)
   85.60 +
   85.61 +end
   85.62 +
   85.63 +instantiation * :: (top, top) top
   85.64 +begin
   85.65 +
   85.66 +definition
   85.67 +  top_prod_def: "top = (top, top)"
   85.68 +
   85.69 +instance proof
   85.70 +qed (auto simp add: top_prod_def prod_le_def)
   85.71  
   85.72  end
   85.73  
    86.1 --- a/src/HOL/Library/Quickcheck.thy	Mon May 11 09:39:53 2009 +0200
    86.2 +++ b/src/HOL/Library/Quickcheck.thy	Mon May 11 17:20:52 2009 +0200
    86.3 @@ -47,6 +47,8 @@
    86.4  
    86.5  val eval_ref : (unit -> int -> int * int -> term list option * (int * int)) option ref = ref NONE;
    86.6  
    86.7 +val target = "Quickcheck";
    86.8 +
    86.9  fun mk_generator_expr thy prop tys =
   86.10    let
   86.11      val bound_max = length tys - 1;
   86.12 @@ -72,14 +74,75 @@
   86.13    let
   86.14      val tys = (map snd o fst o strip_abs) t;
   86.15      val t' = mk_generator_expr thy t tys;
   86.16 -    val f = Code_ML.eval_term ("Quickcheck.eval_ref", eval_ref) thy t' [];
   86.17 -  in f #> Random_Engine.run #> (Option.map o map) (Code.postprocess_term thy) end;
   86.18 +    val f = Code_ML.eval (SOME target) ("Quickcheck.eval_ref", eval_ref)
   86.19 +      (fn proc => fn g => fn s => g s #>> (Option.map o map) proc) thy t' [];
   86.20 +  in f #> Random_Engine.run end;
   86.21  
   86.22  end
   86.23  *}
   86.24  
   86.25  setup {*
   86.26 -  Quickcheck.add_generator ("code", Quickcheck.compile_generator_expr o ProofContext.theory_of)
   86.27 +  Code_Target.extend_target (Quickcheck.target, (Code_ML.target_Eval, K I))
   86.28 +  #> Quickcheck.add_generator ("code", Quickcheck.compile_generator_expr o ProofContext.theory_of)
   86.29  *}
   86.30  
   86.31 +
   86.32 +subsection {* Type @{typ "'a \<Rightarrow> 'b"} *}
   86.33 +
   86.34 +ML {*
   86.35 +structure Random_Engine =
   86.36 +struct
   86.37 +
   86.38 +open Random_Engine;
   86.39 +
   86.40 +fun random_fun (T1 : typ) (T2 : typ) (eq : 'a -> 'a -> bool) (term_of : 'a -> term)
   86.41 +    (random : Random_Engine.seed -> ('b * (unit -> term)) * Random_Engine.seed)
   86.42 +    (random_split : Random_Engine.seed -> Random_Engine.seed * Random_Engine.seed)
   86.43 +    (seed : Random_Engine.seed) =
   86.44 +  let
   86.45 +    val (seed', seed'') = random_split seed;
   86.46 +    val state = ref (seed', [], Const (@{const_name undefined}, T1 --> T2));
   86.47 +    val fun_upd = Const (@{const_name fun_upd},
   86.48 +      (T1 --> T2) --> T1 --> T2 --> T1 --> T2);
   86.49 +    fun random_fun' x =
   86.50 +      let
   86.51 +        val (seed, fun_map, f_t) = ! state;
   86.52 +      in case AList.lookup (uncurry eq) fun_map x
   86.53 +       of SOME y => y
   86.54 +        | NONE => let
   86.55 +              val t1 = term_of x;
   86.56 +              val ((y, t2), seed') = random seed;
   86.57 +              val fun_map' = (x, y) :: fun_map;
   86.58 +              val f_t' = fun_upd $ f_t $ t1 $ t2 ();
   86.59 +              val _ = state := (seed', fun_map', f_t');
   86.60 +            in y end
   86.61 +      end;
   86.62 +    fun term_fun' () = #3 (! state);
   86.63 +  in ((random_fun', term_fun'), seed'') end;
   86.64 +
   86.65  end
   86.66 +*}
   86.67 +
   86.68 +axiomatization
   86.69 +  random_fun_aux :: "typerep \<Rightarrow> typerep \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> term)
   86.70 +    \<Rightarrow> (seed \<Rightarrow> ('b \<times> (unit \<Rightarrow> term)) \<times> seed) \<Rightarrow> (seed \<Rightarrow> seed \<times> seed)
   86.71 +    \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed"
   86.72 +
   86.73 +code_const random_fun_aux (Quickcheck "Random'_Engine.random'_fun")
   86.74 +  -- {* With enough criminal energy this can be abused to derive @{prop False};
   86.75 +  for this reason we use a distinguished target @{text Quickcheck}
   86.76 +  not spoiling the regular trusted code generation *}
   86.77 +
   86.78 +instantiation "fun" :: ("{eq, term_of}", "{type, random}") random
   86.79 +begin
   86.80 +
   86.81 +definition random_fun :: "index \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed" where
   86.82 +  "random n = random_fun_aux TYPEREP('a) TYPEREP('b) (op =) Code_Eval.term_of (random n) split_seed"
   86.83 +
   86.84 +instance ..
   86.85 +
   86.86 +end
   86.87 +
   86.88 +code_reserved Quickcheck Random_Engine
   86.89 +
   86.90 +end
    87.1 --- a/src/HOL/Library/State_Monad.thy	Mon May 11 09:39:53 2009 +0200
    87.2 +++ b/src/HOL/Library/State_Monad.thy	Mon May 11 17:20:52 2009 +0200
    87.3 @@ -190,7 +190,7 @@
    87.4  *}
    87.5  
    87.6  text {*
    87.7 -  For an example, see HOL/ex/Random.thy.
    87.8 +  For an example, see HOL/Extraction/Higman.thy.
    87.9  *}
   87.10  
   87.11  end
    88.1 --- a/src/HOL/Library/Topology_Euclidean_Space.thy	Mon May 11 09:39:53 2009 +0200
    88.2 +++ b/src/HOL/Library/Topology_Euclidean_Space.thy	Mon May 11 17:20:52 2009 +0200
    88.3 @@ -5441,7 +5441,7 @@
    88.4    have "1 - c > 0" using c by auto
    88.5  
    88.6    from s(2) obtain z0 where "z0 \<in> s" by auto
    88.7 -  def z \<equiv> "\<lambda> n::nat. fun_pow n f z0"
    88.8 +  def z \<equiv> "\<lambda>n. (f ^^ n) z0"
    88.9    { fix n::nat
   88.10      have "z n \<in> s" unfolding z_def
   88.11      proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
   88.12 @@ -5580,7 +5580,7 @@
   88.13        using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
   88.14    def y \<equiv> "g x"
   88.15    have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
   88.16 -  def f \<equiv> "\<lambda> n. fun_pow n g"
   88.17 +  def f \<equiv> "\<lambda>n. g ^^ n"
   88.18    have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
   88.19    have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
   88.20    { fix n::nat and z assume "z\<in>s"
    89.1 --- a/src/HOL/Library/Univ_Poly.thy	Mon May 11 09:39:53 2009 +0200
    89.2 +++ b/src/HOL/Library/Univ_Poly.thy	Mon May 11 17:20:52 2009 +0200
    89.3 @@ -167,22 +167,9 @@
    89.4      simp_all add: poly_cmult poly_add left_distrib right_distrib mult_ac)
    89.5  qed
    89.6  
    89.7 -class recpower_semiring = semiring + recpower
    89.8 -class recpower_semiring_1 = semiring_1 + recpower
    89.9 -class recpower_semiring_0 = semiring_0 + recpower
   89.10 -class recpower_ring = ring + recpower
   89.11 -class recpower_ring_1 = ring_1 + recpower
   89.12 -subclass (in recpower_ring_1) recpower_ring ..
   89.13 -class recpower_comm_semiring_1 = recpower + comm_semiring_1
   89.14 -class recpower_comm_ring_1 = recpower + comm_ring_1
   89.15 -subclass (in recpower_comm_ring_1) recpower_comm_semiring_1 ..
   89.16 -class recpower_idom = recpower + idom
   89.17 -subclass (in recpower_idom) recpower_comm_ring_1 ..
   89.18  class idom_char_0 = idom + ring_char_0
   89.19 -class recpower_idom_char_0 = recpower + idom_char_0
   89.20 -subclass (in recpower_idom_char_0) recpower_idom ..
   89.21  
   89.22 -lemma (in recpower_comm_ring_1) poly_exp: "poly (p %^ n) x = (poly p x) ^ n"
   89.23 +lemma (in comm_ring_1) poly_exp: "poly (p %^ n) x = (poly p x) ^ n"
   89.24  apply (induct "n")
   89.25  apply (auto simp add: poly_cmult poly_mult power_Suc)
   89.26  done
   89.27 @@ -418,7 +405,7 @@
   89.28    finally show ?thesis .
   89.29  qed
   89.30  
   89.31 -lemma (in recpower_idom) poly_exp_eq_zero[simp]:
   89.32 +lemma (in idom) poly_exp_eq_zero[simp]:
   89.33       "(poly (p %^ n) = poly []) = (poly p = poly [] & n \<noteq> 0)"
   89.34  apply (simp only: fun_eq add: all_simps [symmetric])
   89.35  apply (rule arg_cong [where f = All])
   89.36 @@ -437,7 +424,7 @@
   89.37  apply simp
   89.38  done
   89.39  
   89.40 -lemma (in recpower_idom) poly_exp_prime_eq_zero: "(poly ([a, 1] %^ n) \<noteq> poly [])"
   89.41 +lemma (in idom) poly_exp_prime_eq_zero: "(poly ([a, 1] %^ n) \<noteq> poly [])"
   89.42  by auto
   89.43  
   89.44  text{*A more constructive notion of polynomials being trivial*}
   89.45 @@ -507,7 +494,7 @@
   89.46  done
   89.47  
   89.48  
   89.49 -lemma (in recpower_comm_semiring_1) poly_divides_exp: "m \<le> n ==> (p %^ m) divides (p %^ n)"
   89.50 +lemma (in comm_semiring_1) poly_divides_exp: "m \<le> n ==> (p %^ m) divides (p %^ n)"
   89.51  apply (auto simp add: le_iff_add)
   89.52  apply (induct_tac k)
   89.53  apply (rule_tac [2] poly_divides_trans)
   89.54 @@ -516,7 +503,7 @@
   89.55  apply (auto simp add: poly_mult fun_eq mult_ac)
   89.56  done
   89.57  
   89.58 -lemma (in recpower_comm_semiring_1) poly_exp_divides: "[| (p %^ n) divides q;  m\<le>n |] ==> (p %^ m) divides q"
   89.59 +lemma (in comm_semiring_1) poly_exp_divides: "[| (p %^ n) divides q;  m\<le>n |] ==> (p %^ m) divides q"
   89.60  by (blast intro: poly_divides_exp poly_divides_trans)
   89.61  
   89.62  lemma (in comm_semiring_0) poly_divides_add:
   89.63 @@ -583,7 +570,7 @@
   89.64  qed
   89.65  
   89.66  
   89.67 -lemma (in recpower_comm_semiring_1) poly_mulexp: "poly (mulexp n p q) x = (poly p x) ^ n * poly q x"
   89.68 +lemma (in comm_semiring_1) poly_mulexp: "poly (mulexp n p q) x = (poly p x) ^ n * poly q x"
   89.69  by(induct n, auto simp add: poly_mult power_Suc mult_ac)
   89.70  
   89.71  lemma (in comm_semiring_1) divides_left_mult:
   89.72 @@ -600,11 +587,11 @@
   89.73  
   89.74  (* FIXME: Tidy up *)
   89.75  
   89.76 -lemma (in recpower_semiring_1)
   89.77 +lemma (in semiring_1)
   89.78    zero_power_iff: "0 ^ n = (if n = 0 then 1 else 0)"
   89.79    by (induct n, simp_all add: power_Suc)
   89.80  
   89.81 -lemma (in recpower_idom_char_0) poly_order_exists:
   89.82 +lemma (in idom_char_0) poly_order_exists:
   89.83    assumes lp: "length p = d" and p0: "poly p \<noteq> poly []"
   89.84    shows "\<exists>n. ([-a, 1] %^ n) divides p & ~(([-a, 1] %^ (Suc n)) divides p)"
   89.85  proof-
   89.86 @@ -637,7 +624,7 @@
   89.87  lemma (in semiring_1) poly_one_divides[simp]: "[1] divides p"
   89.88  by (simp add: divides_def, auto)
   89.89  
   89.90 -lemma (in recpower_idom_char_0) poly_order: "poly p \<noteq> poly []
   89.91 +lemma (in idom_char_0) poly_order: "poly p \<noteq> poly []
   89.92        ==> EX! n. ([-a, 1] %^ n) divides p &
   89.93                   ~(([-a, 1] %^ (Suc n)) divides p)"
   89.94  apply (auto intro: poly_order_exists simp add: less_linear simp del: pmult_Cons pexp_Suc)
   89.95 @@ -652,7 +639,7 @@
   89.96  lemma some1_equalityD: "[| n = (@n. P n); EX! n. P n |] ==> P n"
   89.97  by (blast intro: someI2)
   89.98  
   89.99 -lemma (in recpower_idom_char_0) order:
  89.100 +lemma (in idom_char_0) order:
  89.101        "(([-a, 1] %^ n) divides p &
  89.102          ~(([-a, 1] %^ (Suc n)) divides p)) =
  89.103          ((n = order a p) & ~(poly p = poly []))"
  89.104 @@ -662,17 +649,17 @@
  89.105  apply (blast intro!: poly_order [THEN [2] some1_equalityD])
  89.106  done
  89.107  
  89.108 -lemma (in recpower_idom_char_0) order2: "[| poly p \<noteq> poly [] |]
  89.109 +lemma (in idom_char_0) order2: "[| poly p \<noteq> poly [] |]
  89.110        ==> ([-a, 1] %^ (order a p)) divides p &
  89.111                ~(([-a, 1] %^ (Suc(order a p))) divides p)"
  89.112  by (simp add: order del: pexp_Suc)
  89.113  
  89.114 -lemma (in recpower_idom_char_0) order_unique: "[| poly p \<noteq> poly []; ([-a, 1] %^ n) divides p;
  89.115 +lemma (in idom_char_0) order_unique: "[| poly p \<noteq> poly []; ([-a, 1] %^ n) divides p;
  89.116           ~(([-a, 1] %^ (Suc n)) divides p)
  89.117        |] ==> (n = order a p)"
  89.118  by (insert order [of a n p], auto)
  89.119  
  89.120 -lemma (in recpower_idom_char_0) order_unique_lemma: "(poly p \<noteq> poly [] & ([-a, 1] %^ n) divides p &
  89.121 +lemma (in idom_char_0) order_unique_lemma: "(poly p \<noteq> poly [] & ([-a, 1] %^ n) divides p &
  89.122           ~(([-a, 1] %^ (Suc n)) divides p))
  89.123        ==> (n = order a p)"
  89.124  by (blast intro: order_unique)
  89.125 @@ -692,7 +679,7 @@
  89.126  apply (auto simp add: divides_def poly_mult simp del: pmult_Cons)
  89.127  done
  89.128  
  89.129 -lemma (in recpower_idom_char_0) order_root: "(poly p a = 0) = ((poly p = poly []) | order a p \<noteq> 0)"
  89.130 +lemma (in idom_char_0) order_root: "(poly p a = 0) = ((poly p = poly []) | order a p \<noteq> 0)"
  89.131  proof-
  89.132    let ?poly = poly
  89.133    show ?thesis
  89.134 @@ -706,7 +693,7 @@
  89.135  done
  89.136  qed
  89.137  
  89.138 -lemma (in recpower_idom_char_0) order_divides: "(([-a, 1] %^ n) divides p) = ((poly p = poly []) | n \<le> order a p)"
  89.139 +lemma (in idom_char_0) order_divides: "(([-a, 1] %^ n) divides p) = ((poly p = poly []) | n \<le> order a p)"
  89.140  proof-
  89.141    let ?poly = poly
  89.142    show ?thesis
  89.143 @@ -718,7 +705,7 @@
  89.144  done
  89.145  qed
  89.146  
  89.147 -lemma (in recpower_idom_char_0) order_decomp:
  89.148 +lemma (in idom_char_0) order_decomp:
  89.149       "poly p \<noteq> poly []
  89.150        ==> \<exists>q. (poly p = poly (([-a, 1] %^ (order a p)) *** q)) &
  89.151                  ~([-a, 1] divides q)"
  89.152 @@ -732,7 +719,7 @@
  89.153  
  89.154  text{*Important composition properties of orders.*}
  89.155  lemma order_mult: "poly (p *** q) \<noteq> poly []
  89.156 -      ==> order a (p *** q) = order a p + order (a::'a::{recpower_idom_char_0}) q"
  89.157 +      ==> order a (p *** q) = order a p + order (a::'a::{idom_char_0}) q"
  89.158  apply (cut_tac a = a and p = "p *** q" and n = "order a p + order a q" in order)
  89.159  apply (auto simp add: poly_entire simp del: pmult_Cons)
  89.160  apply (drule_tac a = a in order2)+
  89.161 @@ -753,7 +740,7 @@
  89.162  apply (simp add: fun_eq poly_exp_add poly_mult mult_ac del: pmult_Cons)
  89.163  done
  89.164  
  89.165 -lemma (in recpower_idom_char_0) order_mult:
  89.166 +lemma (in idom_char_0) order_mult:
  89.167    assumes pq0: "poly (p *** q) \<noteq> poly []"
  89.168    shows "order a (p *** q) = order a p + order a q"
  89.169  proof-
  89.170 @@ -783,7 +770,7 @@
  89.171  done
  89.172  qed
  89.173  
  89.174 -lemma (in recpower_idom_char_0) order_root2: "poly p \<noteq> poly [] ==> (poly p a = 0) = (order a p \<noteq> 0)"
  89.175 +lemma (in idom_char_0) order_root2: "poly p \<noteq> poly [] ==> (poly p a = 0) = (order a p \<noteq> 0)"
  89.176  by (rule order_root [THEN ssubst], auto)
  89.177  
  89.178  lemma (in semiring_1) pmult_one[simp]: "[1] *** p = p" by auto
  89.179 @@ -791,7 +778,7 @@
  89.180  lemma (in semiring_0) poly_Nil_zero: "poly [] = poly [0]"
  89.181  by (simp add: fun_eq)
  89.182  
  89.183 -lemma (in recpower_idom_char_0) rsquarefree_decomp:
  89.184 +lemma (in idom_char_0) rsquarefree_decomp:
  89.185       "[| rsquarefree p; poly p a = 0 |]
  89.186        ==> \<exists>q. (poly p = poly ([-a, 1] *** q)) & poly q a \<noteq> 0"
  89.187  apply (simp add: rsquarefree_def, safe)
  89.188 @@ -999,7 +986,7 @@
  89.189    ultimately show ?case by blast
  89.190  qed
  89.191  
  89.192 -lemma (in recpower_idom_char_0) order_degree:
  89.193 +lemma (in idom_char_0) order_degree:
  89.194    assumes p0: "poly p \<noteq> poly []"
  89.195    shows "order a p \<le> degree p"
  89.196  proof-
    90.1 --- a/src/HOL/Library/Word.thy	Mon May 11 09:39:53 2009 +0200
    90.2 +++ b/src/HOL/Library/Word.thy	Mon May 11 17:20:52 2009 +0200
    90.3 @@ -1,5 +1,4 @@
    90.4  (*  Title:      HOL/Library/Word.thy
    90.5 -    ID:         $Id$
    90.6      Author:     Sebastian Skalberg (TU Muenchen)
    90.7  *)
    90.8  
    90.9 @@ -40,10 +39,8 @@
   90.10      Zero ("\<zero>")
   90.11    | One ("\<one>")
   90.12  
   90.13 -primrec
   90.14 -  bitval :: "bit => nat"
   90.15 -where
   90.16 -  "bitval \<zero> = 0"
   90.17 +primrec bitval :: "bit => nat" where
   90.18 +    "bitval \<zero> = 0"
   90.19    | "bitval \<one> = 1"
   90.20  
   90.21  consts
   90.22 @@ -1531,7 +1528,7 @@
   90.23      show ?thesis
   90.24        apply simp
   90.25        apply (subst power_Suc [symmetric])
   90.26 -      apply (simp del: power_int.simps)
   90.27 +      apply simp
   90.28        done
   90.29    qed
   90.30    finally show ?thesis .
    91.1 --- a/src/HOL/Library/comm_ring.ML	Mon May 11 09:39:53 2009 +0200
    91.2 +++ b/src/HOL/Library/comm_ring.ML	Mon May 11 17:20:52 2009 +0200
    91.3 @@ -65,7 +65,7 @@
    91.4    | reif_polex T vs t = polex_pol T $ reif_pol T vs t;
    91.5  
    91.6  (* reification of the equation *)
    91.7 -val TFree (_, cr_sort) = @{typ "'a ::