merged
authorhuffman
Mon Apr 27 07:26:17 2009 -0700 (2009-04-27)
changeset 310077c871a9cf6f4
parent 31006 644d18da3c77
parent 31003 ed7364584aa7
child 31008 b8f4e351b5bf
merged
contrib/SystemOnTPTP/remote
src/HOL/Code_Setup.thy
src/HOL/NatBin.thy
src/Tools/auto_solve.ML
src/Tools/code/code_funcgr.ML
     1.1 --- a/CONTRIBUTORS	Wed Apr 22 11:00:25 2009 -0700
     1.2 +++ b/CONTRIBUTORS	Mon Apr 27 07:26:17 2009 -0700
     1.3 @@ -7,6 +7,10 @@
     1.4  Contributions to this Isabelle version
     1.5  --------------------------------------
     1.6  
     1.7 +
     1.8 +Contributions to Isabelle2009
     1.9 +-----------------------------
    1.10 +
    1.11  * March 2009: Robert Himmelmann, TUM and Amine Chaieb, University of
    1.12    Cambridge
    1.13    Elementary topology in Euclidean space.
     2.1 --- a/NEWS	Wed Apr 22 11:00:25 2009 -0700
     2.2 +++ b/NEWS	Mon Apr 27 07:26:17 2009 -0700
     2.3 @@ -4,6 +4,26 @@
     2.4  New in this Isabelle version
     2.5  ----------------------------
     2.6  
     2.7 +*** Pure ***
     2.8 +
     2.9 +* On instantiation of classes, remaining undefined class parameters are
    2.10 +formally declared.  INCOMPATIBILITY.
    2.11 +
    2.12 +
    2.13 +*** HOL ***
    2.14 +
    2.15 +* Class semiring_div requires superclass no_zero_divisors and proof of div_mult_mult1;
    2.16 +theorems div_mult_mult1, div_mult_mult2, div_mult_mult1_if, div_mult_mult1 and
    2.17 +div_mult_mult2 have been generalized to class semiring_div, subsuming former
    2.18 +theorems zdiv_zmult_zmult1, zdiv_zmult_zmult1_if, zdiv_zmult_zmult1 and zdiv_zmult_zmult2.
    2.19 +div_mult_mult1 is now [simp] by default.  INCOMPATIBILITY.
    2.20 +
    2.21 +* Power operations on relations and functions are now one dedicate constant compow with
    2.22 +infix syntax "^^".  Power operations on multiplicative monoids retains syntax "^"
    2.23 +and is now defined generic in class power.  INCOMPATIBILITY.
    2.24 +
    2.25 +* ML antiquotation @{code_datatype} inserts definition of a datatype generated
    2.26 +by the code generator; see Predicate.thy for an example.
    2.27  
    2.28  
    2.29  New in Isabelle2009 (April 2009)
    2.30 @@ -187,7 +207,7 @@
    2.31  
    2.32  * Keyword 'code_exception' now named 'code_abort'.  INCOMPATIBILITY.
    2.33  
    2.34 -* Unified theorem tables for both code code generators.  Thus [code
    2.35 +* Unified theorem tables for both code generators.  Thus [code
    2.36  func] has disappeared and only [code] remains.  INCOMPATIBILITY.
    2.37  
    2.38  * Command 'find_consts' searches for constants based on type and name
     3.1 --- a/contrib/SystemOnTPTP/remote	Wed Apr 22 11:00:25 2009 -0700
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,120 +0,0 @@
     3.4 -#!/usr/bin/env perl
     3.5 -#
     3.6 -# Wrapper for custom remote provers on SystemOnTPTP
     3.7 -# Author: Fabian Immler, TU Muenchen
     3.8 -#
     3.9 -
    3.10 -use warnings;
    3.11 -use strict;
    3.12 -use Getopt::Std;
    3.13 -use HTTP::Request::Common;
    3.14 -use LWP;
    3.15 -
    3.16 -my $SystemOnTPTPFormReplyURL = "http://www.cs.miami.edu/~tptp/cgi-bin/SystemOnTPTPFormReply";
    3.17 -
    3.18 -# default parameters
    3.19 -my %URLParameters = (
    3.20 -    "NoHTML" => 1,
    3.21 -    "QuietFlag" => "-q01",
    3.22 -    "X2TPTP" => "-S",
    3.23 -    "SubmitButton" => "RunSelectedSystems",
    3.24 -    "ProblemSource" => "UPLOAD",
    3.25 -    );
    3.26 -
    3.27 -#----Get format and transform options if specified
    3.28 -my %Options;
    3.29 -getopts("hws:t:c:",\%Options);
    3.30 -
    3.31 -#----Usage
    3.32 -sub usage() {
    3.33 -  print("Usage: remote [<options>] <File name>\n");
    3.34 -  print("    <options> are ...\n");
    3.35 -  print("    -h            - print this help\n");
    3.36 -  print("    -w            - list available ATP systems\n");
    3.37 -  print("    -s<system>    - specified system to use\n");
    3.38 -  print("    -t<timelimit> - CPU time limit for system\n");
    3.39 -  print("    -c<command>   - custom command for system\n");
    3.40 -  print("    <File name>   - TPTP problem file\n");
    3.41 -  exit(0);
    3.42 -}
    3.43 -if (exists($Options{'h'})) {
    3.44 -  usage();
    3.45 -}
    3.46 -#----What systems flag
    3.47 -if (exists($Options{'w'})) {
    3.48 -    $URLParameters{"SubmitButton"} = "ListSystems";
    3.49 -    delete($URLParameters{"ProblemSource"});
    3.50 -}
    3.51 -#----Selected system
    3.52 -my $System;
    3.53 -if (exists($Options{'s'})) {
    3.54 -    $System = $Options{'s'};
    3.55 -} else {
    3.56 -    # use Vampire as default
    3.57 -    $System = "Vampire---9.0";
    3.58 -}
    3.59 -$URLParameters{"System___$System"} = $System;
    3.60 -
    3.61 -#----Time limit
    3.62 -if (exists($Options{'t'})) {
    3.63 -    $URLParameters{"TimeLimit___$System"} = $Options{'t'};
    3.64 -}
    3.65 -#----Custom command
    3.66 -if (exists($Options{'c'})) {
    3.67 -    $URLParameters{"Command___$System"} = $Options{'c'};
    3.68 -}
    3.69 -
    3.70 -#----Get single file name
    3.71 -if (exists($URLParameters{"ProblemSource"})) {
    3.72 -    if (scalar(@ARGV) >= 1) {
    3.73 -        $URLParameters{"UPLOADProblem"} = [shift(@ARGV)];
    3.74 -    } else {
    3.75 -      print("Missing problem file\n");
    3.76 -      usage();
    3.77 -      die;
    3.78 -    }
    3.79 -}
    3.80 -
    3.81 -# Query Server
    3.82 -my $Agent = LWP::UserAgent->new;
    3.83 -if (exists($Options{'t'})) {
    3.84 -  # give server more time to respond
    3.85 -  $Agent->timeout($Options{'t'} + 10);
    3.86 -}
    3.87 -my $Request = POST($SystemOnTPTPFormReplyURL,
    3.88 -	Content_Type => 'form-data',Content => \%URLParameters);
    3.89 -my $Response = $Agent->request($Request);
    3.90 -
    3.91 -#catch errors / failure
    3.92 -if(! $Response->is_success){
    3.93 -  print "HTTP-Error: " . $Response->message . "\n";
    3.94 -  exit(-1);
    3.95 -} elsif (exists($Options{'w'})) {
    3.96 -  print $Response->content;
    3.97 -  exit (0);
    3.98 -} elsif ($Response->content =~ /WARNING: (\S*) does not exist/) {
    3.99 -  print "Specified System $1 does not exist\n";
   3.100 -  exit(-1);
   3.101 -} elsif ($Response->content =~ /%\s*Result\s*:\s*Unsatisfiable.*\n%\s*Output\s*:\s*(CNF)?Refutation.*\n%/) {
   3.102 -  my @lines = split( /\n/, $Response->content);
   3.103 -  my $extract = "";
   3.104 -  foreach my $line (@lines){
   3.105 -      #ignore comments
   3.106 -      if ($line !~ /^%/ && !($line eq "")) {
   3.107 -          $extract .= "$line";
   3.108 -      }
   3.109 -  }
   3.110 -  # insert newlines after ').'
   3.111 -  $extract =~ s/\s//g;
   3.112 -  $extract =~ s/\)\.cnf/\)\.\ncnf/g;
   3.113 -
   3.114 -  # orientation for res_reconstruct.ML
   3.115 -  print "# SZS output start CNFRefutation.\n";
   3.116 -  print "$extract\n";
   3.117 -  print "# SZS output end CNFRefutation.\n";
   3.118 -  exit(0);
   3.119 -} else {
   3.120 -  print "Remote-script could not extract proof:\n".$Response->content;
   3.121 -  exit(-1);
   3.122 -}
   3.123 -
     4.1 --- a/doc-src/Codegen/Thy/Program.thy	Wed Apr 22 11:00:25 2009 -0700
     4.2 +++ b/doc-src/Codegen/Thy/Program.thy	Mon Apr 27 07:26:17 2009 -0700
     4.3 @@ -323,7 +323,7 @@
     4.4  *}
     4.5  
     4.6  
     4.7 -subsection {* Equality and wellsortedness *}
     4.8 +subsection {* Equality *}
     4.9  
    4.10  text {*
    4.11    Surely you have already noticed how equality is treated
    4.12 @@ -358,60 +358,7 @@
    4.13    manually like any other type class.
    4.14  
    4.15    Though this @{text eq} class is designed to get rarely in
    4.16 -  the way, a subtlety
    4.17 -  enters the stage when definitions of overloaded constants
    4.18 -  are dependent on operational equality.  For example, let
    4.19 -  us define a lexicographic ordering on tuples
    4.20 -  (also see theory @{theory Product_ord}):
    4.21 -*}
    4.22 -
    4.23 -instantiation %quote "*" :: (order, order) order
    4.24 -begin
    4.25 -
    4.26 -definition %quote [code del]:
    4.27 -  "x \<le> y \<longleftrightarrow> fst x < fst y \<or> fst x = fst y \<and> snd x \<le> snd y"
    4.28 -
    4.29 -definition %quote [code del]:
    4.30 -  "x < y \<longleftrightarrow> fst x < fst y \<or> fst x = fst y \<and> snd x < snd y"
    4.31 -
    4.32 -instance %quote proof
    4.33 -qed (auto simp: less_eq_prod_def less_prod_def intro: order_less_trans)
    4.34 -
    4.35 -end %quote
    4.36 -
    4.37 -lemma %quote order_prod [code]:
    4.38 -  "(x1 \<Colon> 'a\<Colon>order, y1 \<Colon> 'b\<Colon>order) < (x2, y2) \<longleftrightarrow>
    4.39 -     x1 < x2 \<or> x1 = x2 \<and> y1 < y2"
    4.40 -  "(x1 \<Colon> 'a\<Colon>order, y1 \<Colon> 'b\<Colon>order) \<le> (x2, y2) \<longleftrightarrow>
    4.41 -     x1 < x2 \<or> x1 = x2 \<and> y1 \<le> y2"
    4.42 -  by (simp_all add: less_prod_def less_eq_prod_def)
    4.43 -
    4.44 -text {*
    4.45 -  \noindent Then code generation will fail.  Why?  The definition
    4.46 -  of @{term "op \<le>"} depends on equality on both arguments,
    4.47 -  which are polymorphic and impose an additional @{class eq}
    4.48 -  class constraint, which the preprocessor does not propagate
    4.49 -  (for technical reasons).
    4.50 -
    4.51 -  The solution is to add @{class eq} explicitly to the first sort arguments in the
    4.52 -  code theorems:
    4.53 -*}
    4.54 -
    4.55 -lemma %quote order_prod_code [code]:
    4.56 -  "(x1 \<Colon> 'a\<Colon>{order, eq}, y1 \<Colon> 'b\<Colon>order) < (x2, y2) \<longleftrightarrow>
    4.57 -     x1 < x2 \<or> x1 = x2 \<and> y1 < y2"
    4.58 -  "(x1 \<Colon> 'a\<Colon>{order, eq}, y1 \<Colon> 'b\<Colon>order) \<le> (x2, y2) \<longleftrightarrow>
    4.59 -     x1 < x2 \<or> x1 = x2 \<and> y1 \<le> y2"
    4.60 -  by (simp_all add: less_prod_def less_eq_prod_def)
    4.61 -
    4.62 -text {*
    4.63 -  \noindent Then code generation succeeds:
    4.64 -*}
    4.65 -
    4.66 -text %quote {*@{code_stmts "op \<le> \<Colon> _ \<times> _ \<Rightarrow> _ \<times> _ \<Rightarrow> bool" (SML)}*}
    4.67 -
    4.68 -text {*
    4.69 -  In some cases, the automatically derived code equations
    4.70 +  the way, in some cases the automatically derived code equations
    4.71    for equality on a particular type may not be appropriate.
    4.72    As example, watch the following datatype representing
    4.73    monomorphic parametric types (where type constructors
     5.1 --- a/doc-src/Codegen/Thy/document/Program.tex	Wed Apr 22 11:00:25 2009 -0700
     5.2 +++ b/doc-src/Codegen/Thy/document/Program.tex	Mon Apr 27 07:26:17 2009 -0700
     5.3 @@ -714,7 +714,7 @@
     5.4  \end{isamarkuptext}%
     5.5  \isamarkuptrue%
     5.6  %
     5.7 -\isamarkupsubsection{Equality and wellsortedness%
     5.8 +\isamarkupsubsection{Equality%
     5.9  }
    5.10  \isamarkuptrue%
    5.11  %
    5.12 @@ -801,141 +801,7 @@
    5.13    manually like any other type class.
    5.14  
    5.15    Though this \isa{eq} class is designed to get rarely in
    5.16 -  the way, a subtlety
    5.17 -  enters the stage when definitions of overloaded constants
    5.18 -  are dependent on operational equality.  For example, let
    5.19 -  us define a lexicographic ordering on tuples
    5.20 -  (also see theory \hyperlink{theory.Product-ord}{\mbox{\isa{Product{\isacharunderscore}ord}}}):%
    5.21 -\end{isamarkuptext}%
    5.22 -\isamarkuptrue%
    5.23 -%
    5.24 -\isadelimquote
    5.25 -%
    5.26 -\endisadelimquote
    5.27 -%
    5.28 -\isatagquote
    5.29 -\isacommand{instantiation}\isamarkupfalse%
    5.30 -\ {\isachardoublequoteopen}{\isacharasterisk}{\isachardoublequoteclose}\ {\isacharcolon}{\isacharcolon}\ {\isacharparenleft}order{\isacharcomma}\ order{\isacharparenright}\ order\isanewline
    5.31 -\isakeyword{begin}\isanewline
    5.32 -\isanewline
    5.33 -\isacommand{definition}\isamarkupfalse%
    5.34 -\ {\isacharbrackleft}code\ del{\isacharbrackright}{\isacharcolon}\isanewline
    5.35 -\ \ {\isachardoublequoteopen}x\ {\isasymle}\ y\ {\isasymlongleftrightarrow}\ fst\ x\ {\isacharless}\ fst\ y\ {\isasymor}\ fst\ x\ {\isacharequal}\ fst\ y\ {\isasymand}\ snd\ x\ {\isasymle}\ snd\ y{\isachardoublequoteclose}\isanewline
    5.36 -\isanewline
    5.37 -\isacommand{definition}\isamarkupfalse%
    5.38 -\ {\isacharbrackleft}code\ del{\isacharbrackright}{\isacharcolon}\isanewline
    5.39 -\ \ {\isachardoublequoteopen}x\ {\isacharless}\ y\ {\isasymlongleftrightarrow}\ fst\ x\ {\isacharless}\ fst\ y\ {\isasymor}\ fst\ x\ {\isacharequal}\ fst\ y\ {\isasymand}\ snd\ x\ {\isacharless}\ snd\ y{\isachardoublequoteclose}\isanewline
    5.40 -\isanewline
    5.41 -\isacommand{instance}\isamarkupfalse%
    5.42 -\ \isacommand{proof}\isamarkupfalse%
    5.43 -\isanewline
    5.44 -\isacommand{qed}\isamarkupfalse%
    5.45 -\ {\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
    5.46 -\isanewline
    5.47 -\isacommand{end}\isamarkupfalse%
    5.48 -\isanewline
    5.49 -\isanewline
    5.50 -\isacommand{lemma}\isamarkupfalse%
    5.51 -\ order{\isacharunderscore}prod\ {\isacharbrackleft}code{\isacharbrackright}{\isacharcolon}\isanewline
    5.52 -\ \ {\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
    5.53 -\ \ \ \ \ 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
    5.54 -\ \ {\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
    5.55 -\ \ \ \ \ 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
    5.56 -\ \ \isacommand{by}\isamarkupfalse%
    5.57 -\ {\isacharparenleft}simp{\isacharunderscore}all\ add{\isacharcolon}\ less{\isacharunderscore}prod{\isacharunderscore}def\ less{\isacharunderscore}eq{\isacharunderscore}prod{\isacharunderscore}def{\isacharparenright}%
    5.58 -\endisatagquote
    5.59 -{\isafoldquote}%
    5.60 -%
    5.61 -\isadelimquote
    5.62 -%
    5.63 -\endisadelimquote
    5.64 -%
    5.65 -\begin{isamarkuptext}%
    5.66 -\noindent Then code generation will fail.  Why?  The definition
    5.67 -  of \isa{op\ {\isasymle}} depends on equality on both arguments,
    5.68 -  which are polymorphic and impose an additional \isa{eq}
    5.69 -  class constraint, which the preprocessor does not propagate
    5.70 -  (for technical reasons).
    5.71 -
    5.72 -  The solution is to add \isa{eq} explicitly to the first sort arguments in the
    5.73 -  code theorems:%
    5.74 -\end{isamarkuptext}%
    5.75 -\isamarkuptrue%
    5.76 -%
    5.77 -\isadelimquote
    5.78 -%
    5.79 -\endisadelimquote
    5.80 -%
    5.81 -\isatagquote
    5.82 -\isacommand{lemma}\isamarkupfalse%
    5.83 -\ order{\isacharunderscore}prod{\isacharunderscore}code\ {\isacharbrackleft}code{\isacharbrackright}{\isacharcolon}\isanewline
    5.84 -\ \ {\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
    5.85 -\ \ \ \ \ 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
    5.86 -\ \ {\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
    5.87 -\ \ \ \ \ 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
    5.88 -\ \ \isacommand{by}\isamarkupfalse%
    5.89 -\ {\isacharparenleft}simp{\isacharunderscore}all\ add{\isacharcolon}\ less{\isacharunderscore}prod{\isacharunderscore}def\ less{\isacharunderscore}eq{\isacharunderscore}prod{\isacharunderscore}def{\isacharparenright}%
    5.90 -\endisatagquote
    5.91 -{\isafoldquote}%
    5.92 -%
    5.93 -\isadelimquote
    5.94 -%
    5.95 -\endisadelimquote
    5.96 -%
    5.97 -\begin{isamarkuptext}%
    5.98 -\noindent Then code generation succeeds:%
    5.99 -\end{isamarkuptext}%
   5.100 -\isamarkuptrue%
   5.101 -%
   5.102 -\isadelimquote
   5.103 -%
   5.104 -\endisadelimquote
   5.105 -%
   5.106 -\isatagquote
   5.107 -%
   5.108 -\begin{isamarkuptext}%
   5.109 -\isatypewriter%
   5.110 -\noindent%
   5.111 -\hspace*{0pt}structure Example = \\
   5.112 -\hspace*{0pt}struct\\
   5.113 -\hspace*{0pt}\\
   5.114 -\hspace*{0pt}type 'a eq = {\char123}eq :~'a -> 'a -> bool{\char125};\\
   5.115 -\hspace*{0pt}fun eq (A{\char95}:'a eq) = {\char35}eq A{\char95};\\
   5.116 -\hspace*{0pt}\\
   5.117 -\hspace*{0pt}type 'a ord = {\char123}less{\char95}eq :~'a -> 'a -> bool,~less :~'a -> 'a -> bool{\char125};\\
   5.118 -\hspace*{0pt}fun less{\char95}eq (A{\char95}:'a ord) = {\char35}less{\char95}eq A{\char95};\\
   5.119 -\hspace*{0pt}fun less (A{\char95}:'a ord) = {\char35}less A{\char95};\\
   5.120 -\hspace*{0pt}\\
   5.121 -\hspace*{0pt}fun eqop A{\char95}~a b = eq A{\char95}~a b;\\
   5.122 -\hspace*{0pt}\\
   5.123 -\hspace*{0pt}type 'a preorder = {\char123}Orderings{\char95}{\char95}ord{\char95}preorder :~'a ord{\char125};\\
   5.124 -\hspace*{0pt}fun ord{\char95}preorder (A{\char95}:'a preorder) = {\char35}Orderings{\char95}{\char95}ord{\char95}preorder A{\char95};\\
   5.125 -\hspace*{0pt}\\
   5.126 -\hspace*{0pt}type 'a order = {\char123}Orderings{\char95}{\char95}preorder{\char95}order :~'a preorder{\char125};\\
   5.127 -\hspace*{0pt}fun preorder{\char95}order (A{\char95}:'a order) = {\char35}Orderings{\char95}{\char95}preorder{\char95}order A{\char95};\\
   5.128 -\hspace*{0pt}\\
   5.129 -\hspace*{0pt}fun less{\char95}eqa (A1{\char95},~A2{\char95}) B{\char95}~(x1,~y1) (x2,~y2) =\\
   5.130 -\hspace*{0pt} ~less ((ord{\char95}preorder o preorder{\char95}order) A2{\char95}) x1 x2 orelse\\
   5.131 -\hspace*{0pt} ~~~eqop A1{\char95}~x1 x2 andalso\\
   5.132 -\hspace*{0pt} ~~~~~less{\char95}eq ((ord{\char95}preorder o preorder{\char95}order) B{\char95}) y1 y2\\
   5.133 -\hspace*{0pt} ~| less{\char95}eqa (A1{\char95},~A2{\char95}) B{\char95}~(x1,~y1) (x2,~y2) =\\
   5.134 -\hspace*{0pt} ~~~less ((ord{\char95}preorder o preorder{\char95}order) A2{\char95}) x1 x2 orelse\\
   5.135 -\hspace*{0pt} ~~~~~eqop A1{\char95}~x1 x2 andalso\\
   5.136 -\hspace*{0pt} ~~~~~~~less{\char95}eq ((ord{\char95}preorder o preorder{\char95}order) B{\char95}) y1 y2;\\
   5.137 -\hspace*{0pt}\\
   5.138 -\hspace*{0pt}end;~(*struct Example*)%
   5.139 -\end{isamarkuptext}%
   5.140 -\isamarkuptrue%
   5.141 -%
   5.142 -\endisatagquote
   5.143 -{\isafoldquote}%
   5.144 -%
   5.145 -\isadelimquote
   5.146 -%
   5.147 -\endisadelimquote
   5.148 -%
   5.149 -\begin{isamarkuptext}%
   5.150 -In some cases, the automatically derived code equations
   5.151 +  the way, in some cases the automatically derived code equations
   5.152    for equality on a particular type may not be appropriate.
   5.153    As example, watch the following datatype representing
   5.154    monomorphic parametric types (where type constructors
     6.1 --- a/doc-src/Main/Docs/Main_Doc.thy	Wed Apr 22 11:00:25 2009 -0700
     6.2 +++ b/doc-src/Main/Docs/Main_Doc.thy	Mon Apr 27 07:26:17 2009 -0700
     6.3 @@ -268,6 +268,7 @@
     6.4  @{const Transitive_Closure.rtrancl} & @{term_type_only Transitive_Closure.rtrancl "('a*'a)set\<Rightarrow>('a*'a)set"}\\
     6.5  @{const Transitive_Closure.trancl} & @{term_type_only Transitive_Closure.trancl "('a*'a)set\<Rightarrow>('a*'a)set"}\\
     6.6  @{const Transitive_Closure.reflcl} & @{term_type_only Transitive_Closure.reflcl "('a*'a)set\<Rightarrow>('a*'a)set"}\\
     6.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"}\\
     6.8  \end{tabular}
     6.9  
    6.10  \subsubsection*{Syntax}
    6.11 @@ -318,7 +319,6 @@
    6.12  @{term "op + :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
    6.13  @{term "op - :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
    6.14  @{term "op * :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
    6.15 -@{term "op ^ :: nat \<Rightarrow> nat \<Rightarrow> nat"} &
    6.16  @{term "op div :: nat \<Rightarrow> nat \<Rightarrow> nat"}&
    6.17  @{term "op mod :: nat \<Rightarrow> nat \<Rightarrow> nat"}&
    6.18  @{term "op dvd :: nat \<Rightarrow> nat \<Rightarrow> bool"}\\
    6.19 @@ -331,7 +331,9 @@
    6.20  \end{tabular}
    6.21  
    6.22  \begin{tabular}{@ {} l @ {~::~} l @ {}}
    6.23 -@{const Nat.of_nat} & @{typeof Nat.of_nat}
    6.24 +@{const Nat.of_nat} & @{typeof Nat.of_nat}\\
    6.25 +@{term "op ^^ :: ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"} &
    6.26 +  @{term_type_only "op ^^ :: ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a" "('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"}
    6.27  \end{tabular}
    6.28  
    6.29  \section{Int}
    6.30 @@ -450,14 +452,6 @@
    6.31  \end{tabular}
    6.32  
    6.33  
    6.34 -\section{Iterated Functions and Relations}
    6.35 -
    6.36 -Theory: @{theory Relation_Power}
    6.37 -
    6.38 -Iterated functions \ @{term[source]"(f::'a\<Rightarrow>'a) ^ n"} \
    6.39 -and relations \ @{term[source]"(r::('a\<times>'a)set) ^ n"}.
    6.40 -
    6.41 -
    6.42  \section{Option}
    6.43  
    6.44  @{datatype option}
     7.1 --- a/doc-src/Main/Docs/document/Main_Doc.tex	Wed Apr 22 11:00:25 2009 -0700
     7.2 +++ b/doc-src/Main/Docs/document/Main_Doc.tex	Mon Apr 27 07:26:17 2009 -0700
     7.3 @@ -279,6 +279,7 @@
     7.4  \isa{rtrancl} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
     7.5  \isa{trancl} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
     7.6  \isa{reflcl} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}a{\isacharparenright}\ set}\\
     7.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}\\
     7.8  \end{tabular}
     7.9  
    7.10  \subsubsection*{Syntax}
    7.11 @@ -328,7 +329,6 @@
    7.12  \isa{op\ {\isacharplus}} &
    7.13  \isa{op\ {\isacharminus}} &
    7.14  \isa{op\ {\isacharasterisk}} &
    7.15 -\isa{op\ {\isacharcircum}} &
    7.16  \isa{op\ div}&
    7.17  \isa{op\ mod}&
    7.18  \isa{op\ dvd}\\
    7.19 @@ -341,7 +341,9 @@
    7.20  \end{tabular}
    7.21  
    7.22  \begin{tabular}{@ {} l @ {~::~} l @ {}}
    7.23 -\isa{of{\isacharunderscore}nat} & \isa{nat\ {\isasymRightarrow}\ {\isacharprime}a}
    7.24 +\isa{of{\isacharunderscore}nat} & \isa{nat\ {\isasymRightarrow}\ {\isacharprime}a}\\
    7.25 +\isa{op\ {\isacharcircum}{\isacharcircum}} &
    7.26 +  \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymRightarrow}\ {\isacharprime}a{\isacharparenright}\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ {\isacharprime}a\ {\isasymRightarrow}\ {\isacharprime}a}
    7.27  \end{tabular}
    7.28  
    7.29  \section{Int}
    7.30 @@ -460,14 +462,6 @@
    7.31  \end{tabular}
    7.32  
    7.33  
    7.34 -\section{Iterated Functions and Relations}
    7.35 -
    7.36 -Theory: \isa{Relation{\isacharunderscore}Power}
    7.37 -
    7.38 -Iterated functions \ \isa{{\isachardoublequote}{\isacharparenleft}f{\isacharcolon}{\isacharcolon}{\isacharprime}a{\isasymRightarrow}{\isacharprime}a{\isacharparenright}\ {\isacharcircum}\ n{\isachardoublequote}} \
    7.39 -and relations \ \isa{{\isachardoublequote}{\isacharparenleft}r{\isacharcolon}{\isacharcolon}{\isacharparenleft}{\isacharprime}a{\isasymtimes}{\isacharprime}a{\isacharparenright}set{\isacharparenright}\ {\isacharcircum}\ n{\isachardoublequote}}.
    7.40 -
    7.41 -
    7.42  \section{Option}
    7.43  
    7.44  \isa{\isacommand{datatype}\ {\isacharprime}a\ option\ {\isacharequal}\ None\ {\isacharbar}\ Some\ {\isacharprime}a}
     8.1 --- a/doc-src/TutorialI/tutorial.tex	Wed Apr 22 11:00:25 2009 -0700
     8.2 +++ b/doc-src/TutorialI/tutorial.tex	Mon Apr 27 07:26:17 2009 -0700
     8.3 @@ -39,10 +39,11 @@
     8.4  %University of Cambridge\\
     8.5  %Computer Laboratory
     8.6  }
     8.7 +\pagenumbering{roman}
     8.8  \maketitle
     8.9 +\newpage
    8.10  
    8.11 -\pagenumbering{roman}
    8.12 -\setcounter{page}{5}
    8.13 +%\setcounter{page}{5}
    8.14  %\vspace*{\fill}
    8.15  %\begin{center}
    8.16  %\LARGE In memoriam \\[1ex]
    8.17 @@ -52,6 +53,7 @@
    8.18  %\vspace*{\fill}
    8.19  %\vspace*{\fill}
    8.20  %\newpage
    8.21 +
    8.22  \include{preface}
    8.23  
    8.24  \tableofcontents
     9.1 --- a/doc-src/more_antiquote.ML	Wed Apr 22 11:00:25 2009 -0700
     9.2 +++ b/doc-src/more_antiquote.ML	Mon Apr 27 07:26:17 2009 -0700
     9.3 @@ -88,7 +88,7 @@
     9.4    let
     9.5      val thy = ProofContext.theory_of ctxt;
     9.6      val const = Code_Unit.check_const thy raw_const;
     9.7 -    val (_, funcgr) = Code_Wellsorted.make thy [const];
     9.8 +    val (_, funcgr) = Code_Wellsorted.obtain thy [const] [];
     9.9      fun holize thm = @{thm meta_eq_to_obj_eq} OF [thm];
    9.10      val thms = Code_Wellsorted.eqns funcgr const
    9.11        |> map_filter (fn (thm, linear) => if linear then SOME thm else NONE)
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/lib/scripts/SystemOnTPTP	Mon Apr 27 07:26:17 2009 -0700
    10.3 @@ -0,0 +1,120 @@
    10.4 +#!/usr/bin/env perl
    10.5 +#
    10.6 +# Wrapper for custom remote provers on SystemOnTPTP
    10.7 +# Author: Fabian Immler, TU Muenchen
    10.8 +#
    10.9 +
   10.10 +use warnings;
   10.11 +use strict;
   10.12 +use Getopt::Std;
   10.13 +use HTTP::Request::Common;
   10.14 +use LWP;
   10.15 +
   10.16 +my $SystemOnTPTPFormReplyURL = "http://www.cs.miami.edu/~tptp/cgi-bin/SystemOnTPTPFormReply";
   10.17 +
   10.18 +# default parameters
   10.19 +my %URLParameters = (
   10.20 +    "NoHTML" => 1,
   10.21 +    "QuietFlag" => "-q01",
   10.22 +    "X2TPTP" => "-S",
   10.23 +    "SubmitButton" => "RunSelectedSystems",
   10.24 +    "ProblemSource" => "UPLOAD",
   10.25 +    );
   10.26 +
   10.27 +#----Get format and transform options if specified
   10.28 +my %Options;
   10.29 +getopts("hws:t:c:",\%Options);
   10.30 +
   10.31 +#----Usage
   10.32 +sub usage() {
   10.33 +  print("Usage: remote [<options>] <File name>\n");
   10.34 +  print("    <options> are ...\n");
   10.35 +  print("    -h            - print this help\n");
   10.36 +  print("    -w            - list available ATP systems\n");
   10.37 +  print("    -s<system>    - specified system to use\n");
   10.38 +  print("    -t<timelimit> - CPU time limit for system\n");
   10.39 +  print("    -c<command>   - custom command for system\n");
   10.40 +  print("    <File name>   - TPTP problem file\n");
   10.41 +  exit(0);
   10.42 +}
   10.43 +if (exists($Options{'h'})) {
   10.44 +  usage();
   10.45 +}
   10.46 +#----What systems flag
   10.47 +if (exists($Options{'w'})) {
   10.48 +    $URLParameters{"SubmitButton"} = "ListSystems";
   10.49 +    delete($URLParameters{"ProblemSource"});
   10.50 +}
   10.51 +#----Selected system
   10.52 +my $System;
   10.53 +if (exists($Options{'s'})) {
   10.54 +    $System = $Options{'s'};
   10.55 +} else {
   10.56 +    # use Vampire as default
   10.57 +    $System = "Vampire---9.0";
   10.58 +}
   10.59 +$URLParameters{"System___$System"} = $System;
   10.60 +
   10.61 +#----Time limit
   10.62 +if (exists($Options{'t'})) {
   10.63 +    $URLParameters{"TimeLimit___$System"} = $Options{'t'};
   10.64 +}
   10.65 +#----Custom command
   10.66 +if (exists($Options{'c'})) {
   10.67 +    $URLParameters{"Command___$System"} = $Options{'c'};
   10.68 +}
   10.69 +
   10.70 +#----Get single file name
   10.71 +if (exists($URLParameters{"ProblemSource"})) {
   10.72 +    if (scalar(@ARGV) >= 1) {
   10.73 +        $URLParameters{"UPLOADProblem"} = [shift(@ARGV)];
   10.74 +    } else {
   10.75 +      print("Missing problem file\n");
   10.76 +      usage();
   10.77 +      die;
   10.78 +    }
   10.79 +}
   10.80 +
   10.81 +# Query Server
   10.82 +my $Agent = LWP::UserAgent->new;
   10.83 +if (exists($Options{'t'})) {
   10.84 +  # give server more time to respond
   10.85 +  $Agent->timeout($Options{'t'} + 10);
   10.86 +}
   10.87 +my $Request = POST($SystemOnTPTPFormReplyURL,
   10.88 +	Content_Type => 'form-data',Content => \%URLParameters);
   10.89 +my $Response = $Agent->request($Request);
   10.90 +
   10.91 +#catch errors / failure
   10.92 +if(! $Response->is_success){
   10.93 +  print "HTTP-Error: " . $Response->message . "\n";
   10.94 +  exit(-1);
   10.95 +} elsif (exists($Options{'w'})) {
   10.96 +  print $Response->content;
   10.97 +  exit (0);
   10.98 +} elsif ($Response->content =~ /WARNING: (\S*) does not exist/) {
   10.99 +  print "Specified System $1 does not exist\n";
  10.100 +  exit(-1);
  10.101 +} elsif ($Response->content =~ /%\s*Result\s*:\s*Unsatisfiable.*\n%\s*Output\s*:\s*(CNF)?Refutation.*\n%/) {
  10.102 +  my @lines = split( /\n/, $Response->content);
  10.103 +  my $extract = "";
  10.104 +  foreach my $line (@lines){
  10.105 +      #ignore comments
  10.106 +      if ($line !~ /^%/ && !($line eq "")) {
  10.107 +          $extract .= "$line";
  10.108 +      }
  10.109 +  }
  10.110 +  # insert newlines after ').'
  10.111 +  $extract =~ s/\s//g;
  10.112 +  $extract =~ s/\)\.cnf/\)\.\ncnf/g;
  10.113 +
  10.114 +  # orientation for res_reconstruct.ML
  10.115 +  print "# SZS output start CNFRefutation.\n";
  10.116 +  print "$extract\n";
  10.117 +  print "# SZS output end CNFRefutation.\n";
  10.118 +  exit(0);
  10.119 +} else {
  10.120 +  print "Remote-script could not extract proof:\n".$Response->content;
  10.121 +  exit(-1);
  10.122 +}
  10.123 +
    11.1 --- a/src/HOL/Algebra/abstract/Ring2.thy	Wed Apr 22 11:00:25 2009 -0700
    11.2 +++ b/src/HOL/Algebra/abstract/Ring2.thy	Mon Apr 27 07:26:17 2009 -0700
    11.3 @@ -12,7 +12,7 @@
    11.4  
    11.5  subsection {* Ring axioms *}
    11.6  
    11.7 -class ring = zero + one + plus + minus + uminus + times + inverse + power + Ring_and_Field.dvd +
    11.8 +class ring = zero + one + plus + minus + uminus + times + inverse + power + dvd +
    11.9    assumes a_assoc:      "(a + b) + c = a + (b + c)"
   11.10    and l_zero:           "0 + a = a"
   11.11    and l_neg:            "(-a) + a = 0"
   11.12 @@ -28,8 +28,6 @@
   11.13    assumes minus_def:    "a - b = a + (-b)"
   11.14    and inverse_def:      "inverse a = (if a dvd 1 then THE x. a*x = 1 else 0)"
   11.15    and divide_def:       "a / b = a * inverse b"
   11.16 -  and power_0 [simp]:   "a ^ 0 = 1"
   11.17 -  and power_Suc [simp]: "a ^ Suc n = a ^ n * a"
   11.18  begin
   11.19  
   11.20  definition assoc :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "assoc" 50) where
    12.1 --- a/src/HOL/Algebra/poly/LongDiv.thy	Wed Apr 22 11:00:25 2009 -0700
    12.2 +++ b/src/HOL/Algebra/poly/LongDiv.thy	Mon Apr 27 07:26:17 2009 -0700
    12.3 @@ -1,6 +1,5 @@
    12.4  (*
    12.5      Experimental theory: long division of polynomials
    12.6 -    $Id$
    12.7      Author: Clemens Ballarin, started 23 June 1999
    12.8  *)
    12.9  
   12.10 @@ -133,9 +132,9 @@
   12.11      delsimprocs [ring_simproc]) 1 *})
   12.12    apply (tactic {* asm_simp_tac (@{simpset} delsimprocs [ring_simproc]) 1 *})
   12.13    apply (tactic {* simp_tac (@{simpset} addsimps [thm "minus_def", thm "smult_r_distr",
   12.14 -    thm "smult_r_minus", thm "monom_mult_smult", thm "smult_assoc1", thm "smult_assoc2"]
   12.15 +    thm "smult_r_minus", thm "monom_mult_smult", thm "smult_assoc2"]
   12.16      delsimprocs [ring_simproc]) 1 *})
   12.17 -  apply simp
   12.18 +  apply (simp add: smult_assoc1 [symmetric])
   12.19    done
   12.20  
   12.21  ML {*
    13.1 --- a/src/HOL/Algebra/poly/UnivPoly2.thy	Wed Apr 22 11:00:25 2009 -0700
    13.2 +++ b/src/HOL/Algebra/poly/UnivPoly2.thy	Mon Apr 27 07:26:17 2009 -0700
    13.3 @@ -155,16 +155,6 @@
    13.4  
    13.5  end
    13.6  
    13.7 -instantiation up :: ("{times, one, comm_monoid_add}") power
    13.8 -begin
    13.9 -
   13.10 -primrec power_up where
   13.11 -  "(a \<Colon> 'a up) ^ 0 = 1"
   13.12 -  | "(a \<Colon> 'a up) ^ Suc n = a ^ n * a"
   13.13 -
   13.14 -instance ..
   13.15 -
   13.16 -end
   13.17  
   13.18  subsection {* Effect of operations on coefficients *}
   13.19  
   13.20 @@ -328,8 +318,9 @@
   13.21    qed
   13.22    show "(p + q) * r = p * r + q * r"
   13.23      by (rule up_eqI) simp
   13.24 -  show "p * q = q * p"
   13.25 +  show "\<And>q. p * q = q * p"
   13.26    proof (rule up_eqI)
   13.27 +    fix q
   13.28      fix n 
   13.29      {
   13.30        fix k
   13.31 @@ -354,11 +345,11 @@
   13.32      by (simp add: up_inverse_def)
   13.33    show "p / q = p * inverse q"
   13.34      by (simp add: up_divide_def)
   13.35 -  fix n
   13.36 -  show "p ^ 0 = 1" by simp
   13.37 -  show "p ^ Suc n = p ^ n * p" by simp
   13.38  qed
   13.39  
   13.40 +instance up :: (ring) recpower proof
   13.41 +qed simp_all
   13.42 +
   13.43  (* Further properties of monom *)
   13.44  
   13.45  lemma monom_zero [simp]:
    14.1 --- a/src/HOL/Bali/Trans.thy	Wed Apr 22 11:00:25 2009 -0700
    14.2 +++ b/src/HOL/Bali/Trans.thy	Mon Apr 27 07:26:17 2009 -0700
    14.3 @@ -359,7 +359,7 @@
    14.4  
    14.5  abbreviation
    14.6    stepn:: "[prog, term \<times> state,nat,term \<times> state] \<Rightarrow> bool" ("_\<turnstile>_ \<mapsto>_ _"[61,82,82] 81)
    14.7 -  where "G\<turnstile>p \<mapsto>n p' \<equiv> (p,p') \<in> {(x, y). step G x y}^n"
    14.8 +  where "G\<turnstile>p \<mapsto>n p' \<equiv> (p,p') \<in> {(x, y). step G x y}^^n"
    14.9  
   14.10  abbreviation
   14.11    steptr:: "[prog,term \<times> state,term \<times> state] \<Rightarrow> bool" ("_\<turnstile>_ \<mapsto>* _"[61,82,82] 81)
   14.12 @@ -370,25 +370,6 @@
   14.13    Smallstep zu Bigstep, nur wenn nicht die Ausdrücke Callee, FinA ,\<dots>
   14.14  *)
   14.15  
   14.16 -lemma rtrancl_imp_rel_pow: "p \<in> R^* \<Longrightarrow> \<exists>n. p \<in> R^n"
   14.17 -proof -
   14.18 -  assume "p \<in> R\<^sup>*"
   14.19 -  moreover obtain x y where p: "p = (x,y)" by (cases p)
   14.20 -  ultimately have "(x,y) \<in> R\<^sup>*" by hypsubst
   14.21 -  hence "\<exists>n. (x,y) \<in> R^n"
   14.22 -  proof induct
   14.23 -    fix a have "(a,a) \<in> R^0" by simp
   14.24 -    thus "\<exists>n. (a,a) \<in> R ^ n" ..
   14.25 -  next
   14.26 -    fix a b c assume "\<exists>n. (a,b) \<in> R ^ n"
   14.27 -    then obtain n where "(a,b) \<in> R^n" ..
   14.28 -    moreover assume "(b,c) \<in> R"
   14.29 -    ultimately have "(a,c) \<in> R^(Suc n)" by auto
   14.30 -    thus "\<exists>n. (a,c) \<in> R^n" ..
   14.31 -  qed
   14.32 -  with p show ?thesis by hypsubst
   14.33 -qed  
   14.34 -
   14.35  (*
   14.36  lemma imp_eval_trans:
   14.37    assumes eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)" 
    15.1 --- a/src/HOL/Code_Eval.thy	Wed Apr 22 11:00:25 2009 -0700
    15.2 +++ b/src/HOL/Code_Eval.thy	Mon Apr 27 07:26:17 2009 -0700
    15.3 @@ -161,6 +161,7 @@
    15.4  signature EVAL =
    15.5  sig
    15.6    val mk_term: ((string * typ) -> term) -> (typ -> term) -> term -> term
    15.7 +  val mk_term_of: typ -> term -> term
    15.8    val eval_ref: (unit -> term) option ref
    15.9    val eval_term: theory -> term -> term
   15.10  end;
   15.11 @@ -175,8 +176,7 @@
   15.12  fun eval_term thy t =
   15.13    t 
   15.14    |> Eval.mk_term_of (fastype_of t)
   15.15 -  |> (fn t => Code_ML.eval_term ("Eval.eval_ref", eval_ref) thy t [])
   15.16 -  |> Code.postprocess_term thy;
   15.17 +  |> (fn t => Code_ML.eval NONE ("Eval.eval_ref", eval_ref) I thy t []);
   15.18  
   15.19  end;
   15.20  *}
    16.1 --- a/src/HOL/Code_Setup.thy	Wed Apr 22 11:00:25 2009 -0700
    16.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.3 @@ -1,253 +0,0 @@
    16.4 -(*  Title:      HOL/Code_Setup.thy
    16.5 -    ID:         $Id$
    16.6 -    Author:     Florian Haftmann
    16.7 -*)
    16.8 -
    16.9 -header {* Setup of code generators and related tools *}
   16.10 -
   16.11 -theory Code_Setup
   16.12 -imports HOL
   16.13 -begin
   16.14 -
   16.15 -subsection {* Generic code generator foundation *}
   16.16 -
   16.17 -text {* Datatypes *}
   16.18 -
   16.19 -code_datatype True False
   16.20 -
   16.21 -code_datatype "TYPE('a\<Colon>{})"
   16.22 -
   16.23 -code_datatype Trueprop "prop"
   16.24 -
   16.25 -text {* Code equations *}
   16.26 -
   16.27 -lemma [code]:
   16.28 -  shows "(True \<Longrightarrow> PROP P) \<equiv> PROP P" 
   16.29 -    and "(False \<Longrightarrow> Q) \<equiv> Trueprop True" 
   16.30 -    and "(PROP P \<Longrightarrow> True) \<equiv> Trueprop True" 
   16.31 -    and "(Q \<Longrightarrow> False) \<equiv> Trueprop (\<not> Q)" by (auto intro!: equal_intr_rule)
   16.32 -
   16.33 -lemma [code]:
   16.34 -  shows "False \<and> x \<longleftrightarrow> False"
   16.35 -    and "True \<and> x \<longleftrightarrow> x"
   16.36 -    and "x \<and> False \<longleftrightarrow> False"
   16.37 -    and "x \<and> True \<longleftrightarrow> x" by simp_all
   16.38 -
   16.39 -lemma [code]:
   16.40 -  shows "False \<or> x \<longleftrightarrow> x"
   16.41 -    and "True \<or> x \<longleftrightarrow> True"
   16.42 -    and "x \<or> False \<longleftrightarrow> x"
   16.43 -    and "x \<or> True \<longleftrightarrow> True" by simp_all
   16.44 -
   16.45 -lemma [code]:
   16.46 -  shows "\<not> True \<longleftrightarrow> False"
   16.47 -    and "\<not> False \<longleftrightarrow> True" by (rule HOL.simp_thms)+
   16.48 -
   16.49 -lemmas [code] = Let_def if_True if_False
   16.50 -
   16.51 -lemmas [code, code unfold, symmetric, code post] = imp_conv_disj
   16.52 -
   16.53 -text {* Equality *}
   16.54 -
   16.55 -context eq
   16.56 -begin
   16.57 -
   16.58 -lemma equals_eq [code inline, code]: "op = \<equiv> eq"
   16.59 -  by (rule eq_reflection) (rule ext, rule ext, rule sym, rule eq_equals)
   16.60 -
   16.61 -declare eq [code unfold, code inline del]
   16.62 -
   16.63 -declare equals_eq [symmetric, code post]
   16.64 -
   16.65 -end
   16.66 -
   16.67 -declare simp_thms(6) [code nbe]
   16.68 -
   16.69 -hide (open) const eq
   16.70 -hide const eq
   16.71 -
   16.72 -setup {*
   16.73 -  Code_Unit.add_const_alias @{thm equals_eq}
   16.74 -*}
   16.75 -
   16.76 -text {* Cases *}
   16.77 -
   16.78 -lemma Let_case_cert:
   16.79 -  assumes "CASE \<equiv> (\<lambda>x. Let x f)"
   16.80 -  shows "CASE x \<equiv> f x"
   16.81 -  using assms by simp_all
   16.82 -
   16.83 -lemma If_case_cert:
   16.84 -  assumes "CASE \<equiv> (\<lambda>b. If b f g)"
   16.85 -  shows "(CASE True \<equiv> f) &&& (CASE False \<equiv> g)"
   16.86 -  using assms by simp_all
   16.87 -
   16.88 -setup {*
   16.89 -  Code.add_case @{thm Let_case_cert}
   16.90 -  #> Code.add_case @{thm If_case_cert}
   16.91 -  #> Code.add_undefined @{const_name undefined}
   16.92 -*}
   16.93 -
   16.94 -code_abort undefined
   16.95 -
   16.96 -
   16.97 -subsection {* Generic code generator preprocessor *}
   16.98 -
   16.99 -setup {*
  16.100 -  Code.map_pre (K HOL_basic_ss)
  16.101 -  #> Code.map_post (K HOL_basic_ss)
  16.102 -*}
  16.103 -
  16.104 -
  16.105 -subsection {* Generic code generator target languages *}
  16.106 -
  16.107 -text {* type bool *}
  16.108 -
  16.109 -code_type bool
  16.110 -  (SML "bool")
  16.111 -  (OCaml "bool")
  16.112 -  (Haskell "Bool")
  16.113 -
  16.114 -code_const True and False and Not and "op &" and "op |" and If
  16.115 -  (SML "true" and "false" and "not"
  16.116 -    and infixl 1 "andalso" and infixl 0 "orelse"
  16.117 -    and "!(if (_)/ then (_)/ else (_))")
  16.118 -  (OCaml "true" and "false" and "not"
  16.119 -    and infixl 4 "&&" and infixl 2 "||"
  16.120 -    and "!(if (_)/ then (_)/ else (_))")
  16.121 -  (Haskell "True" and "False" and "not"
  16.122 -    and infixl 3 "&&" and infixl 2 "||"
  16.123 -    and "!(if (_)/ then (_)/ else (_))")
  16.124 -
  16.125 -code_reserved SML
  16.126 -  bool true false not
  16.127 -
  16.128 -code_reserved OCaml
  16.129 -  bool not
  16.130 -
  16.131 -text {* using built-in Haskell equality *}
  16.132 -
  16.133 -code_class eq
  16.134 -  (Haskell "Eq")
  16.135 -
  16.136 -code_const "eq_class.eq"
  16.137 -  (Haskell infixl 4 "==")
  16.138 -
  16.139 -code_const "op ="
  16.140 -  (Haskell infixl 4 "==")
  16.141 -
  16.142 -text {* undefined *}
  16.143 -
  16.144 -code_const undefined
  16.145 -  (SML "!(raise/ Fail/ \"undefined\")")
  16.146 -  (OCaml "failwith/ \"undefined\"")
  16.147 -  (Haskell "error/ \"undefined\"")
  16.148 -
  16.149 -
  16.150 -subsection {* SML code generator setup *}
  16.151 -
  16.152 -types_code
  16.153 -  "bool"  ("bool")
  16.154 -attach (term_of) {*
  16.155 -fun term_of_bool b = if b then HOLogic.true_const else HOLogic.false_const;
  16.156 -*}
  16.157 -attach (test) {*
  16.158 -fun gen_bool i =
  16.159 -  let val b = one_of [false, true]
  16.160 -  in (b, fn () => term_of_bool b) end;
  16.161 -*}
  16.162 -  "prop"  ("bool")
  16.163 -attach (term_of) {*
  16.164 -fun term_of_prop b =
  16.165 -  HOLogic.mk_Trueprop (if b then HOLogic.true_const else HOLogic.false_const);
  16.166 -*}
  16.167 -
  16.168 -consts_code
  16.169 -  "Trueprop" ("(_)")
  16.170 -  "True"    ("true")
  16.171 -  "False"   ("false")
  16.172 -  "Not"     ("Bool.not")
  16.173 -  "op |"    ("(_ orelse/ _)")
  16.174 -  "op &"    ("(_ andalso/ _)")
  16.175 -  "If"      ("(if _/ then _/ else _)")
  16.176 -
  16.177 -setup {*
  16.178 -let
  16.179 -
  16.180 -fun eq_codegen thy defs dep thyname b t gr =
  16.181 -    (case strip_comb t of
  16.182 -       (Const ("op =", Type (_, [Type ("fun", _), _])), _) => NONE
  16.183 -     | (Const ("op =", _), [t, u]) =>
  16.184 -          let
  16.185 -            val (pt, gr') = Codegen.invoke_codegen thy defs dep thyname false t gr;
  16.186 -            val (pu, gr'') = Codegen.invoke_codegen thy defs dep thyname false u gr';
  16.187 -            val (_, gr''') = Codegen.invoke_tycodegen thy defs dep thyname false HOLogic.boolT gr'';
  16.188 -          in
  16.189 -            SOME (Codegen.parens
  16.190 -              (Pretty.block [pt, Codegen.str " =", Pretty.brk 1, pu]), gr''')
  16.191 -          end
  16.192 -     | (t as Const ("op =", _), ts) => SOME (Codegen.invoke_codegen
  16.193 -         thy defs dep thyname b (Codegen.eta_expand t ts 2) gr)
  16.194 -     | _ => NONE);
  16.195 -
  16.196 -in
  16.197 -  Codegen.add_codegen "eq_codegen" eq_codegen
  16.198 -end
  16.199 -*}
  16.200 -
  16.201 -
  16.202 -subsection {* Evaluation and normalization by evaluation *}
  16.203 -
  16.204 -setup {*
  16.205 -  Value.add_evaluator ("SML", Codegen.eval_term o ProofContext.theory_of)
  16.206 -*}
  16.207 -
  16.208 -ML {*
  16.209 -structure Eval_Method =
  16.210 -struct
  16.211 -
  16.212 -val eval_ref : (unit -> bool) option ref = ref NONE;
  16.213 -
  16.214 -end;
  16.215 -*}
  16.216 -
  16.217 -oracle eval_oracle = {* fn ct =>
  16.218 -  let
  16.219 -    val thy = Thm.theory_of_cterm ct;
  16.220 -    val t = Thm.term_of ct;
  16.221 -    val dummy = @{cprop True};
  16.222 -  in case try HOLogic.dest_Trueprop t
  16.223 -   of SOME t' => if Code_ML.eval_term
  16.224 -         ("Eval_Method.eval_ref", Eval_Method.eval_ref) thy t' [] 
  16.225 -       then Thm.capply (Thm.capply @{cterm "op \<equiv> \<Colon> prop \<Rightarrow> prop \<Rightarrow> prop"} ct) dummy
  16.226 -       else dummy
  16.227 -    | NONE => dummy
  16.228 -  end
  16.229 -*}
  16.230 -
  16.231 -ML {*
  16.232 -fun gen_eval_method conv ctxt = SIMPLE_METHOD'
  16.233 -  (CONVERSION (Conv.params_conv (~1) (K (Conv.concl_conv (~1) conv)) ctxt)
  16.234 -    THEN' rtac TrueI)
  16.235 -*}
  16.236 -
  16.237 -method_setup eval = {* Scan.succeed (gen_eval_method eval_oracle) *}
  16.238 -  "solve goal by evaluation"
  16.239 -
  16.240 -method_setup evaluation = {* Scan.succeed (gen_eval_method Codegen.evaluation_conv) *}
  16.241 -  "solve goal by evaluation"
  16.242 -
  16.243 -method_setup normalization = {*
  16.244 -  Scan.succeed (K (SIMPLE_METHOD' (CONVERSION Nbe.norm_conv THEN' (fn k => TRY (rtac TrueI k)))))
  16.245 -*} "solve goal by normalization"
  16.246 -
  16.247 -
  16.248 -subsection {* Quickcheck *}
  16.249 -
  16.250 -setup {*
  16.251 -  Quickcheck.add_generator ("SML", Codegen.test_term)
  16.252 -*}
  16.253 -
  16.254 -quickcheck_params [size = 5, iterations = 50]
  16.255 -
  16.256 -end
    17.1 --- a/src/HOL/Complex.thy	Wed Apr 22 11:00:25 2009 -0700
    17.2 +++ b/src/HOL/Complex.thy	Mon Apr 27 07:26:17 2009 -0700
    17.3 @@ -159,19 +159,7 @@
    17.4  
    17.5  subsection {* Exponentiation *}
    17.6  
    17.7 -instantiation complex :: recpower
    17.8 -begin
    17.9 -
   17.10 -primrec power_complex where
   17.11 -  "z ^ 0     = (1\<Colon>complex)"
   17.12 -| "z ^ Suc n = (z\<Colon>complex) * z ^ n"
   17.13 -
   17.14 -instance proof
   17.15 -qed simp_all
   17.16 -
   17.17 -declare power_complex.simps [simp del]
   17.18 -
   17.19 -end
   17.20 +instance complex :: recpower ..
   17.21  
   17.22  
   17.23  subsection {* Numerals and Arithmetic *}
    18.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Wed Apr 22 11:00:25 2009 -0700
    18.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Mon Apr 27 07:26:17 2009 -0700
    18.3 @@ -23,8 +23,8 @@
    18.4  qed
    18.5  
    18.6  lemma horner_schema: fixes f :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat" and F :: "nat \<Rightarrow> nat"
    18.7 -  assumes f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
    18.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)"
    18.9 +  assumes f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   18.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)"
   18.11  proof (induct n arbitrary: i k j')
   18.12    case (Suc n)
   18.13  
   18.14 @@ -33,13 +33,13 @@
   18.15  qed auto
   18.16  
   18.17  lemma horner_bounds':
   18.18 -  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
   18.19 +  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   18.20    and lb_0: "\<And> i k x. lb 0 i k x = 0"
   18.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)"
   18.22    and ub_0: "\<And> i k x. ub 0 i k x = 0"
   18.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)"
   18.24 -  shows "Ifloat (lb n ((F^j') s) (f j') x) \<le> horner F G n ((F^j') s) (f j') (Ifloat x) \<and> 
   18.25 -         horner F G n ((F^j') s) (f j') (Ifloat x) \<le> Ifloat (ub n ((F^j') s) (f j') x)"
   18.26 +  shows "Ifloat (lb n ((F ^^ j') s) (f j') x) \<le> horner F G n ((F ^^ j') s) (f j') (Ifloat x) \<and> 
   18.27 +         horner F G n ((F ^^ j') s) (f j') (Ifloat x) \<le> Ifloat (ub n ((F ^^ j') s) (f j') x)"
   18.28    (is "?lb n j' \<le> ?horner n j' \<and> ?horner n j' \<le> ?ub n j'")
   18.29  proof (induct n arbitrary: j')
   18.30    case 0 thus ?case unfolding lb_0 ub_0 horner.simps by auto
   18.31 @@ -49,15 +49,15 @@
   18.32    proof (rule add_mono)
   18.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
   18.34      from Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc, THEN conjunct2] `0 \<le> Ifloat x`
   18.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))"
   18.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))"
   18.37        unfolding Ifloat_mult neg_le_iff_le by (rule mult_left_mono)
   18.38    qed
   18.39    moreover have "?horner (Suc n) j' \<le> ?ub (Suc n) j'" unfolding ub_Suc ub_Suc horner.simps Ifloat_sub diff_def
   18.40    proof (rule add_mono)
   18.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
   18.42      from Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc, THEN conjunct1] `0 \<le> Ifloat x`
   18.43 -    show "- (Ifloat x * horner F G n (F ((F ^ j') s)) (G ((F ^ j') s) (f j')) (Ifloat x)) \<le> 
   18.44 -          - Ifloat (x * lb n (F ((F ^ j') s)) (G ((F ^ j') s) (f j')) x)"
   18.45 +    show "- (Ifloat x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) (Ifloat x)) \<le> 
   18.46 +          - Ifloat (x * lb n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x)"
   18.47        unfolding Ifloat_mult neg_le_iff_le by (rule mult_left_mono)
   18.48    qed
   18.49    ultimately show ?case by blast
   18.50 @@ -73,13 +73,13 @@
   18.51  *}
   18.52  
   18.53  lemma horner_bounds: fixes F :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   18.54 -  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
   18.55 +  assumes "0 \<le> Ifloat x" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   18.56    and lb_0: "\<And> i k x. lb 0 i k x = 0"
   18.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)"
   18.58    and ub_0: "\<And> i k x. ub 0 i k x = 0"
   18.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)"
   18.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 
   18.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")
   18.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 
   18.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")
   18.64  proof -
   18.65    have "?lb  \<and> ?ub" 
   18.66      using horner_bounds'[where lb=lb, OF `0 \<le> Ifloat x` f_Suc lb_0 lb_Suc ub_0 ub_Suc]
   18.67 @@ -88,29 +88,29 @@
   18.68  qed
   18.69  
   18.70  lemma horner_bounds_nonpos: fixes F :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   18.71 -  assumes "Ifloat x \<le> 0" and f_Suc: "\<And>n. f (Suc n) = G ((F^n) s) (f n)"
   18.72 +  assumes "Ifloat x \<le> 0" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
   18.73    and lb_0: "\<And> i k x. lb 0 i k x = 0"
   18.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)"
   18.75    and ub_0: "\<And> i k x. ub 0 i k x = 0"
   18.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)"
   18.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 
   18.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")
   18.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 
   18.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")
   18.81  proof -
   18.82    { fix x y z :: float have "x - y * z = x + - y * z"
   18.83 -      by (cases x, cases y, cases z, simp add: plus_float.simps minus_float.simps uminus_float.simps times_float.simps algebra_simps)
   18.84 +      by (cases x, cases y, cases z, simp add: plus_float.simps minus_float_def uminus_float.simps times_float.simps algebra_simps)
   18.85    } note diff_mult_minus = this
   18.86  
   18.87    { fix x :: float have "- (- x) = x" by (cases x, auto simp add: uminus_float.simps) } note minus_minus = this
   18.88  
   18.89    have move_minus: "Ifloat (-x) = -1 * Ifloat x" by auto
   18.90  
   18.91 -  have sum_eq: "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * (Ifloat x)^j) = 
   18.92 +  have sum_eq: "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * Ifloat x ^ j) = 
   18.93      (\<Sum>j = 0..<n. -1 ^ j * (1 / real (f (j' + j))) * Ifloat (- x) ^ j)"
   18.94    proof (rule setsum_cong, simp)
   18.95      fix j assume "j \<in> {0 ..< n}"
   18.96      show "1 / real (f (j' + j)) * Ifloat x ^ j = -1 ^ j * (1 / real (f (j' + j))) * Ifloat (- x) ^ j"
   18.97        unfolding move_minus power_mult_distrib real_mult_assoc[symmetric]
   18.98 -      unfolding real_mult_commute unfolding real_mult_assoc[of "-1^j", symmetric] power_mult_distrib[symmetric]
   18.99 +      unfolding real_mult_commute unfolding real_mult_assoc[of "-1 ^ j", symmetric] power_mult_distrib[symmetric]
  18.100        by auto
  18.101    qed
  18.102  
  18.103 @@ -160,21 +160,21 @@
  18.104                                              else (0, (max (-l) u) ^ n))"
  18.105  
  18.106  lemma float_power_bnds: assumes "(l1, u1) = float_power_bnds n l u" and "x \<in> {Ifloat l .. Ifloat u}"
  18.107 -  shows "x^n \<in> {Ifloat l1..Ifloat u1}"
  18.108 +  shows "x ^ n \<in> {Ifloat l1..Ifloat u1}"
  18.109  proof (cases "even n")
  18.110    case True 
  18.111    show ?thesis
  18.112    proof (cases "0 < l")
  18.113      case True hence "odd n \<or> 0 < l" and "0 \<le> Ifloat l" unfolding less_float_def by auto
  18.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
  18.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
  18.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
  18.117      thus ?thesis using assms `0 < l` unfolding atLeastAtMost_iff l1 u1 float_power less_float_def by auto
  18.118    next
  18.119      case False hence P: "\<not> (odd n \<or> 0 < l)" using `even n` by auto
  18.120      show ?thesis
  18.121      proof (cases "u < 0")
  18.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
  18.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] 
  18.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] 
  18.125  	unfolding power_minus_even[OF `even n`] by auto
  18.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
  18.127        ultimately show ?thesis using float_power by auto
  18.128 @@ -194,11 +194,11 @@
  18.129  next
  18.130    case False hence "odd n \<or> 0 < l" by auto
  18.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
  18.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
  18.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
  18.134    thus ?thesis unfolding atLeastAtMost_iff l1 u1 float_power less_float_def by auto
  18.135  qed
  18.136  
  18.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"
  18.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"
  18.139    using float_power_bnds by auto
  18.140  
  18.141  section "Square root"
  18.142 @@ -794,8 +794,8 @@
  18.143    let "?f n" = "fact (2 * n)"
  18.144  
  18.145    { fix n 
  18.146 -    have F: "\<And>m. ((\<lambda>i. i + 2) ^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  18.147 -    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^ n) 1 * (((\<lambda>i. i + 2) ^ n) 1 + 1)"
  18.148 +    have F: "\<And>m. ((\<lambda>i. i + 2) ^^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  18.149 +    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^^ n) 1 * (((\<lambda>i. i + 2) ^^ n) 1 + 1)"
  18.150        unfolding F by auto } note f_eq = this
  18.151      
  18.152    from horner_bounds[where lb="lb_sin_cos_aux prec" and ub="ub_sin_cos_aux prec" and j'=0, 
  18.153 @@ -811,7 +811,7 @@
  18.154    have "0 < x * x" using `0 < x` unfolding less_float_def Ifloat_mult Ifloat_0
  18.155      using mult_pos_pos[where a="Ifloat x" and b="Ifloat x"] by auto
  18.156  
  18.157 -  { fix x n have "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * x^(2 * i))
  18.158 +  { fix x n have "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * x ^ (2 * i))
  18.159      = (\<Sum> i = 0 ..< 2 * n. (if even(i) then (-1 ^ (i div 2))/(real (fact i)) else 0) * x ^ i)" (is "?sum = ?ifsum")
  18.160    proof -
  18.161      have "?sum = ?sum + (\<Sum> j = 0 ..< n. 0)" by auto
  18.162 @@ -905,8 +905,8 @@
  18.163    let "?f n" = "fact (2 * n + 1)"
  18.164  
  18.165    { fix n 
  18.166 -    have F: "\<And>m. ((\<lambda>i. i + 2) ^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  18.167 -    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^ n) 2 * (((\<lambda>i. i + 2) ^ n) 2 + 1)"
  18.168 +    have F: "\<And>m. ((\<lambda>i. i + 2) ^^ n) m = m + 2 * n" by (induct n arbitrary: m, auto)
  18.169 +    have "?f (Suc n) = ?f n * ((\<lambda>i. i + 2) ^^ n) 2 * (((\<lambda>i. i + 2) ^^ n) 2 + 1)"
  18.170        unfolding F by auto } note f_eq = this
  18.171      
  18.172    from horner_bounds[where lb="lb_sin_cos_aux prec" and ub="ub_sin_cos_aux prec" and j'=0,
  18.173 @@ -1382,8 +1382,8 @@
  18.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) }"
  18.175  proof -
  18.176    { fix n
  18.177 -    have F: "\<And> m. ((\<lambda>i. i + 1) ^ n) m = n + m" by (induct n, auto)
  18.178 -    have "fact (Suc n) = fact n * ((\<lambda>i. i + 1) ^ n) 1" unfolding F by auto } note f_eq = this
  18.179 +    have F: "\<And> m. ((\<lambda>i. i + 1) ^^ n) m = n + m" by (induct n, auto)
  18.180 +    have "fact (Suc n) = fact n * ((\<lambda>i. i + 1) ^^ n) 1" unfolding F by auto } note f_eq = this
  18.181      
  18.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,
  18.183      OF assms f_eq lb_exp_horner.simps ub_exp_horner.simps]
  18.184 @@ -1462,7 +1462,8 @@
  18.185      finally have "0 < Ifloat ((?horner x) ^ num)" .
  18.186    }
  18.187    ultimately show ?thesis
  18.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) 
  18.189 +    unfolding lb_exp.simps if_not_P[OF `\<not> 0 < x`] Let_def
  18.190 +    by (cases "floor_fl x", cases "x < - 1", auto simp add: float_power le_float_def less_float_def)
  18.191  qed
  18.192  
  18.193  lemma exp_boundaries': assumes "x \<le> 0"
  18.194 @@ -1631,10 +1632,10 @@
  18.195  
  18.196  lemma ln_bounds:
  18.197    assumes "0 \<le> x" and "x < 1"
  18.198 -  shows "(\<Sum>i=0..<2*n. -1^i * (1 / real (i + 1)) * x^(Suc i)) \<le> ln (x + 1)" (is "?lb")
  18.199 -  and "ln (x + 1) \<le> (\<Sum>i=0..<2*n + 1. -1^i * (1 / real (i + 1)) * x^(Suc i))" (is "?ub")
  18.200 +  shows "(\<Sum>i=0..<2*n. -1^i * (1 / real (i + 1)) * x ^ (Suc i)) \<le> ln (x + 1)" (is "?lb")
  18.201 +  and "ln (x + 1) \<le> (\<Sum>i=0..<2*n + 1. -1^i * (1 / real (i + 1)) * x ^ (Suc i))" (is "?ub")
  18.202  proof -
  18.203 -  let "?a n" = "(1/real (n +1)) * x^(Suc n)"
  18.204 +  let "?a n" = "(1/real (n +1)) * x ^ (Suc n)"
  18.205  
  18.206    have ln_eq: "(\<Sum> i. -1^i * ?a i) = ln (x + 1)"
  18.207      using ln_series[of "x + 1"] `0 \<le> x` `x < 1` by auto
  18.208 @@ -2479,7 +2480,7 @@
  18.209      fun lift_var (Free (varname, _)) = (case AList.lookup (op =) bound_eqs varname of
  18.210                                            SOME bound => bound
  18.211                                          | NONE => raise TERM ("No bound equations found for " ^ varname, []))
  18.212 -      | lift_var t = raise TERM ("Can not convert expression " ^ 
  18.213 +      | lift_var t = raise TERM ("Can not convert expression " ^
  18.214                                   (Syntax.string_of_term ctxt t), [t])
  18.215  
  18.216      val _ $ vs = HOLogic.dest_Trueprop (Logic.strip_imp_concl goal')
    19.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Wed Apr 22 11:00:25 2009 -0700
    19.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Mon Apr 27 07:26:17 2009 -0700
    19.3 @@ -76,7 +76,7 @@
    19.4  				  @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
    19.5  				  Suc_plus1]
    19.6  			addsimps @{thms add_ac}
    19.7 -			addsimprocs [cancel_div_mod_proc]
    19.8 +			addsimprocs [cancel_div_mod_nat_proc, cancel_div_mod_int_proc]
    19.9      val simpset0 = HOL_basic_ss
   19.10        addsimps [mod_div_equality', Suc_plus1]
   19.11        addsimps comp_arith
    20.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Wed Apr 22 11:00:25 2009 -0700
    20.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Mon Apr 27 07:26:17 2009 -0700
    20.3 @@ -99,7 +99,7 @@
    20.4                                    @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
    20.5                                    @{thm "Suc_plus1"}]
    20.6                          addsimps @{thms add_ac}
    20.7 -                        addsimprocs [cancel_div_mod_proc]
    20.8 +                        addsimprocs [cancel_div_mod_nat_proc, cancel_div_mod_int_proc]
    20.9      val simpset0 = HOL_basic_ss
   20.10        addsimps [mod_div_equality', Suc_plus1]
   20.11        addsimps comp_ths
    21.1 --- a/src/HOL/Divides.thy	Wed Apr 22 11:00:25 2009 -0700
    21.2 +++ b/src/HOL/Divides.thy	Mon Apr 27 07:26:17 2009 -0700
    21.3 @@ -1,5 +1,4 @@
    21.4  (*  Title:      HOL/Divides.thy
    21.5 -    ID:         $Id$
    21.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    21.7      Copyright   1999  University of Cambridge
    21.8  *)
    21.9 @@ -20,11 +19,12 @@
   21.10  
   21.11  subsection {* Abstract division in commutative semirings. *}
   21.12  
   21.13 -class semiring_div = comm_semiring_1_cancel + div +
   21.14 +class semiring_div = comm_semiring_1_cancel + no_zero_divisors + div +
   21.15    assumes mod_div_equality: "a div b * b + a mod b = a"
   21.16      and div_by_0 [simp]: "a div 0 = 0"
   21.17      and div_0 [simp]: "0 div a = 0"
   21.18      and div_mult_self1 [simp]: "b \<noteq> 0 \<Longrightarrow> (a + c * b) div b = c + a div b"
   21.19 +    and div_mult_mult1 [simp]: "c \<noteq> 0 \<Longrightarrow> (c * a) div (c * b) = a div b"
   21.20  begin
   21.21  
   21.22  text {* @{const div} and @{const mod} *}
   21.23 @@ -38,16 +38,16 @@
   21.24    by (simp only: add_ac)
   21.25  
   21.26  lemma div_mod_equality: "((a div b) * b + a mod b) + c = a + c"
   21.27 -by (simp add: mod_div_equality)
   21.28 +  by (simp add: mod_div_equality)
   21.29  
   21.30  lemma div_mod_equality2: "(b * (a div b) + a mod b) + c = a + c"
   21.31 -by (simp add: mod_div_equality2)
   21.32 +  by (simp add: mod_div_equality2)
   21.33  
   21.34  lemma mod_by_0 [simp]: "a mod 0 = a"
   21.35 -using mod_div_equality [of a zero] by simp
   21.36 +  using mod_div_equality [of a zero] by simp
   21.37  
   21.38  lemma mod_0 [simp]: "0 mod a = 0"
   21.39 -using mod_div_equality [of zero a] div_0 by simp
   21.40 +  using mod_div_equality [of zero a] div_0 by simp
   21.41  
   21.42  lemma div_mult_self2 [simp]:
   21.43    assumes "b \<noteq> 0"
   21.44 @@ -72,7 +72,7 @@
   21.45  qed
   21.46  
   21.47  lemma mod_mult_self2 [simp]: "(a + b * c) mod b = a mod b"
   21.48 -by (simp add: mult_commute [of b])
   21.49 +  by (simp add: mult_commute [of b])
   21.50  
   21.51  lemma div_mult_self1_is_id [simp]: "b \<noteq> 0 \<Longrightarrow> b * a div b = a"
   21.52    using div_mult_self2 [of b 0 a] by simp
   21.53 @@ -238,9 +238,9 @@
   21.54      by (simp only: mod_add_eq [symmetric])
   21.55  qed
   21.56  
   21.57 -lemma div_add[simp]: "z dvd x \<Longrightarrow> z dvd y
   21.58 +lemma div_add [simp]: "z dvd x \<Longrightarrow> z dvd y
   21.59    \<Longrightarrow> (x + y) div z = x div z + y div z"
   21.60 -by(cases "z=0", simp, unfold dvd_def, auto simp add: algebra_simps)
   21.61 +by (cases "z = 0", simp, unfold dvd_def, auto simp add: algebra_simps)
   21.62  
   21.63  text {* Multiplication respects modular equivalence. *}
   21.64  
   21.65 @@ -297,21 +297,41 @@
   21.66    finally show ?thesis .
   21.67  qed
   21.68  
   21.69 -end
   21.70 -
   21.71 -lemma div_mult_div_if_dvd: "(y::'a::{semiring_div,no_zero_divisors}) dvd x \<Longrightarrow> 
   21.72 -  z dvd w \<Longrightarrow> (x div y) * (w div z) = (x * w) div (y * z)"
   21.73 -unfolding dvd_def
   21.74 -  apply clarify
   21.75 -  apply (case_tac "y = 0")
   21.76 -  apply simp
   21.77 -  apply (case_tac "z = 0")
   21.78 -  apply simp
   21.79 -  apply (simp add: algebra_simps)
   21.80 +lemma div_mult_div_if_dvd:
   21.81 +  "y dvd x \<Longrightarrow> z dvd w \<Longrightarrow> (x div y) * (w div z) = (x * w) div (y * z)"
   21.82 +  apply (cases "y = 0", simp)
   21.83 +  apply (cases "z = 0", simp)
   21.84 +  apply (auto elim!: dvdE simp add: algebra_simps)
   21.85    apply (subst mult_assoc [symmetric])
   21.86    apply (simp add: no_zero_divisors)
   21.87 -done
   21.88 +  done
   21.89 +
   21.90 +lemma div_mult_mult2 [simp]:
   21.91 +  "c \<noteq> 0 \<Longrightarrow> (a * c) div (b * c) = a div b"
   21.92 +  by (drule div_mult_mult1) (simp add: mult_commute)
   21.93 +
   21.94 +lemma div_mult_mult1_if [simp]:
   21.95 +  "(c * a) div (c * b) = (if c = 0 then 0 else a div b)"
   21.96 +  by simp_all
   21.97  
   21.98 +lemma mod_mult_mult1:
   21.99 +  "(c * a) mod (c * b) = c * (a mod b)"
  21.100 +proof (cases "c = 0")
  21.101 +  case True then show ?thesis by simp
  21.102 +next
  21.103 +  case False
  21.104 +  from mod_div_equality
  21.105 +  have "((c * a) div (c * b)) * (c * b) + (c * a) mod (c * b) = c * a" .
  21.106 +  with False have "c * ((a div b) * b + a mod b) + (c * a) mod (c * b)
  21.107 +    = c * a + c * (a mod b)" by (simp add: algebra_simps)
  21.108 +  with mod_div_equality show ?thesis by simp 
  21.109 +qed
  21.110 +  
  21.111 +lemma mod_mult_mult2:
  21.112 +  "(a * c) mod (b * c) = (a mod b) * c"
  21.113 +  using mod_mult_mult1 [of c a b] by (simp add: mult_commute)
  21.114 +
  21.115 +end
  21.116  
  21.117  lemma div_power: "(y::'a::{semiring_div,no_zero_divisors,recpower}) dvd x \<Longrightarrow>
  21.118      (x div y)^n = x^n div y^n"
  21.119 @@ -398,15 +418,17 @@
  21.120    @{term "q\<Colon>nat"}(uotient) and @{term "r\<Colon>nat"}(emainder).
  21.121  *}
  21.122  
  21.123 -definition divmod_rel :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
  21.124 -  "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)"
  21.125 +definition divmod_rel :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat \<Rightarrow> bool" where
  21.126 +  "divmod_rel m n qr \<longleftrightarrow>
  21.127 +    m = fst qr * n + snd qr \<and>
  21.128 +      (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)"
  21.129  
  21.130  text {* @{const divmod_rel} is total: *}
  21.131  
  21.132  lemma divmod_rel_ex:
  21.133 -  obtains q r where "divmod_rel m n q r"
  21.134 +  obtains q r where "divmod_rel m n (q, r)"
  21.135  proof (cases "n = 0")
  21.136 -  case True with that show thesis
  21.137 +  case True  with that show thesis
  21.138      by (auto simp add: divmod_rel_def)
  21.139  next
  21.140    case False
  21.141 @@ -436,13 +458,14 @@
  21.142  
  21.143  text {* @{const divmod_rel} is injective: *}
  21.144  
  21.145 -lemma divmod_rel_unique_div:
  21.146 -  assumes "divmod_rel m n q r"
  21.147 -    and "divmod_rel m n q' r'"
  21.148 -  shows "q = q'"
  21.149 +lemma divmod_rel_unique:
  21.150 +  assumes "divmod_rel m n qr"
  21.151 +    and "divmod_rel m n qr'"
  21.152 +  shows "qr = qr'"
  21.153  proof (cases "n = 0")
  21.154    case True with assms show ?thesis
  21.155 -    by (simp add: divmod_rel_def)
  21.156 +    by (cases qr, cases qr')
  21.157 +      (simp add: divmod_rel_def)
  21.158  next
  21.159    case False
  21.160    have aux: "\<And>q r q' r'. q' * n + r' = q * n + r \<Longrightarrow> r < n \<Longrightarrow> q' \<le> (q\<Colon>nat)"
  21.161 @@ -450,18 +473,11 @@
  21.162    apply (subst less_iff_Suc_add)
  21.163    apply (auto simp add: add_mult_distrib)
  21.164    done
  21.165 -  from `n \<noteq> 0` assms show ?thesis
  21.166 -    by (auto simp add: divmod_rel_def
  21.167 -      intro: order_antisym dest: aux sym)
  21.168 -qed
  21.169 -
  21.170 -lemma divmod_rel_unique_mod:
  21.171 -  assumes "divmod_rel m n q r"
  21.172 -    and "divmod_rel m n q' r'"
  21.173 -  shows "r = r'"
  21.174 -proof -
  21.175 -  from assms have "q = q'" by (rule divmod_rel_unique_div)
  21.176 -  with assms show ?thesis by (simp add: divmod_rel_def)
  21.177 +  from `n \<noteq> 0` assms have "fst qr = fst qr'"
  21.178 +    by (auto simp add: divmod_rel_def intro: order_antisym dest: aux sym)
  21.179 +  moreover from this assms have "snd qr = snd qr'"
  21.180 +    by (simp add: divmod_rel_def)
  21.181 +  ultimately show ?thesis by (cases qr, cases qr') simp
  21.182  qed
  21.183  
  21.184  text {*
  21.185 @@ -473,7 +489,21 @@
  21.186  begin
  21.187  
  21.188  definition divmod :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat" where
  21.189 -  [code del]: "divmod m n = (THE (q, r). divmod_rel m n q r)"
  21.190 +  [code del]: "divmod m n = (THE qr. divmod_rel m n qr)"
  21.191 +
  21.192 +lemma divmod_rel_divmod:
  21.193 +  "divmod_rel m n (divmod m n)"
  21.194 +proof -
  21.195 +  from divmod_rel_ex
  21.196 +    obtain qr where rel: "divmod_rel m n qr" .
  21.197 +  then show ?thesis
  21.198 +  by (auto simp add: divmod_def intro: theI elim: divmod_rel_unique)
  21.199 +qed
  21.200 +
  21.201 +lemma divmod_eq:
  21.202 +  assumes "divmod_rel m n qr" 
  21.203 +  shows "divmod m n = qr"
  21.204 +  using assms by (auto intro: divmod_rel_unique divmod_rel_divmod)
  21.205  
  21.206  definition div_nat where
  21.207    "m div n = fst (divmod m n)"
  21.208 @@ -485,30 +515,18 @@
  21.209    "divmod m n = (m div n, m mod n)"
  21.210    unfolding div_nat_def mod_nat_def by simp
  21.211  
  21.212 -lemma divmod_eq:
  21.213 -  assumes "divmod_rel m n q r" 
  21.214 -  shows "divmod m n = (q, r)"
  21.215 -  using assms by (auto simp add: divmod_def
  21.216 -    dest: divmod_rel_unique_div divmod_rel_unique_mod)
  21.217 -
  21.218  lemma div_eq:
  21.219 -  assumes "divmod_rel m n q r" 
  21.220 +  assumes "divmod_rel m n (q, r)" 
  21.221    shows "m div n = q"
  21.222 -  using assms by (auto dest: divmod_eq simp add: div_nat_def)
  21.223 +  using assms by (auto dest: divmod_eq simp add: divmod_div_mod)
  21.224  
  21.225  lemma mod_eq:
  21.226 -  assumes "divmod_rel m n q r" 
  21.227 +  assumes "divmod_rel m n (q, r)" 
  21.228    shows "m mod n = r"
  21.229 -  using assms by (auto dest: divmod_eq simp add: mod_nat_def)
  21.230 +  using assms by (auto dest: divmod_eq simp add: divmod_div_mod)
  21.231  
  21.232 -lemma divmod_rel: "divmod_rel m n (m div n) (m mod n)"
  21.233 -proof -
  21.234 -  from divmod_rel_ex
  21.235 -    obtain q r where rel: "divmod_rel m n q r" .
  21.236 -  moreover with div_eq mod_eq have "m div n = q" and "m mod n = r"
  21.237 -    by simp_all
  21.238 -  ultimately show ?thesis by simp
  21.239 -qed
  21.240 +lemma divmod_rel: "divmod_rel m n (m div n, m mod n)"
  21.241 +  by (simp add: div_nat_def mod_nat_def divmod_rel_divmod)
  21.242  
  21.243  lemma divmod_zero:
  21.244    "divmod m 0 = (0, m)"
  21.245 @@ -531,10 +549,10 @@
  21.246    assumes "0 < n" and "n \<le> m"
  21.247    shows "divmod m n = (Suc ((m - n) div n), (m - n) mod n)"
  21.248  proof -
  21.249 -  from divmod_rel have divmod_m_n: "divmod_rel m n (m div n) (m mod n)" .
  21.250 +  from divmod_rel have divmod_m_n: "divmod_rel m n (m div n, m mod n)" .
  21.251    with assms have m_div_n: "m div n \<ge> 1"
  21.252      by (cases "m div n") (auto simp add: divmod_rel_def)
  21.253 -  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0) (m mod n)"
  21.254 +  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0, m mod n)"
  21.255      by (cases "m div n") (auto simp add: divmod_rel_def)
  21.256    with divmod_eq have "divmod (m - n) n = (m div n - Suc 0, m mod n)" by simp
  21.257    moreover from divmod_div_mod have "divmod (m - n) n = ((m - n) div n, (m - n) mod n)" .
  21.258 @@ -569,55 +587,74 @@
  21.259    shows "m mod n = (m - n) mod n"
  21.260    using assms divmod_step divmod_div_mod by (cases "n = 0") simp_all
  21.261  
  21.262 -instance proof
  21.263 -  fix m n :: nat show "m div n * n + m mod n = m"
  21.264 -    using divmod_rel [of m n] by (simp add: divmod_rel_def)
  21.265 -next
  21.266 -  fix n :: nat show "n div 0 = 0"
  21.267 -    using divmod_zero divmod_div_mod [of n 0] by simp
  21.268 -next
  21.269 -  fix n :: nat show "0 div n = 0"
  21.270 -    using divmod_rel [of 0 n] by (cases n) (simp_all add: divmod_rel_def)
  21.271 -next
  21.272 -  fix m n q :: nat assume "n \<noteq> 0" then show "(q + m * n) div n = m + q div n"
  21.273 -    by (induct m) (simp_all add: le_div_geq)
  21.274 +instance proof -
  21.275 +  have [simp]: "\<And>n::nat. n div 0 = 0"
  21.276 +    by (simp add: div_nat_def divmod_zero)
  21.277 +  have [simp]: "\<And>n::nat. 0 div n = 0"
  21.278 +  proof -
  21.279 +    fix n :: nat
  21.280 +    show "0 div n = 0"
  21.281 +      by (cases "n = 0") simp_all
  21.282 +  qed
  21.283 +  show "OFCLASS(nat, semiring_div_class)" proof
  21.284 +    fix m n :: nat
  21.285 +    show "m div n * n + m mod n = m"
  21.286 +      using divmod_rel [of m n] by (simp add: divmod_rel_def)
  21.287 +  next
  21.288 +    fix m n q :: nat
  21.289 +    assume "n \<noteq> 0"
  21.290 +    then show "(q + m * n) div n = m + q div n"
  21.291 +      by (induct m) (simp_all add: le_div_geq)
  21.292 +  next
  21.293 +    fix m n q :: nat
  21.294 +    assume "m \<noteq> 0"
  21.295 +    then show "(m * n) div (m * q) = n div q"
  21.296 +    proof (cases "n \<noteq> 0 \<and> q \<noteq> 0")
  21.297 +      case False then show ?thesis by auto
  21.298 +    next
  21.299 +      case True with `m \<noteq> 0`
  21.300 +        have "m > 0" and "n > 0" and "q > 0" by auto
  21.301 +      then have "\<And>a b. divmod_rel n q (a, b) \<Longrightarrow> divmod_rel (m * n) (m * q) (a, m * b)"
  21.302 +        by (auto simp add: divmod_rel_def) (simp_all add: algebra_simps)
  21.303 +      moreover from divmod_rel have "divmod_rel n q (n div q, n mod q)" .
  21.304 +      ultimately have "divmod_rel (m * n) (m * q) (n div q, m * (n mod q))" .
  21.305 +      then show ?thesis by (simp add: div_eq)
  21.306 +    qed
  21.307 +  qed simp_all
  21.308  qed
  21.309  
  21.310  end
  21.311  
  21.312  text {* Simproc for cancelling @{const div} and @{const mod} *}
  21.313  
  21.314 -(*lemmas mod_div_equality_nat = semiring_div_class.times_div_mod_plus_zero_one.mod_div_equality [of "m\<Colon>nat" n, standard]
  21.315 -lemmas mod_div_equality2_nat = mod_div_equality2 [of "n\<Colon>nat" m, standard*)
  21.316 +ML {*
  21.317 +local
  21.318 +
  21.319 +structure CancelDivMod = CancelDivModFun(struct
  21.320  
  21.321 -ML {*
  21.322 -structure CancelDivModData =
  21.323 -struct
  21.324 -
  21.325 -val div_name = @{const_name div};
  21.326 -val mod_name = @{const_name mod};
  21.327 -val mk_binop = HOLogic.mk_binop;
  21.328 -val mk_sum = Nat_Arith.mk_sum;
  21.329 -val dest_sum = Nat_Arith.dest_sum;
  21.330 +  val div_name = @{const_name div};
  21.331 +  val mod_name = @{const_name mod};
  21.332 +  val mk_binop = HOLogic.mk_binop;
  21.333 +  val mk_sum = Nat_Arith.mk_sum;
  21.334 +  val dest_sum = Nat_Arith.dest_sum;
  21.335  
  21.336 -(*logic*)
  21.337 +  val div_mod_eqs = map mk_meta_eq [@{thm div_mod_equality}, @{thm div_mod_equality2}];
  21.338  
  21.339 -val div_mod_eqs = map mk_meta_eq [@{thm div_mod_equality}, @{thm div_mod_equality2}]
  21.340 -
  21.341 -val trans = trans
  21.342 +  val trans = trans;
  21.343  
  21.344 -val prove_eq_sums =
  21.345 -  let val simps = @{thm add_0} :: @{thm add_0_right} :: @{thms add_ac}
  21.346 -  in Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac simps) end;
  21.347 +  val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac
  21.348 +    (@{thm monoid_add_class.add_0_left} :: @{thm monoid_add_class.add_0_right} :: @{thms add_ac}))
  21.349  
  21.350 -end;
  21.351 +end)
  21.352  
  21.353 -structure CancelDivMod = CancelDivModFun(CancelDivModData);
  21.354 +in
  21.355  
  21.356 -val cancel_div_mod_proc = Simplifier.simproc (the_context ())
  21.357 +val cancel_div_mod_nat_proc = Simplifier.simproc (the_context ())
  21.358    "cancel_div_mod" ["(m::nat) + n"] (K CancelDivMod.proc);
  21.359  
  21.360 -Addsimprocs[cancel_div_mod_proc];
  21.361 +val _ = Addsimprocs [cancel_div_mod_nat_proc];
  21.362 +
  21.363 +end
  21.364  *}
  21.365  
  21.366  text {* code generator setup *}
  21.367 @@ -658,7 +695,7 @@
  21.368    fixes m n :: nat
  21.369    assumes "n > 0"
  21.370    shows "m mod n < (n::nat)"
  21.371 -  using assms divmod_rel unfolding divmod_rel_def by auto
  21.372 +  using assms divmod_rel [of m n] unfolding divmod_rel_def by auto
  21.373  
  21.374  lemma mod_less_eq_dividend [simp]:
  21.375    fixes m n :: nat
  21.376 @@ -700,18 +737,19 @@
  21.377  subsubsection {* Quotient and Remainder *}
  21.378  
  21.379  lemma divmod_rel_mult1_eq:
  21.380 -  "[| divmod_rel b c q r; c > 0 |]
  21.381 -   ==> divmod_rel (a*b) c (a*q + a*r div c) (a*r mod c)"
  21.382 +  "divmod_rel b c (q, r) \<Longrightarrow> c > 0
  21.383 +   \<Longrightarrow> divmod_rel (a * b) c (a * q + a * r div c, a * r mod c)"
  21.384  by (auto simp add: split_ifs divmod_rel_def algebra_simps)
  21.385  
  21.386 -lemma div_mult1_eq: "(a*b) div c = a*(b div c) + a*(b mod c) div (c::nat)"
  21.387 +lemma div_mult1_eq:
  21.388 +  "(a * b) div c = a * (b div c) + a * (b mod c) div (c::nat)"
  21.389  apply (cases "c = 0", simp)
  21.390  apply (blast intro: divmod_rel [THEN divmod_rel_mult1_eq, THEN div_eq])
  21.391  done
  21.392  
  21.393  lemma divmod_rel_add1_eq:
  21.394 -  "[| divmod_rel a c aq ar; divmod_rel b c bq br;  c > 0 |]
  21.395 -   ==> divmod_rel (a + b) c (aq + bq + (ar+br) div c) ((ar + br) mod c)"
  21.396 +  "divmod_rel a c (aq, ar) \<Longrightarrow> divmod_rel b c (bq, br) \<Longrightarrow>  c > 0
  21.397 +   \<Longrightarrow> divmod_rel (a + b) c (aq + bq + (ar + br) div c, (ar + br) mod c)"
  21.398  by (auto simp add: split_ifs divmod_rel_def algebra_simps)
  21.399  
  21.400  (*NOT suitable for rewriting: the RHS has an instance of the LHS*)
  21.401 @@ -728,8 +766,9 @@
  21.402    apply (simp add: add_mult_distrib2)
  21.403    done
  21.404  
  21.405 -lemma divmod_rel_mult2_eq: "[| divmod_rel a b q r;  0 < b;  0 < c |]
  21.406 -      ==> divmod_rel a (b*c) (q div c) (b*(q mod c) + r)"
  21.407 +lemma divmod_rel_mult2_eq:
  21.408 +  "divmod_rel a b (q, r) \<Longrightarrow> 0 < b \<Longrightarrow> 0 < c
  21.409 +   \<Longrightarrow> divmod_rel a (b * c) (q div c, b *(q mod c) + r)"
  21.410  by (auto simp add: mult_ac divmod_rel_def add_mult_distrib2 [symmetric] mod_lemma)
  21.411  
  21.412  lemma div_mult2_eq: "a div (b*c) = (a div b) div (c::nat)"
  21.413 @@ -745,23 +784,6 @@
  21.414    done
  21.415  
  21.416  
  21.417 -subsubsection{*Cancellation of Common Factors in Division*}
  21.418 -
  21.419 -lemma div_mult_mult_lemma:
  21.420 -    "[| (0::nat) < b;  0 < c |] ==> (c*a) div (c*b) = a div b"
  21.421 -by (auto simp add: div_mult2_eq)
  21.422 -
  21.423 -lemma div_mult_mult1 [simp]: "(0::nat) < c ==> (c*a) div (c*b) = a div b"
  21.424 -  apply (cases "b = 0")
  21.425 -  apply (auto simp add: linorder_neq_iff [of b] div_mult_mult_lemma)
  21.426 -  done
  21.427 -
  21.428 -lemma div_mult_mult2 [simp]: "(0::nat) < c ==> (a*c) div (b*c) = a div b"
  21.429 -  apply (drule div_mult_mult1)
  21.430 -  apply (auto simp add: mult_commute)
  21.431 -  done
  21.432 -
  21.433 -
  21.434  subsubsection{*Further Facts about Quotient and Remainder*}
  21.435  
  21.436  lemma div_1 [simp]: "m div Suc 0 = m"
  21.437 @@ -769,7 +791,7 @@
  21.438  
  21.439  
  21.440  (* Monotonicity of div in first argument *)
  21.441 -lemma div_le_mono [rule_format]:
  21.442 +lemma div_le_mono [rule_format (no_asm)]:
  21.443      "\<forall>m::nat. m \<le> n --> (m div k) \<le> (n div k)"
  21.444  apply (case_tac "k=0", simp)
  21.445  apply (induct "n" rule: nat_less_induct, clarify)
  21.446 @@ -824,12 +846,6 @@
  21.447    apply (simp_all)
  21.448  done
  21.449  
  21.450 -lemma nat_div_eq_0 [simp]: "(n::nat) > 0 ==> ((m div n) = 0) = (m < n)"
  21.451 -by(auto, subst mod_div_equality [of m n, symmetric], auto)
  21.452 -
  21.453 -lemma nat_div_gt_0 [simp]: "(n::nat) > 0 ==> ((m div n) > 0) = (m >= n)"
  21.454 -by (subst neq0_conv [symmetric], auto)
  21.455 -
  21.456  declare div_less_dividend [simp]
  21.457  
  21.458  text{*A fact for the mutilated chess board*}
  21.459 @@ -915,16 +931,10 @@
  21.460    done
  21.461  
  21.462  lemma dvd_imp_le: "[| k dvd n; 0 < n |] ==> k \<le> (n::nat)"
  21.463 -by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  21.464 -
  21.465 -lemma nat_dvd_not_less: "(0::nat) < m \<Longrightarrow> m < n \<Longrightarrow> \<not> n dvd m"
  21.466 -by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  21.467 +  by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  21.468  
  21.469  lemma dvd_mult_div_cancel: "n dvd m ==> n * (m div n) = (m::nat)"
  21.470 -  apply (subgoal_tac "m mod n = 0")
  21.471 -   apply (simp add: mult_div_cancel)
  21.472 -  apply (simp only: dvd_eq_mod_eq_0)
  21.473 -  done
  21.474 +  by (simp add: dvd_eq_mod_eq_0 mult_div_cancel)
  21.475  
  21.476  lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
  21.477    by (induct n) auto
  21.478 @@ -1001,9 +1011,11 @@
  21.479    from A B show ?lhs ..
  21.480  next
  21.481    assume P: ?lhs
  21.482 -  then have "divmod_rel m n q (m - n * q)"
  21.483 +  then have "divmod_rel m n (q, m - n * q)"
  21.484      unfolding divmod_rel_def by (auto simp add: mult_ac)
  21.485 -  then show ?rhs using divmod_rel by (rule divmod_rel_unique_div)
  21.486 +  with divmod_rel_unique divmod_rel [of m n]
  21.487 +  have "(q, m - n * q) = (m div n, m mod n)" by auto
  21.488 +  then show ?rhs by simp
  21.489  qed
  21.490  
  21.491  theorem split_div':
  21.492 @@ -1155,4 +1167,9 @@
  21.493    with j show ?thesis by blast
  21.494  qed
  21.495  
  21.496 +lemma nat_dvd_not_less:
  21.497 +  fixes m n :: nat
  21.498 +  shows "0 < m \<Longrightarrow> m < n \<Longrightarrow> \<not> n dvd m"
  21.499 +by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
  21.500 +
  21.501  end
    22.1 --- a/src/HOL/Groebner_Basis.thy	Wed Apr 22 11:00:25 2009 -0700
    22.2 +++ b/src/HOL/Groebner_Basis.thy	Mon Apr 27 07:26:17 2009 -0700
    22.3 @@ -5,7 +5,7 @@
    22.4  header {* Semiring normalization and Groebner Bases *}
    22.5  
    22.6  theory Groebner_Basis
    22.7 -imports NatBin
    22.8 +imports Nat_Numeral
    22.9  uses
   22.10    "Tools/Groebner_Basis/misc.ML"
   22.11    "Tools/Groebner_Basis/normalizer_data.ML"
    23.1 --- a/src/HOL/HOL.thy	Wed Apr 22 11:00:25 2009 -0700
    23.2 +++ b/src/HOL/HOL.thy	Mon Apr 27 07:26:17 2009 -0700
    23.3 @@ -5,9 +5,10 @@
    23.4  header {* The basis of Higher-Order Logic *}
    23.5  
    23.6  theory HOL
    23.7 -imports Pure
    23.8 +imports Pure "~~/src/Tools/Code_Generator"
    23.9  uses
   23.10    ("Tools/hologic.ML")
   23.11 +  "~~/src/Tools/auto_solve.ML"
   23.12    "~~/src/Tools/IsaPlanner/zipper.ML"
   23.13    "~~/src/Tools/IsaPlanner/isand.ML"
   23.14    "~~/src/Tools/IsaPlanner/rw_tools.ML"
   23.15 @@ -27,16 +28,6 @@
   23.16    "~~/src/Tools/atomize_elim.ML"
   23.17    "~~/src/Tools/induct.ML"
   23.18    ("~~/src/Tools/induct_tacs.ML")
   23.19 -  "~~/src/Tools/value.ML"
   23.20 -  "~~/src/Tools/code/code_name.ML"
   23.21 -  "~~/src/Tools/code/code_funcgr.ML" (*formal dependency*)
   23.22 -  "~~/src/Tools/code/code_wellsorted.ML" 
   23.23 -  "~~/src/Tools/code/code_thingol.ML"
   23.24 -  "~~/src/Tools/code/code_printer.ML"
   23.25 -  "~~/src/Tools/code/code_target.ML"
   23.26 -  "~~/src/Tools/code/code_ml.ML"
   23.27 -  "~~/src/Tools/code/code_haskell.ML"
   23.28 -  "~~/src/Tools/nbe.ML"
   23.29    ("Tools/recfun_codegen.ML")
   23.30  begin
   23.31  
   23.32 @@ -1674,37 +1665,264 @@
   23.33  *}
   23.34  
   23.35  
   23.36 -subsection {* Code generator basics -- see further theory @{text "Code_Setup"} *}
   23.37 +subsection {* Code generator setup *}
   23.38 +
   23.39 +subsubsection {* SML code generator setup *}
   23.40 +
   23.41 +use "Tools/recfun_codegen.ML"
   23.42 +
   23.43 +setup {*
   23.44 +  Codegen.setup
   23.45 +  #> RecfunCodegen.setup
   23.46 +*}
   23.47 +
   23.48 +types_code
   23.49 +  "bool"  ("bool")
   23.50 +attach (term_of) {*
   23.51 +fun term_of_bool b = if b then HOLogic.true_const else HOLogic.false_const;
   23.52 +*}
   23.53 +attach (test) {*
   23.54 +fun gen_bool i =
   23.55 +  let val b = one_of [false, true]
   23.56 +  in (b, fn () => term_of_bool b) end;
   23.57 +*}
   23.58 +  "prop"  ("bool")
   23.59 +attach (term_of) {*
   23.60 +fun term_of_prop b =
   23.61 +  HOLogic.mk_Trueprop (if b then HOLogic.true_const else HOLogic.false_const);
   23.62 +*}
   23.63  
   23.64 -text {* Equality *}
   23.65 +consts_code
   23.66 +  "Trueprop" ("(_)")
   23.67 +  "True"    ("true")
   23.68 +  "False"   ("false")
   23.69 +  "Not"     ("Bool.not")
   23.70 +  "op |"    ("(_ orelse/ _)")
   23.71 +  "op &"    ("(_ andalso/ _)")
   23.72 +  "If"      ("(if _/ then _/ else _)")
   23.73 +
   23.74 +setup {*
   23.75 +let
   23.76 +
   23.77 +fun eq_codegen thy defs dep thyname b t gr =
   23.78 +    (case strip_comb t of
   23.79 +       (Const ("op =", Type (_, [Type ("fun", _), _])), _) => NONE
   23.80 +     | (Const ("op =", _), [t, u]) =>
   23.81 +          let
   23.82 +            val (pt, gr') = Codegen.invoke_codegen thy defs dep thyname false t gr;
   23.83 +            val (pu, gr'') = Codegen.invoke_codegen thy defs dep thyname false u gr';
   23.84 +            val (_, gr''') = Codegen.invoke_tycodegen thy defs dep thyname false HOLogic.boolT gr'';
   23.85 +          in
   23.86 +            SOME (Codegen.parens
   23.87 +              (Pretty.block [pt, Codegen.str " =", Pretty.brk 1, pu]), gr''')
   23.88 +          end
   23.89 +     | (t as Const ("op =", _), ts) => SOME (Codegen.invoke_codegen
   23.90 +         thy defs dep thyname b (Codegen.eta_expand t ts 2) gr)
   23.91 +     | _ => NONE);
   23.92 +
   23.93 +in
   23.94 +  Codegen.add_codegen "eq_codegen" eq_codegen
   23.95 +end
   23.96 +*}
   23.97 +
   23.98 +subsubsection {* Equality *}
   23.99  
  23.100  class eq =
  23.101    fixes eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  23.102    assumes eq_equals: "eq x y \<longleftrightarrow> x = y"
  23.103  begin
  23.104  
  23.105 -lemma eq: "eq = (op =)"
  23.106 +lemma eq [code unfold, code inline del]: "eq = (op =)"
  23.107    by (rule ext eq_equals)+
  23.108  
  23.109  lemma eq_refl: "eq x x \<longleftrightarrow> True"
  23.110    unfolding eq by rule+
  23.111  
  23.112 +lemma equals_eq [code inline]: "(op =) \<equiv> eq"
  23.113 +  by (rule eq_reflection) (rule ext, rule ext, rule sym, rule eq_equals)
  23.114 +
  23.115 +declare equals_eq [symmetric, code post]
  23.116 +
  23.117  end
  23.118  
  23.119 -text {* Module setup *}
  23.120 +declare equals_eq [code]
  23.121 +
  23.122 +
  23.123 +subsubsection {* Generic code generator foundation *}
  23.124 +
  23.125 +text {* Datatypes *}
  23.126 +
  23.127 +code_datatype True False
  23.128 +
  23.129 +code_datatype "TYPE('a\<Colon>{})"
  23.130 +
  23.131 +code_datatype Trueprop "prop"
  23.132 +
  23.133 +text {* Code equations *}
  23.134 +
  23.135 +lemma [code]:
  23.136 +  shows "(True \<Longrightarrow> PROP P) \<equiv> PROP P" 
  23.137 +    and "(False \<Longrightarrow> Q) \<equiv> Trueprop True" 
  23.138 +    and "(PROP P \<Longrightarrow> True) \<equiv> Trueprop True" 
  23.139 +    and "(Q \<Longrightarrow> False) \<equiv> Trueprop (\<not> Q)" by (auto intro!: equal_intr_rule)
  23.140 +
  23.141 +lemma [code]:
  23.142 +  shows "False \<and> x \<longleftrightarrow> False"
  23.143 +    and "True \<and> x \<longleftrightarrow> x"
  23.144 +    and "x \<and> False \<longleftrightarrow> False"
  23.145 +    and "x \<and> True \<longleftrightarrow> x" by simp_all
  23.146 +
  23.147 +lemma [code]:
  23.148 +  shows "False \<or> x \<longleftrightarrow> x"
  23.149 +    and "True \<or> x \<longleftrightarrow> True"
  23.150 +    and "x \<or> False \<longleftrightarrow> x"
  23.151 +    and "x \<or> True \<longleftrightarrow> True" by simp_all
  23.152 +
  23.153 +lemma [code]:
  23.154 +  shows "\<not> True \<longleftrightarrow> False"
  23.155 +    and "\<not> False \<longleftrightarrow> True" by (rule HOL.simp_thms)+
  23.156  
  23.157 -use "Tools/recfun_codegen.ML"
  23.158 +lemmas [code] = Let_def if_True if_False
  23.159 +
  23.160 +lemmas [code, code unfold, symmetric, code post] = imp_conv_disj
  23.161 +
  23.162 +text {* Equality *}
  23.163 +
  23.164 +declare simp_thms(6) [code nbe]
  23.165 +
  23.166 +hide (open) const eq
  23.167 +hide const eq
  23.168 +
  23.169 +setup {*
  23.170 +  Code_Unit.add_const_alias @{thm equals_eq}
  23.171 +*}
  23.172 +
  23.173 +text {* Cases *}
  23.174 +
  23.175 +lemma Let_case_cert:
  23.176 +  assumes "CASE \<equiv> (\<lambda>x. Let x f)"
  23.177 +  shows "CASE x \<equiv> f x"
  23.178 +  using assms by simp_all
  23.179 +
  23.180 +lemma If_case_cert:
  23.181 +  assumes "CASE \<equiv> (\<lambda>b. If b f g)"
  23.182 +  shows "(CASE True \<equiv> f) &&& (CASE False \<equiv> g)"
  23.183 +  using assms by simp_all
  23.184 +
  23.185 +setup {*
  23.186 +  Code.add_case @{thm Let_case_cert}
  23.187 +  #> Code.add_case @{thm If_case_cert}
  23.188 +  #> Code.add_undefined @{const_name undefined}
  23.189 +*}
  23.190 +
  23.191 +code_abort undefined
  23.192 +
  23.193 +subsubsection {* Generic code generator preprocessor *}
  23.194  
  23.195  setup {*
  23.196 -  Code_ML.setup
  23.197 -  #> Code_Haskell.setup
  23.198 -  #> Nbe.setup
  23.199 -  #> Codegen.setup
  23.200 -  #> RecfunCodegen.setup
  23.201 +  Code.map_pre (K HOL_basic_ss)
  23.202 +  #> Code.map_post (K HOL_basic_ss)
  23.203  *}
  23.204  
  23.205 +subsubsection {* Generic code generator target languages *}
  23.206  
  23.207 -subsection {* Nitpick hooks *}
  23.208 +text {* type bool *}
  23.209 +
  23.210 +code_type bool
  23.211 +  (SML "bool")
  23.212 +  (OCaml "bool")
  23.213 +  (Haskell "Bool")
  23.214 +
  23.215 +code_const True and False and Not and "op &" and "op |" and If
  23.216 +  (SML "true" and "false" and "not"
  23.217 +    and infixl 1 "andalso" and infixl 0 "orelse"
  23.218 +    and "!(if (_)/ then (_)/ else (_))")
  23.219 +  (OCaml "true" and "false" and "not"
  23.220 +    and infixl 4 "&&" and infixl 2 "||"
  23.221 +    and "!(if (_)/ then (_)/ else (_))")
  23.222 +  (Haskell "True" and "False" and "not"
  23.223 +    and infixl 3 "&&" and infixl 2 "||"
  23.224 +    and "!(if (_)/ then (_)/ else (_))")
  23.225 +
  23.226 +code_reserved SML
  23.227 +  bool true false not
  23.228 +
  23.229 +code_reserved OCaml
  23.230 +  bool not
  23.231 +
  23.232 +text {* using built-in Haskell equality *}
  23.233 +
  23.234 +code_class eq
  23.235 +  (Haskell "Eq")
  23.236 +
  23.237 +code_const "eq_class.eq"
  23.238 +  (Haskell infixl 4 "==")
  23.239 +
  23.240 +code_const "op ="
  23.241 +  (Haskell infixl 4 "==")
  23.242 +
  23.243 +text {* undefined *}
  23.244 +
  23.245 +code_const undefined
  23.246 +  (SML "!(raise/ Fail/ \"undefined\")")
  23.247 +  (OCaml "failwith/ \"undefined\"")
  23.248 +  (Haskell "error/ \"undefined\"")
  23.249 +
  23.250 +subsubsection {* Evaluation and normalization by evaluation *}
  23.251 +
  23.252 +setup {*
  23.253 +  Value.add_evaluator ("SML", Codegen.eval_term o ProofContext.theory_of)
  23.254 +*}
  23.255 +
  23.256 +ML {*
  23.257 +structure Eval_Method =
  23.258 +struct
  23.259 +
  23.260 +val eval_ref : (unit -> bool) option ref = ref NONE;
  23.261 +
  23.262 +end;
  23.263 +*}
  23.264 +
  23.265 +oracle eval_oracle = {* fn ct =>
  23.266 +  let
  23.267 +    val thy = Thm.theory_of_cterm ct;
  23.268 +    val t = Thm.term_of ct;
  23.269 +    val dummy = @{cprop True};
  23.270 +  in case try HOLogic.dest_Trueprop t
  23.271 +   of SOME t' => if Code_ML.eval NONE
  23.272 +         ("Eval_Method.eval_ref", Eval_Method.eval_ref) (K I) thy t' [] 
  23.273 +       then Thm.capply (Thm.capply @{cterm "op \<equiv> \<Colon> prop \<Rightarrow> prop \<Rightarrow> prop"} ct) dummy
  23.274 +       else dummy
  23.275 +    | NONE => dummy
  23.276 +  end
  23.277 +*}
  23.278 +
  23.279 +ML {*
  23.280 +fun gen_eval_method conv ctxt = SIMPLE_METHOD'
  23.281 +  (CONVERSION (Conv.params_conv (~1) (K (Conv.concl_conv (~1) conv)) ctxt)
  23.282 +    THEN' rtac TrueI)
  23.283 +*}
  23.284 +
  23.285 +method_setup eval = {* Scan.succeed (gen_eval_method eval_oracle) *}
  23.286 +  "solve goal by evaluation"
  23.287 +
  23.288 +method_setup evaluation = {* Scan.succeed (gen_eval_method Codegen.evaluation_conv) *}
  23.289 +  "solve goal by evaluation"
  23.290 +
  23.291 +method_setup normalization = {*
  23.292 +  Scan.succeed (K (SIMPLE_METHOD' (CONVERSION Nbe.norm_conv THEN' (fn k => TRY (rtac TrueI k)))))
  23.293 +*} "solve goal by normalization"
  23.294 +
  23.295 +subsubsection {* Quickcheck *}
  23.296 +
  23.297 +setup {*
  23.298 +  Quickcheck.add_generator ("SML", Codegen.test_term)
  23.299 +*}
  23.300 +
  23.301 +quickcheck_params [size = 5, iterations = 50]
  23.302 +
  23.303 +
  23.304 +subsection {* Nitpick setup *}
  23.305  
  23.306  text {* This will be relocated once Nitpick is moved to HOL. *}
  23.307  
  23.308 @@ -1730,10 +1948,14 @@
  23.309    val description = "introduction rules for (co)inductive predicates as needed by Nitpick"
  23.310  )
  23.311  *}
  23.312 -setup {* Nitpick_Const_Def_Thms.setup
  23.313 -         #> Nitpick_Const_Simp_Thms.setup
  23.314 -         #> Nitpick_Const_Psimp_Thms.setup
  23.315 -         #> Nitpick_Ind_Intro_Thms.setup *}
  23.316 +
  23.317 +setup {*
  23.318 +  Nitpick_Const_Def_Thms.setup
  23.319 +  #> Nitpick_Const_Simp_Thms.setup
  23.320 +  #> Nitpick_Const_Psimp_Thms.setup
  23.321 +  #> Nitpick_Ind_Intro_Thms.setup
  23.322 +*}
  23.323 +
  23.324  
  23.325  subsection {* Legacy tactics and ML bindings *}
  23.326  
    24.1 --- a/src/HOL/HoareParallel/OG_Tran.thy	Wed Apr 22 11:00:25 2009 -0700
    24.2 +++ b/src/HOL/HoareParallel/OG_Tran.thy	Mon Apr 27 07:26:17 2009 -0700
    24.3 @@ -74,7 +74,7 @@
    24.4  abbreviation
    24.5    ann_transition_n :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a) 
    24.6                             \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)  where
    24.7 -  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition^n"
    24.8 +  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition ^^ n"
    24.9  
   24.10  abbreviation
   24.11    ann_transitions :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
   24.12 @@ -84,7 +84,7 @@
   24.13  abbreviation
   24.14    transition_n :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  
   24.15                            ("_ -P_\<rightarrow> _"[81,81,81] 100)  where
   24.16 -  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition^n"
   24.17 +  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition ^^ n"
   24.18  
   24.19  subsection {* Definition of Semantics *}
   24.20  
    25.1 --- a/src/HOL/IMP/Compiler0.thy	Wed Apr 22 11:00:25 2009 -0700
    25.2 +++ b/src/HOL/IMP/Compiler0.thy	Mon Apr 27 07:26:17 2009 -0700
    25.3 @@ -45,7 +45,7 @@
    25.4  abbreviation
    25.5    stepan :: "[instr list,state,nat,nat,state,nat] \<Rightarrow> bool"
    25.6      ("_ \<turnstile>/ (3\<langle>_,_\<rangle>/ -(_)\<rightarrow> \<langle>_,_\<rangle>)" [50,0,0,0,0,0] 50)  where
    25.7 -  "P \<turnstile> \<langle>s,m\<rangle> -(i)\<rightarrow> \<langle>t,n\<rangle> == ((s,m),t,n) : ((stepa1 P)^i)"
    25.8 +  "P \<turnstile> \<langle>s,m\<rangle> -(i)\<rightarrow> \<langle>t,n\<rangle> == ((s,m),t,n) : (stepa1 P ^^ i)"
    25.9  
   25.10  subsection "The compiler"
   25.11  
    26.1 --- a/src/HOL/IMP/Machines.thy	Wed Apr 22 11:00:25 2009 -0700
    26.2 +++ b/src/HOL/IMP/Machines.thy	Mon Apr 27 07:26:17 2009 -0700
    26.3 @@ -1,7 +1,6 @@
    26.4 -
    26.5 -(* $Id$ *)
    26.6 -
    26.7 -theory Machines imports Natural begin
    26.8 +theory Machines
    26.9 +imports Natural
   26.10 +begin
   26.11  
   26.12  lemma rtrancl_eq: "R^* = Id \<union> (R O R^*)"
   26.13    by (fast intro: rtrancl_into_rtrancl elim: rtranclE)
   26.14 @@ -11,20 +10,22 @@
   26.15  
   26.16  lemmas converse_rel_powE = rel_pow_E2
   26.17  
   26.18 -lemma R_O_Rn_commute: "R O R^n = R^n O R"
   26.19 +lemma R_O_Rn_commute: "R O R ^^ n = R ^^ n O R"
   26.20    by (induct n) (simp, simp add: O_assoc [symmetric])
   26.21  
   26.22  lemma converse_in_rel_pow_eq:
   26.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))"
   26.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))"
   26.25  apply(rule iffI)
   26.26   apply(blast elim:converse_rel_powE)
   26.27  apply (fastsimp simp add:gr0_conv_Suc R_O_Rn_commute)
   26.28  done
   26.29  
   26.30 -lemma rel_pow_plus: "R^(m+n) = R^n O R^m"
   26.31 +lemma rel_pow_plus:
   26.32 +  "R ^^ (m+n) = R ^^ n O R ^^ m"
   26.33    by (induct n) (simp, simp add: O_assoc)
   26.34  
   26.35 -lemma rel_pow_plusI: "\<lbrakk> (x,y) \<in> R^m; (y,z) \<in> R^n \<rbrakk> \<Longrightarrow> (x,z) \<in> R^(m+n)"
   26.36 +lemma rel_pow_plusI:
   26.37 +  "\<lbrakk> (x,y) \<in> R ^^ m; (y,z) \<in> R ^^ n \<rbrakk> \<Longrightarrow> (x,z) \<in> R ^^ (m+n)"
   26.38    by (simp add: rel_pow_plus rel_compI)
   26.39  
   26.40  subsection "Instructions"
   26.41 @@ -57,7 +58,7 @@
   26.42  abbreviation
   26.43    exec0n :: "[instrs, nat,state, nat, nat,state] \<Rightarrow> bool"
   26.44      ("(_/ \<turnstile> (1\<langle>_,/_\<rangle>)/ -_\<rightarrow> (1\<langle>_,/_\<rangle>))" [50,0,0,0,0] 50)  where
   26.45 -  "p \<turnstile> \<langle>i,s\<rangle> -n\<rightarrow> \<langle>j,t\<rangle> == ((i,s),j,t) : (exec01 p)^n"
   26.46 +  "p \<turnstile> \<langle>i,s\<rangle> -n\<rightarrow> \<langle>j,t\<rangle> == ((i,s),j,t) : (exec01 p)^^n"
   26.47  
   26.48  subsection "M0 with lists"
   26.49  
   26.50 @@ -89,7 +90,7 @@
   26.51  abbreviation
   26.52    stepan :: "[instrs,instrs,state, nat, instrs,instrs,state] \<Rightarrow> bool"
   26.53      ("((1\<langle>_,/_,/_\<rangle>)/ -_\<rightarrow> (1\<langle>_,/_,/_\<rangle>))" 50) where
   26.54 -  "\<langle>p,q,s\<rangle> -i\<rightarrow> \<langle>p',q',t\<rangle> == ((p,q,s),p',q',t) : (stepa1^i)"
   26.55 +  "\<langle>p,q,s\<rangle> -i\<rightarrow> \<langle>p',q',t\<rangle> == ((p,q,s),p',q',t) : (stepa1^^i)"
   26.56  
   26.57  inductive_cases execE: "((i#is,p,s), (is',p',s')) : stepa1"
   26.58  
    27.1 --- a/src/HOL/IMP/Transition.thy	Wed Apr 22 11:00:25 2009 -0700
    27.2 +++ b/src/HOL/IMP/Transition.thy	Mon Apr 27 07:26:17 2009 -0700
    27.3 @@ -1,5 +1,4 @@
    27.4  (*  Title:        HOL/IMP/Transition.thy
    27.5 -    ID:           $Id$
    27.6      Author:       Tobias Nipkow & Robert Sandner, TUM
    27.7      Isar Version: Gerwin Klein, 2001
    27.8      Copyright     1996 TUM
    27.9 @@ -69,7 +68,7 @@
   27.10  abbreviation
   27.11    evalcn :: "[(com option\<times>state),nat,(com option\<times>state)] \<Rightarrow> bool"
   27.12      ("_ -_\<rightarrow>\<^sub>1 _" [60,60,60] 60)  where
   27.13 -  "cs -n\<rightarrow>\<^sub>1 cs' == (cs,cs') \<in> evalc1^n"
   27.14 +  "cs -n\<rightarrow>\<^sub>1 cs' == (cs,cs') \<in> evalc1^^n"
   27.15  
   27.16  abbreviation
   27.17    evalc' :: "[(com option\<times>state),(com option\<times>state)] \<Rightarrow> bool"
   27.18 @@ -77,28 +76,9 @@
   27.19    "cs \<longrightarrow>\<^sub>1\<^sup>* cs' == (cs,cs') \<in> evalc1^*"
   27.20  
   27.21  (*<*)
   27.22 -(* fixme: move to Relation_Power.thy *)
   27.23 -lemma rel_pow_Suc_E2 [elim!]:
   27.24 -  "[| (x, z) \<in> R ^ Suc n; !!y. [| (x, y) \<in> R; (y, z) \<in> R ^ n |] ==> P |] ==> P"
   27.25 -  by (blast dest: rel_pow_Suc_D2)
   27.26 +declare rel_pow_Suc_E2 [elim!]
   27.27 +(*>*)
   27.28  
   27.29 -lemma rtrancl_imp_rel_pow: "p \<in> R^* \<Longrightarrow> \<exists>n. p \<in> R^n"
   27.30 -proof (induct p)
   27.31 -  fix x y
   27.32 -  assume "(x, y) \<in> R\<^sup>*"
   27.33 -  thus "\<exists>n. (x, y) \<in> R^n"
   27.34 -  proof induct
   27.35 -    fix a have "(a, a) \<in> R^0" by simp
   27.36 -    thus "\<exists>n. (a, a) \<in> R ^ n" ..
   27.37 -  next
   27.38 -    fix a b c assume "\<exists>n. (a, b) \<in> R ^ n"
   27.39 -    then obtain n where "(a, b) \<in> R^n" ..
   27.40 -    moreover assume "(b, c) \<in> R"
   27.41 -    ultimately have "(a, c) \<in> R^(Suc n)" by auto
   27.42 -    thus "\<exists>n. (a, c) \<in> R^n" ..
   27.43 -  qed
   27.44 -qed
   27.45 -(*>*)
   27.46  text {*
   27.47    As for the big step semantics you can read these rules in a
   27.48    syntax directed way:
   27.49 @@ -189,8 +169,8 @@
   27.50  (*<*)
   27.51  (* FIXME: relpow.simps don't work *)
   27.52  lemmas [simp del] = relpow.simps
   27.53 -lemma rel_pow_0 [simp]: "!!R::('a*'a) set. R^0 = Id" by (simp add: relpow.simps)
   27.54 -lemma rel_pow_Suc_0 [simp]: "!!R::('a*'a) set. R^(Suc 0) = R" by (simp add: relpow.simps)
   27.55 +lemma rel_pow_0 [simp]: "!!R::('a*'a) set. R ^^ 0 = Id" by (simp add: relpow.simps)
   27.56 +lemma rel_pow_Suc_0 [simp]: "!!R::('a*'a) set. R ^^ Suc 0 = R" by (simp add: relpow.simps)
   27.57  
   27.58  (*>*)
   27.59  lemma evalc1_None_0 [simp]: "\<langle>s\<rangle> -n\<rightarrow>\<^sub>1 y = (n = 0 \<and> y = \<langle>s\<rangle>)"
    28.1 --- a/src/HOL/Import/HOL/HOL4Base.thy	Wed Apr 22 11:00:25 2009 -0700
    28.2 +++ b/src/HOL/Import/HOL/HOL4Base.thy	Mon Apr 27 07:26:17 2009 -0700
    28.3 @@ -2794,8 +2794,8 @@
    28.4    by (import numeral numeral_fact)
    28.5  
    28.6  lemma numeral_funpow: "ALL n::nat.
    28.7 -   ((f::'a::type => 'a::type) ^ n) (x::'a::type) =
    28.8 -   (if n = 0 then x else (f ^ (n - 1)) (f x))"
    28.9 +   ((f::'a::type => 'a::type) ^^ n) (x::'a::type) =
   28.10 +   (if n = 0 then x else (f ^^ (n - 1)) (f x))"
   28.11    by (import numeral numeral_funpow)
   28.12  
   28.13  ;end_setup
    29.1 --- a/src/HOL/Import/HOL/HOL4Word32.thy	Wed Apr 22 11:00:25 2009 -0700
    29.2 +++ b/src/HOL/Import/HOL/HOL4Word32.thy	Mon Apr 27 07:26:17 2009 -0700
    29.3 @@ -434,15 +434,15 @@
    29.4    by (import word32 EQUIV_QT)
    29.5  
    29.6  lemma FUNPOW_THM: "ALL (f::'a::type => 'a::type) (n::nat) x::'a::type.
    29.7 -   (f ^ n) (f x) = f ((f ^ n) x)"
    29.8 +   (f ^^ n) (f x) = f ((f ^^ n) x)"
    29.9    by (import word32 FUNPOW_THM)
   29.10  
   29.11  lemma FUNPOW_THM2: "ALL (f::'a::type => 'a::type) (n::nat) x::'a::type.
   29.12 -   (f ^ Suc n) x = f ((f ^ n) x)"
   29.13 +   (f ^^ Suc n) x = f ((f ^^ n) x)"
   29.14    by (import word32 FUNPOW_THM2)
   29.15  
   29.16  lemma FUNPOW_COMP: "ALL (f::'a::type => 'a::type) (m::nat) (n::nat) a::'a::type.
   29.17 -   (f ^ m) ((f ^ n) a) = (f ^ (m + n)) a"
   29.18 +   (f ^^ m) ((f ^^ n) a) = (f ^^ (m + n)) a"
   29.19    by (import word32 FUNPOW_COMP)
   29.20  
   29.21  lemma INw_MODw: "ALL n::nat. INw (MODw n)"
   29.22 @@ -1170,23 +1170,23 @@
   29.23  
   29.24  constdefs
   29.25    word_lsr :: "word32 => nat => word32" 
   29.26 -  "word_lsr == %(a::word32) n::nat. (word_lsr1 ^ n) a"
   29.27 +  "word_lsr == %(a::word32) n::nat. (word_lsr1 ^^ n) a"
   29.28  
   29.29 -lemma word_lsr: "ALL (a::word32) n::nat. word_lsr a n = (word_lsr1 ^ n) a"
   29.30 +lemma word_lsr: "ALL (a::word32) n::nat. word_lsr a n = (word_lsr1 ^^ n) a"
   29.31    by (import word32 word_lsr)
   29.32  
   29.33  constdefs
   29.34    word_asr :: "word32 => nat => word32" 
   29.35 -  "word_asr == %(a::word32) n::nat. (word_asr1 ^ n) a"
   29.36 +  "word_asr == %(a::word32) n::nat. (word_asr1 ^^ n) a"
   29.37  
   29.38 -lemma word_asr: "ALL (a::word32) n::nat. word_asr a n = (word_asr1 ^ n) a"
   29.39 +lemma word_asr: "ALL (a::word32) n::nat. word_asr a n = (word_asr1 ^^ n) a"
   29.40    by (import word32 word_asr)
   29.41  
   29.42  constdefs
   29.43    word_ror :: "word32 => nat => word32" 
   29.44 -  "word_ror == %(a::word32) n::nat. (word_ror1 ^ n) a"
   29.45 +  "word_ror == %(a::word32) n::nat. (word_ror1 ^^ n) a"
   29.46  
   29.47 -lemma word_ror: "ALL (a::word32) n::nat. word_ror a n = (word_ror1 ^ n) a"
   29.48 +lemma word_ror: "ALL (a::word32) n::nat. word_ror a n = (word_ror1 ^^ n) a"
   29.49    by (import word32 word_ror)
   29.50  
   29.51  consts
   29.52 @@ -1583,4 +1583,3 @@
   29.53  ;end_setup
   29.54  
   29.55  end
   29.56 -
    30.1 --- a/src/HOL/Import/HOL/arithmetic.imp	Wed Apr 22 11:00:25 2009 -0700
    30.2 +++ b/src/HOL/Import/HOL/arithmetic.imp	Mon Apr 27 07:26:17 2009 -0700
    30.3 @@ -43,7 +43,7 @@
    30.4    "TWO" > "HOL4Base.arithmetic.TWO"
    30.5    "TIMES2" > "NatSimprocs.nat_mult_2"
    30.6    "SUC_SUB1" > "HOL4Base.arithmetic.SUC_SUB1"
    30.7 -  "SUC_ONE_ADD" > "NatBin.Suc_eq_add_numeral_1_left"
    30.8 +  "SUC_ONE_ADD" > "Nat_Numeral.Suc_eq_add_numeral_1_left"
    30.9    "SUC_NOT" > "Nat.nat.simps_2"
   30.10    "SUC_ELIM_THM" > "HOL4Base.arithmetic.SUC_ELIM_THM"
   30.11    "SUC_ADD_SYM" > "HOL4Base.arithmetic.SUC_ADD_SYM"
   30.12 @@ -233,7 +233,7 @@
   30.13    "EVEN_AND_ODD" > "HOL4Base.arithmetic.EVEN_AND_ODD"
   30.14    "EVEN_ADD" > "HOL4Base.arithmetic.EVEN_ADD"
   30.15    "EVEN" > "HOL4Base.arithmetic.EVEN"
   30.16 -  "EQ_MULT_LCANCEL" > "NatBin.nat_mult_eq_cancel_disj"
   30.17 +  "EQ_MULT_LCANCEL" > "Nat_Numeral.nat_mult_eq_cancel_disj"
   30.18    "EQ_MONO_ADD_EQ" > "Nat.nat_add_right_cancel"
   30.19    "EQ_LESS_EQ" > "Orderings.order_eq_iff"
   30.20    "EQ_ADD_RCANCEL" > "Nat.nat_add_right_cancel"
    31.1 --- a/src/HOL/Import/HOL/real.imp	Wed Apr 22 11:00:25 2009 -0700
    31.2 +++ b/src/HOL/Import/HOL/real.imp	Mon Apr 27 07:26:17 2009 -0700
    31.3 @@ -99,7 +99,7 @@
    31.4    "REAL_POW_INV" > "Power.power_inverse"
    31.5    "REAL_POW_DIV" > "Power.power_divide"
    31.6    "REAL_POW_ADD" > "Power.power_add"
    31.7 -  "REAL_POW2_ABS" > "NatBin.power2_abs"
    31.8 +  "REAL_POW2_ABS" > "Nat_Numeral.power2_abs"
    31.9    "REAL_POS_NZ" > "HOL4Real.real.REAL_POS_NZ"
   31.10    "REAL_POS" > "RealDef.real_of_nat_ge_zero"
   31.11    "REAL_POASQ" > "HOL4Real.real.REAL_POASQ"
   31.12 @@ -210,7 +210,7 @@
   31.13    "REAL_LE_RDIV_EQ" > "Ring_and_Field.pos_le_divide_eq"
   31.14    "REAL_LE_RDIV" > "Ring_and_Field.mult_imp_le_div_pos"
   31.15    "REAL_LE_RADD" > "OrderedGroup.add_le_cancel_right"
   31.16 -  "REAL_LE_POW2" > "NatBin.zero_compare_simps_12"
   31.17 +  "REAL_LE_POW2" > "Nat_Numeral.zero_compare_simps_12"
   31.18    "REAL_LE_NEGTOTAL" > "HOL4Real.real.REAL_LE_NEGTOTAL"
   31.19    "REAL_LE_NEGR" > "OrderedGroup.le_minus_self_iff"
   31.20    "REAL_LE_NEGL" > "OrderedGroup.minus_le_self_iff"
   31.21 @@ -313,7 +313,7 @@
   31.22    "POW_ONE" > "Power.power_one"
   31.23    "POW_NZ" > "Power.field_power_not_zero"
   31.24    "POW_MUL" > "Power.power_mult_distrib"
   31.25 -  "POW_MINUS1" > "NatBin.power_minus1_even"
   31.26 +  "POW_MINUS1" > "Nat_Numeral.power_minus1_even"
   31.27    "POW_M1" > "HOL4Real.real.POW_M1"
   31.28    "POW_LT" > "HOL4Real.real.POW_LT"
   31.29    "POW_LE" > "Power.power_mono"
   31.30 @@ -323,7 +323,7 @@
   31.31    "POW_ABS" > "Power.power_abs"
   31.32    "POW_2_LT" > "RealPow.two_realpow_gt"
   31.33    "POW_2_LE1" > "RealPow.two_realpow_ge_one"
   31.34 -  "POW_2" > "NatBin.power2_eq_square"
   31.35 +  "POW_2" > "Nat_Numeral.power2_eq_square"
   31.36    "POW_1" > "Power.power_one_right"
   31.37    "POW_0" > "Power.power_0_Suc"
   31.38    "ABS_ZERO" > "OrderedGroup.abs_eq_0"
   31.39 @@ -335,7 +335,7 @@
   31.40    "ABS_SIGN2" > "HOL4Real.real.ABS_SIGN2"
   31.41    "ABS_SIGN" > "HOL4Real.real.ABS_SIGN"
   31.42    "ABS_REFL" > "HOL4Real.real.ABS_REFL"
   31.43 -  "ABS_POW2" > "NatBin.abs_power2"
   31.44 +  "ABS_POW2" > "Nat_Numeral.abs_power2"
   31.45    "ABS_POS" > "OrderedGroup.abs_ge_zero"
   31.46    "ABS_NZ" > "OrderedGroup.zero_less_abs_iff"
   31.47    "ABS_NEG" > "OrderedGroup.abs_minus_cancel"
    32.1 --- a/src/HOL/Import/HOL4Compat.thy	Wed Apr 22 11:00:25 2009 -0700
    32.2 +++ b/src/HOL/Import/HOL4Compat.thy	Mon Apr 27 07:26:17 2009 -0700
    32.3 @@ -202,19 +202,13 @@
    32.4  
    32.5  constdefs
    32.6    FUNPOW :: "('a => 'a) => nat => 'a => 'a"
    32.7 -  "FUNPOW f n == f ^ n"
    32.8 +  "FUNPOW f n == f ^^ n"
    32.9  
   32.10 -lemma FUNPOW: "(ALL f x. (f ^ 0) x = x) &
   32.11 -  (ALL f n x. (f ^ Suc n) x = (f ^ n) (f x))"
   32.12 -proof auto
   32.13 -  fix f n x
   32.14 -  have "ALL x. f ((f ^ n) x) = (f ^ n) (f x)"
   32.15 -    by (induct n,auto)
   32.16 -  thus "f ((f ^ n) x) = (f ^ n) (f x)"
   32.17 -    ..
   32.18 -qed
   32.19 +lemma FUNPOW: "(ALL f x. (f ^^ 0) x = x) &
   32.20 +  (ALL f n x. (f ^^ Suc n) x = (f ^^ n) (f x))"
   32.21 +  by (simp add: funpow_swap1)
   32.22  
   32.23 -lemma [hol4rew]: "FUNPOW f n = f ^ n"
   32.24 +lemma [hol4rew]: "FUNPOW f n = f ^^ n"
   32.25    by (simp add: FUNPOW_def)
   32.26  
   32.27  lemma ADD: "(!n. (0::nat) + n = n) & (!m n. Suc m + n = Suc (m + n))"
   32.28 @@ -224,7 +218,7 @@
   32.29    by simp
   32.30  
   32.31  lemma SUB: "(!m. (0::nat) - m = 0) & (!m n. (Suc m) - n = (if m < n then 0 else Suc (m - n)))"
   32.32 -  by (simp, arith)
   32.33 +  by (simp) arith
   32.34  
   32.35  lemma MAX_DEF: "max (m::nat) n = (if m < n then n else m)"
   32.36    by (simp add: max_def)
    33.1 --- a/src/HOL/Import/HOLLight/hollight.imp	Wed Apr 22 11:00:25 2009 -0700
    33.2 +++ b/src/HOL/Import/HOLLight/hollight.imp	Mon Apr 27 07:26:17 2009 -0700
    33.3 @@ -1515,7 +1515,7 @@
    33.4    "EQ_REFL_T" > "HOL.simp_thms_6"
    33.5    "EQ_REFL" > "Presburger.fm_modd_pinf"
    33.6    "EQ_MULT_RCANCEL" > "Nat.mult_cancel2"
    33.7 -  "EQ_MULT_LCANCEL" > "NatBin.nat_mult_eq_cancel_disj"
    33.8 +  "EQ_MULT_LCANCEL" > "Nat_Numeral.nat_mult_eq_cancel_disj"
    33.9    "EQ_IMP_LE" > "HOLLight.hollight.EQ_IMP_LE"
   33.10    "EQ_EXT" > "HOL.meta_eq_to_obj_eq"
   33.11    "EQ_CLAUSES" > "HOLLight.hollight.EQ_CLAUSES"
    34.1 --- a/src/HOL/Int.thy	Wed Apr 22 11:00:25 2009 -0700
    34.2 +++ b/src/HOL/Int.thy	Mon Apr 27 07:26:17 2009 -0700
    34.3 @@ -1536,7 +1536,7 @@
    34.4  by (simp add: abs_if)
    34.5  
    34.6  lemma abs_power_minus_one [simp]:
    34.7 -     "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
    34.8 +  "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring})"
    34.9  by (simp add: power_abs)
   34.10  
   34.11  lemma of_int_number_of_eq [simp]:
   34.12 @@ -1848,42 +1848,21 @@
   34.13  
   34.14  subsection {* Integer Powers *} 
   34.15  
   34.16 -instantiation int :: recpower
   34.17 +context ring_1
   34.18  begin
   34.19  
   34.20 -primrec power_int where
   34.21 -  "p ^ 0 = (1\<Colon>int)"
   34.22 -  | "p ^ (Suc n) = (p\<Colon>int) * (p ^ n)"
   34.23 -
   34.24 -instance proof
   34.25 -  fix z :: int
   34.26 -  fix n :: nat
   34.27 -  show "z ^ 0 = 1" by simp
   34.28 -  show "z ^ Suc n = z * (z ^ n)" by simp
   34.29 -qed
   34.30 -
   34.31 -declare power_int.simps [simp del]
   34.32 +lemma of_int_power:
   34.33 +  "of_int (z ^ n) = of_int z ^ n"
   34.34 +  by (induct n) simp_all
   34.35  
   34.36  end
   34.37  
   34.38 -lemma zpower_zadd_distrib: "x ^ (y + z) = ((x ^ y) * (x ^ z)::int)"
   34.39 -  by (rule Power.power_add)
   34.40 -
   34.41 -lemma zpower_zpower: "(x ^ y) ^ z = (x ^ (y * z)::int)"
   34.42 -  by (rule Power.power_mult [symmetric])
   34.43 -
   34.44 -lemma zero_less_zpower_abs_iff [simp]:
   34.45 -  "(0 < abs x ^ n) \<longleftrightarrow> (x \<noteq> (0::int) | n = 0)"
   34.46 -  by (induct n) (auto simp add: zero_less_mult_iff)
   34.47 -
   34.48 -lemma zero_le_zpower_abs [simp]: "(0::int) \<le> abs x ^ n"
   34.49 -  by (induct n) (auto simp add: zero_le_mult_iff)
   34.50 -
   34.51 -lemma of_int_power:
   34.52 -  "of_int (z ^ n) = (of_int z ^ n :: 'a::{recpower, ring_1})"
   34.53 -  by (induct n) simp_all
   34.54 -
   34.55 -lemma int_power: "int (m^n) = (int m) ^ n"
   34.56 +lemma zpower_zpower:
   34.57 +  "(x ^ y) ^ z = (x ^ (y * z)::int)"
   34.58 +  by (rule power_mult [symmetric])
   34.59 +
   34.60 +lemma int_power:
   34.61 +  "int (m ^ n) = int m ^ n"
   34.62    by (rule of_nat_power)
   34.63  
   34.64  lemmas zpower_int = int_power [symmetric]
   34.65 @@ -2224,6 +2203,8 @@
   34.66  
   34.67  subsection {* Legacy theorems *}
   34.68  
   34.69 +instance int :: recpower ..
   34.70 +
   34.71  lemmas zminus_zminus = minus_minus [of "z::int", standard]
   34.72  lemmas zminus_0 = minus_zero [where 'a=int]
   34.73  lemmas zminus_zadd_distrib = minus_add_distrib [of "z::int" "w", standard]
   34.74 @@ -2278,4 +2259,15 @@
   34.75  lemmas zless_le = less_int_def
   34.76  lemmas int_eq_of_nat = TrueI
   34.77  
   34.78 +lemma zpower_zadd_distrib:
   34.79 +  "x ^ (y + z) = ((x ^ y) * (x ^ z)::int)"
   34.80 +  by (rule power_add)
   34.81 +
   34.82 +lemma zero_less_zpower_abs_iff:
   34.83 +  "(0 < abs x ^ n) \<longleftrightarrow> (x \<noteq> (0::int) | n = 0)"
   34.84 +  by (rule zero_less_power_abs_iff)
   34.85 +
   34.86 +lemma zero_le_zpower_abs: "(0::int) \<le> abs x ^ n"
   34.87 +  by (rule zero_le_power_abs)
   34.88 +
   34.89  end
    35.1 --- a/src/HOL/IntDiv.thy	Wed Apr 22 11:00:25 2009 -0700
    35.2 +++ b/src/HOL/IntDiv.thy	Mon Apr 27 07:26:17 2009 -0700
    35.3 @@ -249,33 +249,33 @@
    35.4  text {* Tool setup *}
    35.5  
    35.6  ML {*
    35.7 -local 
    35.8 +local
    35.9  
   35.10 -structure CancelDivMod = CancelDivModFun(
   35.11 -struct
   35.12 -  val div_name = @{const_name Divides.div};
   35.13 -  val mod_name = @{const_name Divides.mod};
   35.14 +structure CancelDivMod = CancelDivModFun(struct
   35.15 +
   35.16 +  val div_name = @{const_name div};
   35.17 +  val mod_name = @{const_name mod};
   35.18    val mk_binop = HOLogic.mk_binop;
   35.19    val mk_sum = Int_Numeral_Simprocs.mk_sum HOLogic.intT;
   35.20    val dest_sum = Int_Numeral_Simprocs.dest_sum;
   35.21 -  val div_mod_eqs =
   35.22 -    map mk_meta_eq [@{thm zdiv_zmod_equality},
   35.23 -      @{thm zdiv_zmod_equality2}];
   35.24 +
   35.25 +  val div_mod_eqs = map mk_meta_eq [@{thm zdiv_zmod_equality}, @{thm zdiv_zmod_equality2}];
   35.26 +
   35.27    val trans = trans;
   35.28 -  val prove_eq_sums =
   35.29 -    let
   35.30 -      val simps = @{thm diff_int_def} :: Int_Numeral_Simprocs.add_0s @ @{thms zadd_ac}
   35.31 -    in Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac simps) end;
   35.32 +
   35.33 +  val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac 
   35.34 +    (@{thm diff_minus} :: @{thms add_0s} @ @{thms add_ac}))
   35.35 +
   35.36  end)
   35.37  
   35.38  in
   35.39  
   35.40 -val cancel_zdiv_zmod_proc = Simplifier.simproc (the_context ())
   35.41 -  "cancel_zdiv_zmod" ["(m::int) + n"] (K CancelDivMod.proc)
   35.42 +val cancel_div_mod_int_proc = Simplifier.simproc (the_context ())
   35.43 +  "cancel_zdiv_zmod" ["(k::int) + l"] (K CancelDivMod.proc);
   35.44  
   35.45 -end;
   35.46 +val _ = Addsimprocs [cancel_div_mod_int_proc];
   35.47  
   35.48 -Addsimprocs [cancel_zdiv_zmod_proc]
   35.49 +end
   35.50  *}
   35.51  
   35.52  lemma pos_mod_conj : "(0::int) < b ==> 0 \<le> a mod b & a mod b < b"
   35.53 @@ -711,6 +711,26 @@
   35.54    show "(a + c * b) div b = c + a div b"
   35.55      unfolding zdiv_zadd1_eq [of a "c * b"] using not0 
   35.56        by (simp add: zmod_zmult1_eq zmod_zdiv_trivial zdiv_zmult1_eq)
   35.57 +next
   35.58 +  fix a b c :: int
   35.59 +  assume "a \<noteq> 0"
   35.60 +  then show "(a * b) div (a * c) = b div c"
   35.61 +  proof (cases "b \<noteq> 0 \<and> c \<noteq> 0")
   35.62 +    case False then show ?thesis by auto
   35.63 +  next
   35.64 +    case True then have "b \<noteq> 0" and "c \<noteq> 0" by auto
   35.65 +    with `a \<noteq> 0`
   35.66 +    have "\<And>q r. divmod_rel b c (q, r) \<Longrightarrow> divmod_rel (a * b) (a * c) (q, a * r)"
   35.67 +      apply (auto simp add: divmod_rel_def) 
   35.68 +      apply (auto simp add: algebra_simps)
   35.69 +      apply (auto simp add: zero_less_mult_iff zero_le_mult_iff mult_le_0_iff)
   35.70 +      apply (simp_all add: mult_less_cancel_left_disj mult_commute [of _ a])
   35.71 +      done
   35.72 +    moreover with `c \<noteq> 0` divmod_rel_div_mod have "divmod_rel b c (b div c, b mod c)" by auto
   35.73 +    ultimately have "divmod_rel (a * b) (a * c) (b div c, a * (b mod c))" .
   35.74 +    moreover from  `a \<noteq> 0` `c \<noteq> 0` have "a * c \<noteq> 0" by simp
   35.75 +    ultimately show ?thesis by (rule divmod_rel_div)
   35.76 +  qed
   35.77  qed auto
   35.78  
   35.79  lemma posDivAlg_div_mod:
   35.80 @@ -808,52 +828,6 @@
   35.81  done
   35.82  
   35.83  
   35.84 -subsection{*Cancellation of Common Factors in div*}
   35.85 -
   35.86 -lemma zdiv_zmult_zmult1_aux1:
   35.87 -     "[| (0::int) < b;  c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
   35.88 -by (subst zdiv_zmult2_eq, auto)
   35.89 -
   35.90 -lemma zdiv_zmult_zmult1_aux2:
   35.91 -     "[| b < (0::int);  c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
   35.92 -apply (subgoal_tac " (c * (-a)) div (c * (-b)) = (-a) div (-b) ")
   35.93 -apply (rule_tac [2] zdiv_zmult_zmult1_aux1, auto)
   35.94 -done
   35.95 -
   35.96 -lemma zdiv_zmult_zmult1: "c \<noteq> (0::int) ==> (c*a) div (c*b) = a div b"
   35.97 -apply (case_tac "b = 0", simp)
   35.98 -apply (auto simp add: linorder_neq_iff zdiv_zmult_zmult1_aux1 zdiv_zmult_zmult1_aux2)
   35.99 -done
  35.100 -
  35.101 -lemma zdiv_zmult_zmult1_if[simp]:
  35.102 -  "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)"
  35.103 -by (simp add:zdiv_zmult_zmult1)
  35.104 -
  35.105 -
  35.106 -subsection{*Distribution of Factors over mod*}
  35.107 -
  35.108 -lemma zmod_zmult_zmult1_aux1:
  35.109 -     "[| (0::int) < b;  c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
  35.110 -by (subst zmod_zmult2_eq, auto)
  35.111 -
  35.112 -lemma zmod_zmult_zmult1_aux2:
  35.113 -     "[| b < (0::int);  c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
  35.114 -apply (subgoal_tac " (c * (-a)) mod (c * (-b)) = c * ((-a) mod (-b))")
  35.115 -apply (rule_tac [2] zmod_zmult_zmult1_aux1, auto)
  35.116 -done
  35.117 -
  35.118 -lemma zmod_zmult_zmult1: "(c*a) mod (c*b) = (c::int) * (a mod b)"
  35.119 -apply (case_tac "b = 0", simp)
  35.120 -apply (case_tac "c = 0", simp)
  35.121 -apply (auto simp add: linorder_neq_iff zmod_zmult_zmult1_aux1 zmod_zmult_zmult1_aux2)
  35.122 -done
  35.123 -
  35.124 -lemma zmod_zmult_zmult2: "(a*c) mod (b*c) = (a mod b) * (c::int)"
  35.125 -apply (cut_tac c = c in zmod_zmult_zmult1)
  35.126 -apply (auto simp add: mult_commute)
  35.127 -done
  35.128 -
  35.129 -
  35.130  subsection {*Splitting Rules for div and mod*}
  35.131  
  35.132  text{*The proofs of the two lemmas below are essentially identical*}
  35.133 @@ -937,7 +911,7 @@
  35.134                    right_distrib) 
  35.135    thus ?thesis
  35.136      by (subst zdiv_zadd1_eq,
  35.137 -        simp add: zdiv_zmult_zmult1 zmod_zmult_zmult1 one_less_a2
  35.138 +        simp add: mod_mult_mult1 one_less_a2
  35.139                    div_pos_pos_trivial)
  35.140  qed
  35.141  
  35.142 @@ -961,7 +935,7 @@
  35.143             then number_of v div (number_of w)     
  35.144             else (number_of v + (1::int)) div (number_of w))"
  35.145  apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) 
  35.146 -apply (simp add: zdiv_zmult_zmult1 pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac)
  35.147 +apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac)
  35.148  done
  35.149  
  35.150  
  35.151 @@ -977,7 +951,7 @@
  35.152  apply (auto simp add: add_commute [of 1] mult_commute add1_zle_eq 
  35.153                        pos_mod_bound)
  35.154  apply (subst mod_add_eq)
  35.155 -apply (simp add: zmod_zmult_zmult2 mod_pos_pos_trivial)
  35.156 +apply (simp add: mod_mult_mult2 mod_pos_pos_trivial)
  35.157  apply (rule mod_pos_pos_trivial)
  35.158  apply (auto simp add: mod_pos_pos_trivial ring_distribs)
  35.159  apply (subgoal_tac "0 \<le> b mod a", arith, simp)
  35.160 @@ -998,7 +972,7 @@
  35.161       "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =  
  35.162        (2::int) * (number_of v mod number_of w)"
  35.163  apply (simp only: number_of_eq numeral_simps) 
  35.164 -apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2 
  35.165 +apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  35.166                   neg_zmod_mult_2 add_ac)
  35.167  done
  35.168  
  35.169 @@ -1008,7 +982,7 @@
  35.170                  then 2 * (number_of v mod number_of w) + 1     
  35.171                  else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
  35.172  apply (simp only: number_of_eq numeral_simps) 
  35.173 -apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2 
  35.174 +apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  35.175                   neg_zmod_mult_2 add_ac)
  35.176  done
  35.177  
  35.178 @@ -1090,9 +1064,7 @@
  35.179  done
  35.180  
  35.181  lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
  35.182 -  apply (simp add: dvd_def)
  35.183 -  apply (auto simp add: zmod_zmult_zmult1)
  35.184 -  done
  35.185 +  by (auto elim!: dvdE simp add: mod_mult_mult1)
  35.186  
  35.187  lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
  35.188    apply (subgoal_tac "k dvd n * (m div n) + m mod n")
  35.189 @@ -1247,9 +1219,9 @@
  35.190  lemmas zmod_simps =
  35.191    mod_add_left_eq  [symmetric]
  35.192    mod_add_right_eq [symmetric]
  35.193 -  IntDiv.zmod_zmult1_eq     [symmetric]
  35.194 -  mod_mult_left_eq          [symmetric]
  35.195 -  IntDiv.zpower_zmod
  35.196 +  zmod_zmult1_eq   [symmetric]
  35.197 +  mod_mult_left_eq [symmetric]
  35.198 +  zpower_zmod
  35.199    zminus_zmod zdiff_zmod_left zdiff_zmod_right
  35.200  
  35.201  text {* Distributive laws for function @{text nat}. *}
    36.1 --- a/src/HOL/IsaMakefile	Wed Apr 22 11:00:25 2009 -0700
    36.2 +++ b/src/HOL/IsaMakefile	Mon Apr 27 07:26:17 2009 -0700
    36.3 @@ -89,7 +89,7 @@
    36.4    $(SRC)/Tools/IsaPlanner/rw_tools.ML \
    36.5    $(SRC)/Tools/IsaPlanner/zipper.ML \
    36.6    $(SRC)/Tools/atomize_elim.ML \
    36.7 -  $(SRC)/Tools/code/code_funcgr.ML \
    36.8 +  $(SRC)/Tools/auto_solve.ML \
    36.9    $(SRC)/Tools/code/code_haskell.ML \
   36.10    $(SRC)/Tools/code/code_ml.ML \
   36.11    $(SRC)/Tools/code/code_name.ML \
   36.12 @@ -103,10 +103,11 @@
   36.13    $(SRC)/Tools/intuitionistic.ML \
   36.14    $(SRC)/Tools/induct_tacs.ML \
   36.15    $(SRC)/Tools/nbe.ML \
   36.16 +  $(SRC)/Tools/quickcheck.ML \
   36.17    $(SRC)/Tools/project_rule.ML \
   36.18    $(SRC)/Tools/random_word.ML \
   36.19    $(SRC)/Tools/value.ML \
   36.20 -  Code_Setup.thy \
   36.21 +  $(SRC)/Tools/Code_Generator.thy \
   36.22    HOL.thy \
   36.23    Tools/hologic.ML \
   36.24    Tools/recfun_codegen.ML \
   36.25 @@ -216,10 +217,9 @@
   36.26    List.thy \
   36.27    Main.thy \
   36.28    Map.thy \
   36.29 -  NatBin.thy \
   36.30 +  Nat_Numeral.thy \
   36.31    Presburger.thy \
   36.32    Recdef.thy \
   36.33 -  Relation_Power.thy \
   36.34    SetInterval.thy \
   36.35    $(SRC)/Provers/Arith/assoc_fold.ML \
   36.36    $(SRC)/Provers/Arith/cancel_numeral_factor.ML \
    37.1 --- a/src/HOL/Library/Code_Index.thy	Wed Apr 22 11:00:25 2009 -0700
    37.2 +++ b/src/HOL/Library/Code_Index.thy	Mon Apr 27 07:26:17 2009 -0700
    37.3 @@ -144,7 +144,7 @@
    37.4  
    37.5  subsection {* Basic arithmetic *}
    37.6  
    37.7 -instantiation index :: "{minus, ordered_semidom, Divides.div, linorder}"
    37.8 +instantiation index :: "{minus, ordered_semidom, semiring_div, linorder}"
    37.9  begin
   37.10  
   37.11  definition [simp, code del]:
   37.12 @@ -172,7 +172,7 @@
   37.13    "n < m \<longleftrightarrow> nat_of n < nat_of m"
   37.14  
   37.15  instance proof
   37.16 -qed (auto simp add: left_distrib)
   37.17 +qed (auto simp add: index left_distrib div_mult_self1)
   37.18  
   37.19  end
   37.20  
    38.1 --- a/src/HOL/Library/Coinductive_List.thy	Wed Apr 22 11:00:25 2009 -0700
    38.2 +++ b/src/HOL/Library/Coinductive_List.thy	Mon Apr 27 07:26:17 2009 -0700
    38.3 @@ -786,7 +786,7 @@
    38.4  
    38.5  lemma funpow_lmap:
    38.6    fixes f :: "'a \<Rightarrow> 'a"
    38.7 -  shows "(lmap f ^ n) (LCons b l) = LCons ((f ^ n) b) ((lmap f ^ n) l)"
    38.8 +  shows "(lmap f ^^ n) (LCons b l) = LCons ((f ^^ n) b) ((lmap f ^^ n) l)"
    38.9    by (induct n) simp_all
   38.10  
   38.11  
   38.12 @@ -796,35 +796,35 @@
   38.13  proof
   38.14    fix x
   38.15    have "(h x, iterates f x) \<in>
   38.16 -      {((lmap f ^ n) (h u), (lmap f ^ n) (iterates f u)) | u n. True}"
   38.17 +      {((lmap f ^^ n) (h u), (lmap f ^^ n) (iterates f u)) | u n. True}"
   38.18    proof -
   38.19 -    have "(h x, iterates f x) = ((lmap f ^ 0) (h x), (lmap f ^ 0) (iterates f x))"
   38.20 +    have "(h x, iterates f x) = ((lmap f ^^ 0) (h x), (lmap f ^^ 0) (iterates f x))"
   38.21        by simp
   38.22      then show ?thesis by blast
   38.23    qed
   38.24    then show "h x = iterates f x"
   38.25    proof (coinduct rule: llist_equalityI)
   38.26      case (Eqllist q)
   38.27 -    then obtain u n where "q = ((lmap f ^ n) (h u), (lmap f ^ n) (iterates f u))"
   38.28 +    then obtain u n where "q = ((lmap f ^^ n) (h u), (lmap f ^^ n) (iterates f u))"
   38.29          (is "_ = (?q1, ?q2)")
   38.30        by auto
   38.31 -    also have "?q1 = LCons ((f ^ n) u) ((lmap f ^ Suc n) (h u))"
   38.32 +    also have "?q1 = LCons ((f ^^ n) u) ((lmap f ^^ Suc n) (h u))"
   38.33      proof -
   38.34 -      have "?q1 = (lmap f ^ n) (LCons u (lmap f (h u)))"
   38.35 +      have "?q1 = (lmap f ^^ n) (LCons u (lmap f (h u)))"
   38.36          by (subst h) rule
   38.37 -      also have "\<dots> = LCons ((f ^ n) u) ((lmap f ^ n) (lmap f (h u)))"
   38.38 +      also have "\<dots> = LCons ((f ^^ n) u) ((lmap f ^^ n) (lmap f (h u)))"
   38.39          by (rule funpow_lmap)
   38.40 -      also have "(lmap f ^ n) (lmap f (h u)) = (lmap f ^ Suc n) (h u)"
   38.41 +      also have "(lmap f ^^ n) (lmap f (h u)) = (lmap f ^^ Suc n) (h u)"
   38.42          by (simp add: funpow_swap1)
   38.43        finally show ?thesis .
   38.44      qed
   38.45 -    also have "?q2 = LCons ((f ^ n) u) ((lmap f ^ Suc n) (iterates f u))"
   38.46 +    also have "?q2 = LCons ((f ^^ n) u) ((lmap f ^^ Suc n) (iterates f u))"
   38.47      proof -
   38.48 -      have "?q2 = (lmap f ^ n) (LCons u (iterates f (f u)))"
   38.49 +      have "?q2 = (lmap f ^^ n) (LCons u (iterates f (f u)))"
   38.50          by (subst iterates) rule
   38.51 -      also have "\<dots> = LCons ((f ^ n) u) ((lmap f ^ n) (iterates f (f u)))"
   38.52 +      also have "\<dots> = LCons ((f ^^ n) u) ((lmap f ^^ n) (iterates f (f u)))"
   38.53          by (rule funpow_lmap)
   38.54 -      also have "(lmap f ^ n) (iterates f (f u)) = (lmap f ^ Suc n) (iterates f u)"
   38.55 +      also have "(lmap f ^^ n) (iterates f (f u)) = (lmap f ^^ Suc n) (iterates f u)"
   38.56          by (simp add: lmap_iterates funpow_swap1)
   38.57        finally show ?thesis .
   38.58      qed
    39.1 --- a/src/HOL/Library/Continuity.thy	Wed Apr 22 11:00:25 2009 -0700
    39.2 +++ b/src/HOL/Library/Continuity.thy	Mon Apr 27 07:26:17 2009 -0700
    39.3 @@ -5,7 +5,7 @@
    39.4  header {* Continuity and iterations (of set transformers) *}
    39.5  
    39.6  theory Continuity
    39.7 -imports Relation_Power Main
    39.8 +imports Transitive_Closure Main
    39.9  begin
   39.10  
   39.11  subsection {* Continuity for complete lattices *}
   39.12 @@ -48,25 +48,25 @@
   39.13  qed
   39.14  
   39.15  lemma continuous_lfp:
   39.16 - assumes "continuous F" shows "lfp F = (SUP i. (F^i) bot)"
   39.17 + assumes "continuous F" shows "lfp F = (SUP i. (F ^^ i) bot)"
   39.18  proof -
   39.19    note mono = continuous_mono[OF `continuous F`]
   39.20 -  { fix i have "(F^i) bot \<le> lfp F"
   39.21 +  { fix i have "(F ^^ i) bot \<le> lfp F"
   39.22      proof (induct i)
   39.23 -      show "(F^0) bot \<le> lfp F" by simp
   39.24 +      show "(F ^^ 0) bot \<le> lfp F" by simp
   39.25      next
   39.26        case (Suc i)
   39.27 -      have "(F^(Suc i)) bot = F((F^i) bot)" by simp
   39.28 +      have "(F ^^ Suc i) bot = F((F ^^ i) bot)" by simp
   39.29        also have "\<dots> \<le> F(lfp F)" by(rule monoD[OF mono Suc])
   39.30        also have "\<dots> = lfp F" by(simp add:lfp_unfold[OF mono, symmetric])
   39.31        finally show ?case .
   39.32      qed }
   39.33 -  hence "(SUP i. (F^i) bot) \<le> lfp F" by (blast intro!:SUP_leI)
   39.34 -  moreover have "lfp F \<le> (SUP i. (F^i) bot)" (is "_ \<le> ?U")
   39.35 +  hence "(SUP i. (F ^^ i) bot) \<le> lfp F" by (blast intro!:SUP_leI)
   39.36 +  moreover have "lfp F \<le> (SUP i. (F ^^ i) bot)" (is "_ \<le> ?U")
   39.37    proof (rule lfp_lowerbound)
   39.38 -    have "chain(%i. (F^i) bot)"
   39.39 +    have "chain(%i. (F ^^ i) bot)"
   39.40      proof -
   39.41 -      { fix i have "(F^i) bot \<le> (F^(Suc i)) bot"
   39.42 +      { fix i have "(F ^^ i) bot \<le> (F ^^ (Suc i)) bot"
   39.43  	proof (induct i)
   39.44  	  case 0 show ?case by simp
   39.45  	next
   39.46 @@ -74,7 +74,7 @@
   39.47  	qed }
   39.48        thus ?thesis by(auto simp add:chain_def)
   39.49      qed
   39.50 -    hence "F ?U = (SUP i. (F^(i+1)) bot)" using `continuous F` by (simp add:continuous_def)
   39.51 +    hence "F ?U = (SUP i. (F ^^ (i+1)) bot)" using `continuous F` by (simp add:continuous_def)
   39.52      also have "\<dots> \<le> ?U" by(fast intro:SUP_leI le_SUPI)
   39.53      finally show "F ?U \<le> ?U" .
   39.54    qed
   39.55 @@ -193,7 +193,7 @@
   39.56  
   39.57  definition
   39.58    up_iterate :: "('a set => 'a set) => nat => 'a set" where
   39.59 -  "up_iterate f n = (f^n) {}"
   39.60 +  "up_iterate f n = (f ^^ n) {}"
   39.61  
   39.62  lemma up_iterate_0 [simp]: "up_iterate f 0 = {}"
   39.63    by (simp add: up_iterate_def)
   39.64 @@ -245,7 +245,7 @@
   39.65  
   39.66  definition
   39.67    down_iterate :: "('a set => 'a set) => nat => 'a set" where
   39.68 -  "down_iterate f n = (f^n) UNIV"
   39.69 +  "down_iterate f n = (f ^^ n) UNIV"
   39.70  
   39.71  lemma down_iterate_0 [simp]: "down_iterate f 0 = UNIV"
   39.72    by (simp add: down_iterate_def)
    40.1 --- a/src/HOL/Library/Euclidean_Space.thy	Wed Apr 22 11:00:25 2009 -0700
    40.2 +++ b/src/HOL/Library/Euclidean_Space.thy	Mon Apr 27 07:26:17 2009 -0700
    40.3 @@ -253,12 +253,7 @@
    40.4    "vector_power x 0 = 1"
    40.5    | "vector_power x (Suc n) = x * vector_power x n"
    40.6  
    40.7 -instantiation "^" :: (recpower,type) recpower
    40.8 -begin
    40.9 -  definition vec_power_def: "op ^ \<equiv> vector_power"
   40.10 -  instance
   40.11 -  apply (intro_classes) by (simp_all add: vec_power_def)
   40.12 -end
   40.13 +instance "^" :: (recpower,type) recpower ..
   40.14  
   40.15  instance "^" :: (semiring,type) semiring
   40.16    apply (intro_classes) by (vector ring_simps)+
    41.1 --- a/src/HOL/Library/Eval_Witness.thy	Wed Apr 22 11:00:25 2009 -0700
    41.2 +++ b/src/HOL/Library/Eval_Witness.thy	Mon Apr 27 07:26:17 2009 -0700
    41.3 @@ -68,7 +68,7 @@
    41.4      | dest_exs _ _ = sys_error "dest_exs";
    41.5    val t = dest_exs (length ws) (HOLogic.dest_Trueprop goal);
    41.6  in
    41.7 -  if Code_ML.eval_term ("Eval_Witness_Method.eval_ref", Eval_Witness_Method.eval_ref) thy t ws
    41.8 +  if Code_ML.eval NONE ("Eval_Witness_Method.eval_ref", Eval_Witness_Method.eval_ref) (K I) thy t ws
    41.9    then Thm.cterm_of thy goal
   41.10    else @{cprop True} (*dummy*)
   41.11  end
    42.1 --- a/src/HOL/Library/Float.thy	Wed Apr 22 11:00:25 2009 -0700
    42.2 +++ b/src/HOL/Library/Float.thy	Mon Apr 27 07:26:17 2009 -0700
    42.3 @@ -15,8 +15,8 @@
    42.4  
    42.5  datatype float = Float int int
    42.6  
    42.7 -fun Ifloat :: "float \<Rightarrow> real" where
    42.8 -"Ifloat (Float a b) = real a * pow2 b"
    42.9 +primrec Ifloat :: "float \<Rightarrow> real" where
   42.10 +  "Ifloat (Float a b) = real a * pow2 b"
   42.11  
   42.12  instantiation float :: zero begin
   42.13  definition zero_float where "0 = Float 0 0" 
   42.14 @@ -33,11 +33,11 @@
   42.15  instance ..
   42.16  end
   42.17  
   42.18 -fun mantissa :: "float \<Rightarrow> int" where
   42.19 -"mantissa (Float a b) = a"
   42.20 +primrec mantissa :: "float \<Rightarrow> int" where
   42.21 +  "mantissa (Float a b) = a"
   42.22  
   42.23 -fun scale :: "float \<Rightarrow> int" where
   42.24 -"scale (Float a b) = b"
   42.25 +primrec scale :: "float \<Rightarrow> int" where
   42.26 +  "scale (Float a b) = b"
   42.27  
   42.28  lemma Ifloat_neg_exp: "e < 0 \<Longrightarrow> Ifloat (Float m e) = real m * inverse (2^nat (-e))" by auto
   42.29  lemma Ifloat_nge0_exp: "\<not> 0 \<le> e \<Longrightarrow> Ifloat (Float m e) = real m * inverse (2^nat (-e))" by auto
   42.30 @@ -320,12 +320,12 @@
   42.31  end
   42.32  
   42.33  instantiation float :: uminus begin
   42.34 -fun uminus_float where [simp del]: "uminus_float (Float m e) = Float (-m) e"
   42.35 +primrec uminus_float where [simp del]: "uminus_float (Float m e) = Float (-m) e"
   42.36  instance ..
   42.37  end
   42.38  
   42.39  instantiation float :: minus begin
   42.40 -fun minus_float where [simp del]: "(z::float) - w = z + (- w)"
   42.41 +definition minus_float where [simp del]: "(z::float) - w = z + (- w)"
   42.42  instance ..
   42.43  end
   42.44  
   42.45 @@ -334,11 +334,11 @@
   42.46  instance ..
   42.47  end
   42.48  
   42.49 -fun float_pprt :: "float \<Rightarrow> float" where
   42.50 -"float_pprt (Float a e) = (if 0 <= a then (Float a e) else 0)"
   42.51 +primrec float_pprt :: "float \<Rightarrow> float" where
   42.52 +  "float_pprt (Float a e) = (if 0 <= a then (Float a e) else 0)"
   42.53  
   42.54 -fun float_nprt :: "float \<Rightarrow> float" where
   42.55 -"float_nprt (Float a e) = (if 0 <= a then 0 else (Float a e))" 
   42.56 +primrec float_nprt :: "float \<Rightarrow> float" where
   42.57 +  "float_nprt (Float a e) = (if 0 <= a then 0 else (Float a e))" 
   42.58  
   42.59  instantiation float :: ord begin
   42.60  definition le_float_def: "z \<le> w \<equiv> Ifloat z \<le> Ifloat w"
   42.61 @@ -354,7 +354,7 @@
   42.62    by (cases a, simp add: uminus_float.simps)
   42.63  
   42.64  lemma Ifloat_sub[simp]: "Ifloat (a - b) = Ifloat a - Ifloat b" 
   42.65 -  by (cases a, cases b, simp add: minus_float.simps)
   42.66 +  by (cases a, cases b, simp add: minus_float_def)
   42.67  
   42.68  lemma Ifloat_mult[simp]: "Ifloat (a*b) = Ifloat a * Ifloat b"
   42.69    by (cases a, cases b, simp add: times_float.simps pow2_add)
   42.70 @@ -443,37 +443,10 @@
   42.71  lemma Ifloat_min: "Ifloat (min x y) = min (Ifloat x) (Ifloat y)" unfolding min_def le_float_def by auto
   42.72  lemma Ifloat_max: "Ifloat (max a b) = max (Ifloat a) (Ifloat b)" unfolding max_def le_float_def by auto
   42.73  
   42.74 -instantiation float :: power begin 
   42.75 -fun power_float where [simp del]: "(Float m e) ^ n = Float (m ^ n) (e * int n)"
   42.76 -instance ..
   42.77 -end
   42.78 -
   42.79 -instance float :: recpower
   42.80 -proof (intro_classes)
   42.81 -  fix a :: float show "a ^ 0 = 1" by (cases a, auto simp add: power_float.simps one_float_def)
   42.82 -next
   42.83 -  fix a :: float and n :: nat show "a ^ (Suc n) = a * a ^ n" 
   42.84 -  by (cases a, auto simp add: power_float.simps times_float.simps algebra_simps)
   42.85 -qed
   42.86 +instance float :: recpower ..
   42.87  
   42.88 -lemma float_power: "Ifloat (x ^ n) = (Ifloat x) ^ n"
   42.89 -proof (cases x)
   42.90 -  case (Float m e)
   42.91 -  
   42.92 -  have "pow2 e ^ n = pow2 (e * int n)"
   42.93 -  proof (cases "e >= 0")
   42.94 -    case True hence e_nat: "e = int (nat e)" by auto
   42.95 -    hence "pow2 e ^ n = (2 ^ nat e) ^ n" using pow2_int[of "nat e"] by auto
   42.96 -    thus ?thesis unfolding power_mult[symmetric] unfolding pow2_int[symmetric] int_mult e_nat[symmetric] .
   42.97 -  next
   42.98 -    case False hence e_minus: "-e = int (nat (-e))" by auto
   42.99 -    hence "pow2 (-e) ^ n = (2 ^ nat (-e)) ^ n" using pow2_int[of "nat (-e)"] by auto
  42.100 -    hence "pow2 (-e) ^ n = pow2 ((-e) * int n)" unfolding power_mult[symmetric] unfolding pow2_int[symmetric] int_mult e_minus[symmetric] zmult_zminus .
  42.101 -    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]
  42.102 -      using nonzero_inverse_eq_imp_eq[OF _ pow2_neq_zero pow2_neq_zero] by auto
  42.103 -  qed
  42.104 -  thus ?thesis by (auto simp add: Float power_mult_distrib Ifloat.simps power_float.simps)
  42.105 -qed
  42.106 +lemma float_power: "Ifloat (x ^ n) = Ifloat x ^ n"
  42.107 +  by (induct n) simp_all
  42.108  
  42.109  lemma zero_le_pow2[simp]: "0 \<le> pow2 s"
  42.110    apply (subgoal_tac "0 < pow2 s")
  42.111 @@ -1182,12 +1155,12 @@
  42.112      unfolding x_eq y_eq float_divr.simps Let_def le_float_def Ifloat_0 Ifloat_mult by (auto intro!: mult_nonneg_nonpos)
  42.113  qed
  42.114  
  42.115 -fun round_down :: "nat \<Rightarrow> float \<Rightarrow> float" where
  42.116 +primrec round_down :: "nat \<Rightarrow> float \<Rightarrow> float" where
  42.117  "round_down prec (Float m e) = (let d = bitlen m - int prec in
  42.118       if 0 < d then let P = 2^nat d ; n = m div P in Float n (e + d)
  42.119                else Float m e)"
  42.120  
  42.121 -fun round_up :: "nat \<Rightarrow> float \<Rightarrow> float" where
  42.122 +primrec round_up :: "nat \<Rightarrow> float \<Rightarrow> float" where
  42.123  "round_up prec (Float m e) = (let d = bitlen m - int prec in
  42.124    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) 
  42.125             else Float m e)"
  42.126 @@ -1314,8 +1287,8 @@
  42.127    finally show ?thesis .
  42.128  qed
  42.129  
  42.130 -fun float_abs :: "float \<Rightarrow> float" where
  42.131 -"float_abs (Float m e) = Float \<bar>m\<bar> e"
  42.132 +primrec float_abs :: "float \<Rightarrow> float" where
  42.133 +  "float_abs (Float m e) = Float \<bar>m\<bar> e"
  42.134  
  42.135  instantiation float :: abs begin
  42.136  definition abs_float_def: "\<bar>x\<bar> = float_abs x"
  42.137 @@ -1329,8 +1302,8 @@
  42.138    thus ?thesis unfolding Float abs_float_def float_abs.simps Ifloat.simps by auto
  42.139  qed
  42.140  
  42.141 -fun floor_fl :: "float \<Rightarrow> float" where
  42.142 -"floor_fl (Float m e) = (if 0 \<le> e then Float m e
  42.143 +primrec floor_fl :: "float \<Rightarrow> float" where
  42.144 +  "floor_fl (Float m e) = (if 0 \<le> e then Float m e
  42.145                                    else Float (m div (2 ^ (nat (-e)))) 0)"
  42.146  
  42.147  lemma floor_fl: "Ifloat (floor_fl x) \<le> Ifloat x"
  42.148 @@ -1358,8 +1331,8 @@
  42.149  
  42.150  declare floor_fl.simps[simp del]
  42.151  
  42.152 -fun ceiling_fl :: "float \<Rightarrow> float" where
  42.153 -"ceiling_fl (Float m e) = (if 0 \<le> e then Float m e
  42.154 +primrec ceiling_fl :: "float \<Rightarrow> float" where
  42.155 +  "ceiling_fl (Float m e) = (if 0 \<le> e then Float m e
  42.156                                      else Float (m div (2 ^ (nat (-e))) + 1) 0)"
  42.157  
  42.158  lemma ceiling_fl: "Ifloat x \<le> Ifloat (ceiling_fl x)"
    43.1 --- a/src/HOL/Library/Formal_Power_Series.thy	Wed Apr 22 11:00:25 2009 -0700
    43.2 +++ b/src/HOL/Library/Formal_Power_Series.thy	Mon Apr 27 07:26:17 2009 -0700
    43.3 @@ -680,30 +680,14 @@
    43.4  
    43.5  subsection {* Powers*}
    43.6  
    43.7 -instantiation fps :: (semiring_1) power
    43.8 -begin
    43.9 -
   43.10 -fun fps_pow :: "nat \<Rightarrow> 'a fps \<Rightarrow> 'a fps" where
   43.11 -  "fps_pow 0 f = 1"
   43.12 -| "fps_pow (Suc n) f = f * fps_pow n f"
   43.13 -
   43.14 -definition fps_power_def: "power (f::'a fps) n = fps_pow n f"
   43.15 -instance ..
   43.16 -end
   43.17 -
   43.18 -instantiation fps :: (comm_ring_1) recpower
   43.19 -begin
   43.20 -instance
   43.21 -  apply (intro_classes)
   43.22 -  by (simp_all add: fps_power_def)
   43.23 -end
   43.24 +instance fps :: (semiring_1) recpower ..
   43.25  
   43.26  lemma fps_power_zeroth_eq_one: "a$0 =1 \<Longrightarrow> a^n $ 0 = (1::'a::semiring_1)"
   43.27 -  by (induct n, auto simp add: fps_power_def expand_fps_eq fps_mult_nth)
   43.28 +  by (induct n, auto simp add: expand_fps_eq fps_mult_nth)
   43.29  
   43.30  lemma fps_power_first_eq: "(a:: 'a::comm_ring_1 fps)$0 =1 \<Longrightarrow> a^n $ 1 = of_nat n * a$1"
   43.31  proof(induct n)
   43.32 -  case 0 thus ?case by (simp add: fps_power_def)
   43.33 +  case 0 thus ?case by simp
   43.34  next
   43.35    case (Suc n)
   43.36    note h = Suc.hyps[OF `a$0 = 1`]
   43.37 @@ -712,13 +696,13 @@
   43.38  qed
   43.39  
   43.40  lemma startsby_one_power:"a $ 0 = (1::'a::comm_ring_1) \<Longrightarrow> a^n $ 0 = 1"
   43.41 -  by (induct n, auto simp add: fps_power_def fps_mult_nth)
   43.42 +  by (induct n, auto simp add: fps_mult_nth)
   43.43  
   43.44  lemma startsby_zero_power:"a $0 = (0::'a::comm_ring_1) \<Longrightarrow> n > 0 \<Longrightarrow> a^n $0 = 0"
   43.45 -  by (induct n, auto simp add: fps_power_def fps_mult_nth)
   43.46 +  by (induct n, auto simp add: fps_mult_nth)
   43.47  
   43.48  lemma startsby_power:"a $0 = (v::'a::{comm_ring_1, recpower}) \<Longrightarrow> a^n $0 = v^n"
   43.49 -  by (induct n, auto simp add: fps_power_def fps_mult_nth power_Suc)
   43.50 +  by (induct n, auto simp add: fps_mult_nth power_Suc)
   43.51  
   43.52  lemma startsby_zero_power_iff[simp]:
   43.53    "a^n $0 = (0::'a::{idom, recpower}) \<longleftrightarrow> (n \<noteq> 0 \<and> a$0 = 0)"
   43.54 @@ -901,7 +885,7 @@
   43.55  
   43.56  lemma X_power_iff: "X^k = Abs_fps (\<lambda>n. if n = k then (1::'a::comm_ring_1) else 0)"
   43.57  proof(induct k)
   43.58 -  case 0 thus ?case by (simp add: X_def fps_power_def fps_eq_iff)
   43.59 +  case 0 thus ?case by (simp add: X_def fps_eq_iff)
   43.60  next
   43.61    case (Suc k)
   43.62    {fix m
   43.63 @@ -979,7 +963,7 @@
   43.64    (* {a_{n+k}}_0^infty Corresponds to (f - setsum (\<lambda>i. a_i * x^i))/x^h, for h>0*)
   43.65  
   43.66  lemma fps_power_mult_eq_shift:
   43.67 -  "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")
   43.68 +  "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")
   43.69  proof-
   43.70    {fix n:: nat
   43.71      have "?lhs $ n = (if n < Suc k then 0 else a n)"
   43.72 @@ -990,7 +974,7 @@
   43.73      next
   43.74        case (Suc k)
   43.75        note th = Suc.hyps[symmetric]
   43.76 -      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)
   43.77 +      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)
   43.78        also  have "\<dots> = (if n < Suc k then 0 else a n) - (fps_const (a (Suc k)) * X^ Suc k)$n"
   43.79  	using th
   43.80  	unfolding fps_sub_nth by simp
   43.81 @@ -1022,13 +1006,16 @@
   43.82  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)"
   43.83    by simp
   43.84  
   43.85 -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)"
   43.86 +lemma XDN_linear:
   43.87 +  "(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)"
   43.88    by (induct n, simp_all)
   43.89  
   43.90  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)
   43.91  
   43.92 -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)"
   43.93 -by (induct k arbitrary: a) (simp_all add: power_Suc XD_def fps_eq_iff ring_simps del: One_nat_def)
   43.94 +
   43.95 +lemma fps_mult_XD_shift:
   43.96 +  "(XD ^^ k) (a:: ('a::{comm_ring_1, recpower}) fps) = Abs_fps (\<lambda>n. (of_nat n ^ k) * a$n)"
   43.97 +  by (induct k arbitrary: a) (simp_all add: power_Suc XD_def fps_eq_iff ring_simps del: One_nat_def)
   43.98  
   43.99  subsubsection{* Rule 3 is trivial and is given by @{text fps_times_def}*}
  43.100  subsubsection{* Rule 5 --- summation and "division" by (1 - X)*}
  43.101 @@ -1901,19 +1888,16 @@
  43.102    done
  43.103  
  43.104  lemma fps_compose_1[simp]: "1 oo a = 1"
  43.105 -  by (simp add: fps_eq_iff fps_compose_nth fps_power_def mult_delta_left setsum_delta)
  43.106 +  by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
  43.107  
  43.108  lemma fps_compose_0[simp]: "0 oo a = 0"
  43.109    by (simp add: fps_eq_iff fps_compose_nth)
  43.110  
  43.111 -lemma fps_pow_0: "fps_pow n 0 = (if n = 0 then 1 else 0)"
  43.112 -  by (induct n, simp_all)
  43.113 -
  43.114  lemma fps_compose_0_right[simp]: "a oo 0 = fps_const (a$0)"
  43.115 -  by (auto simp add: fps_eq_iff fps_compose_nth fps_power_def fps_pow_0 setsum_0')
  43.116 +  by (auto simp add: fps_eq_iff fps_compose_nth power_0_left setsum_0')
  43.117  
  43.118  lemma fps_compose_add_distrib: "(a + b) oo c = (a oo c) + (b oo c)"
  43.119 -  by (simp add: fps_eq_iff fps_compose_nth  ring_simps setsum_addf)
  43.120 +  by (simp add: fps_eq_iff fps_compose_nth ring_simps setsum_addf)
  43.121  
  43.122  lemma fps_compose_setsum_distrib: "(setsum f S) oo a = setsum (\<lambda>i. f i oo a) S"
  43.123  proof-
  43.124 @@ -2341,11 +2325,11 @@
  43.125  proof-
  43.126    have "fps_deriv ?lhs = 0"
  43.127      apply (simp add:  fps_deriv_power fps_sin_deriv fps_cos_deriv power_Suc)
  43.128 -    by (simp add: fps_power_def ring_simps fps_const_neg[symmetric] del: fps_const_neg)
  43.129 +    by (simp add: ring_simps fps_const_neg[symmetric] del: fps_const_neg)
  43.130    then have "?lhs = fps_const (?lhs $ 0)"
  43.131      unfolding fps_deriv_eq_0_iff .
  43.132    also have "\<dots> = 1"
  43.133 -    by (auto simp add: fps_eq_iff fps_power_def numeral_2_eq_2 fps_mult_nth fps_cos_def fps_sin_def)
  43.134 +    by (auto simp add: fps_eq_iff numeral_2_eq_2 fps_mult_nth fps_cos_def fps_sin_def)
  43.135    finally show ?thesis .
  43.136  qed
  43.137  
    44.1 --- a/src/HOL/Library/Numeral_Type.thy	Wed Apr 22 11:00:25 2009 -0700
    44.2 +++ b/src/HOL/Library/Numeral_Type.thy	Mon Apr 27 07:26:17 2009 -0700
    44.3 @@ -154,8 +154,8 @@
    44.4  
    44.5  locale mod_type =
    44.6    fixes n :: int
    44.7 -  and Rep :: "'a::{zero,one,plus,times,uminus,minus,power} \<Rightarrow> int"
    44.8 -  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus,power}"
    44.9 +  and Rep :: "'a::{zero,one,plus,times,uminus,minus} \<Rightarrow> int"
   44.10 +  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus}"
   44.11    assumes type: "type_definition Rep Abs {0..<n}"
   44.12    and size1: "1 < n"
   44.13    and zero_def: "0 = Abs 0"
   44.14 @@ -164,14 +164,13 @@
   44.15    and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
   44.16    and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
   44.17    and minus_def: "- x = Abs ((- Rep x) mod n)"
   44.18 -  and power_def: "x ^ k = Abs (Rep x ^ k mod n)"
   44.19  begin
   44.20  
   44.21  lemma size0: "0 < n"
   44.22  by (cut_tac size1, simp)
   44.23  
   44.24  lemmas definitions =
   44.25 -  zero_def one_def add_def mult_def minus_def diff_def power_def
   44.26 +  zero_def one_def add_def mult_def minus_def diff_def
   44.27  
   44.28  lemma Rep_less_n: "Rep x < n"
   44.29  by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])
   44.30 @@ -227,8 +226,8 @@
   44.31  
   44.32  locale mod_ring = mod_type +
   44.33    constrains n :: int
   44.34 -  and Rep :: "'a::{number_ring,power} \<Rightarrow> int"
   44.35 -  and Abs :: "int \<Rightarrow> 'a::{number_ring,power}"
   44.36 +  and Rep :: "'a::{number_ring} \<Rightarrow> int"
   44.37 +  and Abs :: "int \<Rightarrow> 'a::{number_ring}"
   44.38  begin
   44.39  
   44.40  lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
   44.41 @@ -272,7 +271,7 @@
   44.42    @{typ num1}, since 0 and 1 are not distinct.
   44.43  *}
   44.44  
   44.45 -instantiation num1 :: "{comm_ring,comm_monoid_mult,number,recpower}"
   44.46 +instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
   44.47  begin
   44.48  
   44.49  lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
   44.50 @@ -284,7 +283,7 @@
   44.51  end
   44.52  
   44.53  instantiation
   44.54 -  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus,power}"
   44.55 +  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus}"
   44.56  begin
   44.57  
   44.58  definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
   44.59 @@ -299,7 +298,6 @@
   44.60  definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
   44.61  definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
   44.62  definition "- x = Abs_bit0' (- Rep_bit0 x)"
   44.63 -definition "x ^ k = Abs_bit0' (Rep_bit0 x ^ k)"
   44.64  
   44.65  definition "0 = Abs_bit1 0"
   44.66  definition "1 = Abs_bit1 1"
   44.67 @@ -307,7 +305,6 @@
   44.68  definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
   44.69  definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
   44.70  definition "- x = Abs_bit1' (- Rep_bit1 x)"
   44.71 -definition "x ^ k = Abs_bit1' (Rep_bit1 x ^ k)"
   44.72  
   44.73  instance ..
   44.74  
   44.75 @@ -326,7 +323,6 @@
   44.76  apply (rule times_bit0_def [unfolded Abs_bit0'_def])
   44.77  apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
   44.78  apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
   44.79 -apply (rule power_bit0_def [unfolded Abs_bit0'_def])
   44.80  done
   44.81  
   44.82  interpretation bit1:
   44.83 @@ -342,7 +338,6 @@
   44.84  apply (rule times_bit1_def [unfolded Abs_bit1'_def])
   44.85  apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
   44.86  apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
   44.87 -apply (rule power_bit1_def [unfolded Abs_bit1'_def])
   44.88  done
   44.89  
   44.90  instance bit0 :: (finite) "{comm_ring_1,recpower}"
   44.91 @@ -386,9 +381,6 @@
   44.92  lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
   44.93  lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
   44.94  
   44.95 -declare power_Suc [where ?'a="'a::finite bit0", standard, simp]
   44.96 -declare power_Suc [where ?'a="'a::finite bit1", standard, simp]
   44.97 -
   44.98  
   44.99  subsection {* Syntax *}
  44.100  
    45.1 --- a/src/HOL/Library/Polynomial.thy	Wed Apr 22 11:00:25 2009 -0700
    45.2 +++ b/src/HOL/Library/Polynomial.thy	Mon Apr 27 07:26:17 2009 -0700
    45.3 @@ -632,19 +632,7 @@
    45.4    shows "a \<noteq> 0 \<Longrightarrow> p dvd smult a q \<longleftrightarrow> p dvd q"
    45.5    by (safe elim!: dvd_smult dvd_smult_cancel)
    45.6  
    45.7 -instantiation poly :: (comm_semiring_1) recpower
    45.8 -begin
    45.9 -
   45.10 -primrec power_poly where
   45.11 -  "(p::'a poly) ^ 0 = 1"
   45.12 -| "(p::'a poly) ^ (Suc n) = p * p ^ n"
   45.13 -
   45.14 -instance
   45.15 -  by default simp_all
   45.16 -
   45.17 -declare power_poly.simps [simp del]
   45.18 -
   45.19 -end
   45.20 +instance poly :: (comm_semiring_1) recpower ..
   45.21  
   45.22  lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
   45.23  by (induct n, simp, auto intro: order_trans degree_mult_le)
   45.24 @@ -987,6 +975,30 @@
   45.25      by (simp add: pdivmod_rel_def left_distrib)
   45.26    thus "(x + z * y) div y = z + x div y"
   45.27      by (rule div_poly_eq)
   45.28 +next
   45.29 +  fix x y z :: "'a poly"
   45.30 +  assume "x \<noteq> 0"
   45.31 +  show "(x * y) div (x * z) = y div z"
   45.32 +  proof (cases "y \<noteq> 0 \<and> z \<noteq> 0")
   45.33 +    have "\<And>x::'a poly. pdivmod_rel x 0 0 x"
   45.34 +      by (rule pdivmod_rel_by_0)
   45.35 +    then have [simp]: "\<And>x::'a poly. x div 0 = 0"
   45.36 +      by (rule div_poly_eq)
   45.37 +    have "\<And>x::'a poly. pdivmod_rel 0 x 0 0"
   45.38 +      by (rule pdivmod_rel_0)
   45.39 +    then have [simp]: "\<And>x::'a poly. 0 div x = 0"
   45.40 +      by (rule div_poly_eq)
   45.41 +    case False then show ?thesis by auto
   45.42 +  next
   45.43 +    case True then have "y \<noteq> 0" and "z \<noteq> 0" by auto
   45.44 +    with `x \<noteq> 0`
   45.45 +    have "\<And>q r. pdivmod_rel y z q r \<Longrightarrow> pdivmod_rel (x * y) (x * z) q (x * r)"
   45.46 +      by (auto simp add: pdivmod_rel_def algebra_simps)
   45.47 +        (rule classical, simp add: degree_mult_eq)
   45.48 +    moreover from pdivmod_rel have "pdivmod_rel y z (y div z) (y mod z)" .
   45.49 +    ultimately have "pdivmod_rel (x * y) (x * z) (y div z) (x * (y mod z))" .
   45.50 +    then show ?thesis by (simp add: div_poly_eq)
   45.51 +  qed
   45.52  qed
   45.53  
   45.54  end
    46.1 --- a/src/HOL/Library/Quickcheck.thy	Wed Apr 22 11:00:25 2009 -0700
    46.2 +++ b/src/HOL/Library/Quickcheck.thy	Mon Apr 27 07:26:17 2009 -0700
    46.3 @@ -47,6 +47,8 @@
    46.4  
    46.5  val eval_ref : (unit -> int -> int * int -> term list option * (int * int)) option ref = ref NONE;
    46.6  
    46.7 +val target = "Quickcheck";
    46.8 +
    46.9  fun mk_generator_expr thy prop tys =
   46.10    let
   46.11      val bound_max = length tys - 1;
   46.12 @@ -72,14 +74,75 @@
   46.13    let
   46.14      val tys = (map snd o fst o strip_abs) t;
   46.15      val t' = mk_generator_expr thy t tys;
   46.16 -    val f = Code_ML.eval_term ("Quickcheck.eval_ref", eval_ref) thy t' [];
   46.17 -  in f #> Random_Engine.run #> (Option.map o map) (Code.postprocess_term thy) end;
   46.18 +    val f = Code_ML.eval (SOME target) ("Quickcheck.eval_ref", eval_ref)
   46.19 +      (fn proc => fn g => fn s => g s #>> (Option.map o map) proc) thy t' [];
   46.20 +  in f #> Random_Engine.run end;
   46.21  
   46.22  end
   46.23  *}
   46.24  
   46.25  setup {*
   46.26 -  Quickcheck.add_generator ("code", Quickcheck.compile_generator_expr o ProofContext.theory_of)
   46.27 +  Code_Target.extend_target (Quickcheck.target, (Code_ML.target_Eval, K I))
   46.28 +  #> Quickcheck.add_generator ("code", Quickcheck.compile_generator_expr o ProofContext.theory_of)
   46.29  *}
   46.30  
   46.31 +
   46.32 +subsection {* Type @{typ "'a \<Rightarrow> 'b"} *}
   46.33 +
   46.34 +ML {*
   46.35 +structure Random_Engine =
   46.36 +struct
   46.37 +
   46.38 +open Random_Engine;
   46.39 +
   46.40 +fun random_fun (T1 : typ) (T2 : typ) (eq : 'a -> 'a -> bool) (term_of : 'a -> term)
   46.41 +    (random : Random_Engine.seed -> ('b * (unit -> term)) * Random_Engine.seed)
   46.42 +    (random_split : Random_Engine.seed -> Random_Engine.seed * Random_Engine.seed)
   46.43 +    (seed : Random_Engine.seed) =
   46.44 +  let
   46.45 +    val (seed', seed'') = random_split seed;
   46.46 +    val state = ref (seed', [], Const (@{const_name undefined}, T1 --> T2));
   46.47 +    val fun_upd = Const (@{const_name fun_upd},
   46.48 +      (T1 --> T2) --> T1 --> T2 --> T1 --> T2);
   46.49 +    fun random_fun' x =
   46.50 +      let
   46.51 +        val (seed, fun_map, f_t) = ! state;
   46.52 +      in case AList.lookup (uncurry eq) fun_map x
   46.53 +       of SOME y => y
   46.54 +        | NONE => let
   46.55 +              val t1 = term_of x;
   46.56 +              val ((y, t2), seed') = random seed;
   46.57 +              val fun_map' = (x, y) :: fun_map;
   46.58 +              val f_t' = fun_upd $ f_t $ t1 $ t2 ();
   46.59 +              val _ = state := (seed', fun_map', f_t');
   46.60 +            in y end
   46.61 +      end;
   46.62 +    fun term_fun' () = #3 (! state);
   46.63 +  in ((random_fun', term_fun'), seed'') end;
   46.64 +
   46.65  end
   46.66 +*}
   46.67 +
   46.68 +axiomatization
   46.69 +  random_fun_aux :: "typerep \<Rightarrow> typerep \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> term)
   46.70 +    \<Rightarrow> (seed \<Rightarrow> ('b \<times> (unit \<Rightarrow> term)) \<times> seed) \<Rightarrow> (seed \<Rightarrow> seed \<times> seed)
   46.71 +    \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed"
   46.72 +
   46.73 +code_const random_fun_aux (Quickcheck "Random'_Engine.random'_fun")
   46.74 +  -- {* With enough criminal energy this can be abused to derive @{prop False};
   46.75 +  for this reason we use a distinguished target @{text Quickcheck}
   46.76 +  not spoiling the regular trusted code generation *}
   46.77 +
   46.78 +instantiation "fun" :: ("{eq, term_of}", "{type, random}") random
   46.79 +begin
   46.80 +
   46.81 +definition random_fun :: "index \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed" where
   46.82 +  "random n = random_fun_aux TYPEREP('a) TYPEREP('b) (op =) Code_Eval.term_of (random n) split_seed"
   46.83 +
   46.84 +instance ..
   46.85 +
   46.86 +end
   46.87 +
   46.88 +code_reserved Quickcheck Random_Engine
   46.89 +
   46.90 +end
    47.1 --- a/src/HOL/Library/Topology_Euclidean_Space.thy	Wed Apr 22 11:00:25 2009 -0700
    47.2 +++ b/src/HOL/Library/Topology_Euclidean_Space.thy	Mon Apr 27 07:26:17 2009 -0700
    47.3 @@ -5441,7 +5441,7 @@
    47.4    have "1 - c > 0" using c by auto
    47.5  
    47.6    from s(2) obtain z0 where "z0 \<in> s" by auto
    47.7 -  def z \<equiv> "\<lambda> n::nat. fun_pow n f z0"
    47.8 +  def z \<equiv> "\<lambda>n. (f ^^ n) z0"
    47.9    { fix n::nat
   47.10      have "z n \<in> s" unfolding z_def
   47.11      proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
   47.12 @@ -5580,7 +5580,7 @@
   47.13        using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
   47.14    def y \<equiv> "g x"
   47.15    have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
   47.16 -  def f \<equiv> "\<lambda> n. fun_pow n g"
   47.17 +  def f \<equiv> "\<lambda>n. g ^^ n"
   47.18    have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
   47.19    have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
   47.20    { fix n::nat and z assume "z\<in>s"
    48.1 --- a/src/HOL/Library/Word.thy	Wed Apr 22 11:00:25 2009 -0700
    48.2 +++ b/src/HOL/Library/Word.thy	Mon Apr 27 07:26:17 2009 -0700
    48.3 @@ -1,5 +1,4 @@
    48.4  (*  Title:      HOL/Library/Word.thy
    48.5 -    ID:         $Id$
    48.6      Author:     Sebastian Skalberg (TU Muenchen)
    48.7  *)
    48.8  
    48.9 @@ -40,10 +39,8 @@
   48.10      Zero ("\<zero>")
   48.11    | One ("\<one>")
   48.12  
   48.13 -primrec
   48.14 -  bitval :: "bit => nat"
   48.15 -where
   48.16 -  "bitval \<zero> = 0"
   48.17 +primrec bitval :: "bit => nat" where
   48.18 +    "bitval \<zero> = 0"
   48.19    | "bitval \<one> = 1"
   48.20  
   48.21  consts
   48.22 @@ -1531,7 +1528,7 @@
   48.23      show ?thesis
   48.24        apply simp
   48.25        apply (subst power_Suc [symmetric])
   48.26 -      apply (simp del: power_int.simps)
   48.27 +      apply simp
   48.28        done
   48.29    qed
   48.30    finally show ?thesis .
    49.1 --- a/src/HOL/Library/reflection.ML	Wed Apr 22 11:00:25 2009 -0700
    49.2 +++ b/src/HOL/Library/reflection.ML	Mon Apr 27 07:26:17 2009 -0700
    49.3 @@ -314,5 +314,6 @@
    49.4    in (rtac th i THEN TRY(rtac TrueI i)) st end);
    49.5  
    49.6  fun reflection_tac ctxt = gen_reflection_tac ctxt Codegen.evaluation_conv;
    49.7 +  (*FIXME why Codegen.evaluation_conv?  very specific...*)
    49.8  
    49.9  end
    50.1 --- a/src/HOL/List.thy	Wed Apr 22 11:00:25 2009 -0700
    50.2 +++ b/src/HOL/List.thy	Mon Apr 27 07:26:17 2009 -0700
    50.3 @@ -5,7 +5,7 @@
    50.4  header {* The datatype of finite lists *}
    50.5  
    50.6  theory List
    50.7 -imports Plain Relation_Power Presburger Recdef ATP_Linkup
    50.8 +imports Plain Presburger Recdef ATP_Linkup
    50.9  uses "Tools/string_syntax.ML"
   50.10  begin
   50.11  
   50.12 @@ -198,7 +198,7 @@
   50.13  
   50.14  definition
   50.15    rotate :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   50.16 -  "rotate n = rotate1 ^ n"
   50.17 +  "rotate n = rotate1 ^^ n"
   50.18  
   50.19  definition
   50.20    list_all2 :: "('a => 'b => bool) => 'a list => 'b list => bool" where
    51.1 --- a/src/HOL/Map.thy	Wed Apr 22 11:00:25 2009 -0700
    51.2 +++ b/src/HOL/Map.thy	Mon Apr 27 07:26:17 2009 -0700
    51.3 @@ -11,7 +11,7 @@
    51.4  imports List
    51.5  begin
    51.6  
    51.7 -types ('a,'b) "~=>" = "'a => 'b option"  (infixr 0)
    51.8 +types ('a,'b) "~=>" = "'a => 'b option"  (infixr "~=>" 0)
    51.9  translations (type) "a ~=> b " <= (type) "a => b option"
   51.10  
   51.11  syntax (xsymbols)
    52.1 --- a/src/HOL/NSA/HyperDef.thy	Wed Apr 22 11:00:25 2009 -0700
    52.2 +++ b/src/HOL/NSA/HyperDef.thy	Mon Apr 27 07:26:17 2009 -0700
    52.3 @@ -459,7 +459,7 @@
    52.4  by transfer (rule power_add)
    52.5  
    52.6  lemma hyperpow_one [simp]:
    52.7 -  "\<And>r. (r::'a::recpower star) pow (1::hypnat) = r"
    52.8 +  "\<And>r. (r::'a::monoid_mult star) pow (1::hypnat) = r"
    52.9  by transfer (rule power_one_right)
   52.10  
   52.11  lemma hyperpow_two:
    53.1 --- a/src/HOL/NSA/StarDef.thy	Wed Apr 22 11:00:25 2009 -0700
    53.2 +++ b/src/HOL/NSA/StarDef.thy	Mon Apr 27 07:26:17 2009 -0700
    53.3 @@ -1,5 +1,4 @@
    53.4  (*  Title       : HOL/Hyperreal/StarDef.thy
    53.5 -    ID          : $Id$
    53.6      Author      : Jacques D. Fleuriot and Brian Huffman
    53.7  *)
    53.8  
    53.9 @@ -546,16 +545,6 @@
   53.10  
   53.11  end
   53.12  
   53.13 -instantiation star :: (power) power
   53.14 -begin
   53.15 -
   53.16 -definition
   53.17 -  star_power_def:   "(op ^) \<equiv> \<lambda>x n. ( *f* (\<lambda>x. x ^ n)) x"
   53.18 -
   53.19 -instance ..
   53.20 -
   53.21 -end
   53.22 -
   53.23  instantiation star :: (ord) ord
   53.24  begin
   53.25  
   53.26 @@ -574,7 +563,7 @@
   53.27    star_add_def      star_diff_def     star_minus_def
   53.28    star_mult_def     star_divide_def   star_inverse_def
   53.29    star_le_def       star_less_def     star_abs_def       star_sgn_def
   53.30 -  star_div_def      star_mod_def      star_power_def
   53.31 +  star_div_def      star_mod_def
   53.32  
   53.33  text {* Class operations preserve standard elements *}
   53.34  
   53.35 @@ -614,15 +603,11 @@
   53.36  lemma Standard_mod: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x mod y \<in> Standard"
   53.37  by (simp add: star_mod_def)
   53.38  
   53.39 -lemma Standard_power: "x \<in> Standard \<Longrightarrow> x ^ n \<in> Standard"
   53.40 -by (simp add: star_power_def)
   53.41 -
   53.42  lemmas Standard_simps [simp] =
   53.43    Standard_zero  Standard_one  Standard_number_of
   53.44    Standard_add  Standard_diff  Standard_minus
   53.45    Standard_mult  Standard_divide  Standard_inverse
   53.46    Standard_abs  Standard_div  Standard_mod
   53.47 -  Standard_power
   53.48  
   53.49  text {* @{term star_of} preserves class operations *}
   53.50  
   53.51 @@ -650,9 +635,6 @@
   53.52  lemma star_of_mod: "star_of (x mod y) = star_of x mod star_of y"
   53.53  by transfer (rule refl)
   53.54  
   53.55 -lemma star_of_power: "star_of (x ^ n) = star_of x ^ n"
   53.56 -by transfer (rule refl)
   53.57 -
   53.58  lemma star_of_abs: "star_of (abs x) = abs (star_of x)"
   53.59  by transfer (rule refl)
   53.60  
   53.61 @@ -717,8 +699,7 @@
   53.62  lemmas star_of_simps [simp] =
   53.63    star_of_add     star_of_diff    star_of_minus
   53.64    star_of_mult    star_of_divide  star_of_inverse
   53.65 -  star_of_div     star_of_mod
   53.66 -  star_of_power   star_of_abs
   53.67 +  star_of_div     star_of_mod     star_of_abs
   53.68    star_of_zero    star_of_one     star_of_number_of
   53.69    star_of_less    star_of_le      star_of_eq
   53.70    star_of_0_less  star_of_0_le    star_of_0_eq
   53.71 @@ -970,25 +951,35 @@
   53.72  instance star :: (ordered_idom) ordered_idom ..
   53.73  instance star :: (ordered_field) ordered_field ..
   53.74  
   53.75 -subsection {* Power classes *}
   53.76 +
   53.77 +subsection {* Power *}
   53.78 +
   53.79 +instance star :: (recpower) recpower ..
   53.80  
   53.81 -text {*
   53.82 -  Proving the class axiom @{thm [source] power_Suc} for type
   53.83 -  @{typ "'a star"} is a little tricky, because it quantifies
   53.84 -  over values of type @{typ nat}. The transfer principle does
   53.85 -  not handle quantification over non-star types in general,
   53.86 -  but we can work around this by fixing an arbitrary @{typ nat}
   53.87 -  value, and then applying the transfer principle.
   53.88 -*}
   53.89 +lemma star_power_def [transfer_unfold]:
   53.90 +  "(op ^) \<equiv> \<lambda>x n. ( *f* (\<lambda>x. x ^ n)) x"
   53.91 +proof (rule eq_reflection, rule ext, rule ext)
   53.92 +  fix n :: nat
   53.93 +  show "\<And>x::'a star. x ^ n = ( *f* (\<lambda>x. x ^ n)) x" 
   53.94 +  proof (induct n)
   53.95 +    case 0
   53.96 +    have "\<And>x::'a star. ( *f* (\<lambda>x. 1)) x = 1"
   53.97 +      by transfer simp
   53.98 +    then show ?case by simp
   53.99 +  next
  53.100 +    case (Suc n)
  53.101 +    have "\<And>x::'a star. x * ( *f* (\<lambda>x\<Colon>'a. x ^ n)) x = ( *f* (\<lambda>x\<Colon>'a. x * x ^ n)) x"
  53.102 +      by transfer simp
  53.103 +    with Suc show ?case by simp
  53.104 +  qed
  53.105 +qed
  53.106  
  53.107 -instance star :: (recpower) recpower
  53.108 -proof
  53.109 -  show "\<And>a::'a star. a ^ 0 = 1"
  53.110 -    by transfer (rule power_0)
  53.111 -next
  53.112 -  fix n show "\<And>a::'a star. a ^ Suc n = a * a ^ n"
  53.113 -    by transfer (rule power_Suc)
  53.114 -qed
  53.115 +lemma Standard_power [simp]: "x \<in> Standard \<Longrightarrow> x ^ n \<in> Standard"
  53.116 +  by (simp add: star_power_def)
  53.117 +
  53.118 +lemma star_of_power [simp]: "star_of (x ^ n) = star_of x ^ n"
  53.119 +  by transfer (rule refl)
  53.120 +
  53.121  
  53.122  subsection {* Number classes *}
  53.123  
    54.1 --- a/src/HOL/Nat.thy	Wed Apr 22 11:00:25 2009 -0700
    54.2 +++ b/src/HOL/Nat.thy	Mon Apr 27 07:26:17 2009 -0700
    54.3 @@ -1164,6 +1164,64 @@
    54.4  end
    54.5  
    54.6  
    54.7 +subsection {* Natural operation of natural numbers on functions *}
    54.8 +
    54.9 +text {*
   54.10 +  We use the same logical constant for the power operations on
   54.11 +  functions and relations, in order to share the same syntax.
   54.12 +*}
   54.13 +
   54.14 +consts compow :: "nat \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)"
   54.15 +
   54.16 +abbreviation compower :: "('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'b" (infixr "^^" 80) where
   54.17 +  "f ^^ n \<equiv> compow n f"
   54.18 +
   54.19 +notation (latex output)
   54.20 +  compower ("(_\<^bsup>_\<^esup>)" [1000] 1000)
   54.21 +
   54.22 +notation (HTML output)
   54.23 +  compower ("(_\<^bsup>_\<^esup>)" [1000] 1000)
   54.24 +
   54.25 +text {* @{text "f ^^ n = f o ... o f"}, the n-fold composition of @{text f} *}
   54.26 +
   54.27 +overloading
   54.28 +  funpow == "compow :: nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)"
   54.29 +begin
   54.30 +
   54.31 +primrec funpow :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where
   54.32 +    "funpow 0 f = id"
   54.33 +  | "funpow (Suc n) f = f o funpow n f"
   54.34 +
   54.35 +end
   54.36 +
   54.37 +text {* for code generation *}
   54.38 +
   54.39 +definition funpow :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where
   54.40 +  funpow_code_def [code post]: "funpow = compow"
   54.41 +
   54.42 +lemmas [code inline] = funpow_code_def [symmetric]
   54.43 +
   54.44 +lemma [code]:
   54.45 +  "funpow 0 f = id"
   54.46 +  "funpow (Suc n) f = f o funpow n f"
   54.47 +  unfolding funpow_code_def by simp_all
   54.48 +
   54.49 +hide (open) const funpow
   54.50 +
   54.51 +lemma funpow_add:
   54.52 +  "f ^^ (m + n) = f ^^ m \<circ> f ^^ n"
   54.53 +  by (induct m) simp_all
   54.54 +
   54.55 +lemma funpow_swap1:
   54.56 +  "f ((f ^^ n) x) = (f ^^ n) (f x)"
   54.57 +proof -
   54.58 +  have "f ((f ^^ n) x) = (f ^^ (n + 1)) x" by simp
   54.59 +  also have "\<dots>  = (f ^^ n o f ^^ 1) x" by (simp only: funpow_add)
   54.60 +  also have "\<dots> = (f ^^ n) (f x)" by simp
   54.61 +  finally show ?thesis .
   54.62 +qed
   54.63 +
   54.64 +
   54.65  subsection {* Embedding of the Naturals into any
   54.66    @{text semiring_1}: @{term of_nat} *}
   54.67  
   54.68 @@ -1189,7 +1247,7 @@
   54.69    "of_nat_aux inc 0 i = i"
   54.70    | "of_nat_aux inc (Suc n) i = of_nat_aux inc n (inc i)" -- {* tail recursive *}
   54.71  
   54.72 -lemma of_nat_code [code, code unfold, code inline del]:
   54.73 +lemma of_nat_code:
   54.74    "of_nat n = of_nat_aux (\<lambda>i. i + 1) n 0"
   54.75  proof (induct n)
   54.76    case 0 then show ?case by simp
   54.77 @@ -1201,9 +1259,11 @@
   54.78      by simp
   54.79    with Suc show ?case by (simp add: add_commute)
   54.80  qed
   54.81 -    
   54.82 +
   54.83  end
   54.84  
   54.85 +declare of_nat_code [code, code unfold, code inline del]
   54.86 +
   54.87  text{*Class for unital semirings with characteristic zero.
   54.88   Includes non-ordered rings like the complex numbers.*}
   54.89  
    55.1 --- a/src/HOL/NatBin.thy	Wed Apr 22 11:00:25 2009 -0700
    55.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    55.3 @@ -1,975 +0,0 @@
    55.4 -(*  Title:      HOL/NatBin.thy
    55.5 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    55.6 -    Copyright   1999  University of Cambridge
    55.7 -*)
    55.8 -
    55.9 -header {* Binary arithmetic for the natural numbers *}
   55.10 -
   55.11 -theory NatBin
   55.12 -imports IntDiv
   55.13 -uses ("Tools/nat_simprocs.ML")
   55.14 -begin
   55.15 -
   55.16 -text {*
   55.17 -  Arithmetic for naturals is reduced to that for the non-negative integers.
   55.18 -*}
   55.19 -
   55.20 -instantiation nat :: number
   55.21 -begin
   55.22 -
   55.23 -definition
   55.24 -  nat_number_of_def [code inline, code del]: "number_of v = nat (number_of v)"
   55.25 -
   55.26 -instance ..
   55.27 -
   55.28 -end
   55.29 -
   55.30 -lemma [code post]:
   55.31 -  "nat (number_of v) = number_of v"
   55.32 -  unfolding nat_number_of_def ..
   55.33 -
   55.34 -abbreviation (xsymbols)
   55.35 -  power2 :: "'a::power => 'a"  ("(_\<twosuperior>)" [1000] 999) where
   55.36 -  "x\<twosuperior> == x^2"
   55.37 -
   55.38 -notation (latex output)
   55.39 -  power2  ("(_\<twosuperior>)" [1000] 999)
   55.40 -
   55.41 -notation (HTML output)
   55.42 -  power2  ("(_\<twosuperior>)" [1000] 999)
   55.43 -
   55.44 -
   55.45 -subsection {* Predicate for negative binary numbers *}
   55.46 -
   55.47 -definition neg  :: "int \<Rightarrow> bool" where
   55.48 -  "neg Z \<longleftrightarrow> Z < 0"
   55.49 -
   55.50 -lemma not_neg_int [simp]: "~ neg (of_nat n)"
   55.51 -by (simp add: neg_def)
   55.52 -
   55.53 -lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
   55.54 -by (simp add: neg_def neg_less_0_iff_less del: of_nat_Suc)
   55.55 -
   55.56 -lemmas neg_eq_less_0 = neg_def
   55.57 -
   55.58 -lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
   55.59 -by (simp add: neg_def linorder_not_less)
   55.60 -
   55.61 -text{*To simplify inequalities when Numeral1 can get simplified to 1*}
   55.62 -
   55.63 -lemma not_neg_0: "~ neg 0"
   55.64 -by (simp add: One_int_def neg_def)
   55.65 -
   55.66 -lemma not_neg_1: "~ neg 1"
   55.67 -by (simp add: neg_def linorder_not_less zero_le_one)
   55.68 -
   55.69 -lemma neg_nat: "neg z ==> nat z = 0"
   55.70 -by (simp add: neg_def order_less_imp_le) 
   55.71 -
   55.72 -lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
   55.73 -by (simp add: linorder_not_less neg_def)
   55.74 -
   55.75 -text {*
   55.76 -  If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
   55.77 -  @{term Numeral0} IS @{term "number_of Pls"}
   55.78 -*}
   55.79 -
   55.80 -lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
   55.81 -  by (simp add: neg_def)
   55.82 -
   55.83 -lemma neg_number_of_Min: "neg (number_of Int.Min)"
   55.84 -  by (simp add: neg_def)
   55.85 -
   55.86 -lemma neg_number_of_Bit0:
   55.87 -  "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
   55.88 -  by (simp add: neg_def)
   55.89 -
   55.90 -lemma neg_number_of_Bit1:
   55.91 -  "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
   55.92 -  by (simp add: neg_def)
   55.93 -
   55.94 -lemmas neg_simps [simp] =
   55.95 -  not_neg_0 not_neg_1
   55.96 -  not_neg_number_of_Pls neg_number_of_Min
   55.97 -  neg_number_of_Bit0 neg_number_of_Bit1
   55.98 -
   55.99 -
  55.100 -subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
  55.101 -
  55.102 -declare nat_0 [simp] nat_1 [simp]
  55.103 -
  55.104 -lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
  55.105 -by (simp add: nat_number_of_def)
  55.106 -
  55.107 -lemma nat_numeral_0_eq_0 [simp]: "Numeral0 = (0::nat)"
  55.108 -by (simp add: nat_number_of_def)
  55.109 -
  55.110 -lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)"
  55.111 -by (simp add: nat_1 nat_number_of_def)
  55.112 -
  55.113 -lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
  55.114 -by (simp add: nat_numeral_1_eq_1)
  55.115 -
  55.116 -lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
  55.117 -apply (unfold nat_number_of_def)
  55.118 -apply (rule nat_2)
  55.119 -done
  55.120 -
  55.121 -
  55.122 -subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
  55.123 -
  55.124 -lemma int_nat_number_of [simp]:
  55.125 -     "int (number_of v) =  
  55.126 -         (if neg (number_of v :: int) then 0  
  55.127 -          else (number_of v :: int))"
  55.128 -  unfolding nat_number_of_def number_of_is_id neg_def
  55.129 -  by simp
  55.130 -
  55.131 -
  55.132 -subsubsection{*Successor *}
  55.133 -
  55.134 -lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)"
  55.135 -apply (rule sym)
  55.136 -apply (simp add: nat_eq_iff int_Suc)
  55.137 -done
  55.138 -
  55.139 -lemma Suc_nat_number_of_add:
  55.140 -     "Suc (number_of v + n) =  
  55.141 -        (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
  55.142 -  unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
  55.143 -  by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
  55.144 -
  55.145 -lemma Suc_nat_number_of [simp]:
  55.146 -     "Suc (number_of v) =  
  55.147 -        (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
  55.148 -apply (cut_tac n = 0 in Suc_nat_number_of_add)
  55.149 -apply (simp cong del: if_weak_cong)
  55.150 -done
  55.151 -
  55.152 -
  55.153 -subsubsection{*Addition *}
  55.154 -
  55.155 -lemma add_nat_number_of [simp]:
  55.156 -     "(number_of v :: nat) + number_of v' =  
  55.157 -         (if v < Int.Pls then number_of v'  
  55.158 -          else if v' < Int.Pls then number_of v  
  55.159 -          else number_of (v + v'))"
  55.160 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.161 -  by (simp add: nat_add_distrib)
  55.162 -
  55.163 -lemma nat_number_of_add_1 [simp]:
  55.164 -  "number_of v + (1::nat) =
  55.165 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  55.166 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.167 -  by (simp add: nat_add_distrib)
  55.168 -
  55.169 -lemma nat_1_add_number_of [simp]:
  55.170 -  "(1::nat) + number_of v =
  55.171 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  55.172 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.173 -  by (simp add: nat_add_distrib)
  55.174 -
  55.175 -lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
  55.176 -  by (rule int_int_eq [THEN iffD1]) simp
  55.177 -
  55.178 -
  55.179 -subsubsection{*Subtraction *}
  55.180 -
  55.181 -lemma diff_nat_eq_if:
  55.182 -     "nat z - nat z' =  
  55.183 -        (if neg z' then nat z   
  55.184 -         else let d = z-z' in     
  55.185 -              if neg d then 0 else nat d)"
  55.186 -by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
  55.187 -
  55.188 -
  55.189 -lemma diff_nat_number_of [simp]: 
  55.190 -     "(number_of v :: nat) - number_of v' =  
  55.191 -        (if v' < Int.Pls then number_of v  
  55.192 -         else let d = number_of (v + uminus v') in     
  55.193 -              if neg d then 0 else nat d)"
  55.194 -  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
  55.195 -  by auto
  55.196 -
  55.197 -lemma nat_number_of_diff_1 [simp]:
  55.198 -  "number_of v - (1::nat) =
  55.199 -    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
  55.200 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.201 -  by auto
  55.202 -
  55.203 -
  55.204 -subsubsection{*Multiplication *}
  55.205 -
  55.206 -lemma mult_nat_number_of [simp]:
  55.207 -     "(number_of v :: nat) * number_of v' =  
  55.208 -       (if v < Int.Pls then 0 else number_of (v * v'))"
  55.209 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.210 -  by (simp add: nat_mult_distrib)
  55.211 -
  55.212 -
  55.213 -subsubsection{*Quotient *}
  55.214 -
  55.215 -lemma div_nat_number_of [simp]:
  55.216 -     "(number_of v :: nat)  div  number_of v' =  
  55.217 -          (if neg (number_of v :: int) then 0  
  55.218 -           else nat (number_of v div number_of v'))"
  55.219 -  unfolding nat_number_of_def number_of_is_id neg_def
  55.220 -  by (simp add: nat_div_distrib)
  55.221 -
  55.222 -lemma one_div_nat_number_of [simp]:
  55.223 -     "Suc 0 div number_of v' = nat (1 div number_of v')" 
  55.224 -by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) 
  55.225 -
  55.226 -
  55.227 -subsubsection{*Remainder *}
  55.228 -
  55.229 -lemma mod_nat_number_of [simp]:
  55.230 -     "(number_of v :: nat)  mod  number_of v' =  
  55.231 -        (if neg (number_of v :: int) then 0  
  55.232 -         else if neg (number_of v' :: int) then number_of v  
  55.233 -         else nat (number_of v mod number_of v'))"
  55.234 -  unfolding nat_number_of_def number_of_is_id neg_def
  55.235 -  by (simp add: nat_mod_distrib)
  55.236 -
  55.237 -lemma one_mod_nat_number_of [simp]:
  55.238 -     "Suc 0 mod number_of v' =  
  55.239 -        (if neg (number_of v' :: int) then Suc 0
  55.240 -         else nat (1 mod number_of v'))"
  55.241 -by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) 
  55.242 -
  55.243 -
  55.244 -subsubsection{* Divisibility *}
  55.245 -
  55.246 -lemmas dvd_eq_mod_eq_0_number_of =
  55.247 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y", standard]
  55.248 -
  55.249 -declare dvd_eq_mod_eq_0_number_of [simp]
  55.250 -
  55.251 -ML
  55.252 -{*
  55.253 -val nat_number_of_def = thm"nat_number_of_def";
  55.254 -
  55.255 -val nat_number_of = thm"nat_number_of";
  55.256 -val nat_numeral_0_eq_0 = thm"nat_numeral_0_eq_0";
  55.257 -val nat_numeral_1_eq_1 = thm"nat_numeral_1_eq_1";
  55.258 -val numeral_1_eq_Suc_0 = thm"numeral_1_eq_Suc_0";
  55.259 -val numeral_2_eq_2 = thm"numeral_2_eq_2";
  55.260 -val nat_div_distrib = thm"nat_div_distrib";
  55.261 -val nat_mod_distrib = thm"nat_mod_distrib";
  55.262 -val int_nat_number_of = thm"int_nat_number_of";
  55.263 -val Suc_nat_eq_nat_zadd1 = thm"Suc_nat_eq_nat_zadd1";
  55.264 -val Suc_nat_number_of_add = thm"Suc_nat_number_of_add";
  55.265 -val Suc_nat_number_of = thm"Suc_nat_number_of";
  55.266 -val add_nat_number_of = thm"add_nat_number_of";
  55.267 -val diff_nat_eq_if = thm"diff_nat_eq_if";
  55.268 -val diff_nat_number_of = thm"diff_nat_number_of";
  55.269 -val mult_nat_number_of = thm"mult_nat_number_of";
  55.270 -val div_nat_number_of = thm"div_nat_number_of";
  55.271 -val mod_nat_number_of = thm"mod_nat_number_of";
  55.272 -*}
  55.273 -
  55.274 -
  55.275 -subsection{*Comparisons*}
  55.276 -
  55.277 -subsubsection{*Equals (=) *}
  55.278 -
  55.279 -lemma eq_nat_nat_iff:
  55.280 -     "[| (0::int) <= z;  0 <= z' |] ==> (nat z = nat z') = (z=z')"
  55.281 -by (auto elim!: nonneg_eq_int)
  55.282 -
  55.283 -lemma eq_nat_number_of [simp]:
  55.284 -     "((number_of v :: nat) = number_of v') =  
  55.285 -      (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
  55.286 -       else if neg (number_of v' :: int) then (number_of v :: int) = 0
  55.287 -       else v = v')"
  55.288 -  unfolding nat_number_of_def number_of_is_id neg_def
  55.289 -  by auto
  55.290 -
  55.291 -
  55.292 -subsubsection{*Less-than (<) *}
  55.293 -
  55.294 -lemma less_nat_number_of [simp]:
  55.295 -  "(number_of v :: nat) < number_of v' \<longleftrightarrow>
  55.296 -    (if v < v' then Int.Pls < v' else False)"
  55.297 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.298 -  by auto
  55.299 -
  55.300 -
  55.301 -subsubsection{*Less-than-or-equal *}
  55.302 -
  55.303 -lemma le_nat_number_of [simp]:
  55.304 -  "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
  55.305 -    (if v \<le> v' then True else v \<le> Int.Pls)"
  55.306 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.307 -  by auto
  55.308 -
  55.309 -(*Maps #n to n for n = 0, 1, 2*)
  55.310 -lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
  55.311 -
  55.312 -
  55.313 -subsection{*Powers with Numeric Exponents*}
  55.314 -
  55.315 -text{*We cannot refer to the number @{term 2} in @{text Ring_and_Field.thy}.
  55.316 -We cannot prove general results about the numeral @{term "-1"}, so we have to
  55.317 -use @{term "- 1"} instead.*}
  55.318 -
  55.319 -lemma power2_eq_square: "(a::'a::recpower)\<twosuperior> = a * a"
  55.320 -  by (simp add: numeral_2_eq_2 Power.power_Suc)
  55.321 -
  55.322 -lemma zero_power2 [simp]: "(0::'a::{semiring_1,recpower})\<twosuperior> = 0"
  55.323 -  by (simp add: power2_eq_square)
  55.324 -
  55.325 -lemma one_power2 [simp]: "(1::'a::{semiring_1,recpower})\<twosuperior> = 1"
  55.326 -  by (simp add: power2_eq_square)
  55.327 -
  55.328 -lemma power3_eq_cube: "(x::'a::recpower) ^ 3 = x * x * x"
  55.329 -  apply (subgoal_tac "3 = Suc (Suc (Suc 0))")
  55.330 -  apply (erule ssubst)
  55.331 -  apply (simp add: power_Suc mult_ac)
  55.332 -  apply (unfold nat_number_of_def)
  55.333 -  apply (subst nat_eq_iff)
  55.334 -  apply simp
  55.335 -done
  55.336 -
  55.337 -text{*Squares of literal numerals will be evaluated.*}
  55.338 -lemmas power2_eq_square_number_of =
  55.339 -    power2_eq_square [of "number_of w", standard]
  55.340 -declare power2_eq_square_number_of [simp]
  55.341 -
  55.342 -
  55.343 -lemma zero_le_power2[simp]: "0 \<le> (a\<twosuperior>::'a::{ordered_idom,recpower})"
  55.344 -  by (simp add: power2_eq_square)
  55.345 -
  55.346 -lemma zero_less_power2[simp]:
  55.347 -     "(0 < a\<twosuperior>) = (a \<noteq> (0::'a::{ordered_idom,recpower}))"
  55.348 -  by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff)
  55.349 -
  55.350 -lemma power2_less_0[simp]:
  55.351 -  fixes a :: "'a::{ordered_idom,recpower}"
  55.352 -  shows "~ (a\<twosuperior> < 0)"
  55.353 -by (force simp add: power2_eq_square mult_less_0_iff) 
  55.354 -
  55.355 -lemma zero_eq_power2[simp]:
  55.356 -     "(a\<twosuperior> = 0) = (a = (0::'a::{ordered_idom,recpower}))"
  55.357 -  by (force simp add: power2_eq_square mult_eq_0_iff)
  55.358 -
  55.359 -lemma abs_power2[simp]:
  55.360 -     "abs(a\<twosuperior>) = (a\<twosuperior>::'a::{ordered_idom,recpower})"
  55.361 -  by (simp add: power2_eq_square abs_mult abs_mult_self)
  55.362 -
  55.363 -lemma power2_abs[simp]:
  55.364 -     "(abs a)\<twosuperior> = (a\<twosuperior>::'a::{ordered_idom,recpower})"
  55.365 -  by (simp add: power2_eq_square abs_mult_self)
  55.366 -
  55.367 -lemma power2_minus[simp]:
  55.368 -     "(- a)\<twosuperior> = (a\<twosuperior>::'a::{comm_ring_1,recpower})"
  55.369 -  by (simp add: power2_eq_square)
  55.370 -
  55.371 -lemma power2_le_imp_le:
  55.372 -  fixes x y :: "'a::{ordered_semidom,recpower}"
  55.373 -  shows "\<lbrakk>x\<twosuperior> \<le> y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x \<le> y"
  55.374 -unfolding numeral_2_eq_2 by (rule power_le_imp_le_base)
  55.375 -
  55.376 -lemma power2_less_imp_less:
  55.377 -  fixes x y :: "'a::{ordered_semidom,recpower}"
  55.378 -  shows "\<lbrakk>x\<twosuperior> < y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x < y"
  55.379 -by (rule power_less_imp_less_base)
  55.380 -
  55.381 -lemma power2_eq_imp_eq:
  55.382 -  fixes x y :: "'a::{ordered_semidom,recpower}"
  55.383 -  shows "\<lbrakk>x\<twosuperior> = y\<twosuperior>; 0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> x = y"
  55.384 -unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base, simp)
  55.385 -
  55.386 -lemma power_minus1_even[simp]: "(- 1) ^ (2*n) = (1::'a::{comm_ring_1,recpower})"
  55.387 -proof (induct n)
  55.388 -  case 0 show ?case by simp
  55.389 -next
  55.390 -  case (Suc n) then show ?case by (simp add: power_Suc power_add)
  55.391 -qed
  55.392 -
  55.393 -lemma power_minus1_odd: "(- 1) ^ Suc(2*n) = -(1::'a::{comm_ring_1,recpower})"
  55.394 -  by (simp add: power_Suc) 
  55.395 -
  55.396 -lemma power_even_eq: "(a::'a::recpower) ^ (2*n) = (a^n)^2"
  55.397 -by (subst mult_commute) (simp add: power_mult)
  55.398 -
  55.399 -lemma power_odd_eq: "(a::int) ^ Suc(2*n) = a * (a^n)^2"
  55.400 -by (simp add: power_even_eq) 
  55.401 -
  55.402 -lemma power_minus_even [simp]:
  55.403 -     "(-a) ^ (2*n) = (a::'a::{comm_ring_1,recpower}) ^ (2*n)"
  55.404 -by (simp add: power_minus1_even power_minus [of a]) 
  55.405 -
  55.406 -lemma zero_le_even_power'[simp]:
  55.407 -     "0 \<le> (a::'a::{ordered_idom,recpower}) ^ (2*n)"
  55.408 -proof (induct "n")
  55.409 -  case 0
  55.410 -    show ?case by (simp add: zero_le_one)
  55.411 -next
  55.412 -  case (Suc n)
  55.413 -    have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)" 
  55.414 -      by (simp add: mult_ac power_add power2_eq_square)
  55.415 -    thus ?case
  55.416 -      by (simp add: prems zero_le_mult_iff)
  55.417 -qed
  55.418 -
  55.419 -lemma odd_power_less_zero:
  55.420 -     "(a::'a::{ordered_idom,recpower}) < 0 ==> a ^ Suc(2*n) < 0"
  55.421 -proof (induct "n")
  55.422 -  case 0
  55.423 -  then show ?case by simp
  55.424 -next
  55.425 -  case (Suc n)
  55.426 -  have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)"
  55.427 -    by (simp add: mult_ac power_add power2_eq_square)
  55.428 -  thus ?case
  55.429 -    by (simp del: power_Suc add: prems mult_less_0_iff mult_neg_neg)
  55.430 -qed
  55.431 -
  55.432 -lemma odd_0_le_power_imp_0_le:
  55.433 -     "0 \<le> a  ^ Suc(2*n) ==> 0 \<le> (a::'a::{ordered_idom,recpower})"
  55.434 -apply (insert odd_power_less_zero [of a n]) 
  55.435 -apply (force simp add: linorder_not_less [symmetric]) 
  55.436 -done
  55.437 -
  55.438 -text{*Simprules for comparisons where common factors can be cancelled.*}
  55.439 -lemmas zero_compare_simps =
  55.440 -    add_strict_increasing add_strict_increasing2 add_increasing
  55.441 -    zero_le_mult_iff zero_le_divide_iff 
  55.442 -    zero_less_mult_iff zero_less_divide_iff 
  55.443 -    mult_le_0_iff divide_le_0_iff 
  55.444 -    mult_less_0_iff divide_less_0_iff 
  55.445 -    zero_le_power2 power2_less_0
  55.446 -
  55.447 -subsubsection{*Nat *}
  55.448 -
  55.449 -lemma Suc_pred': "0 < n ==> n = Suc(n - 1)"
  55.450 -by (simp add: numerals)
  55.451 -
  55.452 -(*Expresses a natural number constant as the Suc of another one.
  55.453 -  NOT suitable for rewriting because n recurs in the condition.*)
  55.454 -lemmas expand_Suc = Suc_pred' [of "number_of v", standard]
  55.455 -
  55.456 -subsubsection{*Arith *}
  55.457 -
  55.458 -lemma Suc_eq_add_numeral_1: "Suc n = n + 1"
  55.459 -by (simp add: numerals)
  55.460 -
  55.461 -lemma Suc_eq_add_numeral_1_left: "Suc n = 1 + n"
  55.462 -by (simp add: numerals)
  55.463 -
  55.464 -(* These two can be useful when m = number_of... *)
  55.465 -
  55.466 -lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
  55.467 -  unfolding One_nat_def by (cases m) simp_all
  55.468 -
  55.469 -lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
  55.470 -  unfolding One_nat_def by (cases m) simp_all
  55.471 -
  55.472 -lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
  55.473 -  unfolding One_nat_def by (cases m) simp_all
  55.474 -
  55.475 -
  55.476 -subsection{*Comparisons involving (0::nat) *}
  55.477 -
  55.478 -text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
  55.479 -
  55.480 -lemma eq_number_of_0 [simp]:
  55.481 -  "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
  55.482 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.483 -  by auto
  55.484 -
  55.485 -lemma eq_0_number_of [simp]:
  55.486 -  "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
  55.487 -by (rule trans [OF eq_sym_conv eq_number_of_0])
  55.488 -
  55.489 -lemma less_0_number_of [simp]:
  55.490 -   "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
  55.491 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  55.492 -  by simp
  55.493 -
  55.494 -lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
  55.495 -by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
  55.496 -
  55.497 -
  55.498 -
  55.499 -subsection{*Comparisons involving  @{term Suc} *}
  55.500 -
  55.501 -lemma eq_number_of_Suc [simp]:
  55.502 -     "(number_of v = Suc n) =  
  55.503 -        (let pv = number_of (Int.pred v) in  
  55.504 -         if neg pv then False else nat pv = n)"
  55.505 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  55.506 -                  number_of_pred nat_number_of_def 
  55.507 -            split add: split_if)
  55.508 -apply (rule_tac x = "number_of v" in spec)
  55.509 -apply (auto simp add: nat_eq_iff)
  55.510 -done
  55.511 -
  55.512 -lemma Suc_eq_number_of [simp]:
  55.513 -     "(Suc n = number_of v) =  
  55.514 -        (let pv = number_of (Int.pred v) in  
  55.515 -         if neg pv then False else nat pv = n)"
  55.516 -by (rule trans [OF eq_sym_conv eq_number_of_Suc])
  55.517 -
  55.518 -lemma less_number_of_Suc [simp]:
  55.519 -     "(number_of v < Suc n) =  
  55.520 -        (let pv = number_of (Int.pred v) in  
  55.521 -         if neg pv then True else nat pv < n)"
  55.522 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  55.523 -                  number_of_pred nat_number_of_def  
  55.524 -            split add: split_if)
  55.525 -apply (rule_tac x = "number_of v" in spec)
  55.526 -apply (auto simp add: nat_less_iff)
  55.527 -done
  55.528 -
  55.529 -lemma less_Suc_number_of [simp]:
  55.530 -     "(Suc n < number_of v) =  
  55.531 -        (let pv = number_of (Int.pred v) in  
  55.532 -         if neg pv then False else n < nat pv)"
  55.533 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  55.534 -                  number_of_pred nat_number_of_def
  55.535 -            split add: split_if)
  55.536 -apply (rule_tac x = "number_of v" in spec)
  55.537 -apply (auto simp add: zless_nat_eq_int_zless)
  55.538 -done
  55.539 -
  55.540 -lemma le_number_of_Suc [simp]:
  55.541 -     "(number_of v <= Suc n) =  
  55.542 -        (let pv = number_of (Int.pred v) in  
  55.543 -         if neg pv then True else nat pv <= n)"
  55.544 -by (simp add: Let_def less_Suc_number_of linorder_not_less [symmetric])
  55.545 -
  55.546 -lemma le_Suc_number_of [simp]:
  55.547 -     "(Suc n <= number_of v) =  
  55.548 -        (let pv = number_of (Int.pred v) in  
  55.549 -         if neg pv then False else n <= nat pv)"
  55.550 -by (simp add: Let_def less_number_of_Suc linorder_not_less [symmetric])
  55.551 -
  55.552 -
  55.553 -lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
  55.554 -by auto
  55.555 -
  55.556 -
  55.557 -
  55.558 -subsection{*Max and Min Combined with @{term Suc} *}
  55.559 -
  55.560 -lemma max_number_of_Suc [simp]:
  55.561 -     "max (Suc n) (number_of v) =  
  55.562 -        (let pv = number_of (Int.pred v) in  
  55.563 -         if neg pv then Suc n else Suc(max n (nat pv)))"
  55.564 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  55.565 -            split add: split_if nat.split)
  55.566 -apply (rule_tac x = "number_of v" in spec) 
  55.567 -apply auto
  55.568 -done
  55.569 - 
  55.570 -lemma max_Suc_number_of [simp]:
  55.571 -     "max (number_of v) (Suc n) =  
  55.572 -        (let pv = number_of (Int.pred v) in  
  55.573 -         if neg pv then Suc n else Suc(max (nat pv) n))"
  55.574 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  55.575 -            split add: split_if nat.split)
  55.576 -apply (rule_tac x = "number_of v" in spec) 
  55.577 -apply auto
  55.578 -done
  55.579 - 
  55.580 -lemma min_number_of_Suc [simp]:
  55.581 -     "min (Suc n) (number_of v) =  
  55.582 -        (let pv = number_of (Int.pred v) in  
  55.583 -         if neg pv then 0 else Suc(min n (nat pv)))"
  55.584 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  55.585 -            split add: split_if nat.split)
  55.586 -apply (rule_tac x = "number_of v" in spec) 
  55.587 -apply auto
  55.588 -done
  55.589 - 
  55.590 -lemma min_Suc_number_of [simp]:
  55.591 -     "min (number_of v) (Suc n) =  
  55.592 -        (let pv = number_of (Int.pred v) in  
  55.593 -         if neg pv then 0 else Suc(min (nat pv) n))"
  55.594 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  55.595 -            split add: split_if nat.split)
  55.596 -apply (rule_tac x = "number_of v" in spec) 
  55.597 -apply auto
  55.598 -done
  55.599 - 
  55.600 -subsection{*Literal arithmetic involving powers*}
  55.601 -
  55.602 -lemma nat_power_eq: "(0::int) <= z ==> nat (z^n) = nat z ^ n"
  55.603 -apply (induct "n")
  55.604 -apply (simp_all (no_asm_simp) add: nat_mult_distrib)
  55.605 -done
  55.606 -
  55.607 -lemma power_nat_number_of:
  55.608 -     "(number_of v :: nat) ^ n =  
  55.609 -       (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
  55.610 -by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
  55.611 -         split add: split_if cong: imp_cong)
  55.612 -
  55.613 -
  55.614 -lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w", standard]
  55.615 -declare power_nat_number_of_number_of [simp]
  55.616 -
  55.617 -
  55.618 -
  55.619 -text{*For arbitrary rings*}
  55.620 -
  55.621 -lemma power_number_of_even:
  55.622 -  fixes z :: "'a::{number_ring,recpower}"
  55.623 -  shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
  55.624 -unfolding Let_def nat_number_of_def number_of_Bit0
  55.625 -apply (rule_tac x = "number_of w" in spec, clarify)
  55.626 -apply (case_tac " (0::int) <= x")
  55.627 -apply (auto simp add: nat_mult_distrib power_even_eq power2_eq_square)
  55.628 -done
  55.629 -
  55.630 -lemma power_number_of_odd:
  55.631 -  fixes z :: "'a::{number_ring,recpower}"
  55.632 -  shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
  55.633 -     then (let w = z ^ (number_of w) in z * w * w) else 1)"
  55.634 -unfolding Let_def nat_number_of_def number_of_Bit1
  55.635 -apply (rule_tac x = "number_of w" in spec, auto)
  55.636 -apply (simp only: nat_add_distrib nat_mult_distrib)
  55.637 -apply simp
  55.638 -apply (auto simp add: nat_add_distrib nat_mult_distrib power_even_eq power2_eq_square neg_nat power_Suc)
  55.639 -done
  55.640 -
  55.641 -lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
  55.642 -lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
  55.643 -
  55.644 -lemmas power_number_of_even_number_of [simp] =
  55.645 -    power_number_of_even [of "number_of v", standard]
  55.646 -
  55.647 -lemmas power_number_of_odd_number_of [simp] =
  55.648 -    power_number_of_odd [of "number_of v", standard]
  55.649 -
  55.650 -
  55.651 -
  55.652 -ML
  55.653 -{*
  55.654 -val numeral_ss = @{simpset} addsimps @{thms numerals};
  55.655 -
  55.656 -val nat_bin_arith_setup =
  55.657 - Lin_Arith.map_data
  55.658 -   (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
  55.659 -     {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
  55.660 -      inj_thms = inj_thms,
  55.661 -      lessD = lessD, neqE = neqE,
  55.662 -      simpset = simpset addsimps @{thms neg_simps} @
  55.663 -        [@{thm Suc_nat_number_of}, @{thm int_nat_number_of}]})
  55.664 -*}
  55.665 -
  55.666 -declaration {* K nat_bin_arith_setup *}
  55.667 -
  55.668 -(* Enable arith to deal with div/mod k where k is a numeral: *)
  55.669 -declare split_div[of _ _ "number_of k", standard, arith_split]
  55.670 -declare split_mod[of _ _ "number_of k", standard, arith_split]
  55.671 -
  55.672 -lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
  55.673 -  by (simp add: number_of_Pls nat_number_of_def)
  55.674 -
  55.675 -lemma nat_number_of_Min: "number_of Int.Min = (0::nat)"
  55.676 -  apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
  55.677 -  done
  55.678 -
  55.679 -lemma nat_number_of_Bit0:
  55.680 -    "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
  55.681 -  unfolding nat_number_of_def number_of_is_id numeral_simps Let_def
  55.682 -  by auto
  55.683 -
  55.684 -lemma nat_number_of_Bit1:
  55.685 -  "number_of (Int.Bit1 w) =
  55.686 -    (if neg (number_of w :: int) then 0
  55.687 -     else let n = number_of w in Suc (n + n))"
  55.688 -  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def Let_def
  55.689 -  by auto
  55.690 -
  55.691 -lemmas nat_number =
  55.692 -  nat_number_of_Pls nat_number_of_Min
  55.693 -  nat_number_of_Bit0 nat_number_of_Bit1
  55.694 -
  55.695 -lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
  55.696 -  by (simp add: Let_def)
  55.697 -
  55.698 -lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring,recpower})"
  55.699 -by (simp add: power_mult power_Suc); 
  55.700 -
  55.701 -lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring,recpower})"
  55.702 -by (simp add: power_mult power_Suc); 
  55.703 -
  55.704 -
  55.705 -subsection{*Literal arithmetic and @{term of_nat}*}
  55.706 -
  55.707 -lemma of_nat_double:
  55.708 -     "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
  55.709 -by (simp only: mult_2 nat_add_distrib of_nat_add) 
  55.710 -
  55.711 -lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
  55.712 -by (simp only: nat_number_of_def)
  55.713 -
  55.714 -lemma of_nat_number_of_lemma:
  55.715 -     "of_nat (number_of v :: nat) =  
  55.716 -         (if 0 \<le> (number_of v :: int) 
  55.717 -          then (number_of v :: 'a :: number_ring)
  55.718 -          else 0)"
  55.719 -by (simp add: int_number_of_def nat_number_of_def number_of_eq of_nat_nat);
  55.720 -
  55.721 -lemma of_nat_number_of_eq [simp]:
  55.722 -     "of_nat (number_of v :: nat) =  
  55.723 -         (if neg (number_of v :: int) then 0  
  55.724 -          else (number_of v :: 'a :: number_ring))"
  55.725 -by (simp only: of_nat_number_of_lemma neg_def, simp) 
  55.726 -
  55.727 -
  55.728 -subsection {*Lemmas for the Combination and Cancellation Simprocs*}
  55.729 -
  55.730 -lemma nat_number_of_add_left:
  55.731 -     "number_of v + (number_of v' + (k::nat)) =  
  55.732 -         (if neg (number_of v :: int) then number_of v' + k  
  55.733 -          else if neg (number_of v' :: int) then number_of v + k  
  55.734 -          else number_of (v + v') + k)"
  55.735 -  unfolding nat_number_of_def number_of_is_id neg_def
  55.736 -  by auto
  55.737 -
  55.738 -lemma nat_number_of_mult_left:
  55.739 -     "number_of v * (number_of v' * (k::nat)) =  
  55.740 -         (if v < Int.Pls then 0
  55.741 -          else number_of (v * v') * k)"
  55.742 -by simp
  55.743 -
  55.744 -
  55.745 -subsubsection{*For @{text combine_numerals}*}
  55.746 -
  55.747 -lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)"
  55.748 -by (simp add: add_mult_distrib)
  55.749 -
  55.750 -
  55.751 -subsubsection{*For @{text cancel_numerals}*}
  55.752 -
  55.753 -lemma nat_diff_add_eq1:
  55.754 -     "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)"
  55.755 -by (simp split add: nat_diff_split add: add_mult_distrib)
  55.756 -
  55.757 -lemma nat_diff_add_eq2:
  55.758 -     "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))"
  55.759 -by (simp split add: nat_diff_split add: add_mult_distrib)
  55.760 -
  55.761 -lemma nat_eq_add_iff1:
  55.762 -     "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)"
  55.763 -by (auto split add: nat_diff_split simp add: add_mult_distrib)
  55.764 -
  55.765 -lemma nat_eq_add_iff2:
  55.766 -     "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)"
  55.767 -by (auto split add: nat_diff_split simp add: add_mult_distrib)
  55.768 -
  55.769 -lemma nat_less_add_iff1:
  55.770 -     "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)"
  55.771 -by (auto split add: nat_diff_split simp add: add_mult_distrib)
  55.772 -
  55.773 -lemma nat_less_add_iff2:
  55.774 -     "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)"
  55.775 -by (auto split add: nat_diff_split simp add: add_mult_distrib)
  55.776 -
  55.777 -lemma nat_le_add_iff1:
  55.778 -     "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)"
  55.779 -by (auto split add: nat_diff_split simp add: add_mult_distrib)
  55.780 -
  55.781 -lemma nat_le_add_iff2:
  55.782 -     "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)"
  55.783 -by (auto split add: nat_diff_split simp add: add_mult_distrib)
  55.784 -
  55.785 -
  55.786 -subsubsection{*For @{text cancel_numeral_factors} *}
  55.787 -
  55.788 -lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)"
  55.789 -by auto
  55.790 -
  55.791 -lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m<n)"
  55.792 -by auto
  55.793 -
  55.794 -lemma nat_mult_eq_cancel1: "(0::nat) < k ==> (k*m = k*n) = (m=n)"
  55.795 -by auto
  55.796 -
  55.797 -lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)"
  55.798 -by auto
  55.799 -
  55.800 -lemma nat_mult_dvd_cancel_disj[simp]:
  55.801 -  "(k*m) dvd (k*n) = (k=0 | m dvd (n::nat))"
  55.802 -by(auto simp: dvd_eq_mod_eq_0 mod_mult_distrib2[symmetric])
  55.803 -
  55.804 -lemma nat_mult_dvd_cancel1: "0 < k \<Longrightarrow> (k*m) dvd (k*n::nat) = (m dvd n)"
  55.805 -by(auto)
  55.806 -
  55.807 -
  55.808 -subsubsection{*For @{text cancel_factor} *}
  55.809 -
  55.810 -lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)"
  55.811 -by auto
  55.812 -
  55.813 -lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m<n)"
  55.814 -by auto
  55.815 -
  55.816 -lemma nat_mult_eq_cancel_disj: "(k*m = k*n) = (k = (0::nat) | m=n)"
  55.817 -by auto
  55.818 -
  55.819 -lemma nat_mult_div_cancel_disj[simp]:
  55.820 -     "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)"
  55.821 -by (simp add: nat_mult_div_cancel1)
  55.822 -
  55.823 -
  55.824 -subsection {* Simprocs for the Naturals *}
  55.825 -
  55.826 -use "Tools/nat_simprocs.ML"
  55.827 -declaration {* K nat_simprocs_setup *}
  55.828 -
  55.829 -subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
  55.830 -
  55.831 -text{*Where K above is a literal*}
  55.832 -
  55.833 -lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
  55.834 -by (simp add: numeral_0_eq_0 numeral_1_eq_1 split add: nat_diff_split)
  55.835 -
  55.836 -text {*Now just instantiating @{text n} to @{text "number_of v"} does
  55.837 -  the right simplification, but with some redundant inequality
  55.838 -  tests.*}
  55.839 -lemma neg_number_of_pred_iff_0:
  55.840 -  "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
  55.841 -apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
  55.842 -apply (simp only: less_Suc_eq_le le_0_eq)
  55.843 -apply (subst less_number_of_Suc, simp)
  55.844 -done
  55.845 -
  55.846 -text{*No longer required as a simprule because of the @{text inverse_fold}
  55.847 -   simproc*}
  55.848 -lemma Suc_diff_number_of:
  55.849 -     "Int.Pls < v ==>
  55.850 -      Suc m - (number_of v) = m - (number_of (Int.pred v))"
  55.851 -apply (subst Suc_diff_eq_diff_pred)
  55.852 -apply simp
  55.853 -apply (simp del: nat_numeral_1_eq_1)
  55.854 -apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
  55.855 -                        neg_number_of_pred_iff_0)
  55.856 -done
  55.857 -
  55.858 -lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
  55.859 -by (simp add: numerals split add: nat_diff_split)
  55.860 -
  55.861 -
  55.862 -subsubsection{*For @{term nat_case} and @{term nat_rec}*}
  55.863 -
  55.864 -lemma nat_case_number_of [simp]:
  55.865 -     "nat_case a f (number_of v) =
  55.866 -        (let pv = number_of (Int.pred v) in
  55.867 -         if neg pv then a else f (nat pv))"
  55.868 -by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
  55.869 -
  55.870 -lemma nat_case_add_eq_if [simp]:
  55.871 -     "nat_case a f ((number_of v) + n) =
  55.872 -       (let pv = number_of (Int.pred v) in
  55.873 -         if neg pv then nat_case a f n else f (nat pv + n))"
  55.874 -apply (subst add_eq_if)
  55.875 -apply (simp split add: nat.split
  55.876 -            del: nat_numeral_1_eq_1
  55.877 -            add: nat_numeral_1_eq_1 [symmetric]
  55.878 -                 numeral_1_eq_Suc_0 [symmetric]
  55.879 -                 neg_number_of_pred_iff_0)
  55.880 -done
  55.881 -
  55.882 -lemma nat_rec_number_of [simp]:
  55.883 -     "nat_rec a f (number_of v) =
  55.884 -        (let pv = number_of (Int.pred v) in
  55.885 -         if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
  55.886 -apply (case_tac " (number_of v) ::nat")
  55.887 -apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
  55.888 -apply (simp split add: split_if_asm)
  55.889 -done
  55.890 -
  55.891 -lemma nat_rec_add_eq_if [simp]:
  55.892 -     "nat_rec a f (number_of v + n) =
  55.893 -        (let pv = number_of (Int.pred v) in
  55.894 -         if neg pv then nat_rec a f n
  55.895 -                   else f (nat pv + n) (nat_rec a f (nat pv + n)))"
  55.896 -apply (subst add_eq_if)
  55.897 -apply (simp split add: nat.split
  55.898 -            del: nat_numeral_1_eq_1
  55.899 -            add: nat_numeral_1_eq_1 [symmetric]
  55.900 -                 numeral_1_eq_Suc_0 [symmetric]
  55.901 -                 neg_number_of_pred_iff_0)
  55.902 -done
  55.903 -
  55.904 -
  55.905 -subsubsection{*Various Other Lemmas*}
  55.906 -
  55.907 -text {*Evens and Odds, for Mutilated Chess Board*}
  55.908 -
  55.909 -text{*Lemmas for specialist use, NOT as default simprules*}
  55.910 -lemma nat_mult_2: "2 * z = (z+z::nat)"
  55.911 -proof -
  55.912 -  have "2*z = (1 + 1)*z" by simp
  55.913 -  also have "... = z+z" by (simp add: left_distrib)
  55.914 -  finally show ?thesis .
  55.915 -qed
  55.916 -
  55.917 -lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
  55.918 -by (subst mult_commute, rule nat_mult_2)
  55.919 -
  55.920 -text{*Case analysis on @{term "n<2"}*}
  55.921 -lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
  55.922 -by arith
  55.923 -
  55.924 -lemma div2_Suc_Suc [simp]: "Suc(Suc m) div 2 = Suc (m div 2)"
  55.925 -by arith
  55.926 -
  55.927 -lemma add_self_div_2 [simp]: "(m + m) div 2 = (m::nat)"
  55.928 -by (simp add: nat_mult_2 [symmetric])
  55.929 -
  55.930 -lemma mod2_Suc_Suc [simp]: "Suc(Suc(m)) mod 2 = m mod 2"
  55.931 -apply (subgoal_tac "m mod 2 < 2")
  55.932 -apply (erule less_2_cases [THEN disjE])
  55.933 -apply (simp_all (no_asm_simp) add: Let_def mod_Suc nat_1)
  55.934 -done
  55.935 -
  55.936 -lemma mod2_gr_0 [simp]: "!!m::nat. (0 < m mod 2) = (m mod 2 = 1)"
  55.937 -apply (subgoal_tac "m mod 2 < 2")
  55.938 -apply (force simp del: mod_less_divisor, simp)
  55.939 -done
  55.940 -
  55.941 -text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
  55.942 -
  55.943 -lemma add_2_eq_Suc [simp]: "2 + n = Suc (Suc n)"
  55.944 -by simp
  55.945 -
  55.946 -lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)"
  55.947 -by simp
  55.948 -
  55.949 -text{*Can be used to eliminate long strings of Sucs, but not by default*}
  55.950 -lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
  55.951 -by simp
  55.952 -
  55.953 -
  55.954 -text{*These lemmas collapse some needless occurrences of Suc:
  55.955 -    at least three Sucs, since two and fewer are rewritten back to Suc again!
  55.956 -    We already have some rules to simplify operands smaller than 3.*}
  55.957 -
  55.958 -lemma div_Suc_eq_div_add3 [simp]: "m div (Suc (Suc (Suc n))) = m div (3+n)"
  55.959 -by (simp add: Suc3_eq_add_3)
  55.960 -
  55.961 -lemma mod_Suc_eq_mod_add3 [simp]: "m mod (Suc (Suc (Suc n))) = m mod (3+n)"
  55.962 -by (simp add: Suc3_eq_add_3)
  55.963 -
  55.964 -lemma Suc_div_eq_add3_div: "(Suc (Suc (Suc m))) div n = (3+m) div n"
  55.965 -by (simp add: Suc3_eq_add_3)
  55.966 -
  55.967 -lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
  55.968 -by (simp add: Suc3_eq_add_3)
  55.969 -
  55.970 -lemmas Suc_div_eq_add3_div_number_of =
  55.971 -    Suc_div_eq_add3_div [of _ "number_of v", standard]
  55.972 -declare Suc_div_eq_add3_div_number_of [simp]
  55.973 -
  55.974 -lemmas Suc_mod_eq_add3_mod_number_of =
  55.975 -    Suc_mod_eq_add3_mod [of _ "number_of v", standard]
  55.976 -declare Suc_mod_eq_add3_mod_number_of [simp]
  55.977 -
  55.978 -end
    56.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    56.2 +++ b/src/HOL/Nat_Numeral.thy	Mon Apr 27 07:26:17 2009 -0700
    56.3 @@ -0,0 +1,980 @@
    56.4 +(*  Title:      HOL/Nat_Numeral.thy
    56.5 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    56.6 +    Copyright   1999  University of Cambridge
    56.7 +*)
    56.8 +
    56.9 +header {* Binary numerals for the natural numbers *}
   56.10 +
   56.11 +theory Nat_Numeral
   56.12 +imports IntDiv
   56.13 +uses ("Tools/nat_simprocs.ML")
   56.14 +begin
   56.15 +
   56.16 +text {*
   56.17 +  Arithmetic for naturals is reduced to that for the non-negative integers.
   56.18 +*}
   56.19 +
   56.20 +instantiation nat :: number
   56.21 +begin
   56.22 +
   56.23 +definition
   56.24 +  nat_number_of_def [code inline, code del]: "number_of v = nat (number_of v)"
   56.25 +
   56.26 +instance ..
   56.27 +
   56.28 +end
   56.29 +
   56.30 +lemma [code post]:
   56.31 +  "nat (number_of v) = number_of v"
   56.32 +  unfolding nat_number_of_def ..
   56.33 +
   56.34 +context recpower
   56.35 +begin
   56.36 +
   56.37 +abbreviation (xsymbols)
   56.38 +  power2 :: "'a \<Rightarrow> 'a"  ("(_\<twosuperior>)" [1000] 999) where
   56.39 +  "x\<twosuperior> \<equiv> x ^ 2"
   56.40 +
   56.41 +notation (latex output)
   56.42 +  power2  ("(_\<twosuperior>)" [1000] 999)
   56.43 +
   56.44 +notation (HTML output)
   56.45 +  power2  ("(_\<twosuperior>)" [1000] 999)
   56.46 +
   56.47 +end
   56.48 +
   56.49 +
   56.50 +subsection {* Predicate for negative binary numbers *}
   56.51 +
   56.52 +definition neg  :: "int \<Rightarrow> bool" where
   56.53 +  "neg Z \<longleftrightarrow> Z < 0"
   56.54 +
   56.55 +lemma not_neg_int [simp]: "~ neg (of_nat n)"
   56.56 +by (simp add: neg_def)
   56.57 +
   56.58 +lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
   56.59 +by (simp add: neg_def neg_less_0_iff_less del: of_nat_Suc)
   56.60 +
   56.61 +lemmas neg_eq_less_0 = neg_def
   56.62 +
   56.63 +lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
   56.64 +by (simp add: neg_def linorder_not_less)
   56.65 +
   56.66 +text{*To simplify inequalities when Numeral1 can get simplified to 1*}
   56.67 +
   56.68 +lemma not_neg_0: "~ neg 0"
   56.69 +by (simp add: One_int_def neg_def)
   56.70 +
   56.71 +lemma not_neg_1: "~ neg 1"
   56.72 +by (simp add: neg_def linorder_not_less zero_le_one)
   56.73 +
   56.74 +lemma neg_nat: "neg z ==> nat z = 0"
   56.75 +by (simp add: neg_def order_less_imp_le) 
   56.76 +
   56.77 +lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
   56.78 +by (simp add: linorder_not_less neg_def)
   56.79 +
   56.80 +text {*
   56.81 +  If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
   56.82 +  @{term Numeral0} IS @{term "number_of Pls"}
   56.83 +*}
   56.84 +
   56.85 +lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
   56.86 +  by (simp add: neg_def)
   56.87 +
   56.88 +lemma neg_number_of_Min: "neg (number_of Int.Min)"
   56.89 +  by (simp add: neg_def)
   56.90 +
   56.91 +lemma neg_number_of_Bit0:
   56.92 +  "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
   56.93 +  by (simp add: neg_def)
   56.94 +
   56.95 +lemma neg_number_of_Bit1:
   56.96 +  "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
   56.97 +  by (simp add: neg_def)
   56.98 +
   56.99 +lemmas neg_simps [simp] =
  56.100 +  not_neg_0 not_neg_1
  56.101 +  not_neg_number_of_Pls neg_number_of_Min
  56.102 +  neg_number_of_Bit0 neg_number_of_Bit1
  56.103 +
  56.104 +
  56.105 +subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
  56.106 +
  56.107 +declare nat_0 [simp] nat_1 [simp]
  56.108 +
  56.109 +lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
  56.110 +by (simp add: nat_number_of_def)
  56.111 +
  56.112 +lemma nat_numeral_0_eq_0 [simp]: "Numeral0 = (0::nat)"
  56.113 +by (simp add: nat_number_of_def)
  56.114 +
  56.115 +lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)"
  56.116 +by (simp add: nat_1 nat_number_of_def)
  56.117 +
  56.118 +lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
  56.119 +by (simp add: nat_numeral_1_eq_1)
  56.120 +
  56.121 +lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
  56.122 +apply (unfold nat_number_of_def)
  56.123 +apply (rule nat_2)
  56.124 +done
  56.125 +
  56.126 +
  56.127 +subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
  56.128 +
  56.129 +lemma int_nat_number_of [simp]:
  56.130 +     "int (number_of v) =  
  56.131 +         (if neg (number_of v :: int) then 0  
  56.132 +          else (number_of v :: int))"
  56.133 +  unfolding nat_number_of_def number_of_is_id neg_def
  56.134 +  by simp
  56.135 +
  56.136 +
  56.137 +subsubsection{*Successor *}
  56.138 +
  56.139 +lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)"
  56.140 +apply (rule sym)
  56.141 +apply (simp add: nat_eq_iff int_Suc)
  56.142 +done
  56.143 +
  56.144 +lemma Suc_nat_number_of_add:
  56.145 +     "Suc (number_of v + n) =  
  56.146 +        (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
  56.147 +  unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
  56.148 +  by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
  56.149 +
  56.150 +lemma Suc_nat_number_of [simp]:
  56.151 +     "Suc (number_of v) =  
  56.152 +        (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
  56.153 +apply (cut_tac n = 0 in Suc_nat_number_of_add)
  56.154 +apply (simp cong del: if_weak_cong)
  56.155 +done
  56.156 +
  56.157 +
  56.158 +subsubsection{*Addition *}
  56.159 +
  56.160 +lemma add_nat_number_of [simp]:
  56.161 +     "(number_of v :: nat) + number_of v' =  
  56.162 +         (if v < Int.Pls then number_of v'  
  56.163 +          else if v' < Int.Pls then number_of v  
  56.164 +          else number_of (v + v'))"
  56.165 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.166 +  by (simp add: nat_add_distrib)
  56.167 +
  56.168 +lemma nat_number_of_add_1 [simp]:
  56.169 +  "number_of v + (1::nat) =
  56.170 +    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  56.171 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.172 +  by (simp add: nat_add_distrib)
  56.173 +
  56.174 +lemma nat_1_add_number_of [simp]:
  56.175 +  "(1::nat) + number_of v =
  56.176 +    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  56.177 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.178 +  by (simp add: nat_add_distrib)
  56.179 +
  56.180 +lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
  56.181 +  by (rule int_int_eq [THEN iffD1]) simp
  56.182 +
  56.183 +
  56.184 +subsubsection{*Subtraction *}
  56.185 +
  56.186 +lemma diff_nat_eq_if:
  56.187 +     "nat z - nat z' =  
  56.188 +        (if neg z' then nat z   
  56.189 +         else let d = z-z' in     
  56.190 +              if neg d then 0 else nat d)"
  56.191 +by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
  56.192 +
  56.193 +
  56.194 +lemma diff_nat_number_of [simp]: 
  56.195 +     "(number_of v :: nat) - number_of v' =  
  56.196 +        (if v' < Int.Pls then number_of v  
  56.197 +         else let d = number_of (v + uminus v') in     
  56.198 +              if neg d then 0 else nat d)"
  56.199 +  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
  56.200 +  by auto
  56.201 +
  56.202 +lemma nat_number_of_diff_1 [simp]:
  56.203 +  "number_of v - (1::nat) =
  56.204 +    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
  56.205 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.206 +  by auto
  56.207 +
  56.208 +
  56.209 +subsubsection{*Multiplication *}
  56.210 +
  56.211 +lemma mult_nat_number_of [simp]:
  56.212 +     "(number_of v :: nat) * number_of v' =  
  56.213 +       (if v < Int.Pls then 0 else number_of (v * v'))"
  56.214 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.215 +  by (simp add: nat_mult_distrib)
  56.216 +
  56.217 +
  56.218 +subsubsection{*Quotient *}
  56.219 +
  56.220 +lemma div_nat_number_of [simp]:
  56.221 +     "(number_of v :: nat)  div  number_of v' =  
  56.222 +          (if neg (number_of v :: int) then 0  
  56.223 +           else nat (number_of v div number_of v'))"
  56.224 +  unfolding nat_number_of_def number_of_is_id neg_def
  56.225 +  by (simp add: nat_div_distrib)
  56.226 +
  56.227 +lemma one_div_nat_number_of [simp]:
  56.228 +     "Suc 0 div number_of v' = nat (1 div number_of v')" 
  56.229 +by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) 
  56.230 +
  56.231 +
  56.232 +subsubsection{*Remainder *}
  56.233 +
  56.234 +lemma mod_nat_number_of [simp]:
  56.235 +     "(number_of v :: nat)  mod  number_of v' =  
  56.236 +        (if neg (number_of v :: int) then 0  
  56.237 +         else if neg (number_of v' :: int) then number_of v  
  56.238 +         else nat (number_of v mod number_of v'))"
  56.239 +  unfolding nat_number_of_def number_of_is_id neg_def
  56.240 +  by (simp add: nat_mod_distrib)
  56.241 +
  56.242 +lemma one_mod_nat_number_of [simp]:
  56.243 +     "Suc 0 mod number_of v' =  
  56.244 +        (if neg (number_of v' :: int) then Suc 0
  56.245 +         else nat (1 mod number_of v'))"
  56.246 +by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) 
  56.247 +
  56.248 +
  56.249 +subsubsection{* Divisibility *}
  56.250 +
  56.251 +lemmas dvd_eq_mod_eq_0_number_of =
  56.252 +  dvd_eq_mod_eq_0 [of "number_of x" "number_of y", standard]
  56.253 +
  56.254 +declare dvd_eq_mod_eq_0_number_of [simp]
  56.255 +
  56.256 +ML
  56.257 +{*
  56.258 +val nat_number_of_def = thm"nat_number_of_def";
  56.259 +
  56.260 +val nat_number_of = thm"nat_number_of";
  56.261 +val nat_numeral_0_eq_0 = thm"nat_numeral_0_eq_0";
  56.262 +val nat_numeral_1_eq_1 = thm"nat_numeral_1_eq_1";
  56.263 +val numeral_1_eq_Suc_0 = thm"numeral_1_eq_Suc_0";
  56.264 +val numeral_2_eq_2 = thm"numeral_2_eq_2";
  56.265 +val nat_div_distrib = thm"nat_div_distrib";
  56.266 +val nat_mod_distrib = thm"nat_mod_distrib";
  56.267 +val int_nat_number_of = thm"int_nat_number_of";
  56.268 +val Suc_nat_eq_nat_zadd1 = thm"Suc_nat_eq_nat_zadd1";
  56.269 +val Suc_nat_number_of_add = thm"Suc_nat_number_of_add";
  56.270 +val Suc_nat_number_of = thm"Suc_nat_number_of";
  56.271 +val add_nat_number_of = thm"add_nat_number_of";
  56.272 +val diff_nat_eq_if = thm"diff_nat_eq_if";
  56.273 +val diff_nat_number_of = thm"diff_nat_number_of";
  56.274 +val mult_nat_number_of = thm"mult_nat_number_of";
  56.275 +val div_nat_number_of = thm"div_nat_number_of";
  56.276 +val mod_nat_number_of = thm"mod_nat_number_of";
  56.277 +*}
  56.278 +
  56.279 +
  56.280 +subsection{*Comparisons*}
  56.281 +
  56.282 +subsubsection{*Equals (=) *}
  56.283 +
  56.284 +lemma eq_nat_nat_iff:
  56.285 +     "[| (0::int) <= z;  0 <= z' |] ==> (nat z = nat z') = (z=z')"
  56.286 +by (auto elim!: nonneg_eq_int)
  56.287 +
  56.288 +lemma eq_nat_number_of [simp]:
  56.289 +     "((number_of v :: nat) = number_of v') =  
  56.290 +      (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
  56.291 +       else if neg (number_of v' :: int) then (number_of v :: int) = 0
  56.292 +       else v = v')"
  56.293 +  unfolding nat_number_of_def number_of_is_id neg_def
  56.294 +  by auto
  56.295 +
  56.296 +
  56.297 +subsubsection{*Less-than (<) *}
  56.298 +
  56.299 +lemma less_nat_number_of [simp]:
  56.300 +  "(number_of v :: nat) < number_of v' \<longleftrightarrow>
  56.301 +    (if v < v' then Int.Pls < v' else False)"
  56.302 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.303 +  by auto
  56.304 +
  56.305 +
  56.306 +subsubsection{*Less-than-or-equal *}
  56.307 +
  56.308 +lemma le_nat_number_of [simp]:
  56.309 +  "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
  56.310 +    (if v \<le> v' then True else v \<le> Int.Pls)"
  56.311 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.312 +  by auto
  56.313 +
  56.314 +(*Maps #n to n for n = 0, 1, 2*)
  56.315 +lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
  56.316 +
  56.317 +
  56.318 +subsection{*Powers with Numeric Exponents*}
  56.319 +
  56.320 +text{*We cannot refer to the number @{term 2} in @{text Ring_and_Field.thy}.
  56.321 +We cannot prove general results about the numeral @{term "-1"}, so we have to
  56.322 +use @{term "- 1"} instead.*}
  56.323 +
  56.324 +lemma power2_eq_square: "(a::'a::recpower)\<twosuperior> = a * a"
  56.325 +  by (simp add: numeral_2_eq_2 Power.power_Suc)
  56.326 +
  56.327 +lemma zero_power2 [simp]: "(0::'a::{semiring_1,recpower})\<twosuperior> = 0"
  56.328 +  by (simp add: power2_eq_square)
  56.329 +
  56.330 +lemma one_power2 [simp]: "(1::'a::{semiring_1,recpower})\<twosuperior> = 1"
  56.331 +  by (simp add: power2_eq_square)
  56.332 +
  56.333 +lemma power3_eq_cube: "(x::'a::recpower) ^ 3 = x * x * x"
  56.334 +  apply (subgoal_tac "3 = Suc (Suc (Suc 0))")
  56.335 +  apply (erule ssubst)
  56.336 +  apply (simp add: power_Suc mult_ac)
  56.337 +  apply (unfold nat_number_of_def)
  56.338 +  apply (subst nat_eq_iff)
  56.339 +  apply simp
  56.340 +done
  56.341 +
  56.342 +text{*Squares of literal numerals will be evaluated.*}
  56.343 +lemmas power2_eq_square_number_of =
  56.344 +    power2_eq_square [of "number_of w", standard]
  56.345 +declare power2_eq_square_number_of [simp]
  56.346 +
  56.347 +
  56.348 +lemma zero_le_power2[simp]: "0 \<le> (a\<twosuperior>::'a::{ordered_idom,recpower})"
  56.349 +  by (simp add: power2_eq_square)
  56.350 +
  56.351 +lemma zero_less_power2[simp]:
  56.352 +     "(0 < a\<twosuperior>) = (a \<noteq> (0::'a::{ordered_idom,recpower}))"
  56.353 +  by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff)
  56.354 +
  56.355 +lemma power2_less_0[simp]:
  56.356 +  fixes a :: "'a::{ordered_idom,recpower}"
  56.357 +  shows "~ (a\<twosuperior> < 0)"
  56.358 +by (force simp add: power2_eq_square mult_less_0_iff) 
  56.359 +
  56.360 +lemma zero_eq_power2[simp]:
  56.361 +     "(a\<twosuperior> = 0) = (a = (0::'a::{ordered_idom,recpower}))"
  56.362 +  by (force simp add: power2_eq_square mult_eq_0_iff)
  56.363 +
  56.364 +lemma abs_power2[simp]:
  56.365 +     "abs(a\<twosuperior>) = (a\<twosuperior>::'a::{ordered_idom,recpower})"
  56.366 +  by (simp add: power2_eq_square abs_mult abs_mult_self)
  56.367 +
  56.368 +lemma power2_abs[simp]:
  56.369 +     "(abs a)\<twosuperior> = (a\<twosuperior>::'a::{ordered_idom,recpower})"
  56.370 +  by (simp add: power2_eq_square abs_mult_self)
  56.371 +
  56.372 +lemma power2_minus[simp]:
  56.373 +     "(- a)\<twosuperior> = (a\<twosuperior>::'a::{comm_ring_1,recpower})"
  56.374 +  by (simp add: power2_eq_square)
  56.375 +
  56.376 +lemma power2_le_imp_le:
  56.377 +  fixes x y :: "'a::{ordered_semidom,recpower}"
  56.378 +  shows "\<lbrakk>x\<twosuperior> \<le> y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x \<le> y"
  56.379 +unfolding numeral_2_eq_2 by (rule power_le_imp_le_base)
  56.380 +
  56.381 +lemma power2_less_imp_less:
  56.382 +  fixes x y :: "'a::{ordered_semidom,recpower}"
  56.383 +  shows "\<lbrakk>x\<twosuperior> < y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x < y"
  56.384 +by (rule power_less_imp_less_base)
  56.385 +
  56.386 +lemma power2_eq_imp_eq:
  56.387 +  fixes x y :: "'a::{ordered_semidom,recpower}"
  56.388 +  shows "\<lbrakk>x\<twosuperior> = y\<twosuperior>; 0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> x = y"
  56.389 +unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base, simp)
  56.390 +
  56.391 +lemma power_minus1_even[simp]: "(- 1) ^ (2*n) = (1::'a::{comm_ring_1,recpower})"
  56.392 +proof (induct n)
  56.393 +  case 0 show ?case by simp
  56.394 +next
  56.395 +  case (Suc n) then show ?case by (simp add: power_Suc power_add)
  56.396 +qed
  56.397 +
  56.398 +lemma power_minus1_odd: "(- 1) ^ Suc(2*n) = -(1::'a::{comm_ring_1,recpower})"
  56.399 +  by (simp add: power_Suc) 
  56.400 +
  56.401 +lemma power_even_eq: "(a::'a::recpower) ^ (2*n) = (a^n)^2"
  56.402 +  by (subst mult_commute) (simp add: power_mult)
  56.403 +
  56.404 +lemma power_odd_eq: "(a::int) ^ Suc(2*n) = a * (a^n)^2"
  56.405 +  by (simp add: power_even_eq)
  56.406 +
  56.407 +lemma power_minus_even [simp]:
  56.408 +  "(-a) ^ (2*n) = (a::'a::{comm_ring_1,recpower}) ^ (2*n)"
  56.409 +  by (simp add: power_minus [of a]) 
  56.410 +
  56.411 +lemma zero_le_even_power'[simp]:
  56.412 +     "0 \<le> (a::'a::{ordered_idom,recpower}) ^ (2*n)"
  56.413 +proof (induct "n")
  56.414 +  case 0
  56.415 +    show ?case by (simp add: zero_le_one)
  56.416 +next
  56.417 +  case (Suc n)
  56.418 +    have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)" 
  56.419 +      by (simp add: mult_ac power_add power2_eq_square)
  56.420 +    thus ?case
  56.421 +      by (simp add: prems zero_le_mult_iff)
  56.422 +qed
  56.423 +
  56.424 +lemma odd_power_less_zero:
  56.425 +     "(a::'a::{ordered_idom,recpower}) < 0 ==> a ^ Suc(2*n) < 0"
  56.426 +proof (induct "n")
  56.427 +  case 0
  56.428 +  then show ?case by simp
  56.429 +next
  56.430 +  case (Suc n)
  56.431 +  have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)"
  56.432 +    by (simp add: mult_ac power_add power2_eq_square)
  56.433 +  thus ?case
  56.434 +    by (simp del: power_Suc add: prems mult_less_0_iff mult_neg_neg)
  56.435 +qed
  56.436 +
  56.437 +lemma odd_0_le_power_imp_0_le:
  56.438 +     "0 \<le> a  ^ Suc(2*n) ==> 0 \<le> (a::'a::{ordered_idom,recpower})"
  56.439 +apply (insert odd_power_less_zero [of a n]) 
  56.440 +apply (force simp add: linorder_not_less [symmetric]) 
  56.441 +done
  56.442 +
  56.443 +text{*Simprules for comparisons where common factors can be cancelled.*}
  56.444 +lemmas zero_compare_simps =
  56.445 +    add_strict_increasing add_strict_increasing2 add_increasing
  56.446 +    zero_le_mult_iff zero_le_divide_iff 
  56.447 +    zero_less_mult_iff zero_less_divide_iff 
  56.448 +    mult_le_0_iff divide_le_0_iff 
  56.449 +    mult_less_0_iff divide_less_0_iff 
  56.450 +    zero_le_power2 power2_less_0
  56.451 +
  56.452 +subsubsection{*Nat *}
  56.453 +
  56.454 +lemma Suc_pred': "0 < n ==> n = Suc(n - 1)"
  56.455 +by (simp add: numerals)
  56.456 +
  56.457 +(*Expresses a natural number constant as the Suc of another one.
  56.458 +  NOT suitable for rewriting because n recurs in the condition.*)
  56.459 +lemmas expand_Suc = Suc_pred' [of "number_of v", standard]
  56.460 +
  56.461 +subsubsection{*Arith *}
  56.462 +
  56.463 +lemma Suc_eq_add_numeral_1: "Suc n = n + 1"
  56.464 +by (simp add: numerals)
  56.465 +
  56.466 +lemma Suc_eq_add_numeral_1_left: "Suc n = 1 + n"
  56.467 +by (simp add: numerals)
  56.468 +
  56.469 +(* These two can be useful when m = number_of... *)
  56.470 +
  56.471 +lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
  56.472 +  unfolding One_nat_def by (cases m) simp_all
  56.473 +
  56.474 +lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
  56.475 +  unfolding One_nat_def by (cases m) simp_all
  56.476 +
  56.477 +lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
  56.478 +  unfolding One_nat_def by (cases m) simp_all
  56.479 +
  56.480 +
  56.481 +subsection{*Comparisons involving (0::nat) *}
  56.482 +
  56.483 +text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
  56.484 +
  56.485 +lemma eq_number_of_0 [simp]:
  56.486 +  "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
  56.487 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.488 +  by auto
  56.489 +
  56.490 +lemma eq_0_number_of [simp]:
  56.491 +  "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
  56.492 +by (rule trans [OF eq_sym_conv eq_number_of_0])
  56.493 +
  56.494 +lemma less_0_number_of [simp]:
  56.495 +   "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
  56.496 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  56.497 +  by simp
  56.498 +
  56.499 +lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
  56.500 +by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
  56.501 +
  56.502 +
  56.503 +
  56.504 +subsection{*Comparisons involving  @{term Suc} *}
  56.505 +
  56.506 +lemma eq_number_of_Suc [simp]:
  56.507 +     "(number_of v = Suc n) =  
  56.508 +        (let pv = number_of (Int.pred v) in  
  56.509 +         if neg pv then False else nat pv = n)"
  56.510 +apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  56.511 +                  number_of_pred nat_number_of_def 
  56.512 +            split add: split_if)
  56.513 +apply (rule_tac x = "number_of v" in spec)
  56.514 +apply (auto simp add: nat_eq_iff)
  56.515 +done
  56.516 +
  56.517 +lemma Suc_eq_number_of [simp]:
  56.518 +     "(Suc n = number_of v) =  
  56.519 +        (let pv = number_of (Int.pred v) in  
  56.520 +         if neg pv then False else nat pv = n)"
  56.521 +by (rule trans [OF eq_sym_conv eq_number_of_Suc])
  56.522 +
  56.523 +lemma less_number_of_Suc [simp]:
  56.524 +     "(number_of v < Suc n) =  
  56.525 +        (let pv = number_of (Int.pred v) in  
  56.526 +         if neg pv then True else nat pv < n)"
  56.527 +apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  56.528 +                  number_of_pred nat_number_of_def  
  56.529 +            split add: split_if)
  56.530 +apply (rule_tac x = "number_of v" in spec)
  56.531 +apply (auto simp add: nat_less_iff)
  56.532 +done
  56.533 +
  56.534 +lemma less_Suc_number_of [simp]:
  56.535 +     "(Suc n < number_of v) =  
  56.536 +        (let pv = number_of (Int.pred v) in  
  56.537 +         if neg pv then False else n < nat pv)"
  56.538 +apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  56.539 +                  number_of_pred nat_number_of_def
  56.540 +            split add: split_if)
  56.541 +apply (rule_tac x = "number_of v" in spec)
  56.542 +apply (auto simp add: zless_nat_eq_int_zless)
  56.543 +done
  56.544 +
  56.545 +lemma le_number_of_Suc [simp]:
  56.546 +     "(number_of v <= Suc n) =  
  56.547 +        (let pv = number_of (Int.pred v) in  
  56.548 +         if neg pv then True else nat pv <= n)"
  56.549 +by (simp add: Let_def less_Suc_number_of linorder_not_less [symmetric])
  56.550 +
  56.551 +lemma le_Suc_number_of [simp]:
  56.552 +     "(Suc n <= number_of v) =  
  56.553 +        (let pv = number_of (Int.pred v) in  
  56.554 +         if neg pv then False else n <= nat pv)"
  56.555 +by (simp add: Let_def less_number_of_Suc linorder_not_less [symmetric])
  56.556 +
  56.557 +
  56.558 +lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
  56.559 +by auto
  56.560 +
  56.561 +
  56.562 +
  56.563 +subsection{*Max and Min Combined with @{term Suc} *}
  56.564 +
  56.565 +lemma max_number_of_Suc [simp]:
  56.566 +     "max (Suc n) (number_of v) =  
  56.567 +        (let pv = number_of (Int.pred v) in  
  56.568 +         if neg pv then Suc n else Suc(max n (nat pv)))"
  56.569 +apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  56.570 +            split add: split_if nat.split)
  56.571 +apply (rule_tac x = "number_of v" in spec) 
  56.572 +apply auto
  56.573 +done
  56.574 + 
  56.575 +lemma max_Suc_number_of [simp]:
  56.576 +     "max (number_of v) (Suc n) =  
  56.577 +        (let pv = number_of (Int.pred v) in  
  56.578 +         if neg pv then Suc n else Suc(max (nat pv) n))"
  56.579 +apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  56.580 +            split add: split_if nat.split)
  56.581 +apply (rule_tac x = "number_of v" in spec) 
  56.582 +apply auto
  56.583 +done
  56.584 + 
  56.585 +lemma min_number_of_Suc [simp]:
  56.586 +     "min (Suc n) (number_of v) =  
  56.587 +        (let pv = number_of (Int.pred v) in  
  56.588 +         if neg pv then 0 else Suc(min n (nat pv)))"
  56.589 +apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  56.590 +            split add: split_if nat.split)
  56.591 +apply (rule_tac x = "number_of v" in spec) 
  56.592 +apply auto
  56.593 +done
  56.594 + 
  56.595 +lemma min_Suc_number_of [simp]:
  56.596 +     "min (number_of v) (Suc n) =  
  56.597 +        (let pv = number_of (Int.pred v) in  
  56.598 +         if neg pv then 0 else Suc(min (nat pv) n))"
  56.599 +apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  56.600 +            split add: split_if nat.split)
  56.601 +apply (rule_tac x = "number_of v" in spec) 
  56.602 +apply auto
  56.603 +done
  56.604 + 
  56.605 +subsection{*Literal arithmetic involving powers*}
  56.606 +
  56.607 +lemma nat_power_eq: "(0::int) <= z ==> nat (z^n) = nat z ^ n"
  56.608 +apply (induct "n")
  56.609 +apply (simp_all (no_asm_simp) add: nat_mult_distrib)
  56.610 +done
  56.611 +
  56.612 +lemma power_nat_number_of:
  56.613 +     "(number_of v :: nat) ^ n =  
  56.614 +       (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
  56.615 +by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
  56.616 +         split add: split_if cong: imp_cong)
  56.617 +
  56.618 +
  56.619 +lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w", standard]
  56.620 +declare power_nat_number_of_number_of [simp]
  56.621 +
  56.622 +
  56.623 +
  56.624 +text{*For arbitrary rings*}
  56.625 +
  56.626 +lemma power_number_of_even:
  56.627 +  fixes z :: "'a::{number_ring,recpower}"
  56.628 +  shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
  56.629 +unfolding Let_def nat_number_of_def number_of_Bit0
  56.630 +apply (rule_tac x = "number_of w" in spec, clarify)
  56.631 +apply (case_tac " (0::int) <= x")
  56.632 +apply (auto simp add: nat_mult_distrib power_even_eq power2_eq_square)
  56.633 +done
  56.634 +
  56.635 +lemma power_number_of_odd:
  56.636 +  fixes z :: "'a::{number_ring,recpower}"
  56.637 +  shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
  56.638 +     then (let w = z ^ (number_of w) in z * w * w) else 1)"
  56.639 +unfolding Let_def nat_number_of_def number_of_Bit1
  56.640 +apply (rule_tac x = "number_of w" in spec, auto)
  56.641 +apply (simp only: nat_add_distrib nat_mult_distrib)
  56.642 +apply simp
  56.643 +apply (auto simp add: nat_add_distrib nat_mult_distrib power_even_eq power2_eq_square neg_nat power_Suc)
  56.644 +done
  56.645 +
  56.646 +lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
  56.647 +lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
  56.648 +
  56.649 +lemmas power_number_of_even_number_of [simp] =
  56.650 +    power_number_of_even [of "number_of v", standard]
  56.651 +
  56.652 +lemmas power_number_of_odd_number_of [simp] =
  56.653 +    power_number_of_odd [of "number_of v", standard]
  56.654 +
  56.655 +
  56.656 +
  56.657 +ML
  56.658 +{*
  56.659 +val numeral_ss = @{simpset} addsimps @{thms numerals};
  56.660 +
  56.661 +val nat_bin_arith_setup =
  56.662 + Lin_Arith.map_data
  56.663 +   (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
  56.664 +     {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
  56.665 +      inj_thms = inj_thms,
  56.666 +      lessD = lessD, neqE = neqE,
  56.667 +      simpset = simpset addsimps @{thms neg_simps} @
  56.668 +        [@{thm Suc_nat_number_of}, @{thm int_nat_number_of}]})
  56.669 +*}
  56.670 +
  56.671 +declaration {* K nat_bin_arith_setup *}
  56.672 +
  56.673 +(* Enable arith to deal with div/mod k where k is a numeral: *)
  56.674 +declare split_div[of _ _ "number_of k", standard, arith_split]
  56.675 +declare split_mod[of _ _ "number_of k", standard, arith_split]
  56.676 +
  56.677 +lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
  56.678 +  by (simp add: number_of_Pls nat_number_of_def)
  56.679 +
  56.680 +lemma nat_number_of_Min: "number_of Int.Min = (0::nat)"
  56.681 +  apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
  56.682 +  done
  56.683 +
  56.684 +lemma nat_number_of_Bit0:
  56.685 +    "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
  56.686 +  unfolding nat_number_of_def number_of_is_id numeral_simps Let_def
  56.687 +  by auto
  56.688 +
  56.689 +lemma nat_number_of_Bit1:
  56.690 +  "number_of (Int.Bit1 w) =
  56.691 +    (if neg (number_of w :: int) then 0
  56.692 +     else let n = number_of w in Suc (n + n))"
  56.693 +  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def Let_def
  56.694 +  by auto
  56.695 +
  56.696 +lemmas nat_number =
  56.697 +  nat_number_of_Pls nat_number_of_Min
  56.698 +  nat_number_of_Bit0 nat_number_of_Bit1
  56.699 +
  56.700 +lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
  56.701 +  by (simp add: Let_def)
  56.702 +
  56.703 +lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring,recpower})"
  56.704 +by (simp add: power_mult power_Suc); 
  56.705 +
  56.706 +lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring,recpower})"
  56.707 +by (simp add: power_mult power_Suc); 
  56.708 +
  56.709 +
  56.710 +subsection{*Literal arithmetic and @{term of_nat}*}
  56.711 +
  56.712 +lemma of_nat_double:
  56.713 +     "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
  56.714 +by (simp only: mult_2 nat_add_distrib of_nat_add) 
  56.715 +
  56.716 +lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
  56.717 +by (simp only: nat_number_of_def)
  56.718 +
  56.719 +lemma of_nat_number_of_lemma:
  56.720 +     "of_nat (number_of v :: nat) =  
  56.721 +         (if 0 \<le> (number_of v :: int) 
  56.722 +          then (number_of v :: 'a :: number_ring)
  56.723 +          else 0)"
  56.724 +by (simp add: int_number_of_def nat_number_of_def number_of_eq of_nat_nat);
  56.725 +
  56.726 +lemma of_nat_number_of_eq [simp]:
  56.727 +     "of_nat (number_of v :: nat) =  
  56.728 +         (if neg (number_of v :: int) then 0  
  56.729 +          else (number_of v :: 'a :: number_ring))"
  56.730 +by (simp only: of_nat_number_of_lemma neg_def, simp) 
  56.731 +
  56.732 +
  56.733 +subsection {*Lemmas for the Combination and Cancellation Simprocs*}
  56.734 +
  56.735 +lemma nat_number_of_add_left:
  56.736 +     "number_of v + (number_of v' + (k::nat)) =  
  56.737 +         (if neg (number_of v :: int) then number_of v' + k  
  56.738 +          else if neg (number_of v' :: int) then number_of v + k  
  56.739 +          else number_of (v + v') + k)"
  56.740 +  unfolding nat_number_of_def number_of_is_id neg_def
  56.741 +  by auto
  56.742 +
  56.743 +lemma nat_number_of_mult_left:
  56.744 +     "number_of v * (number_of v' * (k::nat)) =  
  56.745 +         (if v < Int.Pls then 0
  56.746 +          else number_of (v * v') * k)"
  56.747 +by simp
  56.748 +
  56.749 +
  56.750 +subsubsection{*For @{text combine_numerals}*}
  56.751 +
  56.752 +lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)"
  56.753 +by (simp add: add_mult_distrib)
  56.754 +
  56.755 +
  56.756 +subsubsection{*For @{text cancel_numerals}*}
  56.757 +
  56.758 +lemma nat_diff_add_eq1:
  56.759 +     "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)"
  56.760 +by (simp split add: nat_diff_split add: add_mult_distrib)
  56.761 +
  56.762 +lemma nat_diff_add_eq2:
  56.763 +     "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))"
  56.764 +by (simp split add: nat_diff_split add: add_mult_distrib)
  56.765 +
  56.766 +lemma nat_eq_add_iff1:
  56.767 +     "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)"
  56.768 +by (auto split add: nat_diff_split simp add: add_mult_distrib)
  56.769 +
  56.770 +lemma nat_eq_add_iff2:
  56.771 +     "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)"
  56.772 +by (auto split add: nat_diff_split simp add: add_mult_distrib)
  56.773 +
  56.774 +lemma nat_less_add_iff1:
  56.775 +     "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)"
  56.776 +by (auto split add: nat_diff_split simp add: add_mult_distrib)
  56.777 +
  56.778 +lemma nat_less_add_iff2:
  56.779 +     "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)"
  56.780 +by (auto split add: nat_diff_split simp add: add_mult_distrib)
  56.781 +
  56.782 +lemma nat_le_add_iff1:
  56.783 +     "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)"
  56.784 +by (auto split add: nat_diff_split simp add: add_mult_distrib)
  56.785 +
  56.786 +lemma nat_le_add_iff2:
  56.787 +     "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)"
  56.788 +by (auto split add: nat_diff_split simp add: add_mult_distrib)
  56.789 +
  56.790 +
  56.791 +subsubsection{*For @{text cancel_numeral_factors} *}
  56.792 +
  56.793 +lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)"
  56.794 +by auto
  56.795 +
  56.796 +lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m<n)"
  56.797 +by auto
  56.798 +
  56.799 +lemma nat_mult_eq_cancel1: "(0::nat) < k ==> (k*m = k*n) = (m=n)"
  56.800 +by auto
  56.801 +
  56.802 +lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)"
  56.803 +by auto
  56.804 +
  56.805 +lemma nat_mult_dvd_cancel_disj[simp]:
  56.806 +  "(k*m) dvd (k*n) = (k=0 | m dvd (n::nat))"
  56.807 +by(auto simp: dvd_eq_mod_eq_0 mod_mult_distrib2[symmetric])
  56.808 +
  56.809 +lemma nat_mult_dvd_cancel1: "0 < k \<Longrightarrow> (k*m) dvd (k*n::nat) = (m dvd n)"
  56.810 +by(auto)
  56.811 +
  56.812 +
  56.813 +subsubsection{*For @{text cancel_factor} *}
  56.814 +
  56.815 +lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)"
  56.816 +by auto
  56.817 +
  56.818 +lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m<n)"
  56.819 +by auto
  56.820 +
  56.821 +lemma nat_mult_eq_cancel_disj: "(k*m = k*n) = (k = (0::nat) | m=n)"
  56.822 +by auto
  56.823 +
  56.824 +lemma nat_mult_div_cancel_disj[simp]:
  56.825 +     "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)"
  56.826 +by (simp add: nat_mult_div_cancel1)
  56.827 +
  56.828 +
  56.829 +subsection {* Simprocs for the Naturals *}
  56.830 +
  56.831 +use "Tools/nat_simprocs.ML"
  56.832 +declaration {* K nat_simprocs_setup *}
  56.833 +
  56.834 +subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
  56.835 +
  56.836 +text{*Where K above is a literal*}
  56.837 +
  56.838 +lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
  56.839 +by (simp add: numeral_0_eq_0 numeral_1_eq_1 split add: nat_diff_split)
  56.840 +
  56.841 +text {*Now just instantiating @{text n} to @{text "number_of v"} does
  56.842 +  the right simplification, but with some redundant inequality
  56.843 +  tests.*}
  56.844 +lemma neg_number_of_pred_iff_0:
  56.845 +  "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
  56.846 +apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
  56.847 +apply (simp only: less_Suc_eq_le le_0_eq)
  56.848 +apply (subst less_number_of_Suc, simp)
  56.849 +done
  56.850 +
  56.851 +text{*No longer required as a simprule because of the @{text inverse_fold}
  56.852 +   simproc*}
  56.853 +lemma Suc_diff_number_of:
  56.854 +     "Int.Pls < v ==>
  56.855 +      Suc m - (number_of v) = m - (number_of (Int.pred v))"
  56.856 +apply (subst Suc_diff_eq_diff_pred)
  56.857 +apply simp
  56.858 +apply (simp del: nat_numeral_1_eq_1)
  56.859 +apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
  56.860 +                        neg_number_of_pred_iff_0)
  56.861 +done
  56.862 +
  56.863 +lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
  56.864 +by (simp add: numerals split add: nat_diff_split)
  56.865 +
  56.866 +
  56.867 +subsubsection{*For @{term nat_case} and @{term nat_rec}*}
  56.868 +
  56.869 +lemma nat_case_number_of [simp]:
  56.870 +     "nat_case a f (number_of v) =
  56.871 +        (let pv = number_of (Int.pred v) in
  56.872 +         if neg pv then a else f (nat pv))"
  56.873 +by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
  56.874 +
  56.875 +lemma nat_case_add_eq_if [simp]:
  56.876 +     "nat_case a f ((number_of v) + n) =
  56.877 +       (let pv = number_of (Int.pred v) in
  56.878 +         if neg pv then nat_case a f n else f (nat pv + n))"
  56.879 +apply (subst add_eq_if)
  56.880 +apply (simp split add: nat.split
  56.881 +            del: nat_numeral_1_eq_1
  56.882 +            add: nat_numeral_1_eq_1 [symmetric]
  56.883 +                 numeral_1_eq_Suc_0 [symmetric]
  56.884 +                 neg_number_of_pred_iff_0)
  56.885 +done
  56.886 +
  56.887 +lemma nat_rec_number_of [simp]:
  56.888 +     "nat_rec a f (number_of v) =
  56.889 +        (let pv = number_of (Int.pred v) in
  56.890 +         if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
  56.891 +apply (case_tac " (number_of v) ::nat")
  56.892 +apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
  56.893 +apply (simp split add: split_if_asm)
  56.894 +done
  56.895 +
  56.896 +lemma nat_rec_add_eq_if [simp]:
  56.897 +     "nat_rec a f (number_of v + n) =
  56.898 +        (let pv = number_of (Int.pred v) in
  56.899 +         if neg pv then nat_rec a f n
  56.900 +                   else f (nat pv + n) (nat_rec a f (nat pv + n)))"
  56.901 +apply (subst add_eq_if)
  56.902 +apply (simp split add: nat.split
  56.903 +            del: nat_numeral_1_eq_1
  56.904 +            add: nat_numeral_1_eq_1 [symmetric]
  56.905 +                 numeral_1_eq_Suc_0 [symmetric]
  56.906 +                 neg_number_of_pred_iff_0)
  56.907 +done
  56.908 +
  56.909 +
  56.910 +subsubsection{*Various Other Lemmas*}
  56.911 +
  56.912 +text {*Evens and Odds, for Mutilated Chess Board*}
  56.913 +
  56.914 +text{*Lemmas for specialist use, NOT as default simprules*}
  56.915 +lemma nat_mult_2: "2 * z = (z+z::nat)"
  56.916 +proof -
  56.917 +  have "2*z = (1 + 1)*z" by simp
  56.918 +  also have "... = z+z" by (simp add: left_distrib)
  56.919 +  finally show ?thesis .
  56.920 +qed
  56.921 +
  56.922 +lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
  56.923 +by (subst mult_commute, rule nat_mult_2)
  56.924 +
  56.925 +text{*Case analysis on @{term "n<2"}*}
  56.926 +lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
  56.927 +by arith
  56.928 +
  56.929 +lemma div2_Suc_Suc [simp]: "Suc(Suc m) div 2 = Suc (m div 2)"
  56.930 +by arith
  56.931 +
  56.932 +lemma add_self_div_2 [simp]: "(m + m) div 2 = (m::nat)"
  56.933 +by (simp add: nat_mult_2 [symmetric])
  56.934 +
  56.935 +lemma mod2_Suc_Suc [simp]: "Suc(Suc(m)) mod 2 = m mod 2"
  56.936 +apply (subgoal_tac "m mod 2 < 2")
  56.937 +apply (erule less_2_cases [THEN disjE])
  56.938 +apply (simp_all (no_asm_simp) add: Let_def mod_Suc nat_1)
  56.939 +done
  56.940 +
  56.941 +lemma mod2_gr_0 [simp]: "!!m::nat. (0 < m mod 2) = (m mod 2 = 1)"
  56.942 +apply (subgoal_tac "m mod 2 < 2")
  56.943 +apply (force simp del: mod_less_divisor, simp)
  56.944 +done
  56.945 +
  56.946 +text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
  56.947 +
  56.948 +lemma add_2_eq_Suc [simp]: "2 + n = Suc (Suc n)"
  56.949 +by simp
  56.950 +
  56.951 +lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)"
  56.952 +by simp
  56.953 +
  56.954 +text{*Can be used to eliminate long strings of Sucs, but not by default*}
  56.955 +lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
  56.956 +by simp
  56.957 +
  56.958 +
  56.959 +text{*These lemmas collapse some needless occurrences of Suc:
  56.960 +    at least three Sucs, since two and fewer are rewritten back to Suc again!
  56.961 +    We already have some rules to simplify operands smaller than 3.*}
  56.962 +
  56.963 +lemma div_Suc_eq_div_add3 [simp]: "m div (Suc (Suc (Suc n))) = m div (3+n)"
  56.964 +by (simp add: Suc3_eq_add_3)
  56.965 +
  56.966 +lemma mod_Suc_eq_mod_add3 [simp]: "m mod (Suc (Suc (Suc n))) = m mod (3+n)"
  56.967 +by (simp add: Suc3_eq_add_3)
  56.968 +
  56.969 +lemma Suc_div_eq_add3_div: "(Suc (Suc (Suc m))) div n = (3+m) div n"
  56.970 +by (simp add: Suc3_eq_add_3)
  56.971 +
  56.972 +lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
  56.973 +by (simp add: Suc3_eq_add_3)
  56.974 +
  56.975 +lemmas Suc_div_eq_add3_div_number_of =
  56.976 +    Suc_div_eq_add3_div [of _ "number_of v", standard]
  56.977 +declare Suc_div_eq_add3_div_number_of [simp]
  56.978 +
  56.979 +lemmas Suc_mod_eq_add3_mod_number_of =
  56.980 +    Suc_mod_eq_add3_mod [of _ "number_of v", standard]
  56.981 +declare Suc_mod_eq_add3_mod_number_of [simp]
  56.982 +
  56.983 +end
  56.984 \ No newline at end of file
    57.1 --- a/src/HOL/Nominal/Examples/Fsub.thy	Wed Apr 22 11:00:25 2009 -0700
    57.2 +++ b/src/HOL/Nominal/Examples/Fsub.thy	Mon Apr 27 07:26:17 2009 -0700
    57.3 @@ -245,7 +245,7 @@
    57.4    apply (simp add: dj_perm_forget[OF dj_tyvrs_vrs])
    57.5    done
    57.6  
    57.7 -lemma ty_vrs_fresh[fresh]:
    57.8 +lemma ty_vrs_fresh:
    57.9    fixes x::"vrs"
   57.10    and   T::"ty"
   57.11    shows "x \<sharp> T"
   57.12 @@ -422,7 +422,7 @@
   57.13    by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
   57.14       (perm_simp add: fresh_left)+
   57.15  
   57.16 -lemma type_subst_fresh[fresh]:
   57.17 +lemma type_subst_fresh:
   57.18    fixes X::"tyvrs"
   57.19    assumes "X \<sharp> T" and "X \<sharp> P"
   57.20    shows   "X \<sharp> T[Y \<mapsto> P]\<^sub>\<tau>"
   57.21 @@ -430,7 +430,7 @@
   57.22  by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
   57.23     (auto simp add: abs_fresh)
   57.24  
   57.25 -lemma fresh_type_subst_fresh[fresh]:
   57.26 +lemma fresh_type_subst_fresh:
   57.27      assumes "X\<sharp>T'"
   57.28      shows "X\<sharp>T[X \<mapsto> T']\<^sub>\<tau>"
   57.29  using assms 
   57.30 @@ -458,18 +458,19 @@
   57.31  | "(VarB  X U)[Y \<mapsto> T]\<^sub>b =  VarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
   57.32  by auto
   57.33  
   57.34 -lemma binding_subst_fresh[fresh]:
   57.35 +lemma binding_subst_fresh:
   57.36    fixes X::"tyvrs"
   57.37    assumes "X \<sharp> a"
   57.38    and     "X \<sharp> P"
   57.39    shows "X \<sharp> a[Y \<mapsto> P]\<^sub>b"
   57.40  using assms
   57.41 -by (nominal_induct a rule:binding.strong_induct)
   57.42 -   (auto simp add: freshs)
   57.43 +by (nominal_induct a rule: binding.strong_induct)
   57.44 +   (auto simp add: type_subst_fresh)
   57.45  
   57.46 -lemma binding_subst_identity: "X \<sharp> B \<Longrightarrow> B[X \<mapsto> U]\<^sub>b = B"
   57.47 -  by (induct B rule: binding.induct)
   57.48 -    (simp_all add: fresh_atm type_subst_identity)
   57.49 +lemma binding_subst_identity: 
   57.50 +  shows "X \<sharp> B \<Longrightarrow> B[X \<mapsto> U]\<^sub>b = B"
   57.51 +by (induct B rule: binding.induct)
   57.52 +   (simp_all add: fresh_atm type_subst_identity)
   57.53  
   57.54  consts 
   57.55    subst_tyc :: "env \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> env" ("_[_ \<mapsto> _]\<^sub>e" [100,100,100] 100)
   57.56 @@ -478,14 +479,14 @@
   57.57  "([])[Y \<mapsto> T]\<^sub>e= []"
   57.58  "(B#\<Gamma>)[Y \<mapsto> T]\<^sub>e = (B[Y \<mapsto> T]\<^sub>b)#(\<Gamma>[Y \<mapsto> T]\<^sub>e)"
   57.59  
   57.60 -lemma ctxt_subst_fresh'[fresh]:
   57.61 +lemma ctxt_subst_fresh':
   57.62    fixes X::"tyvrs"
   57.63    assumes "X \<sharp> \<Gamma>"
   57.64    and     "X \<sharp> P"
   57.65    shows   "X \<sharp> \<Gamma>[Y \<mapsto> P]\<^sub>e"
   57.66  using assms
   57.67  by (induct \<Gamma>)
   57.68 -   (auto simp add: fresh_list_cons freshs)
   57.69 +   (auto simp add: fresh_list_cons binding_subst_fresh)
   57.70  
   57.71  lemma ctxt_subst_mem_TVarB: "TVarB X T \<in> set \<Gamma> \<Longrightarrow> TVarB X (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
   57.72    by (induct \<Gamma>) auto
   57.73 @@ -1188,8 +1189,8 @@
   57.74  using assms by (induct, auto)
   57.75  
   57.76  nominal_inductive typing
   57.77 -  by (auto dest!: typing_ok intro: closed_in_fresh fresh_domain
   57.78 -    simp: abs_fresh fresh_prod fresh_atm freshs valid_ty_domain_fresh fresh_trm_domain)
   57.79 +by (auto dest!: typing_ok intro: closed_in_fresh fresh_domain type_subst_fresh
   57.80 +    simp: abs_fresh fresh_type_subst_fresh ty_vrs_fresh valid_ty_domain_fresh fresh_trm_domain)
   57.81  
   57.82  lemma ok_imp_VarB_closed_in:
   57.83    assumes ok: "\<turnstile> \<Gamma> ok"
    58.1 --- a/src/HOL/Nominal/Nominal.thy	Wed Apr 22 11:00:25 2009 -0700
    58.2 +++ b/src/HOL/Nominal/Nominal.thy	Mon Apr 27 07:26:17 2009 -0700
    58.3 @@ -18,25 +18,98 @@
    58.4  types 
    58.5    'x prm = "('x \<times> 'x) list"
    58.6  
    58.7 -(* polymorphic operations for permutation and swapping *)
    58.8 +(* polymorphic constants for permutation and swapping *)
    58.9  consts 
   58.10    perm :: "'x prm \<Rightarrow> 'a \<Rightarrow> 'a"     (infixr "\<bullet>" 80)
   58.11    swap :: "('x \<times> 'x) \<Rightarrow> 'x \<Rightarrow> 'x"
   58.12  
   58.13 +(* a "private" copy of the option type used in the abstraction function *)
   58.14 +datatype 'a noption = nSome 'a | nNone
   58.15 +
   58.16 +(* a "private" copy of the product type used in the nominal induct method *)
   58.17 +datatype ('a,'b) nprod = nPair 'a 'b
   58.18 +
   58.19  (* an auxiliary constant for the decision procedure involving *) 
   58.20 -(* permutations (to avoid loops when using perm-composition)  *)
   58.21 +(* permutations (to avoid loops when using perm-compositions)  *)
   58.22  constdefs
   58.23    "perm_aux pi x \<equiv> pi\<bullet>x"
   58.24  
   58.25 -(* permutation on functions *)
   58.26 -defs (unchecked overloaded)
   58.27 -  perm_fun_def: "pi\<bullet>(f::'a\<Rightarrow>'b) \<equiv> (\<lambda>x. pi\<bullet>f((rev pi)\<bullet>x))"
   58.28 -
   58.29 -(* permutation on bools *)
   58.30 -primrec (unchecked perm_bool)
   58.31 -  true_eqvt:  "pi\<bullet>True  = True"
   58.32 -  false_eqvt: "pi\<bullet>False = False"
   58.33 -
   58.34 +(* overloaded permutation operations *)
   58.35 +overloading
   58.36 +  perm_fun    \<equiv> "perm :: 'x prm \<Rightarrow> ('a\<Rightarrow>'b) \<Rightarrow> ('a\<Rightarrow>'b)"   (unchecked)
   58.37 +  perm_bool   \<equiv> "perm :: 'x prm \<Rightarrow> bool \<Rightarrow> bool"           (unchecked)
   58.38 +  perm_unit   \<equiv> "perm :: 'x prm \<Rightarrow> unit \<Rightarrow> unit"           (unchecked)
   58.39 +  perm_prod   \<equiv> "perm :: 'x prm \<Rightarrow> ('a\<times>'b) \<Rightarrow> ('a\<times>'b)"     (unchecked)
   58.40 +  perm_list   \<equiv> "perm :: 'x prm \<Rightarrow> 'a list \<Rightarrow> 'a list"     (unchecked)
   58.41 +  perm_option \<equiv> "perm :: 'x prm \<Rightarrow> 'a option \<Rightarrow> 'a option" (unchecked)
   58.42 +  perm_char   \<equiv> "perm :: 'x prm \<Rightarrow> char \<Rightarrow> char"           (unchecked)
   58.43 +  perm_nat    \<equiv> "perm :: 'x prm \<Rightarrow> nat \<Rightarrow> nat"             (unchecked)
   58.44 +  perm_int    \<equiv> "perm :: 'x prm \<Rightarrow> int \<Rightarrow> int"             (unchecked)
   58.45 +
   58.46 +  perm_noption \<equiv> "perm :: 'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption"   (unchecked)
   58.47 +  perm_nprod   \<equiv> "perm :: 'x prm \<Rightarrow> ('a, 'b) nprod \<Rightarrow> ('a, 'b) nprod" (unchecked)
   58.48 +begin
   58.49 +
   58.50 +definition
   58.51 +  perm_fun_def: "perm_fun pi (f::'a\<Rightarrow>'b) \<equiv> (\<lambda>x. pi\<bullet>f((rev pi)\<bullet>x))"
   58.52 +
   58.53 +fun
   58.54 +  perm_bool :: "'x prm \<Rightarrow> bool \<Rightarrow> bool"
   58.55 +where
   58.56 +  true_eqvt:  "perm_bool pi True  = True"
   58.57 +| false_eqvt: "perm_bool pi False = False"
   58.58 +
   58.59 +fun
   58.60 +  perm_unit :: "'x prm \<Rightarrow> unit \<Rightarrow> unit" 
   58.61 +where 
   58.62 +  "perm_unit pi () = ()"
   58.63 +  
   58.64 +fun
   58.65 +  perm_prod :: "'x prm \<Rightarrow> ('a\<times>'b) \<Rightarrow> ('a\<times>'b)"
   58.66 +where
   58.67 +  "perm_prod pi (x,y) = (pi\<bullet>x,pi\<bullet>y)"
   58.68 +
   58.69 +fun
   58.70 +  perm_list :: "'x prm \<Rightarrow> 'a list \<Rightarrow> 'a list"
   58.71 +where
   58.72 +  nil_eqvt:  "perm_list pi []     = []"
   58.73 +| cons_eqvt: "perm_list pi (x#xs) = (pi\<bullet>x)#(pi\<bullet>xs)"
   58.74 +
   58.75 +fun
   58.76 +  perm_option :: "'x prm \<Rightarrow> 'a option \<Rightarrow> 'a option"
   58.77 +where
   58.78 +  some_eqvt:  "perm_option pi (Some x) = Some (pi\<bullet>x)"
   58.79 +| none_eqvt:  "perm_option pi None     = None"
   58.80 +
   58.81 +definition
   58.82 +  perm_char :: "'x prm \<Rightarrow> char \<Rightarrow> char"
   58.83 +where
   58.84 +  perm_char_def: "perm_char pi c \<equiv> c"
   58.85 +
   58.86 +definition
   58.87 +  perm_nat :: "'x prm \<Rightarrow> nat \<Rightarrow> nat"
   58.88 +where
   58.89 +  perm_nat_def: "perm_nat pi i \<equiv> i"
   58.90 +
   58.91 +definition
   58.92 +  perm_int :: "'x prm \<Rightarrow> int \<Rightarrow> int"
   58.93 +where
   58.94 +  perm_int_def: "perm_int pi i \<equiv> i"
   58.95 +
   58.96 +fun
   58.97 +  perm_noption :: "'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption"
   58.98 +where
   58.99 +  nsome_eqvt:  "perm_noption pi (nSome x) = nSome (pi\<bullet>x)"
  58.100 +| nnone_eqvt:  "perm_noption pi nNone     = nNone"
  58.101 +
  58.102 +fun
  58.103 +  perm_nprod :: "'x prm \<Rightarrow> ('a, 'b) nprod \<Rightarrow> ('a, 'b) nprod"
  58.104 +where
  58.105 +  "perm_nprod pi (nPair x y) = nPair (pi\<bullet>x) (pi\<bullet>y)"
  58.106 +end
  58.107 +
  58.108 +
  58.109 +(* permutations on booleans *)
  58.110  lemma perm_bool:
  58.111    shows "pi\<bullet>(b::bool) = b"
  58.112    by (cases b) auto
  58.113 @@ -54,8 +127,7 @@
  58.114  lemma if_eqvt:
  58.115    fixes pi::"'a prm"
  58.116    shows "pi\<bullet>(if b then c1 else c2) = (if (pi\<bullet>b) then (pi\<bullet>c1) else (pi\<bullet>c2))"
  58.117 -apply(simp add: perm_fun_def)
  58.118 -done
  58.119 +  by (simp add: perm_fun_def)
  58.120  
  58.121  lemma imp_eqvt:
  58.122    shows "pi\<bullet>(A\<longrightarrow>B) = ((pi\<bullet>A)\<longrightarrow>(pi\<bullet>B))"
  58.123 @@ -82,13 +154,7 @@
  58.124    shows "(pi\<bullet>(X\<union>Y)) = (pi\<bullet>X) \<union> (pi\<bullet>Y)"
  58.125    by (simp add: perm_fun_def perm_bool Un_iff [unfolded mem_def] expand_fun_eq)
  58.126  
  58.127 -(* permutation on units and products *)
  58.128 -primrec (unchecked perm_unit)
  58.129 -  "pi\<bullet>() = ()"
  58.130 -  
  58.131 -primrec (unchecked perm_prod)
  58.132 -  "pi\<bullet>(x,y) = (pi\<bullet>x,pi\<bullet>y)"
  58.133 -
  58.134 +(* permutations on products *)
  58.135  lemma fst_eqvt:
  58.136    "pi\<bullet>(fst x) = fst (pi\<bullet>x)"
  58.137   by (cases x) simp
  58.138 @@ -98,10 +164,6 @@
  58.139   by (cases x) simp
  58.140  
  58.141  (* permutation on lists *)
  58.142 -primrec (unchecked perm_list)
  58.143 -  nil_eqvt:  "pi\<bullet>[]     = []"
  58.144 -  cons_eqvt: "pi\<bullet>(x#xs) = (pi\<bullet>x)#(pi\<bullet>xs)"
  58.145 -
  58.146  lemma append_eqvt:
  58.147    fixes pi :: "'x prm"
  58.148    and   l1 :: "'a list"
  58.149 @@ -115,41 +177,12 @@
  58.150    shows "pi\<bullet>(rev l) = rev (pi\<bullet>l)"
  58.151    by (induct l) (simp_all add: append_eqvt)
  58.152  
  58.153 -(* permutation on options *)
  58.154 -
  58.155 -primrec (unchecked perm_option)
  58.156 -  some_eqvt:  "pi\<bullet>Some(x) = Some(pi\<bullet>x)"
  58.157 -  none_eqvt:  "pi\<bullet>None    = None"
  58.158 -
  58.159 -(* a "private" copy of the option type used in the abstraction function *)
  58.160 -datatype 'a noption = nSome 'a | nNone
  58.161 -
  58.162 -primrec (unchecked perm_noption)
  58.163 -  nSome_eqvt: "pi\<bullet>nSome(x) = nSome(pi\<bullet>x)"
  58.164 -  nNone_eqvt: "pi\<bullet>nNone    = nNone"
  58.165 -
  58.166 -(* a "private" copy of the product type used in the nominal induct method *)
  58.167 -datatype ('a,'b) nprod = nPair 'a 'b
  58.168 -
  58.169 -primrec (unchecked perm_nprod)
  58.170 -  perm_nProd_def: "pi\<bullet>(nPair x1 x2)  = nPair (pi\<bullet>x1) (pi\<bullet>x2)"
  58.171 -
  58.172 -(* permutation on characters (used in strings) *)
  58.173 -defs (unchecked overloaded)
  58.174 -  perm_char_def: "pi\<bullet>(c::char) \<equiv> c"
  58.175 -
  58.176 +(* permutation on characters and strings *)
  58.177  lemma perm_string:
  58.178    fixes s::"string"
  58.179    shows "pi\<bullet>s = s"
  58.180 -by (induct s)(auto simp add: perm_char_def)
  58.181 -
  58.182 -(* permutation on ints *)
  58.183 -defs (unchecked overloaded)
  58.184 -  perm_int_def:    "pi\<bullet>(i::int) \<equiv> i"
  58.185 -
  58.186 -(* permutation on nats *)
  58.187 -defs (unchecked overloaded)
  58.188 -  perm_nat_def:    "pi\<bullet>(i::nat) \<equiv> i"
  58.189 +  by (induct s)(auto simp add: perm_char_def)
  58.190 +
  58.191  
  58.192  section {* permutation equality *}
  58.193  (*==============================*)
  58.194 @@ -170,11 +203,12 @@
  58.195     supports :: "'x set \<Rightarrow> 'a \<Rightarrow> bool" (infixl "supports" 80)
  58.196     "S supports x \<equiv> \<forall>a b. (a\<notin>S \<and> b\<notin>S \<longrightarrow> [(a,b)]\<bullet>x=x)"
  58.197  
  58.198 +(* lemmas about supp *)
  58.199  lemma supp_fresh_iff: 
  58.200    fixes x :: "'a"
  58.201    shows "(supp x) = {a::'x. \<not>a\<sharp>x}"
  58.202 -apply(simp add: fresh_def)
  58.203 -done
  58.204 +  by (simp add: fresh_def)
  58.205 +
  58.206  
  58.207  lemma supp_unit:
  58.208    shows "supp () = {}"
  58.209 @@ -205,14 +239,13 @@
  58.210    fixes x  :: "'a"
  58.211    and   xs :: "'a list"
  58.212    shows "supp (x#xs) = (supp x)\<union>(supp xs)"
  58.213 -apply(auto simp add: supp_def Collect_imp_eq Collect_neg_eq)
  58.214 -done
  58.215 +  by (auto simp add: supp_def Collect_imp_eq Collect_neg_eq)
  58.216  
  58.217  lemma supp_list_append:
  58.218    fixes xs :: "'a list"
  58.219    and   ys :: "'a list"
  58.220    shows "supp (xs@ys) = (supp xs)\<union>(supp ys)"
  58.221 -  by (induct xs, auto simp add: supp_list_nil supp_list_cons)
  58.222 +  by (induct xs) (auto simp add: supp_list_nil supp_list_cons)
  58.223  
  58.224  lemma supp_list_rev:
  58.225    fixes xs :: "'a list"
  58.226 @@ -221,47 +254,40 @@
  58.227  
  58.228  lemma supp_bool:
  58.229    fixes x  :: "bool"
  58.230 -  shows "supp (x) = {}"
  58.231 -  apply(case_tac "x")
  58.232 -  apply(simp_all add: supp_def)
  58.233 -done
  58.234 +  shows "supp x = {}"
  58.235 +  by (cases "x") (simp_all add: supp_def)
  58.236  
  58.237  lemma supp_some:
  58.238    fixes x :: "'a"
  58.239    shows "supp (Some x) = (supp x)"
  58.240 -  apply(simp add: supp_def)
  58.241 -  done
  58.242 +  by (simp add: supp_def)
  58.243  
  58.244  lemma supp_none:
  58.245    fixes x :: "'a"
  58.246    shows "supp (None) = {}"
  58.247 -  apply(simp add: supp_def)
  58.248 -  done
  58.249 +  by (simp add: supp_def)
  58.250  
  58.251  lemma supp_int:
  58.252    fixes i::"int"
  58.253    shows "supp (i) = {}"
  58.254 -  apply(simp add: supp_def perm_int_def)
  58.255 -  done
  58.256 +  by (simp add: supp_def perm_int_def)
  58.257  
  58.258  lemma supp_nat:
  58.259    fixes n::"nat"
  58.260 -  shows "supp (n) = {}"
  58.261 -  apply(simp add: supp_def perm_nat_def)
  58.262 -  done
  58.263 +  shows "(supp n) = {}"
  58.264 +  by (simp add: supp_def perm_nat_def)
  58.265  
  58.266  lemma supp_char:
  58.267    fixes c::"char"
  58.268 -  shows "supp (c) = {}"
  58.269 -  apply(simp add: supp_def perm_char_def)
  58.270 -  done
  58.271 +  shows "(supp c) = {}"
  58.272 +  by (simp add: supp_def perm_char_def)
  58.273    
  58.274  lemma supp_string:
  58.275    fixes s::"string"
  58.276 -  shows "supp (s) = {}"
  58.277 -apply(simp add: supp_def perm_string)
  58.278 -done
  58.279 -
  58.280 +  shows "(supp s) = {}"
  58.281 +  by (simp add: supp_def perm_string)
  58.282 +
  58.283 +(* lemmas about freshness *)
  58.284  lemma fresh_set_empty:
  58.285    shows "a\<sharp>{}"
  58.286    by (simp add: fresh_def supp_set_empty)
  58.287 @@ -344,7 +370,6 @@
  58.288    by (simp add: fresh_def supp_bool)
  58.289  
  58.290  text {* Normalization of freshness results; cf.\ @{text nominal_induct} *}
  58.291 -
  58.292  lemma fresh_unit_elim: 
  58.293    shows "(a\<sharp>() \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.294    by (simp add: fresh_def supp_unit)
  58.295 @@ -371,63 +396,6 @@
  58.296    Simplifier.map_ss (fn ss => ss setmksimps (mksimps mksimps_pairs))
  58.297  *}
  58.298  
  58.299 -section {* generalisation of freshness to lists and sets of atoms *}
  58.300 -(*================================================================*)
  58.301 - 
  58.302 -consts
  58.303 -  fresh_star :: "'b \<Rightarrow> 'a \<Rightarrow> bool" ("_ \<sharp>* _" [100,100] 100)
  58.304 -
  58.305 -defs (overloaded)
  58.306 -  fresh_star_set: "xs\<sharp>*c \<equiv> \<forall>x\<in>xs. x\<sharp>c"
  58.307 -
  58.308 -defs (overloaded)
  58.309 -  fresh_star_list: "xs\<sharp>*c \<equiv> \<forall>x\<in>set xs. x\<sharp>c"
  58.310 -
  58.311 -lemmas fresh_star_def = fresh_star_list fresh_star_set
  58.312 -
  58.313 -lemma fresh_star_prod_set:
  58.314 -  fixes xs::"'a set"
  58.315 -  shows "xs\<sharp>*(a,b) = (xs\<sharp>*a \<and> xs\<sharp>*b)"
  58.316 -by (auto simp add: fresh_star_def fresh_prod)
  58.317 -
  58.318 -lemma fresh_star_prod_list:
  58.319 -  fixes xs::"'a list"
  58.320 -  shows "xs\<sharp>*(a,b) = (xs\<sharp>*a \<and> xs\<sharp>*b)"
  58.321 -by (auto simp add: fresh_star_def fresh_prod)
  58.322 -
  58.323 -lemmas fresh_star_prod = fresh_star_prod_list fresh_star_prod_set
  58.324 -
  58.325 -lemma fresh_star_set_eq: "set xs \<sharp>* c = xs \<sharp>* c"
  58.326 -  by (simp add: fresh_star_def)
  58.327 -
  58.328 -lemma fresh_star_Un_elim:
  58.329 -  "((S \<union> T) \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (S \<sharp>* c \<Longrightarrow> T \<sharp>* c \<Longrightarrow> PROP C)"
  58.330 -  apply rule
  58.331 -  apply (simp_all add: fresh_star_def)
  58.332 -  apply (erule meta_mp)
  58.333 -  apply blast
  58.334 -  done
  58.335 -
  58.336 -lemma fresh_star_insert_elim:
  58.337 -  "(insert x S \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (x \<sharp> c \<Longrightarrow> S \<sharp>* c \<Longrightarrow> PROP C)"
  58.338 -  by rule (simp_all add: fresh_star_def)
  58.339 -
  58.340 -lemma fresh_star_empty_elim:
  58.341 -  "({} \<sharp>* c \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.342 -  by (simp add: fresh_star_def)
  58.343 -
  58.344 -text {* Normalization of freshness results; cf.\ @{text nominal_induct} *}
  58.345 -
  58.346 -lemma fresh_star_unit_elim: 
  58.347 -  shows "((a::'a set)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.348 -  and "((b::'a list)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.349 -  by (simp_all add: fresh_star_def fresh_def supp_unit)
  58.350 -
  58.351 -lemma fresh_star_prod_elim: 
  58.352 -  shows "((a::'a set)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (a\<sharp>*x \<Longrightarrow> a\<sharp>*y \<Longrightarrow> PROP C)"
  58.353 -  and "((b::'a list)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (b\<sharp>*x \<Longrightarrow> b\<sharp>*y \<Longrightarrow> PROP C)"
  58.354 -  by (rule, simp_all add: fresh_star_prod)+
  58.355 -
  58.356  section {* Abstract Properties for Permutations and  Atoms *}
  58.357  (*=========================================================*)
  58.358  
  58.359 @@ -487,7 +455,7 @@
  58.360    shows "swap (a,b) c = (if a=c then b else (if b=c then a else c))"
  58.361    using a by (simp only: at_def)
  58.362  
  58.363 -(* rules to calculate simple premutations *)
  58.364 +(* rules to calculate simple permutations *)
  58.365  lemmas at_calc = at2 at1 at3
  58.366  
  58.367  lemma at_swap_simps:
  58.368 @@ -682,7 +650,6 @@
  58.369    shows "pi1 \<triangleq> pi2 \<Longrightarrow> (rev pi1) \<triangleq> (rev pi2)"
  58.370    by (simp add: at_prm_rev_eq[OF at])
  58.371  
  58.372 -
  58.373  lemma at_ds1:
  58.374    fixes a  :: "'x"
  58.375    assumes at: "at TYPE('x)"
  58.376 @@ -838,15 +805,18 @@
  58.377    by (auto intro: ex_in_inf[OF at, OF fs] simp add: fresh_def)
  58.378  
  58.379  lemma at_finite_select: 
  58.380 -  shows "at (TYPE('a)) \<Longrightarrow> finite (S::'a set) \<Longrightarrow> \<exists>x. x \<notin> S"
  58.381 -  apply (drule Diff_infinite_finite)
  58.382 -  apply (simp add: at_def)
  58.383 -  apply blast
  58.384 -  apply (subgoal_tac "UNIV - S \<noteq> {}")
  58.385 -  apply (simp only: ex_in_conv [symmetric])
  58.386 -  apply blast
  58.387 -  apply (rule notI)
  58.388 -  apply simp
  58.389 +  fixes S::"'a set"
  58.390 +  assumes a: "at TYPE('a)"
  58.391 +  and     b: "finite S" 
  58.392 +  shows "\<exists>x. x \<notin> S" 
  58.393 +  using a b
  58.394 +  apply(drule_tac S="UNIV::'a set" in Diff_infinite_finite)
  58.395 +  apply(simp add: at_def)
  58.396 +  apply(subgoal_tac "UNIV - S \<noteq> {}")
  58.397 +  apply(simp only: ex_in_conv [symmetric])
  58.398 +  apply(blast)
  58.399 +  apply(rule notI)
  58.400 +  apply(simp)
  58.401    done
  58.402  
  58.403  lemma at_different:
  58.404 @@ -1222,8 +1192,8 @@
  58.405    assumes pt: "pt TYPE('a) TYPE('x)"
  58.406    and     at: "at TYPE('x)"
  58.407    shows "pi\<bullet>(x=y) = (pi\<bullet>x = pi\<bullet>y)"
  58.408 -using assms
  58.409 -by (auto simp add: pt_bij perm_bool)
  58.410 +  using pt at
  58.411 +  by (auto simp add: pt_bij perm_bool)
  58.412  
  58.413  lemma pt_bij3:
  58.414    fixes pi :: "'x prm"
  58.415 @@ -1231,7 +1201,7 @@
  58.416    and   y  :: "'a"
  58.417    assumes a:  "x=y"
  58.418    shows "(pi\<bullet>x = pi\<bullet>y)"
  58.419 -using a by simp 
  58.420 +  using a by simp 
  58.421  
  58.422  lemma pt_bij4:
  58.423    fixes pi :: "'x prm"
  58.424 @@ -1241,7 +1211,7 @@
  58.425    and     at: "at TYPE('x)"
  58.426    and     a:  "pi\<bullet>x = pi\<bullet>y"
  58.427    shows "x = y"
  58.428 -using a by (simp add: pt_bij[OF pt, OF at])
  58.429 +  using a by (simp add: pt_bij[OF pt, OF at])
  58.430  
  58.431  lemma pt_swap_bij:
  58.432    fixes a  :: "'x"
  58.433 @@ -1574,35 +1544,6 @@
  58.434  apply(simp add: pt_rev_pi[OF ptb, OF at])
  58.435  done
  58.436  
  58.437 -lemma pt_fresh_star_bij_ineq:
  58.438 -  fixes  pi :: "'x prm"
  58.439 -  and     x :: "'a"
  58.440 -  and     a :: "'y set"
  58.441 -  and     b :: "'y list"
  58.442 -  assumes pta: "pt TYPE('a) TYPE('x)"
  58.443 -  and     ptb: "pt TYPE('y) TYPE('x)"
  58.444 -  and     at:  "at TYPE('x)"
  58.445 -  and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
  58.446 -  shows "(pi\<bullet>a)\<sharp>*(pi\<bullet>x) = a\<sharp>*x"
  58.447 -  and   "(pi\<bullet>b)\<sharp>*(pi\<bullet>x) = b\<sharp>*x"
  58.448 -apply(unfold fresh_star_def)
  58.449 -apply(auto)
  58.450 -apply(drule_tac x="pi\<bullet>xa" in bspec)
  58.451 -apply(rule pt_set_bij2[OF ptb, OF at])
  58.452 -apply(assumption)
  58.453 -apply(simp add: fresh_star_def pt_fresh_bij_ineq[OF pta, OF ptb, OF at, OF cp])
  58.454 -apply(drule_tac x="(rev pi)\<bullet>xa" in bspec)
  58.455 -apply(simp add: pt_set_bij1[OF ptb, OF at])
  58.456 -apply(simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp])
  58.457 -apply(drule_tac x="pi\<bullet>xa" in bspec)
  58.458 -apply(simp add: pt_set_bij1[OF ptb, OF at])
  58.459 -apply(simp add: pt_set_eqvt [OF ptb at] pt_rev_pi[OF pt_list_inst[OF ptb], OF at])
  58.460 -apply(simp add: pt_fresh_bij_ineq[OF pta, OF ptb, OF at, OF cp])
  58.461 -apply(drule_tac x="(rev pi)\<bullet>xa" in bspec)
  58.462 -apply(simp add: pt_set_bij1[OF ptb, OF at] pt_set_eqvt [OF ptb at])
  58.463 -apply(simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp])
  58.464 -done
  58.465 -
  58.466  lemma pt_fresh_left:  
  58.467    fixes  pi :: "'x prm"
  58.468    and     x :: "'a"
  58.469 @@ -1651,56 +1592,6 @@
  58.470  apply(rule at)
  58.471  done
  58.472  
  58.473 -lemma pt_fresh_star_bij:
  58.474 -  fixes  pi :: "'x prm"
  58.475 -  and     x :: "'a"
  58.476 -  and     a :: "'x set"
  58.477 -  and     b :: "'x list"
  58.478 -  assumes pt: "pt TYPE('a) TYPE('x)"
  58.479 -  and     at: "at TYPE('x)"
  58.480 -  shows "(pi\<bullet>a)\<sharp>*(pi\<bullet>x) = a\<sharp>*x"
  58.481 -  and   "(pi\<bullet>b)\<sharp>*(pi\<bullet>x) = b\<sharp>*x"
  58.482 -apply(rule pt_fresh_star_bij_ineq(1))
  58.483 -apply(rule pt)
  58.484 -apply(rule at_pt_inst)
  58.485 -apply(rule at)+
  58.486 -apply(rule cp_pt_inst)
  58.487 -apply(rule pt)
  58.488 -apply(rule at)
  58.489 -apply(rule pt_fresh_star_bij_ineq(2))
  58.490 -apply(rule pt)
  58.491 -apply(rule at_pt_inst)
  58.492 -apply(rule at)+
  58.493 -apply(rule cp_pt_inst)
  58.494 -apply(rule pt)
  58.495 -apply(rule at)
  58.496 -done
  58.497 -
  58.498 -lemma pt_fresh_star_eqvt:
  58.499 -  fixes  pi :: "'x prm"
  58.500 -  and     x :: "'a"
  58.501 -  and     a :: "'x set"
  58.502 -  and     b :: "'x list"
  58.503 -  assumes pt: "pt TYPE('a) TYPE('x)"
  58.504 -  and     at: "at TYPE('x)"
  58.505 -  shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
  58.506 -  and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
  58.507 -  by (simp_all add: perm_bool pt_fresh_star_bij[OF pt, OF at])
  58.508 -
  58.509 -lemma pt_fresh_star_eqvt_ineq:
  58.510 -  fixes pi::"'x prm"
  58.511 -  and   a::"'y set"
  58.512 -  and   b::"'y list"
  58.513 -  and   x::"'a"
  58.514 -  assumes pta: "pt TYPE('a) TYPE('x)"
  58.515 -  and     ptb: "pt TYPE('y) TYPE('x)"
  58.516 -  and     at:  "at TYPE('x)"
  58.517 -  and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
  58.518 -  and     dj:  "disjoint TYPE('y) TYPE('x)"
  58.519 -  shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
  58.520 -  and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
  58.521 -  by (simp_all add: pt_fresh_star_bij_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)
  58.522 -
  58.523  lemma pt_fresh_bij1:
  58.524    fixes  pi :: "'x prm"
  58.525    and     x :: "'a"
  58.526 @@ -1753,7 +1644,6 @@
  58.527  
  58.528  (* the next two lemmas are needed in the proof *)
  58.529  (* of the structural induction principle       *)
  58.530 -
  58.531  lemma pt_fresh_aux:
  58.532    fixes a::"'x"
  58.533    and   b::"'x"
  58.534 @@ -1857,27 +1747,6 @@
  58.535    thus ?thesis using eq3 by simp
  58.536  qed
  58.537  
  58.538 -lemma pt_freshs_freshs:
  58.539 -  assumes pt: "pt TYPE('a) TYPE('x)"
  58.540 -  and at: "at TYPE ('x)"
  58.541 -  and pi: "set (pi::'x prm) \<subseteq> Xs \<times> Ys"
  58.542 -  and Xs: "Xs \<sharp>* (x::'a)"
  58.543 -  and Ys: "Ys \<sharp>* x"
  58.544 -  shows "pi \<bullet> x = x"
  58.545 -  using pi
  58.546 -proof (induct pi)
  58.547 -  case Nil
  58.548 -  show ?case by (simp add: pt1 [OF pt])
  58.549 -next
  58.550 -  case (Cons p pi)
  58.551 -  obtain a b where p: "p = (a, b)" by (cases p)
  58.552 -  with Cons Xs Ys have "a \<sharp> x" "b \<sharp> x"
  58.553 -    by (simp_all add: fresh_star_def)
  58.554 -  with Cons p show ?case
  58.555 -    by (simp add: pt_fresh_fresh [OF pt at]
  58.556 -      pt2 [OF pt, of "[(a, b)]" pi, simplified])
  58.557 -qed
  58.558 -
  58.559  lemma pt_pi_fresh_fresh:
  58.560    fixes   x :: "'a"
  58.561    and     pi :: "'x prm"
  58.562 @@ -1943,8 +1812,7 @@
  58.563    thus ?thesis by (simp add: pt2[OF pt])
  58.564  qed
  58.565  
  58.566 -section {* equivaraince for some connectives *}
  58.567 -
  58.568 +section {* equivariance for some connectives *}
  58.569  lemma pt_all_eqvt:
  58.570    fixes  pi :: "'x prm"
  58.571    and     x :: "'a"
  58.572 @@ -1990,8 +1858,6 @@
  58.573    apply(rule theI'[OF unique])
  58.574    done
  58.575  
  58.576 -
  58.577 -
  58.578  section {* facts about supports *}
  58.579  (*==============================*)
  58.580  
  58.581 @@ -2160,6 +2026,7 @@
  58.582    shows "(x \<sharp> X) = (x \<notin> X)"
  58.583    by (simp add: at_fin_set_supp fresh_def at fs)
  58.584  
  58.585 +
  58.586  section {* Permutations acting on Functions *}
  58.587  (*==========================================*)
  58.588  
  58.589 @@ -2540,9 +2407,8 @@
  58.590    and     a1:  "a\<sharp>x"
  58.591    and     a2:  "a\<sharp>X"
  58.592    shows "a\<sharp>(insert x X)"
  58.593 -using a1 a2
  58.594 -apply(simp add: fresh_fin_insert[OF pt, OF at, OF fs, OF f])
  58.595 -done
  58.596 +  using a1 a2
  58.597 +  by (simp add: fresh_fin_insert[OF pt, OF at, OF fs, OF f])
  58.598  
  58.599  lemma pt_list_set_supp:
  58.600    fixes xs :: "'a list"
  58.601 @@ -2571,14 +2437,191 @@
  58.602    shows "a\<sharp>(set xs) = a\<sharp>xs"
  58.603  by (simp add: fresh_def pt_list_set_supp[OF pt, OF at, OF fs])
  58.604  
  58.605 +
  58.606 +section {* generalisation of freshness to lists and sets of atoms *}
  58.607 +(*================================================================*)
  58.608 + 
  58.609 +consts
  58.610 +  fresh_star :: "'b \<Rightarrow> 'a \<Rightarrow> bool" ("_ \<sharp>* _" [100,100] 100)
  58.611 +
  58.612 +defs (overloaded)
  58.613 +  fresh_star_set: "xs\<sharp>*c \<equiv> \<forall>x\<in>xs. x\<sharp>c"
  58.614 +
  58.615 +defs (overloaded)
  58.616 +  fresh_star_list: "xs\<sharp>*c \<equiv> \<forall>x\<in>set xs. x\<sharp>c"
  58.617 +
  58.618 +lemmas fresh_star_def = fresh_star_list fresh_star_set
  58.619 +
  58.620 +lemma fresh_star_prod_set:
  58.621 +  fixes xs::"'a set"
  58.622 +  shows "xs\<sharp>*(a,b) = (xs\<sharp>*a \<and> xs\<sharp>*b)"
  58.623 +by (auto simp add: fresh_star_def fresh_prod)
  58.624 +
  58.625 +lemma fresh_star_prod_list:
  58.626 +  fixes xs::"'a list"
  58.627 +  shows "xs\<sharp>*(a,b) = (xs\<sharp>*a \<and> xs\<sharp>*b)"
  58.628 +  by (auto simp add: fresh_star_def fresh_prod)
  58.629 +
  58.630 +lemmas fresh_star_prod = fresh_star_prod_list fresh_star_prod_set
  58.631 +
  58.632 +lemma fresh_star_set_eq: "set xs \<sharp>* c = xs \<sharp>* c"
  58.633 +  by (simp add: fresh_star_def)
  58.634 +
  58.635 +lemma fresh_star_Un_elim:
  58.636 +  "((S \<union> T) \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (S \<sharp>* c \<Longrightarrow> T \<sharp>* c \<Longrightarrow> PROP C)"
  58.637 +  apply rule
  58.638 +  apply (simp_all add: fresh_star_def)
  58.639 +  apply (erule meta_mp)
  58.640 +  apply blast
  58.641 +  done
  58.642 +
  58.643 +lemma fresh_star_insert_elim:
  58.644 +  "(insert x S \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (x \<sharp> c \<Longrightarrow> S \<sharp>* c \<Longrightarrow> PROP C)"
  58.645 +  by rule (simp_all add: fresh_star_def)
  58.646 +
  58.647 +lemma fresh_star_empty_elim:
  58.648 +  "({} \<sharp>* c \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.649 +  by (simp add: fresh_star_def)
  58.650 +
  58.651 +text {* Normalization of freshness results; see \ @{text nominal_induct} *}
  58.652 +
  58.653 +lemma fresh_star_unit_elim: 
  58.654 +  shows "((a::'a set)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.655 +  and "((b::'a list)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
  58.656 +  by (simp_all add: fresh_star_def fresh_def supp_unit)
  58.657 +
  58.658 +lemma fresh_star_prod_elim: 
  58.659 +  shows "((a::'a set)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (a\<sharp>*x \<Longrightarrow> a\<sharp>*y \<Longrightarrow> PROP C)"
  58.660 +  and "((b::'a list)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (b\<sharp>*x \<Longrightarrow> b\<sharp>*y \<Longrightarrow> PROP C)"
  58.661 +  by (rule, simp_all add: fresh_star_prod)+
  58.662 +
  58.663 +
  58.664 +lemma pt_fresh_star_bij_ineq:
  58.665 +  fixes  pi :: "'x prm"
  58.666 +  and     x :: "'a"
  58.667 +  and     a :: "'y set"
  58.668 +  and     b :: "'y list"
  58.669 +  assumes pta: "pt TYPE('a) TYPE('x)"
  58.670 +  and     ptb: "pt TYPE('y) TYPE('x)"
  58.671 +  and     at:  "at TYPE('x)"
  58.672 +  and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
  58.673 +  shows "(pi\<bullet>a)\<sharp>*(pi\<bullet>x) = a\<sharp>*x"
  58.674 +  and   "(pi\<bullet>b)\<sharp>*(pi\<bullet>x) = b\<sharp>*x"
  58.675 +apply(unfold fresh_star_def)
  58.676 +apply(auto)
  58.677 +apply(drule_tac x="pi\<bullet>xa" in bspec)
  58.678 +apply(erule pt_set_bij2[OF ptb, OF at])
  58.679 +apply(simp add: fresh_star_def pt_fresh_bij_ineq[OF pta, OF ptb, OF at, OF cp])
  58.680 +apply(drule_tac x="(rev pi)\<bullet>xa" in bspec)
  58.681 +apply(simp add: pt_set_bij1[OF ptb, OF at])
  58.682 +apply(simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp])
  58.683 +apply(drule_tac x="pi\<bullet>xa" in bspec)
  58.684 +apply(simp add: pt_set_bij1[OF ptb, OF at])
  58.685 +apply(simp add: pt_set_eqvt [OF ptb at] pt_rev_pi[OF pt_list_inst[OF ptb], OF at])
  58.686 +apply(simp add: pt_fresh_bij_ineq[OF pta, OF ptb, OF at, OF cp])
  58.687 +apply(drule_tac x="(rev pi)\<bullet>xa" in bspec)
  58.688 +apply(simp add: pt_set_bij1[OF ptb, OF at] pt_set_eqvt [OF ptb at])
  58.689 +apply(simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp])
  58.690 +done
  58.691 +
  58.692 +lemma pt_fresh_star_bij:
  58.693 +  fixes  pi :: "'x prm"
  58.694 +  and     x :: "'a"
  58.695 +  and     a :: "'x set"
  58.696 +  and     b :: "'x list"
  58.697 +  assumes pt: "pt TYPE('a) TYPE('x)"
  58.698 +  and     at: "at TYPE('x)"
  58.699 +  shows "(pi\<bullet>a)\<sharp>*(pi\<bullet>x) = a\<sharp>*x"
  58.700 +  and   "(pi\<bullet>b)\<sharp>*(pi\<bullet>x) = b\<sharp>*x"
  58.701 +apply(rule pt_fresh_star_bij_ineq(1))
  58.702 +apply(rule pt)
  58.703 +apply(rule at_pt_inst)
  58.704 +apply(rule at)+
  58.705 +apply(rule cp_pt_inst)
  58.706 +apply(rule pt)
  58.707 +apply(rule at)
  58.708 +apply(rule pt_fresh_star_bij_ineq(2))
  58.709 +apply(rule pt)
  58.710 +apply(rule at_pt_inst)
  58.711 +apply(rule at)+
  58.712 +apply(rule cp_pt_inst)
  58.713 +apply(rule pt)
  58.714 +apply(rule at)
  58.715 +done
  58.716 +
  58.717 +lemma pt_fresh_star_eqvt:
  58.718 +  fixes  pi :: "'x prm"
  58.719 +  and     x :: "'a"
  58.720 +  and     a :: "'x set"
  58.721 +  and     b :: "'x list"
  58.722 +  assumes pt: "pt TYPE('a) TYPE('x)"
  58.723 +  and     at: "at TYPE('x)"
  58.724 +  shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
  58.725 +  and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
  58.726 +  by (simp_all add: perm_bool pt_fresh_star_bij[OF pt, OF at])
  58.727 +
  58.728 +lemma pt_fresh_star_eqvt_ineq:
  58.729 +  fixes pi::"'x prm"
  58.730 +  and   a::"'y set"
  58.731 +  and   b::"'y list"
  58.732 +  and   x::"'a"
  58.733 +  assumes pta: "pt TYPE('a) TYPE('x)"
  58.734 +  and     ptb: "pt TYPE('y) TYPE('x)"
  58.735 +  and     at:  "at TYPE('x)"
  58.736 +  and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
  58.737 +  and     dj:  "disjoint TYPE('y) TYPE('x)"
  58.738 +  shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
  58.739 +  and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
  58.740 +  by (simp_all add: pt_fresh_star_bij_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)
  58.741 +
  58.742 +lemma pt_freshs_freshs:
  58.743 +  assumes pt: "pt TYPE('a) TYPE('x)"
  58.744 +  and at: "at TYPE ('x)"
  58.745 +  and pi: "set (pi::'x prm) \<subseteq> Xs \<times> Ys"
  58.746 +  and Xs: "Xs \<sharp>* (x::'a)"
  58.747 +  and Ys: "Ys \<sharp>* x"
  58.748 +  shows "pi\<bullet>x = x"
  58.749 +  using pi
  58.750 +proof (induct pi)
  58.751 +  case Nil
  58.752 +  show ?case by (simp add: pt1 [OF pt])
  58.753 +next
  58.754 +  case (Cons p pi)
  58.755 +  obtain a b where p: "p = (a, b)" by (cases p)
  58.756 +  with Cons Xs Ys have "a \<sharp> x" "b \<sharp> x"
  58.757 +    by (simp_all add: fresh_star_def)
  58.758 +  with Cons p show ?case
  58.759 +    by (simp add: pt_fresh_fresh [OF pt at]
  58.760 +      pt2 [OF pt, of "[(a, b)]" pi, simplified])
  58.761 +qed
  58.762 +
  58.763 +lemma pt_fresh_star_pi: 
  58.764 +  fixes x::"'a"
  58.765 +  and   pi::"'x prm"
  58.766 +  assumes pt: "pt TYPE('a) TYPE('x)"
  58.767 +  and     at: "at TYPE('x)"
  58.768 +  and     a: "((supp x)::'x set)\<sharp>* pi"
  58.769 +  shows "pi\<bullet>x = x"
  58.770 +using a
  58.771 +apply(induct pi)
  58.772 +apply(auto simp add: fresh_star_def fresh_list_cons fresh_prod pt1[OF pt])
  58.773 +apply(subgoal_tac "((a,b)#pi)\<bullet>x = ([(a,b)]@pi)\<bullet>x")
  58.774 +apply(simp only: pt2[OF pt])
  58.775 +apply(rule pt_fresh_fresh[OF pt at])
  58.776 +apply(simp add: fresh_def at_supp[OF at])
  58.777 +apply(blast)
  58.778 +apply(simp add: fresh_def at_supp[OF at])
  58.779 +apply(blast)
  58.780 +apply(simp add: pt2[OF pt])
  58.781 +done
  58.782 +
  58.783  section {* Infrastructure lemmas for strong rule inductions *}
  58.784  (*==========================================================*)
  58.785  
  58.786 -
  58.787  text {* 
  58.788    For every set of atoms, there is another set of atoms
  58.789    avoiding a finitely supported c and there is a permutation
  58.790 -  which make 'translates' between both sets.
  58.791 +  which 'translates' between both sets.
  58.792  *}
  58.793  lemma at_set_avoiding_aux:
  58.794    fixes Xs::"'a set"
  58.795 @@ -3365,7 +3408,6 @@
  58.796  
  58.797  syntax ABS :: "type \<Rightarrow> type \<Rightarrow> type" ("\<guillemotleft>_\<guillemotright>_" [1000,1000] 1000)
  58.798  
  58.799 -
  58.800  section {* lemmas for deciding permutation equations *}
  58.801  (*===================================================*)
  58.802  
  58.803 @@ -3526,8 +3568,8 @@
  58.804    shows "pi\<bullet>(x div y) = (pi\<bullet>x) div (pi\<bullet>y)" 
  58.805  by (simp add:perm_int_def) 
  58.806  
  58.807 -(*******************************************************************)
  58.808 -(* Setup of the theorem attributes eqvt, eqvt_force, fresh and bij *)
  58.809 +(*******************************************************)
  58.810 +(* Setup of the theorem attributes eqvt and eqvt_force *)
  58.811  use "nominal_thmdecls.ML"
  58.812  setup "NominalThmDecls.setup"
  58.813  
    59.1 --- a/src/HOL/Nominal/nominal_thmdecls.ML	Wed Apr 22 11:00:25 2009 -0700
    59.2 +++ b/src/HOL/Nominal/nominal_thmdecls.ML	Mon Apr 27 07:26:17 2009 -0700
    59.3 @@ -1,12 +1,12 @@
    59.4  (* Authors: Julien Narboux and Christian Urban
    59.5  
    59.6     This file introduces the infrastructure for the lemma
    59.7 -   declaration "eqvts" "bijs" and "freshs".
    59.8 +   collection "eqvts".
    59.9  
   59.10 -   By attaching [eqvt] [bij] or [fresh] to a lemma, the lemma gets stored
   59.11 -   in a data-slot in the context. Possible modifiers
   59.12 -   are [attribute add] and [attribute del] for adding and deleting,
   59.13 -   respectively the lemma from the data-slot.
   59.14 +   By attaching [eqvt] or [eqvt_force] to a lemma, it will get 
   59.15 +   stored in a data-slot in the context. Possible modifiers
   59.16 +   are [... add] and [... del] for adding and deleting, 
   59.17 +   respectively, the lemma from the data-slot.
   59.18  *)
   59.19  
   59.20  signature NOMINAL_THMDECLS =
   59.21 @@ -17,9 +17,6 @@
   59.22    val eqvt_force_del: attribute
   59.23    val setup: theory -> theory
   59.24    val get_eqvt_thms: Proof.context -> thm list
   59.25 -  val get_fresh_thms: Proof.context -> thm list
   59.26 -  val get_bij_thms: Proof.context -> thm list
   59.27 -
   59.28  
   59.29    val NOMINAL_EQVT_DEBUG : bool ref
   59.30  end;
   59.31 @@ -29,13 +26,11 @@
   59.32  
   59.33  structure Data = GenericDataFun
   59.34  (
   59.35 -  type T = {eqvts:thm list, freshs:thm list, bijs:thm list};
   59.36 -  val empty = ({eqvts=[], freshs=[], bijs=[]}:T);
   59.37 -  val extend = I;
   59.38 -  fun merge _ (r1:T,r2:T) = {eqvts  = Thm.merge_thms (#eqvts r1, #eqvts r2),
   59.39 -                             freshs = Thm.merge_thms (#freshs r1, #freshs r2),
   59.40 -                             bijs   = Thm.merge_thms (#bijs r1, #bijs r2)}
   59.41 -);
   59.42 +  type T = thm list
   59.43 +  val empty = []:T
   59.44 +  val extend = I
   59.45 +  fun merge _ (r1:T, r2:T) = Thm.merge_thms (r1, r2)
   59.46 +)
   59.47  
   59.48  (* Exception for when a theorem does not conform with form of an equivariance lemma. *)
   59.49  (* There are two forms: one is an implication (for relations) and the other is an    *)
   59.50 @@ -46,72 +41,68 @@
   59.51  (* the implicational case it is also checked that the variables and permutation fit  *)
   59.52  (* together, i.e. are of the right "pt_class", so that a stronger version of the     *)
   59.53  (* equality-lemma can be derived. *)
   59.54 -exception EQVT_FORM of string;
   59.55 +exception EQVT_FORM of string
   59.56  
   59.57 -val get_eqvt_thms = Context.Proof #> Data.get #> #eqvts;
   59.58 -val get_fresh_thms = Context.Proof #> Data.get #> #freshs;
   59.59 -val get_bij_thms = Context.Proof #> Data.get #> #bijs;
   59.60 +val NOMINAL_EQVT_DEBUG = ref false
   59.61  
   59.62 -(* FIXME: should be a function in a library *)
   59.63 -fun mk_permT T = HOLogic.listT (HOLogic.mk_prodT (T, T));
   59.64 -
   59.65 -val NOMINAL_EQVT_DEBUG = ref false;
   59.66 -
   59.67 -fun tactic (msg,tac) =
   59.68 -    if !NOMINAL_EQVT_DEBUG
   59.69 -    then tac THEN print_tac ("after "^msg)
   59.70 -    else tac
   59.71 +fun tactic (msg, tac) =
   59.72 +  if !NOMINAL_EQVT_DEBUG
   59.73 +  then tac THEN' (K (print_tac ("after " ^ msg)))
   59.74 +  else tac
   59.75  
   59.76 -fun tactic_eqvt ctx orig_thm pi pi' =
   59.77 -    let
   59.78 -        val mypi = Thm.cterm_of ctx pi
   59.79 -        val T = fastype_of pi'
   59.80 -        val mypifree = Thm.cterm_of ctx (Const ("List.rev", T --> T) $ pi')
   59.81 -        val perm_pi_simp = PureThy.get_thms ctx "perm_pi_simp"
   59.82 -    in
   59.83 -        EVERY [tactic ("iffI applied",rtac iffI 1),
   59.84 -	       tactic ("remove pi with perm_boolE", (dtac @{thm perm_boolE} 1)),
   59.85 -               tactic ("solve with orig_thm", (etac orig_thm 1)),
   59.86 -               tactic ("applies orig_thm instantiated with rev pi",
   59.87 -                          dtac (Drule.cterm_instantiate [(mypi,mypifree)] orig_thm) 1),
   59.88 -	       tactic ("getting rid of the pi on the right",
   59.89 -                          (rtac @{thm perm_boolI} 1)),
   59.90 -               tactic ("getting rid of all remaining perms",
   59.91 -                          full_simp_tac (HOL_basic_ss addsimps perm_pi_simp) 1)]
   59.92 -    end;
   59.93 +fun prove_eqvt_tac ctxt orig_thm pi pi' =
   59.94 +let
   59.95 +  val mypi = Thm.cterm_of ctxt pi
   59.96 +  val T = fastype_of pi'
   59.97 +  val mypifree = Thm.cterm_of ctxt (Const (@{const_name "rev"}, T --> T) $ pi')
   59.98 +  val perm_pi_simp = PureThy.get_thms ctxt "perm_pi_simp"
   59.99 +in
  59.100 +  EVERY1 [tactic ("iffI applied", rtac @{thm iffI}),
  59.101 +	  tactic ("remove pi with perm_boolE", dtac @{thm perm_boolE}),
  59.102 +          tactic ("solve with orig_thm", etac orig_thm),
  59.103 +          tactic ("applies orig_thm instantiated with rev pi",
  59.104 +                     dtac (Drule.cterm_instantiate [(mypi,mypifree)] orig_thm)),
  59.105 +	  tactic ("getting rid of the pi on the right", rtac @{thm perm_boolI}),
  59.106 +          tactic ("getting rid of all remaining perms",
  59.107 +                     full_simp_tac (HOL_basic_ss addsimps perm_pi_simp))]
  59.108 +end;
  59.109  
  59.110  fun get_derived_thm ctxt hyp concl orig_thm pi typi =
  59.111    let
  59.112      val thy = ProofContext.theory_of ctxt;
  59.113      val pi' = Var (pi, typi);
  59.114 -    val lhs = Const ("Nominal.perm", typi --> HOLogic.boolT --> HOLogic.boolT) $ pi' $ hyp;
  59.115 +    val lhs = Const (@{const_name "perm"}, typi --> HOLogic.boolT --> HOLogic.boolT) $ pi' $ hyp;
  59.116      val ([goal_term, pi''], ctxt') = Variable.import_terms false
  59.117        [HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, concl)), pi'] ctxt
  59.118      val _ = Display.print_cterm (cterm_of thy goal_term)
  59.119    in
  59.120      Goal.prove ctxt' [] [] goal_term
  59.121 -      (fn _ => tactic_eqvt thy orig_thm pi' pi'') |>
  59.122 +      (fn _ => prove_eqvt_tac thy orig_thm pi' pi'') |>
  59.123      singleton (ProofContext.export ctxt' ctxt)
  59.124    end
  59.125  
  59.126 -(* replaces every variable x in t with pi o x *)
  59.127 -fun apply_pi trm (pi,typi) =
  59.128 -  let
  59.129 -    fun only_vars t =
  59.130 -       (case t of
  59.131 -          Var (n,ty) => (Const ("Nominal.perm",typi --> ty --> ty) $ (Var (pi,typi)) $ (Var (n,ty)))
  59.132 -        | _ => t)
  59.133 +(* replaces in t every variable, say x, with pi o x *)
  59.134 +fun apply_pi trm (pi, typi) =
  59.135 +let
  59.136 +  fun replace n ty =
  59.137 +  let 
  59.138 +    val c  = Const (@{const_name "perm"}, typi --> ty --> ty) 
  59.139 +    val v1 = Var (pi, typi)
  59.140 +    val v2 = Var (n, ty)
  59.141    in
  59.142 -     map_aterms only_vars trm
  59.143 -  end;
  59.144 +    c $ v1 $ v2 
  59.145 +  end
  59.146 +in
  59.147 +  map_aterms (fn Var (n, ty) => replace n ty | t => t) trm
  59.148 +end
  59.149  
  59.150  (* returns *the* pi which is in front of all variables, provided there *)
  59.151  (* exists such a pi; otherwise raises EQVT_FORM                        *)
  59.152  fun get_pi t thy =
  59.153    let fun get_pi_aux s =
  59.154          (case s of
  59.155 -          (Const ("Nominal.perm",typrm) $
  59.156 -             (Var (pi,typi as Type("List.list",[Type ("*",[Type (tyatm,[]),_])]))) $
  59.157 +          (Const (@{const_name "perm"} ,typrm) $
  59.158 +             (Var (pi,typi as Type(@{type_name "list"}, [Type ("*", [Type (tyatm,[]),_])]))) $
  59.159                 (Var (n,ty))) =>
  59.160               let
  59.161                  (* FIXME: this should be an operation the library *)
  59.162 @@ -130,7 +121,7 @@
  59.163      (* to ensure that all pi's must have been the same, i.e. distinct returns  *)
  59.164      (* a singleton-list  *)
  59.165      (case (distinct (op =) (get_pi_aux t)) of
  59.166 -      [(pi,typi)] => (pi,typi)
  59.167 +      [(pi,typi)] => (pi, typi)
  59.168      | _ => raise EQVT_FORM "All permutation should be the same")
  59.169    end;
  59.170  
  59.171 @@ -155,8 +146,8 @@
  59.172               else raise EQVT_FORM "Type Implication"
  59.173            end
  59.174         (* case: eqvt-lemma is of the equational form *)
  59.175 -      | (Const ("Trueprop", _) $ (Const ("op =", _) $
  59.176 -            (Const ("Nominal.perm",typrm) $ Var (pi,typi) $ lhs) $ rhs)) =>
  59.177 +      | (Const (@{const_name "Trueprop"}, _) $ (Const (@{const_name "op ="}, _) $
  59.178 +            (Const (@{const_name "perm"},typrm) $ Var (pi,typi) $ lhs) $ rhs)) =>
  59.179             (if (apply_pi lhs (pi,typi)) = rhs
  59.180                 then [orig_thm]
  59.181                 else raise EQVT_FORM "Type Equality")
  59.182 @@ -165,38 +156,24 @@
  59.183        fold (fn thm => Data.map (flag thm)) thms_to_be_added context
  59.184    end
  59.185    handle EQVT_FORM s =>
  59.186 -      error (Display.string_of_thm orig_thm ^ " does not comply with the form of an equivariance lemma ("^s^").")
  59.187 -
  59.188 -(* in cases of bij- and freshness, we just add the lemmas to the *)
  59.189 -(* data-slot *)
  59.190 -
  59.191 -fun eqvt_map f (r:Data.T)  = {eqvts = f (#eqvts r), freshs = #freshs r, bijs = #bijs r};
  59.192 -fun fresh_map f (r:Data.T) = {eqvts = #eqvts r, freshs = f (#freshs r), bijs = #bijs r};
  59.193 -fun bij_map f (r:Data.T)   = {eqvts = #eqvts r, freshs = #freshs r, bijs = f (#bijs r)};
  59.194 -
  59.195 -val eqvt_add = Thm.declaration_attribute (eqvt_add_del_aux (eqvt_map o Thm.add_thm));
  59.196 -val eqvt_del = Thm.declaration_attribute (eqvt_add_del_aux (eqvt_map o Thm.del_thm));
  59.197 -
  59.198 -val eqvt_force_add  = Thm.declaration_attribute (Data.map o eqvt_map o Thm.add_thm);
  59.199 -val eqvt_force_del  = Thm.declaration_attribute (Data.map o eqvt_map o Thm.del_thm);
  59.200 -val bij_add   = Thm.declaration_attribute (Data.map o bij_map o Thm.add_thm);
  59.201 -val bij_del   = Thm.declaration_attribute (Data.map o bij_map o Thm.del_thm);
  59.202 -val fresh_add = Thm.declaration_attribute (Data.map o fresh_map o Thm.add_thm);
  59.203 -val fresh_del = Thm.declaration_attribute (Data.map o fresh_map o Thm.del_thm);
  59.204 +      error (Display.string_of_thm orig_thm ^ 
  59.205 +               " does not comply with the form of an equivariance lemma (" ^ s ^").")
  59.206  
  59.207  
  59.208 +val eqvt_add = Thm.declaration_attribute (eqvt_add_del_aux (Thm.add_thm));
  59.209 +val eqvt_del = Thm.declaration_attribute (eqvt_add_del_aux (Thm.del_thm));
  59.210 +
  59.211 +val eqvt_force_add  = Thm.declaration_attribute (Data.map o Thm.add_thm);
  59.212 +val eqvt_force_del  = Thm.declaration_attribute (Data.map o Thm.del_thm);
  59.213 +
  59.214 +val get_eqvt_thms = Context.Proof #> Data.get;
  59.215  
  59.216  val setup =
  59.217 -  Attrib.setup @{binding eqvt} (Attrib.add_del eqvt_add eqvt_del)
  59.218 -    "equivariance theorem declaration" #>
  59.219 -  Attrib.setup @{binding eqvt_force} (Attrib.add_del eqvt_force_add eqvt_force_del)
  59.220 -    "equivariance theorem declaration (without checking the form of the lemma)" #>
  59.221 -  Attrib.setup @{binding fresh} (Attrib.add_del fresh_add fresh_del)
  59.222 -    "freshness theorem declaration" #>
  59.223 -  Attrib.setup @{binding "bij"} (Attrib.add_del bij_add bij_del)
  59.224 -    "bijection theorem declaration" #>
  59.225 -  PureThy.add_thms_dynamic (Binding.name "eqvts", #eqvts o Data.get) #>
  59.226 -  PureThy.add_thms_dynamic (Binding.name "freshs", #freshs o Data.get) #>
  59.227 -  PureThy.add_thms_dynamic (Binding.name "bijs", #bijs o Data.get);
  59.228 +    Attrib.setup @{binding eqvt} (Attrib.add_del eqvt_add eqvt_del) 
  59.229 +     "equivariance theorem declaration" 
  59.230 + #> Attrib.setup @{binding eqvt_force} (Attrib.add_del eqvt_force_add eqvt_force_del)
  59.231 +     "equivariance theorem declaration (without checking the form of the lemma)" 
  59.232 + #> PureThy.add_thms_dynamic (Binding.name "eqvts", Data.get) 
  59.233 +
  59.234  
  59.235  end;
    60.1 --- a/src/HOL/Orderings.thy	Wed Apr 22 11:00:25 2009 -0700
    60.2 +++ b/src/HOL/Orderings.thy	Mon Apr 27 07:26:17 2009 -0700
    60.3 @@ -5,7 +5,7 @@
    60.4  header {* Abstract orderings *}
    60.5  
    60.6  theory Orderings
    60.7 -imports Code_Setup
    60.8 +imports HOL
    60.9  uses "~~/src/Provers/order.ML"
   60.10  begin
   60.11  
    61.1 --- a/src/HOL/Power.thy	Wed Apr 22 11:00:25 2009 -0700
    61.2 +++ b/src/HOL/Power.thy	Mon Apr 27 07:26:17 2009 -0700
    61.3 @@ -1,95 +1,179 @@
    61.4  (*  Title:      HOL/Power.thy
    61.5 -    ID:         $Id$
    61.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    61.7      Copyright   1997  University of Cambridge
    61.8 -
    61.9  *)
   61.10  
   61.11 -header{*Exponentiation*}
   61.12 +header {* Exponentiation *}
   61.13  
   61.14  theory Power
   61.15  imports Nat
   61.16  begin
   61.17  
   61.18 -class power =
   61.19 -  fixes power :: "'a \<Rightarrow> nat \<Rightarrow> 'a"            (infixr "^" 80)
   61.20 +subsection {* Powers for Arbitrary Monoids *}
   61.21 +
   61.22 +class power = one + times
   61.23 +begin
   61.24  
   61.25 -subsection{*Powers for Arbitrary Monoids*}
   61.26 +primrec power :: "'a \<Rightarrow> nat \<Rightarrow> 'a" (infixr "^" 80) where
   61.27 +    power_0: "a ^ 0 = 1"
   61.28 +  | power_Suc: "a ^ Suc n = a * a ^ n"
   61.29 +
   61.30 +notation (latex output)
   61.31 +  power ("(_\<^bsup>_\<^esup>)" [1000] 1000)
   61.32  
   61.33 -class recpower = monoid_mult + power +
   61.34 -  assumes power_0 [simp]: "a ^ 0       = 1"
   61.35 -  assumes power_Suc [simp]: "a ^ Suc n = a * (a ^ n)"
   61.36 +notation (HTML output)
   61.37 +  power ("(_\<^bsup>_\<^esup>)" [1000] 1000)
   61.38 +
   61.39 +end
   61.40 +
   61.41 +context monoid_mult
   61.42 +begin
   61.43  
   61.44 -lemma power_0_Suc [simp]: "(0::'a::{recpower,semiring_0}) ^ (Suc n) = 0"
   61.45 +subclass power ..
   61.46 +
   61.47 +lemma power_one [simp]:
   61.48 +  "1 ^ n = 1"
   61.49 +  by (induct n) simp_all
   61.50 +
   61.51 +lemma power_one_right [simp]:
   61.52 +  "a ^ 1 = a"
   61.53    by simp
   61.54  
   61.55 -text{*It looks plausible as a simprule, but its effect can be strange.*}
   61.56 -lemma power_0_left: "0^n = (if n=0 then 1 else (0::'a::{recpower,semiring_0}))"
   61.57 -  by (induct n) simp_all
   61.58 -
   61.59 -lemma power_one [simp]: "1^n = (1::'a::recpower)"
   61.60 -  by (induct n) simp_all
   61.61 -
   61.62 -lemma power_one_right [simp]: "(a::'a::recpower) ^ 1 = a"
   61.63 -  unfolding One_nat_def by simp
   61.64 -
   61.65 -lemma power_commutes: "(a::'a::recpower) ^ n * a = a * a ^ n"
   61.66 +lemma power_commutes:
   61.67 +  "a ^ n * a = a * a ^ n"
   61.68    by (induct n) (simp_all add: mult_assoc)
   61.69  
   61.70 -lemma power_Suc2: "(a::'a::recpower) ^ Suc n = a ^ n * a"
   61.71 +lemma power_Suc2:
   61.72 +  "a ^ Suc n = a ^ n * a"
   61.73    by (simp add: power_commutes)
   61.74  
   61.75 -lemma power_add: "(a::'a::recpower) ^ (m+n) = (a^m) * (a^n)"
   61.76 -  by (induct m) (simp_all add: mult_ac)
   61.77 +lemma power_add:
   61.78 +  "a ^ (m + n) = a ^ m * a ^ n"
   61.79 +  by (induct m) (simp_all add: algebra_simps)
   61.80  
   61.81 -lemma power_mult: "(a::'a::recpower) ^ (m*n) = (a^m) ^ n"
   61.82 +lemma power_mult:
   61.83 +  "a ^ (m * n) = (a ^ m) ^ n"
   61.84    by (induct n) (simp_all add: power_add)
   61.85  
   61.86 -lemma power_mult_distrib: "((a::'a::{recpower,comm_monoid_mult}) * b) ^ n = (a^n) * (b^n)"
   61.87 +end
   61.88 +
   61.89 +context comm_monoid_mult
   61.90 +begin
   61.91 +
   61.92 +lemma power_mult_distrib:
   61.93 +  "(a * b) ^ n = (a ^ n) * (b ^ n)"
   61.94    by (induct n) (simp_all add: mult_ac)
   61.95  
   61.96 -lemma zero_less_power[simp]:
   61.97 -     "0 < (a::'a::{ordered_semidom,recpower}) ==> 0 < a^n"
   61.98 -by (induct n) (simp_all add: mult_pos_pos)
   61.99 +end
  61.100 +
  61.101 +context semiring_1
  61.102 +begin
  61.103 +
  61.104 +lemma of_nat_power:
  61.105 +  "of_nat (m ^ n) = of_nat m ^ n"
  61.106 +  by (induct n) (simp_all add: of_nat_mult)
  61.107 +
  61.108 +end
  61.109 +
  61.110 +context comm_semiring_1
  61.111 +begin
  61.112 +
  61.113 +text {* The divides relation *}
  61.114 +
  61.115 +lemma le_imp_power_dvd:
  61.116 +  assumes "m \<le> n" shows "a ^ m dvd a ^ n"
  61.117 +proof
  61.118 +  have "a ^ n = a ^ (m + (n - m))"
  61.119 +    using `m \<le> n` by simp
  61.120 +  also have "\<dots> = a ^ m * a ^ (n - m)"
  61.121 +    by (rule power_add)
  61.122 +  finally show "a ^ n = a ^ m * a ^ (n - m)" .
  61.123 +qed
  61.124 +
  61.125 +lemma power_le_dvd:
  61.126 +  "a ^ n dvd b \<Longrightarrow> m \<le> n \<Longrightarrow> a ^ m dvd b"
  61.127 +  by (rule dvd_trans [OF le_imp_power_dvd])
  61.128 +
  61.129 +lemma dvd_power_same:
  61.130 +  "x dvd y \<Longrightarrow> x ^ n dvd y ^ n"
  61.131 +  by (induct n) (auto simp add: mult_dvd_mono)
  61.132 +
  61.133 +lemma dvd_power_le:
  61.134 +  "x dvd y \<Longrightarrow> m \<ge> n \<Longrightarrow> x ^ n dvd y ^ m"
  61.135 +  by (rule power_le_dvd [OF dvd_power_same])
  61.136  
  61.137 -lemma zero_le_power[simp]:
  61.138 -     "0 \<le> (a::'a::{ordered_semidom,recpower}) ==> 0 \<le> a^n"
  61.139 -by (induct n) (simp_all add: mult_nonneg_nonneg)
  61.140 +lemma dvd_power [simp]:
  61.141 +  assumes "n > (0::nat) \<or> x = 1"
  61.142 +  shows "x dvd (x ^ n)"
  61.143 +using assms proof
  61.144 +  assume "0 < n"
  61.145 +  then have "x ^ n = x ^ Suc (n - 1)" by simp
  61.146 +  then show "x dvd (x ^ n)" by simp
  61.147 +next
  61.148 +  assume "x = 1"
  61.149 +  then show "x dvd (x ^ n)" by simp
  61.150 +qed
  61.151 +
  61.152 +end
  61.153 +
  61.154 +context ring_1
  61.155 +begin
  61.156 +
  61.157 +lemma power_minus:
  61.158 +  "(- a) ^ n = (- 1) ^ n * a ^ n"
  61.159 +proof (induct n)
  61.160 +  case 0 show ?case by simp
  61.161 +next
  61.162 +  case (Suc n) then show ?case
  61.163 +    by (simp del: power_Suc add: power_Suc2 mult_assoc)
  61.164 +qed
  61.165 +
  61.166 +end
  61.167 +
  61.168 +context ordered_semidom
  61.169 +begin
  61.170 +
  61.171 +lemma zero_less_power [simp]:
  61.172 +  "0 < a \<Longrightarrow> 0 < a ^ n"
  61.173 +  by (induct n) (simp_all add: mult_pos_pos)
  61.174 +
  61.175 +lemma zero_le_power [simp]:
  61.176 +  "0 \<le> a \<Longrightarrow> 0 \<le> a ^ n"
  61.177 +  by (induct n) (simp_all add: mult_nonneg_nonneg)
  61.178  
  61.179  lemma one_le_power[simp]:
  61.180 -     "1 \<le> (a::'a::{ordered_semidom,recpower}) ==> 1 \<le> a^n"
  61.181 -apply (induct "n")
  61.182 -apply simp_all
  61.183 -apply (rule order_trans [OF _ mult_mono [of 1 _ 1]])
  61.184 -apply (simp_all add: order_trans [OF zero_le_one])
  61.185 -done
  61.186 -
  61.187 -lemma gt1_imp_ge0: "1 < a ==> 0 \<le> (a::'a::ordered_semidom)"
  61.188 -  by (simp add: order_trans [OF zero_le_one order_less_imp_le])
  61.189 +  "1 \<le> a \<Longrightarrow> 1 \<le> a ^ n"
  61.190 +  apply (induct n)
  61.191 +  apply simp_all
  61.192 +  apply (rule order_trans [OF _ mult_mono [of 1 _ 1]])
  61.193 +  apply (simp_all add: order_trans [OF zero_le_one])
  61.194 +  done
  61.195  
  61.196  lemma power_gt1_lemma:
  61.197 -  assumes gt1: "1 < (a::'a::{ordered_semidom,recpower})"
  61.198 -  shows "1 < a * a^n"
  61.199 +  assumes gt1: "1 < a"
  61.200 +  shows "1 < a * a ^ n"
  61.201  proof -
  61.202 -  have "1*1 < a*1" using gt1 by simp
  61.203 -  also have "\<dots> \<le> a * a^n" using gt1
  61.204 -    by (simp only: mult_mono gt1_imp_ge0 one_le_power order_less_imp_le
  61.205 +  from gt1 have "0 \<le> a"
  61.206 +    by (fact order_trans [OF zero_le_one less_imp_le])
  61.207 +  have "1 * 1 < a * 1" using gt1 by simp
  61.208 +  also have "\<dots> \<le> a * a ^ n" using gt1
  61.209 +    by (simp only: mult_mono `0 \<le> a` one_le_power order_less_imp_le
  61.210          zero_le_one order_refl)
  61.211    finally show ?thesis by simp
  61.212  qed
  61.213  
  61.214 -lemma one_less_power[simp]:
  61.215 -  "\<lbrakk>1 < (a::'a::{ordered_semidom,recpower}); 0 < n\<rbrakk> \<Longrightarrow> 1 < a ^ n"
  61.216 -by (cases n, simp_all add: power_gt1_lemma)
  61.217 +lemma power_gt1:
  61.218 +  "1 < a \<Longrightarrow> 1 < a ^ Suc n"
  61.219 +  by (simp add: power_gt1_lemma)
  61.220  
  61.221 -lemma power_gt1:
  61.222 -     "1 < (a::'a::{ordered_semidom,recpower}) ==> 1 < a ^ (Suc n)"
  61.223 -by (simp add: power_gt1_lemma)
  61.224 +lemma one_less_power [simp]:
  61.225 +  "1 < a \<Longrightarrow> 0 < n \<Longrightarrow> 1 < a ^ n"
  61.226 +  by (cases n) (simp_all add: power_gt1_lemma)
  61.227  
  61.228  lemma power_le_imp_le_exp:
  61.229 -  assumes gt1: "(1::'a::{recpower,ordered_semidom}) < a"
  61.230 -  shows "!!n. a^m \<le> a^n ==> m \<le> n"
  61.231 -proof (induct m)
  61.232 +  assumes gt1: "1 < a"
  61.233 +  shows "a ^ m \<le> a ^ n \<Longrightarrow> m \<le> n"
  61.234 +proof (induct m arbitrary: n)
  61.235    case 0
  61.236    show ?case by simp
  61.237  next
  61.238 @@ -97,212 +181,128 @@
  61.239    show ?case
  61.240    proof (cases n)
  61.241      case 0
  61.242 -    from prems have "a * a^m \<le> 1" by simp
  61.243 +    with Suc.prems Suc.hyps have "a * a ^ m \<le> 1" by simp
  61.244      with gt1 show ?thesis
  61.245        by (force simp only: power_gt1_lemma
  61.246 -          linorder_not_less [symmetric])
  61.247 +          not_less [symmetric])
  61.248    next
  61.249      case (Suc n)
  61.250 -    from prems show ?thesis
  61.251 +    with Suc.prems Suc.hyps show ?thesis
  61.252        by (force dest: mult_left_le_imp_le
  61.253 -          simp add: order_less_trans [OF zero_less_one gt1])
  61.254 +          simp add: less_trans [OF zero_less_one gt1])
  61.255    qed
  61.256  qed
  61.257  
  61.258  text{*Surely we can strengthen this? It holds for @{text "0<a<1"} too.*}
  61.259  lemma power_inject_exp [simp]:
  61.260 -     "1 < (a::'a::{ordered_semidom,recpower}) ==> (a^m = a^n) = (m=n)"
  61.261 +  "1 < a \<Longrightarrow> a ^ m = a ^ n \<longleftrightarrow> m = n"
  61.262    by (force simp add: order_antisym power_le_imp_le_exp)
  61.263  
  61.264  text{*Can relax the first premise to @{term "0<a"} in the case of the
  61.265  natural numbers.*}
  61.266  lemma power_less_imp_less_exp:
  61.267 -     "[| (1::'a::{recpower,ordered_semidom}) < a; a^m < a^n |] ==> m < n"
  61.268 -by (simp add: order_less_le [of m n] order_less_le [of "a^m" "a^n"]
  61.269 -              power_le_imp_le_exp)
  61.270 -
  61.271 +  "1 < a \<Longrightarrow> a ^ m < a ^ n \<Longrightarrow> m < n"
  61.272 +  by (simp add: order_less_le [of m n] less_le [of "a^m" "a^n"]
  61.273 +    power_le_imp_le_exp)
  61.274  
  61.275  lemma power_mono:
  61.276 -     "[|a \<le> b; (0::'a::{recpower,ordered_semidom}) \<le> a|] ==> a^n \<le> b^n"
  61.277 -apply (induct "n")
  61.278 -apply simp_all
  61.279 -apply (auto intro: mult_mono order_trans [of 0 a b])
  61.280 -done
  61.281 +  "a \<le> b \<Longrightarrow> 0 \<le> a \<Longrightarrow> a ^ n \<le> b ^ n"
  61.282 +  by (induct n)
  61.283 +    (auto intro: mult_mono order_trans [of 0 a b])
  61.284  
  61.285  lemma power_strict_mono [rule_format]:
  61.286 -     "[|a < b; (0::'a::{recpower,ordered_semidom}) \<le> a|]
  61.287 -      ==> 0 < n --> a^n < b^n"
  61.288 -apply (induct "n")
  61.289 -apply (auto simp add: mult_strict_mono order_le_less_trans [of 0 a b])
  61.290 -done
  61.291 -
  61.292 -lemma power_eq_0_iff [simp]:
  61.293 -  "(a^n = 0) \<longleftrightarrow>
  61.294 -   (a = (0::'a::{mult_zero,zero_neq_one,no_zero_divisors,recpower}) & n\<noteq>0)"
  61.295 -apply (induct "n")
  61.296 -apply (auto simp add: no_zero_divisors)
  61.297 -done
  61.298 -
  61.299 -
  61.300 -lemma field_power_not_zero:
  61.301 -  "a \<noteq> (0::'a::{ring_1_no_zero_divisors,recpower}) ==> a^n \<noteq> 0"
  61.302 -by force
  61.303 -
  61.304 -lemma nonzero_power_inverse:
  61.305 -  fixes a :: "'a::{division_ring,recpower}"
  61.306 -  shows "a \<noteq> 0 ==> inverse (a ^ n) = (inverse a) ^ n"
  61.307 -apply (induct "n")
  61.308 -apply (auto simp add: nonzero_inverse_mult_distrib power_commutes)
  61.309 -done (* TODO: reorient or rename to nonzero_inverse_power *)
  61.310 -
  61.311 -text{*Perhaps these should be simprules.*}
  61.312 -lemma power_inverse:
  61.313 -  fixes a :: "'a::{division_ring,division_by_zero,recpower}"
  61.314 -  shows "inverse (a ^ n) = (inverse a) ^ n"
  61.315 -apply (cases "a = 0")
  61.316 -apply (simp add: power_0_left)
  61.317 -apply (simp add: nonzero_power_inverse)
  61.318 -done (* TODO: reorient or rename to inverse_power *)
  61.319 -
  61.320 -lemma power_one_over: "1 / (a::'a::{field,division_by_zero,recpower})^n = 
  61.321 -    (1 / a)^n"
  61.322 -apply (simp add: divide_inverse)
  61.323 -apply (rule power_inverse)
  61.324 -done
  61.325 -
  61.326 -lemma nonzero_power_divide:
  61.327 -    "b \<noteq> 0 ==> (a/b) ^ n = ((a::'a::{field,recpower}) ^ n) / (b ^ n)"
  61.328 -by (simp add: divide_inverse power_mult_distrib nonzero_power_inverse)
  61.329 -
  61.330 -lemma power_divide:
  61.331 -    "(a/b) ^ n = ((a::'a::{field,division_by_zero,recpower}) ^ n / b ^ n)"
  61.332 -apply (case_tac "b=0", simp add: power_0_left)
  61.333 -apply (rule nonzero_power_divide)
  61.334 -apply assumption
  61.335 -done
  61.336 -
  61.337 -lemma power_abs: "abs(a ^ n) = abs(a::'a::{ordered_idom,recpower}) ^ n"
  61.338 -apply (induct "n")
  61.339 -apply (auto simp add: abs_mult)
  61.340 -done
  61.341 -
  61.342 -lemma abs_power_minus [simp]:
  61.343 -  fixes a:: "'a::{ordered_idom,recpower}" shows "abs((-a) ^ n) = abs(a ^ n)"
  61.344 -  by (simp add: abs_minus_cancel power_abs) 
  61.345 -
  61.346 -lemma zero_less_power_abs_iff [simp,noatp]:
  61.347 -     "(0 < (abs a)^n) = (a \<noteq> (0::'a::{ordered_idom,recpower}) | n=0)"
  61.348 -proof (induct "n")
  61.349 -  case 0
  61.350 -    show ?case by simp
  61.351 -next
  61.352 -  case (Suc n)
  61.353 -    show ?case by (auto simp add: prems zero_less_mult_iff)
  61.354 -qed
  61.355 -
  61.356 -lemma zero_le_power_abs [simp]:
  61.357 -     "(0::'a::{ordered_idom,recpower}) \<le> (abs a)^n"
  61.358 -by (rule zero_le_power [OF abs_ge_zero])
  61.359 -
  61.360 -lemma power_minus: "(-a) ^ n = (- 1)^n * (a::'a::{ring_1,recpower}) ^ n"
  61.361 -proof (induct n)
  61.362 -  case 0 show ?case by simp
  61.363 -next
  61.364 -  case (Suc n) then show ?case
  61.365 -    by (simp del: power_Suc add: power_Suc2 mult_assoc)
  61.366 -qed
  61.367 +  "a < b \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 < n \<longrightarrow> a ^ n < b ^ n"
  61.368 +  by (induct n)
  61.369 +   (auto simp add: mult_strict_mono le_less_trans [of 0 a b])
  61.370  
  61.371  text{*Lemma for @{text power_strict_decreasing}*}
  61.372  lemma power_Suc_less:
  61.373 -     "[|(0::'a::{ordered_semidom,recpower}) < a; a < 1|]
  61.374 -      ==> a * a^n < a^n"
  61.375 -apply (induct n)
  61.376 -apply (auto simp add: mult_strict_left_mono)
  61.377 -done
  61.378 +  "0 < a \<Longrightarrow> a < 1 \<Longrightarrow> a * a ^ n < a ^ n"
  61.379 +  by (induct n)
  61.380 +    (auto simp add: mult_strict_left_mono)
  61.381  
  61.382 -lemma power_strict_decreasing:
  61.383 -     "[|n < N; 0 < a; a < (1::'a::{ordered_semidom,recpower})|]
  61.384 -      ==> a^N < a^n"
  61.385 -apply (erule rev_mp)
  61.386 -apply (induct "N")
  61.387 -apply (auto simp add: power_Suc_less less_Suc_eq)
  61.388 -apply (rename_tac m)
  61.389 -apply (subgoal_tac "a * a^m < 1 * a^n", simp)
  61.390 -apply (rule mult_strict_mono)
  61.391 -apply (auto simp add: order_less_imp_le)
  61.392 -done
  61.393 +lemma power_strict_decreasing [rule_format]:
  61.394 +  "n < N \<Longrightarrow> 0 < a \<Longrightarrow> a < 1 \<longrightarrow> a ^ N < a ^ n"
  61.395 +proof (induct N)
  61.396 +  case 0 then show ?case by simp
  61.397 +next
  61.398 +  case (Suc N) then show ?case 
  61.399 +  apply (auto simp add: power_Suc_less less_Suc_eq)
  61.400 +  apply (subgoal_tac "a * a^N < 1 * a^n")
  61.401 +  apply simp
  61.402 +  apply (rule mult_strict_mono) apply auto
  61.403 +  done
  61.404 +qed
  61.405  
  61.406  text{*Proof resembles that of @{text power_strict_decreasing}*}
  61.407 -lemma power_decreasing:
  61.408 -     "[|n \<le> N; 0 \<le> a; a \<le> (1::'a::{ordered_semidom,recpower})|]
  61.409 -      ==> a^N \<le> a^n"
  61.410 -apply (erule rev_mp)
  61.411 -apply (induct "N")
  61.412 -apply (auto simp add: le_Suc_eq)
  61.413 -apply (rename_tac m)
  61.414 -apply (subgoal_tac "a * a^m \<le> 1 * a^n", simp)
  61.415 -apply (rule mult_mono)
  61.416 -apply auto
  61.417 -done
  61.418 +lemma power_decreasing [rule_format]:
  61.419 +  "n \<le> N \<Longrightarrow> 0 \<le> a \<Longrightarrow> a \<le> 1 \<longrightarrow> a ^ N \<le> a ^ n"
  61.420 +proof (induct N)
  61.421 +  case 0 then show ?case by simp
  61.422 +next
  61.423 +  case (Suc N) then show ?case 
  61.424 +  apply (auto simp add: le_Suc_eq)
  61.425 +  apply (subgoal_tac "a * a^N \<le> 1 * a^n", simp)
  61.426 +  apply (rule mult_mono) apply auto
  61.427 +  done
  61.428 +qed
  61.429  
  61.430  lemma power_Suc_less_one:
  61.431 -     "[| 0 < a; a < (1::'a::{ordered_semidom,recpower}) |] ==> a ^ Suc n < 1"
  61.432 -apply (insert power_strict_decreasing [of 0 "Suc n" a], simp)
  61.433 -done
  61.434 +  "0 < a \<Longrightarrow> a < 1 \<Longrightarrow> a ^ Suc n < 1"
  61.435 +  using power_strict_decreasing [of 0 "Suc n" a] by simp
  61.436  
  61.437  text{*Proof again resembles that of @{text power_strict_decreasing}*}
  61.438 -lemma power_increasing:
  61.439 -     "[|n \<le> N; (1::'a::{ordered_semidom,recpower}) \<le> a|] ==> a^n \<le> a^N"
  61.440 -apply (erule rev_mp)
  61.441 -apply (induct "N")
  61.442 -apply (auto simp add: le_Suc_eq)
  61.443 -apply (rename_tac m)
  61.444 -apply (subgoal_tac "1 * a^n \<le> a * a^m", simp)
  61.445 -apply (rule mult_mono)
  61.446 -apply (auto simp add: order_trans [OF zero_le_one])
  61.447 -done
  61.448 +lemma power_increasing [rule_format]:
  61.449 +  "n \<le> N \<Longrightarrow> 1 \<le> a \<Longrightarrow> a ^ n \<le> a ^ N"
  61.450 +proof (induct N)
  61.451 +  case 0 then show ?case by simp
  61.452 +next
  61.453 +  case (Suc N) then show ?case 
  61.454 +  apply (auto simp add: le_Suc_eq)
  61.455 +  apply (subgoal_tac "1 * a^n \<le> a * a^N", simp)
  61.456 +  apply (rule mult_mono) apply (auto simp add: order_trans [OF zero_le_one])
  61.457 +  done
  61.458 +qed
  61.459  
  61.460  text{*Lemma for @{text power_strict_increasing}*}
  61.461  lemma power_less_power_Suc:
  61.462 -     "(1::'a::{ordered_semidom,recpower}) < a ==> a^n < a * a^n"
  61.463 -apply (induct n)
  61.464 -apply (auto simp add: mult_strict_left_mono order_less_trans [OF zero_less_one])
  61.465 -done
  61.466 +  "1 < a \<Longrightarrow> a ^ n < a * a ^ n"
  61.467 +  by (induct n) (auto simp add: mult_strict_left_mono less_trans [OF zero_less_one])
  61.468  
  61.469 -lemma power_strict_increasing:
  61.470 -     "[|n < N; (1::'a::{ordered_semidom,recpower}) < a|] ==> a^n < a^N"
  61.471 -apply (erule rev_mp)
  61.472 -apply (induct "N")
  61.473 -apply (auto simp add: power_less_power_Suc less_Suc_eq)
  61.474 -apply (rename_tac m)
  61.475 -apply (subgoal_tac "1 * a^n < a * a^m", simp)
  61.476 -apply (rule mult_strict_mono)
  61.477 -apply (auto simp add: order_less_trans [OF zero_less_one] order_less_imp_le)
  61.478 -done
  61.479 +lemma power_strict_increasing [rule_format]:
  61.480 +  "n < N \<Longrightarrow> 1 < a \<longrightarrow> a ^ n < a ^ N"
  61.481 +proof (induct N)
  61.482 +  case 0 then show ?case by simp
  61.483 +next
  61.484 +  case (Suc N) then show ?case 
  61.485 +  apply (auto simp add: power_less_power_Suc less_Suc_eq)
  61.486 +  apply (subgoal_tac "1 * a^n < a * a^N", simp)
  61.487 +  apply (rule mult_strict_mono) apply (auto simp add: less_trans [OF zero_less_one] less_imp_le)
  61.488 +  done
  61.489 +qed
  61.490  
  61.491  lemma power_increasing_iff [simp]:
  61.492 -  "1 < (b::'a::{ordered_semidom,recpower}) ==> (b ^ x \<le> b ^ y) = (x \<le> y)"
  61.493 -by (blast intro: power_le_imp_le_exp power_increasing order_less_imp_le) 
  61.494 +  "1 < b \<Longrightarrow> b ^ x \<le> b ^ y \<longleftrightarrow> x \<le> y"
  61.495 +  by (blast intro: power_le_imp_le_exp power_increasing less_imp_le)
  61.496  
  61.497  lemma power_strict_increasing_iff [simp]:
  61.498 -  "1 < (b::'a::{ordered_semidom,recpower}) ==> (b ^ x < b ^ y) = (x < y)"
  61.499 +  "1 < b \<Longrightarrow> b ^ x < b ^ y \<longleftrightarrow> x < y"
  61.500  by (blast intro: power_less_imp_less_exp power_strict_increasing) 
  61.501  
  61.502  lemma power_le_imp_le_base:
  61.503 -assumes le: "a ^ Suc n \<le> b ^ Suc n"
  61.504 -    and ynonneg: "(0::'a::{ordered_semidom,recpower}) \<le> b"
  61.505 -shows "a \<le> b"
  61.506 +  assumes le: "a ^ Suc n \<le> b ^ Suc n"
  61.507 +    and ynonneg: "0 \<le> b"
  61.508 +  shows "a \<le> b"
  61.509  proof (rule ccontr)
  61.510    assume "~ a \<le> b"
  61.511    then have "b < a" by (simp only: linorder_not_le)
  61.512    then have "b ^ Suc n < a ^ Suc n"
  61.513      by (simp only: prems power_strict_mono)
  61.514 -  from le and this show "False"
  61.515 +  from le and this show False
  61.516      by (simp add: linorder_not_less [symmetric])
  61.517  qed
  61.518  
  61.519  lemma power_less_imp_less_base:
  61.520 -  fixes a b :: "'a::{ordered_semidom,recpower}"
  61.521    assumes less: "a ^ n < b ^ n"
  61.522    assumes nonneg: "0 \<le> b"
  61.523    shows "a < b"
  61.524 @@ -310,98 +310,144 @@
  61.525    assume "~ a < b"
  61.526    hence "b \<le> a" by (simp only: linorder_not_less)
  61.527    hence "b ^ n \<le> a ^ n" using nonneg by (rule power_mono)
  61.528 -  thus "~ a ^ n < b ^ n" by (simp only: linorder_not_less)
  61.529 +  thus "\<not> a ^ n < b ^ n" by (simp only: linorder_not_less)
  61.530  qed
  61.531  
  61.532  lemma power_inject_base:
  61.533 -     "[| a ^ Suc n = b ^ Suc n; 0 \<le> a; 0 \<le> b |]
  61.534 -      ==> a = (b::'a::{ordered_semidom,recpower})"
  61.535 -by (blast intro: power_le_imp_le_base order_antisym order_eq_refl sym)
  61.536 +  "a ^ Suc n = b ^ Suc n \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> a = b"
  61.537 +by (blast intro: power_le_imp_le_base antisym eq_refl sym)
  61.538  
  61.539  lemma power_eq_imp_eq_base:
  61.540 -  fixes a b :: "'a::{ordered_semidom,recpower}"
  61.541 -  shows "\<lbrakk>a ^ n = b ^ n; 0 \<le> a; 0 \<le> b; 0 < n\<rbrakk> \<Longrightarrow> a = b"
  61.542 -by (cases n, simp_all del: power_Suc, rule power_inject_base)
  61.543 +  "a ^ n = b ^ n \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 < n \<Longrightarrow> a = b"
  61.544 +  by (cases n) (simp_all del: power_Suc, rule power_inject_base)
  61.545  
  61.546 -text {* The divides relation *}
  61.547 +end
  61.548 +
  61.549 +context ordered_idom
  61.550 +begin
  61.551  
  61.552 -lemma le_imp_power_dvd:
  61.553 -  fixes a :: "'a::{comm_semiring_1,recpower}"
  61.554 -  assumes "m \<le> n" shows "a^m dvd a^n"
  61.555 -proof
  61.556 -  have "a^n = a^(m + (n - m))"
  61.557 -    using `m \<le> n` by simp
  61.558 -  also have "\<dots> = a^m * a^(n - m)"
  61.559 -    by (rule power_add)
  61.560 -  finally show "a^n = a^m * a^(n - m)" .
  61.561 +lemma power_abs:
  61.562 +  "abs (a ^ n) = abs a ^ n"
  61.563 +  by (induct n) (auto simp add: abs_mult)
  61.564 +
  61.565 +lemma abs_power_minus [simp]:
  61.566 +  "abs ((-a) ^ n) = abs (a ^ n)"
  61.567 +  by (simp add: abs_minus_cancel power_abs) 
  61.568 +
  61.569 +lemma zero_less_power_abs_iff [simp, noatp]:
  61.570 +  "0 < abs a ^ n \<longleftrightarrow> a \<noteq> 0 \<or> n = 0"
  61.571 +proof (induct n)
  61.572 +  case 0 show ?case by simp
  61.573 +next
  61.574 +  case (Suc n) show ?case by (auto simp add: Suc zero_less_mult_iff)
  61.575  qed
  61.576  
  61.577 -lemma power_le_dvd:
  61.578 -  fixes a b :: "'a::{comm_semiring_1,recpower}"
  61.579 -  shows "a^n dvd b \<Longrightarrow> m \<le> n \<Longrightarrow> a^m dvd b"
  61.580 -  by (rule dvd_trans [OF le_imp_power_dvd])
  61.581 -
  61.582 -
  61.583 -lemma dvd_power_same:
  61.584 -  "(x::'a::{comm_semiring_1,recpower}) dvd y \<Longrightarrow> x^n dvd y^n"
  61.585 -by (induct n) (auto simp add: mult_dvd_mono)
  61.586 -
  61.587 -lemma dvd_power_le:
  61.588 -  "(x::'a::{comm_semiring_1,recpower}) dvd y \<Longrightarrow> m >= n \<Longrightarrow> x^n dvd y^m"
  61.589 -by(rule power_le_dvd[OF dvd_power_same])
  61.590 +lemma zero_le_power_abs [simp]:
  61.591 +  "0 \<le> abs a ^ n"
  61.592 +  by (rule zero_le_power [OF abs_ge_zero])
  61.593  
  61.594 -lemma dvd_power [simp]:
  61.595 -  "n > 0 | (x::'a::{comm_semiring_1,recpower}) = 1 \<Longrightarrow> x dvd x^n"
  61.596 -apply (erule disjE)
  61.597 - apply (subgoal_tac "x ^ n = x^(Suc (n - 1))")
  61.598 -  apply (erule ssubst)
  61.599 -  apply (subst power_Suc)
  61.600 -  apply auto
  61.601 -done
  61.602 +end
  61.603  
  61.604 -
  61.605 -subsection{*Exponentiation for the Natural Numbers*}
  61.606 -
  61.607 -instantiation nat :: recpower
  61.608 +context ring_1_no_zero_divisors
  61.609  begin
  61.610  
  61.611 -primrec power_nat where
  61.612 -  "p ^ 0 = (1\<Colon>nat)"
  61.613 -  | "p ^ (Suc n) = (p\<Colon>nat) * (p ^ n)"
  61.614 +lemma field_power_not_zero:
  61.615 +  "a \<noteq> 0 \<Longrightarrow> a ^ n \<noteq> 0"
  61.616 +  by (induct n) auto
  61.617 +
  61.618 +end
  61.619 +
  61.620 +context division_ring
  61.621 +begin
  61.622  
  61.623 -instance proof
  61.624 -  fix z n :: nat
  61.625 -  show "z^0 = 1" by simp
  61.626 -  show "z^(Suc n) = z * (z^n)" by simp
  61.627 -qed
  61.628 +text {* FIXME reorient or rename to @{text nonzero_inverse_power} *}
  61.629 +lemma nonzero_power_inverse:
  61.630 +  "a \<noteq> 0 \<Longrightarrow> inverse (a ^ n) = (inverse a) ^ n"
  61.631 +  by (induct n)
  61.632 +    (simp_all add: nonzero_inverse_mult_distrib power_commutes field_power_not_zero)
  61.633  
  61.634 -declare power_nat.simps [simp del]
  61.635 +end
  61.636 +
  61.637 +context field
  61.638 +begin
  61.639 +
  61.640 +lemma nonzero_power_divide:
  61.641 +  "b \<noteq> 0 \<Longrightarrow> (a / b) ^ n = a ^ n / b ^ n"
  61.642 +  by (simp add: divide_inverse power_mult_distrib nonzero_power_inverse)
  61.643  
  61.644  end
  61.645  
  61.646 -lemma of_nat_power:
  61.647 -  "of_nat (m ^ n) = (of_nat m::'a::{semiring_1,recpower}) ^ n"
  61.648 -by (induct n, simp_all add: of_nat_mult)
  61.649 +lemma power_0_Suc [simp]:
  61.650 +  "(0::'a::{power, semiring_0}) ^ Suc n = 0"
  61.651 +  by simp
  61.652 +
  61.653 +text{*It looks plausible as a simprule, but its effect can be strange.*}
  61.654 +lemma power_0_left:
  61.655 +  "0 ^ n = (if n = 0 then 1 else (0::'a::{power, semiring_0}))"
  61.656 +  by (induct n) simp_all
  61.657 +
  61.658 +lemma power_eq_0_iff [simp]:
  61.659 +  "a ^ n = 0 \<longleftrightarrow>
  61.660 +     a = (0::'a::{mult_zero,zero_neq_one,no_zero_divisors,power}) \<and> n \<noteq> 0"
  61.661 +  by (induct n)
  61.662 +    (auto simp add: no_zero_divisors elim: contrapos_pp)
  61.663 +
  61.664 +lemma power_diff:
  61.665 +  fixes a :: "'a::field"
  61.666 +  assumes nz: "a \<noteq> 0"
  61.667 +  shows "n \<le> m \<Longrightarrow> a ^ (m - n) = a ^ m / a ^ n"
  61.668 +  by (induct m n rule: diff_induct) (simp_all add: nz)
  61.669  
  61.670 -lemma nat_one_le_power [simp]: "Suc 0 \<le> i ==> Suc 0 \<le> i^n"
  61.671 -by (rule one_le_power [of i n, unfolded One_nat_def])
  61.672 +text{*Perhaps these should be simprules.*}
  61.673 +lemma power_inverse:
  61.674 +  fixes a :: "'a::{division_ring,division_by_zero,power}"
  61.675 +  shows "inverse (a ^ n) = (inverse a) ^ n"
  61.676 +apply (cases "a = 0")
  61.677 +apply (simp add: power_0_left)
  61.678 +apply (simp add: nonzero_power_inverse)
  61.679 +done (* TODO: reorient or rename to inverse_power *)
  61.680 +
  61.681 +lemma power_one_over:
  61.682 +  "1 / (a::'a::{field,division_by_zero, power}) ^ n =  (1 / a) ^ n"
  61.683 +  by (simp add: divide_inverse) (rule power_inverse)
  61.684  
  61.685 -lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
  61.686 -by (induct "n", auto)
  61.687 +lemma power_divide:
  61.688 +  "(a / b) ^ n = (a::'a::{field,division_by_zero}) ^ n / b ^ n"
  61.689 +apply (cases "b = 0")
  61.690 +apply (simp add: power_0_left)
  61.691 +apply (rule nonzero_power_divide)
  61.692 +apply assumption
  61.693 +done
  61.694 +
  61.695 +class recpower = monoid_mult
  61.696 +
  61.697 +
  61.698 +subsection {* Exponentiation for the Natural Numbers *}
  61.699 +
  61.700 +instance nat :: recpower ..
  61.701 +
  61.702 +lemma nat_one_le_power [simp]:
  61.703 +  "Suc 0 \<le> i \<Longrightarrow> Suc 0 \<le> i ^ n"
  61.704 +  by (rule one_le_power [of i n, unfolded One_nat_def])
  61.705 +
  61.706 +lemma nat_zero_less_power_iff [simp]:
  61.707 +  "x ^ n > 0 \<longleftrightarrow> x > (0::nat) \<or> n = 0"
  61.708 +  by (induct n) auto
  61.709  
  61.710  lemma nat_power_eq_Suc_0_iff [simp]: 
  61.711 -  "((x::nat)^m = Suc 0) = (m = 0 | x = Suc 0)"
  61.712 -by (induct_tac m, auto)
  61.713 +  "x ^ m = Suc 0 \<longleftrightarrow> m = 0 \<or> x = Suc 0"
  61.714 +  by (induct m) auto
  61.715  
  61.716 -lemma power_Suc_0[simp]: "(Suc 0)^n = Suc 0"
  61.717 -by simp
  61.718 +lemma power_Suc_0 [simp]:
  61.719 +  "Suc 0 ^ n = Suc 0"
  61.720 +  by simp
  61.721  
  61.722  text{*Valid for the naturals, but what if @{text"0<i<1"}?
  61.723  Premises cannot be weakened: consider the case where @{term "i=0"},
  61.724  @{term "m=1"} and @{term "n=0"}.*}
  61.725  lemma nat_power_less_imp_less:
  61.726    assumes nonneg: "0 < (i\<Colon>nat)"
  61.727 -  assumes less: "i^m < i^n"
  61.728 +  assumes less: "i ^ m < i ^ n"
  61.729    shows "m < n"
  61.730  proof (cases "i = 1")
  61.731    case True with less power_one [where 'a = nat] show ?thesis by simp
  61.732 @@ -410,10 +456,4 @@
  61.733    from power_strict_increasing_iff [OF this] less show ?thesis ..
  61.734  qed
  61.735  
  61.736 -lemma power_diff:
  61.737 -  assumes nz: "a ~= 0"
  61.738 -  shows "n <= m ==> (a::'a::{recpower, field}) ^ (m-n) = (a^m) / (a^n)"
  61.739 -  by (induct m n rule: diff_induct)
  61.740 -    (simp_all add: nonzero_mult_divide_cancel_left nz)
  61.741 -
  61.742  end
    62.1 --- a/src/HOL/Predicate.thy	Wed Apr 22 11:00:25 2009 -0700
    62.2 +++ b/src/HOL/Predicate.thy	Mon Apr 27 07:26:17 2009 -0700
    62.3 @@ -622,6 +622,51 @@
    62.4    "pred_rec f P = f (eval P)"
    62.5    by (cases P) simp
    62.6  
    62.7 +text {* for evaluation of predicate enumerations *}
    62.8 +
    62.9 +ML {*
   62.10 +signature PREDICATE =
   62.11 +sig
   62.12 +  datatype 'a pred = Seq of (unit -> 'a seq)
   62.13 +  and 'a seq = Empty | Insert of 'a * 'a pred | Join of 'a pred * 'a seq
   62.14 +  val yield: 'a pred -> ('a * 'a pred) option
   62.15 +  val yieldn: int -> 'a pred -> 'a list * 'a pred
   62.16 +end;
   62.17 +
   62.18 +structure Predicate : PREDICATE =
   62.19 +struct
   62.20 +
   62.21 +@{code_datatype pred = Seq};
   62.22 +@{code_datatype seq = Empty | Insert | Join};
   62.23 +
   62.24 +fun yield (Seq f) = next (f ())
   62.25 +and next @{code Empty} = NONE
   62.26 +  | next (@{code Insert} (x, P)) = SOME (x, P)
   62.27 +  | next (@{code Join} (P, xq)) = (case yield P
   62.28 +     of NONE => next xq
   62.29 +      | SOME (x, Q) => SOME (x, @{code Seq} (fn _ => @{code Join} (Q, xq))))
   62.30 +
   62.31 +fun anamorph f k x = (if k = 0 then ([], x)
   62.32 +  else case f x
   62.33 +   of NONE => ([], x)
   62.34 +    | SOME (v, y) => let
   62.35 +        val (vs, z) = anamorph f (k - 1) y
   62.36 +      in (v :: vs, z) end)
   62.37 +
   62.38 +fun yieldn P = anamorph yield P;
   62.39 +
   62.40 +end;
   62.41 +*}
   62.42 +
   62.43 +code_reserved Eval Predicate
   62.44 +
   62.45 +code_type pred and seq
   62.46 +  (Eval "_/ Predicate.pred" and "_/ Predicate.seq")
   62.47 +
   62.48 +code_const Seq and Empty and Insert and Join
   62.49 +  (Eval "Predicate.Seq" and "Predicate.Empty" and "Predicate.Insert/ (_,/ _)" and "Predicate.Join/ (_,/ _)")
   62.50 +
   62.51 +
   62.52  no_notation
   62.53    inf (infixl "\<sqinter>" 70) and
   62.54    sup (infixl "\<squnion>" 65) and
    63.1 --- a/src/HOL/Product_Type.thy	Wed Apr 22 11:00:25 2009 -0700
    63.2 +++ b/src/HOL/Product_Type.thy	Mon Apr 27 07:26:17 2009 -0700
    63.3 @@ -84,6 +84,14 @@
    63.4  lemma unit_abs_eta_conv [simp,noatp]: "(%u::unit. f ()) = f"
    63.5    by (rule ext) simp
    63.6  
    63.7 +instantiation unit :: default
    63.8 +begin
    63.9 +
   63.10 +definition "default = ()"
   63.11 +
   63.12 +instance ..
   63.13 +
   63.14 +end
   63.15  
   63.16  text {* code generator setup *}
   63.17  
    64.1 --- a/src/HOL/Rational.thy	Wed Apr 22 11:00:25 2009 -0700
    64.2 +++ b/src/HOL/Rational.thy	Mon Apr 27 07:26:17 2009 -0700
    64.3 @@ -156,11 +156,6 @@
    64.4    then show ?thesis by (simp add: mult_rat [symmetric])
    64.5  qed
    64.6  
    64.7 -primrec power_rat
    64.8 -where
    64.9 -  "q ^ 0 = (1\<Colon>rat)"
   64.10 -| "q ^ Suc n = (q\<Colon>rat) * (q ^ n)"
   64.11 -
   64.12  instance proof
   64.13    fix q r s :: rat show "(q * r) * s = q * (r * s)" 
   64.14      by (cases q, cases r, cases s) (simp add: eq_rat)
   64.15 @@ -193,15 +188,8 @@
   64.16  next
   64.17    fix q :: rat show "q * 1 = q"
   64.18      by (cases q) (simp add: One_rat_def eq_rat)
   64.19 -next
   64.20 -  fix q :: rat
   64.21 -  fix n :: nat
   64.22 -  show "q ^ 0 = 1" by simp
   64.23 -  show "q ^ (Suc n) = q * (q ^ n)" by simp
   64.24  qed
   64.25  
   64.26 -declare power_rat.simps [simp del]
   64.27 -
   64.28  end
   64.29  
   64.30  lemma of_nat_rat: "of_nat k = Fract (of_nat k) 1"
   64.31 @@ -222,7 +210,8 @@
   64.32  definition
   64.33    rat_number_of_def [code del]: "number_of w = Fract w 1"
   64.34  
   64.35 -instance by intro_classes (simp add: rat_number_of_def of_int_rat)
   64.36 +instance proof
   64.37 +qed (simp add: rat_number_of_def of_int_rat)
   64.38  
   64.39  end
   64.40  
    65.1 --- a/src/HOL/RealPow.thy	Wed Apr 22 11:00:25 2009 -0700
    65.2 +++ b/src/HOL/RealPow.thy	Mon Apr 27 07:26:17 2009 -0700
    65.3 @@ -12,24 +12,7 @@
    65.4  
    65.5  declare abs_mult_self [simp]
    65.6  
    65.7 -instantiation real :: recpower
    65.8 -begin
    65.9 -
   65.10 -primrec power_real where
   65.11 -  "r ^ 0     = (1\<Colon>real)"
   65.12 -| "r ^ Suc n = (r\<Colon>real) * r ^ n"
   65.13 -
   65.14 -instance proof
   65.15 -  fix z :: real
   65.16 -  fix n :: nat
   65.17 -  show "z^0 = 1" by simp
   65.18 -  show "z^(Suc n) = z * (z^n)" by simp
   65.19 -qed
   65.20 -
   65.21 -declare power_real.simps [simp del]
   65.22 -
   65.23 -end
   65.24 -
   65.25 +instance real :: recpower ..
   65.26  
   65.27  lemma two_realpow_ge_one [simp]: "(1::real) \<le> 2 ^ n"
   65.28  by simp
   65.29 @@ -47,7 +30,6 @@
   65.30  
   65.31  lemma realpow_minus_mult [rule_format]:
   65.32       "0 < n --> (x::real) ^ (n - 1) * x = x ^ n"
   65.33 -unfolding One_nat_def
   65.34  apply (simp split add: nat_diff_split)
   65.35  done
   65.36  
    66.1 --- a/src/HOL/Relation_Power.thy	Wed Apr 22 11:00:25 2009 -0700
    66.2 +++ b/src/HOL/Relation_Power.thy	Mon Apr 27 07:26:17 2009 -0700
    66.3 @@ -9,132 +9,124 @@
    66.4  imports Power Transitive_Closure Plain
    66.5  begin
    66.6  
    66.7 -instance
    66.8 -  "fun" :: (type, type) power ..
    66.9 -      --{* only type @{typ "'a => 'a"} should be in class @{text power}!*}
   66.10 +consts funpower :: "('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'b" (infixr "^^" 80)
   66.11  
   66.12  overloading
   66.13 -  relpow \<equiv> "power \<Colon> ('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a \<times> 'a) set"  (unchecked)
   66.14 +  relpow \<equiv> "funpower \<Colon> ('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a \<times> 'a) set"
   66.15  begin
   66.16  
   66.17 -text {* @{text "R ^ n = R O ... O R"}, the n-fold composition of @{text R} *}
   66.18 +text {* @{text "R ^^ n = R O ... O R"}, the n-fold composition of @{text R} *}
   66.19  
   66.20  primrec relpow where
   66.21 -  "(R \<Colon> ('a \<times> 'a) set)  ^ 0 = Id"
   66.22 -  | "(R \<Colon> ('a \<times> 'a) set) ^ Suc n = R O (R ^ n)"
   66.23 +    "(R \<Colon> ('a \<times> 'a) set) ^^ 0 = Id"
   66.24 +  | "(R \<Colon> ('a \<times> 'a) set) ^^ Suc n = R O (R ^^ n)"
   66.25  
   66.26  end
   66.27  
   66.28  overloading
   66.29 -  funpow \<equiv> "power \<Colon>  ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a" (unchecked)
   66.30 +  funpow \<equiv> "funpower \<Colon> ('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   66.31  begin
   66.32  
   66.33 -text {* @{text "f ^ n = f o ... o f"}, the n-fold composition of @{text f} *}
   66.34 +text {* @{text "f ^^ n = f o ... o f"}, the n-fold composition of @{text f} *}
   66.35  
   66.36  primrec funpow where
   66.37 -  "(f \<Colon> 'a \<Rightarrow> 'a) ^ 0 = id"
   66.38 -  | "(f \<Colon> 'a \<Rightarrow> 'a) ^ Suc n = f o (f ^ n)"
   66.39 +    "(f \<Colon> 'a \<Rightarrow> 'a) ^^ 0 = id"
   66.40 +  | "(f \<Colon> 'a \<Rightarrow> 'a) ^^ Suc n = f o (f ^^ n)"
   66.41  
   66.42  end
   66.43  
   66.44 -text{*WARNING: due to the limits of Isabelle's type classes, exponentiation on
   66.45 -functions and relations has too general a domain, namely @{typ "('a * 'b)set"}
   66.46 -and @{typ "'a => 'b"}.  Explicit type constraints may therefore be necessary.
   66.47 -For example, @{term "range(f^n) = A"} and @{term "Range(R^n) = B"} need
   66.48 -constraints.*}
   66.49 -
   66.50 -text {*
   66.51 -  Circumvent this problem for code generation:
   66.52 -*}
   66.53 -
   66.54 -primrec
   66.55 -  fun_pow :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a"
   66.56 -where
   66.57 -  "fun_pow 0 f = id"
   66.58 +primrec fun_pow :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where
   66.59 +    "fun_pow 0 f = id"
   66.60    | "fun_pow (Suc n) f = f o fun_pow n f"
   66.61  
   66.62 -lemma funpow_fun_pow [code unfold]: "f ^ n = fun_pow n f"
   66.63 +lemma funpow_fun_pow [code unfold]:
   66.64 +  "f ^^ n = fun_pow n f"
   66.65    unfolding funpow_def fun_pow_def ..
   66.66  
   66.67 -lemma funpow_add: "f ^ (m+n) = f^m o f^n"
   66.68 +lemma funpow_add:
   66.69 +  "f ^^ (m + n) = f ^^ m o f ^^ n"
   66.70    by (induct m) simp_all
   66.71  
   66.72 -lemma funpow_swap1: "f((f^n) x) = (f^n)(f x)"
   66.73 +lemma funpow_swap1:
   66.74 +  "f ((f ^^ n) x) = (f ^^ n) (f x)"
   66.75  proof -
   66.76 -  have "f((f^n) x) = (f^(n+1)) x" unfolding One_nat_def by simp
   66.77 -  also have "\<dots>  = (f^n o f^1) x" by (simp only: funpow_add)
   66.78 -  also have "\<dots> = (f^n)(f x)" unfolding One_nat_def by simp
   66.79 +  have "f ((f ^^ n) x) = (f ^^ (n+1)) x" unfolding One_nat_def by simp
   66.80 +  also have "\<dots>  = (f ^^ n o f ^^ 1) x" by (simp only: funpow_add)
   66.81 +  also have "\<dots> = (f ^^ n) (f x)" unfolding One_nat_def by simp
   66.82    finally show ?thesis .
   66.83  qed
   66.84  
   66.85  lemma rel_pow_1 [simp]:
   66.86 -  fixes R :: "('a*'a)set"
   66.87 -  shows "R^1 = R"
   66.88 -  unfolding One_nat_def by simp
   66.89 -
   66.90 -lemma rel_pow_0_I: "(x,x) : R^0"
   66.91 +  fixes R :: "('a * 'a) set"
   66.92 +  shows "R ^^ 1 = R"
   66.93    by simp
   66.94  
   66.95 -lemma rel_pow_Suc_I: "[| (x,y) : R^n; (y,z):R |] ==> (x,z):R^(Suc n)"
   66.96 +lemma rel_pow_0_I: 
   66.97 +  "(x, x) \<in> R ^^ 0"
   66.98 +  by simp
   66.99 +
  66.100 +lemma rel_pow_Suc_I:
  66.101 +  "(x, y) \<in>  R ^^ n \<Longrightarrow> (y, z) \<in> R \<Longrightarrow> (x, z) \<in> R ^^ Suc n"
  66.102    by auto
  66.103  
  66.104  lemma rel_pow_Suc_I2:
  66.105 -    "(x, y) : R \<Longrightarrow> (y, z) : R^n \<Longrightarrow> (x,z) : R^(Suc n)"
  66.106 -  apply (induct n arbitrary: z)
  66.107 -   apply simp
  66.108 -  apply fastsimp
  66.109 -  done
  66.110 +  "(x, y) \<in> R \<Longrightarrow> (y, z) \<in> R ^^ n \<Longrightarrow> (x, z) \<in> R ^^ Suc n"
  66.111 +  by (induct n arbitrary: z) (simp, fastsimp)
  66.112  
  66.113 -lemma rel_pow_0_E: "[| (x,y) : R^0; x=y ==> P |] ==> P"
  66.114 +lemma rel_pow_0_E:
  66.115 +  "(x, y) \<in> R ^^ 0 \<Longrightarrow> (x = y \<Longrightarrow> P) \<Longrightarrow> P"
  66.116    by simp
  66.117  
  66.118  lemma rel_pow_Suc_E:
  66.119 -    "[| (x,z) : R^(Suc n);  !!y. [| (x,y) : R^n; (y,z) : R |] ==> P |] ==> P"
  66.120 +  "(x, z) \<in> R ^^ Suc n \<Longrightarrow> (\<And>y. (x, y) \<in> R ^^ n \<Longrightarrow> (y, z) \<in> R \<Longrightarrow> P) \<Longrightarrow> P"
  66.121    by auto
  66.122  
  66.123  lemma rel_pow_E:
  66.124 -    "[| (x,z) : R^n;  [| n=0; x = z |] ==> P;
  66.125 -        !!y m. [| n = Suc m; (x,y) : R^m; (y,z) : R |] ==> P
  66.126 -     |] ==> P"
  66.127 +  "(x, z) \<in>  R ^^ n \<Longrightarrow>  (n = 0 \<Longrightarrow> x = z \<Longrightarrow> P)
  66.128 +   \<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> (x, y) \<in>  R ^^ m \<Longrightarrow> (y, z) \<in> R \<Longrightarrow> P)
  66.129 +   \<Longrightarrow> P"
  66.130    by (cases n) auto
  66.131  
  66.132  lemma rel_pow_Suc_D2:
  66.133 -    "(x, z) : R^(Suc n) \<Longrightarrow> (\<exists>y. (x,y) : R & (y,z) : R^n)"
  66.134 +  "(x, z) \<in> R ^^ Suc n \<Longrightarrow> (\<exists>y. (x, y) \<in> R \<and> (y, z) \<in> R ^^ n)"
  66.135    apply (induct n arbitrary: x z)
  66.136     apply (blast intro: rel_pow_0_I elim: rel_pow_0_E rel_pow_Suc_E)
  66.137    apply (blast intro: rel_pow_Suc_I elim: rel_pow_0_E rel_pow_Suc_E)
  66.138    done
  66.139  
  66.140  lemma rel_pow_Suc_D2':
  66.141 -    "\<forall>x y z. (x,y) : R^n & (y,z) : R --> (\<exists>w. (x,w) : R & (w,z) : R^n)"
  66.142 +  "\<forall>x y z. (x, y) \<in> R ^^ n \<and> (y, z) \<in> R \<longrightarrow> (\<exists>w. (x, w) \<in> R \<and> (w, z) \<in> R ^^ n)"
  66.143    by (induct n) (simp_all, blast)
  66.144  
  66.145  lemma rel_pow_E2:
  66.146 -    "[| (x,z) : R^n;  [| n=0; x = z |] ==> P;
  66.147 -        !!y m. [| n = Suc m; (x,y) : R; (y,z) : R^m |] ==> P
  66.148 -     |] ==> P"
  66.149 -  apply (case_tac n, simp)
  66.150 +  "(x, z) \<in> R ^^ n \<Longrightarrow>  (n = 0 \<Longrightarrow> x = z \<Longrightarrow> P)
  66.151 +     \<Longrightarrow> (\<And>y m. n = Suc m \<Longrightarrow> (x, y) \<in> R \<Longrightarrow> (y, z) \<in> R ^^ m \<Longrightarrow> P)
  66.152 +   \<Longrightarrow> P"
  66.153 +  apply (cases n, simp)
  66.154    apply (cut_tac n=nat and R=R in rel_pow_Suc_D2', simp, blast)
  66.155    done
  66.156  
  66.157 -lemma rtrancl_imp_UN_rel_pow: "!!p. p:R^* ==> p : (UN n. R^n)"
  66.158 -  apply (simp only: split_tupled_all)
  66.159 +lemma rtrancl_imp_UN_rel_pow:
  66.160 +  "p \<in> R^* \<Longrightarrow> p \<in> (\<Union>n. R ^^ n)"
  66.161 +  apply (cases p) apply (simp only:)
  66.162    apply (erule rtrancl_induct)
  66.163     apply (blast intro: rel_pow_0_I rel_pow_Suc_I)+
  66.164    done
  66.165  
  66.166 -lemma rel_pow_imp_rtrancl: "!!p. p:R^n ==> p:R^*"
  66.167 -  apply (simp only: split_tupled_all)
  66.168 -  apply (induct n)
  66.169 +lemma rel_pow_imp_rtrancl:
  66.170 +  "p \<in> R ^^ n \<Longrightarrow> p \<in> R^*"
  66.171 +  apply (induct n arbitrary: p)
  66.172 +  apply (simp_all only: split_tupled_all)
  66.173     apply (blast intro: rtrancl_refl elim: rel_pow_0_E)
  66.174    apply (blast elim: rel_pow_Suc_E intro: rtrancl_into_rtrancl)
  66.175    done
  66.176  
  66.177 -lemma rtrancl_is_UN_rel_pow: "R^* = (UN n. R^n)"
  66.178 +lemma rtrancl_is_UN_rel_pow:
  66.179 +  "R^* = (UN n. R ^^ n)"
  66.180    by (blast intro: rtrancl_imp_UN_rel_pow rel_pow_imp_rtrancl)
  66.181  
  66.182  lemma trancl_power:
  66.183 -  "x \<in> r^+ = (\<exists>n > 0. x \<in> r^n)"
  66.184 +  "x \<in> r^+ = (\<exists>n > 0. x \<in> r ^^ n)"
  66.185    apply (cases x)
  66.186    apply simp
  66.187    apply (rule iffI)
  66.188 @@ -151,30 +143,12 @@
  66.189    done
  66.190  
  66.191  lemma single_valued_rel_pow:
  66.192 -    "!!r::('a * 'a)set. single_valued r ==> single_valued (r^n)"
  66.193 +  fixes R :: "('a * 'a) set"
  66.194 +  shows "single_valued R \<Longrightarrow> single_valued (R ^^ n)"
  66.195 +  apply (induct n arbitrary: R)
  66.196 +  apply simp_all
  66.197    apply (rule single_valuedI)
  66.198 -  apply (induct n)
  66.199 -   apply simp
  66.200    apply (fast dest: single_valuedD elim: rel_pow_Suc_E)
  66.201    done
  66.202  
  66.203 -ML
  66.204 -{*
  66.205 -val funpow_add = thm "funpow_add";
  66.206 -val rel_pow_1 = thm "rel_pow_1";
  66.207 -val rel_pow_0_I = thm "rel_pow_0_I";
  66.208 -val rel_pow_Suc_I = thm "rel_pow_Suc_I";
  66.209 -val rel_pow_Suc_I2 = thm "rel_pow_Suc_I2";
  66.210 -val rel_pow_0_E = thm "rel_pow_0_E";
  66.211 -val rel_pow_Suc_E = thm "rel_pow_Suc_E";
  66.212 -val rel_pow_E = thm "rel_pow_E";
  66.213 -val rel_pow_Suc_D2 = thm "rel_pow_Suc_D2";
  66.214 -val rel_pow_Suc_D2 = thm "rel_pow_Suc_D2";
  66.215 -val rel_pow_E2 = thm "rel_pow_E2";
  66.216 -val rtrancl_imp_UN_rel_pow = thm "rtrancl_imp_UN_rel_pow";
  66.217 -val rel_pow_imp_rtrancl = thm "rel_pow_imp_rtrancl";
  66.218 -val rtrancl_is_UN_rel_pow = thm "rtrancl_is_UN_rel_pow";
  66.219 -val single_valued_rel_pow = thm "single_valued_rel_pow";
  66.220 -*}
  66.221 -
  66.222  end
    67.1 --- a/src/HOL/Ring_and_Field.thy	Wed Apr 22 11:00:25 2009 -0700
    67.2 +++ b/src/HOL/Ring_and_Field.thy	Mon Apr 27 07:26:17 2009 -0700
    67.3 @@ -2226,15 +2226,21 @@
    67.4  qed
    67.5  qed
    67.6  
    67.7 -instance ordered_idom \<subseteq> pordered_ring_abs
    67.8 -by default (auto simp add: abs_if not_less
    67.9 -  equal_neg_zero neg_equal_zero mult_less_0_iff)
   67.10 -
   67.11 -lemma abs_mult: "abs (a * b) = abs a * abs (b::'a::ordered_idom)" 
   67.12 -by (simp add: abs_eq_mult linorder_linear)
   67.13 -
   67.14 -lemma abs_mult_self: "abs a * abs a = a * (a::'a::ordered_idom)"
   67.15 -by (simp add: abs_if) 
   67.16 +context ordered_idom
   67.17 +begin
   67.18 +
   67.19 +subclass pordered_ring_abs proof
   67.20 +qed (auto simp add: abs_if not_less equal_neg_zero neg_equal_zero mult_less_0_iff)
   67.21 +
   67.22 +lemma abs_mult:
   67.23 +  "abs (a * b) = abs a * abs b" 
   67.24 +  by (rule abs_eq_mult) auto
   67.25 +
   67.26 +lemma abs_mult_self:
   67.27 +  "abs a * abs a = a * a"
   67.28 +  by (simp add: abs_if) 
   67.29 +
   67.30 +end
   67.31  
   67.32  lemma nonzero_abs_inverse:
   67.33       "a \<noteq> 0 ==> abs (inverse (a::'a::ordered_field)) = inverse (abs a)"
    68.1 --- a/src/HOL/SizeChange/Graphs.thy	Wed Apr 22 11:00:25 2009 -0700
    68.2 +++ b/src/HOL/SizeChange/Graphs.thy	Mon Apr 27 07:26:17 2009 -0700
    68.3 @@ -228,18 +228,8 @@
    68.4    qed
    68.5  qed
    68.6  
    68.7 -instantiation graph :: (type, monoid_mult) "{semiring_1, idem_add, recpower, star}"
    68.8 -begin
    68.9 -
   68.10 -primrec power_graph :: "('a\<Colon>type, 'b\<Colon>monoid_mult) graph \<Rightarrow> nat => ('a, 'b) graph"
   68.11 -where
   68.12 -  "(A \<Colon> ('a, 'b) graph) ^ 0 = 1"