Merged.
authorballarin
Tue, 30 Dec 2008 11:10:01 +0100
changeset 29252 ea97aa6aeba2
parent 29251 8f84a608883d (current diff)
parent 29205 7dc7a75033ea (diff)
child 29253 3c6cd80a4854
child 29254 ef3e2c3399d7
child 29332 edc1e2a56398
Merged.
etc/isar-keywords-ZF.el
etc/isar-keywords.el
src/HOL/Complex/Fundamental_Theorem_Algebra.thy
src/HOL/Complex/README.html
src/HOL/Complex/document/root.tex
src/HOL/Dense_Linear_Order.thy
src/HOL/Divides.thy
src/HOL/HahnBanach/Bounds.thy
src/HOL/HahnBanach/FunctionNorm.thy
src/HOL/HahnBanach/HahnBanach.thy
src/HOL/HahnBanach/HahnBanachExtLemmas.thy
src/HOL/HahnBanach/HahnBanachSupLemmas.thy
src/HOL/HahnBanach/Linearform.thy
src/HOL/HahnBanach/NormedSpace.thy
src/HOL/HahnBanach/Subspace.thy
src/HOL/HahnBanach/VectorSpace.thy
src/HOL/HahnBanach/ZornLemma.thy
src/HOL/Hyperreal/SEQ.thy
src/HOL/Library/Dense_Linear_Order.thy
src/HOL/Library/Multiset.thy
src/HOL/Real/HahnBanach/Bounds.thy
src/HOL/Real/HahnBanach/FunctionNorm.thy
src/HOL/Real/HahnBanach/FunctionOrder.thy
src/HOL/Real/HahnBanach/HahnBanach.thy
src/HOL/Real/HahnBanach/HahnBanachExtLemmas.thy
src/HOL/Real/HahnBanach/HahnBanachLemmas.thy
src/HOL/Real/HahnBanach/HahnBanachSupLemmas.thy
src/HOL/Real/HahnBanach/Linearform.thy
src/HOL/Real/HahnBanach/NormedSpace.thy
src/HOL/Real/HahnBanach/README.html
src/HOL/Real/HahnBanach/ROOT.ML
src/HOL/Real/HahnBanach/Subspace.thy
src/HOL/Real/HahnBanach/VectorSpace.thy
src/HOL/Real/HahnBanach/ZornLemma.thy
src/HOL/Real/HahnBanach/document/root.bib
src/HOL/Real/HahnBanach/document/root.tex
src/HOL/Real/RealVector.thy
src/HOL/RealVector.thy
src/HOL/ex/LexOrds.thy
src/HOLCF/Algebraic.thy
src/HOLCF/Bifinite.thy
src/HOLCF/CompactBasis.thy
src/HOLCF/Completion.thy
src/HOLCF/ConvexPD.thy
src/HOLCF/Deflation.thy
src/HOLCF/LowerPD.thy
src/HOLCF/Universal.thy
src/HOLCF/UpperPD.thy
src/Pure/Concurrent/schedule.ML
src/Pure/IsaMakefile
src/Pure/Isar/theory_target.ML
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/MacOS/README	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,17 @@
+Isabelle application bundle for MacOS
+=====================================
+
+Requirements:
+
+* CocoaDialog http://cocoadialog.sourceforge.net/
+
+* Platypus http://www.sveinbjorn.org/platypus
+
+* AppHack 1.1 http://www.sveinbjorn.org/apphack
+
+  Manual setup:
+    File type: "Isabelle theory"
+    Icon: "theory.icns"
+    "Editor"
+    Suffixes: "thy"
+
Binary file Admin/MacOS/isabelle.icns has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/MacOS/mk	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,19 @@
+#!/bin/bash
+#
+# Make Isabelle application bundle
+
+THIS="$(cd "$(dirname "$0")"; pwd)"
+
+PLATYPUS_APP="/Applications/Platypus-4.0/Platypus.app"
+COCOADIALOG_APP="/Applications/CocoaDialog.app"
+
+"$PLATYPUS_APP/Contents/Resources/platypus" \
+  -a Isabelle -u Isabelle \
+  -I "de.tum.in.isabelle" \
+  -i "$THIS/isabelle.icns" \
+  -D -X thy \
+  -p /bin/bash \
+  -c "$THIS/script" \
+  -o None \
+  -f "$COCOADIALOG_APP" \
+  "$PWD/Isabelle.app"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/MacOS/script	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,78 @@
+#!/bin/bash
+#
+# Author: Makarius
+#
+# Isabelle application wrapper
+
+THIS="$(cd "$(dirname "$0")"; pwd)"
+THIS_APP="$(cd "$THIS/../.."; pwd)"
+SUPER_APP="$(cd "$THIS/../../.."; pwd)"
+
+
+# sane environment defaults
+cd "$HOME"
+PATH="$PATH:/opt/local/bin"
+
+
+# settings support
+
+function choosefrom ()
+{
+  local RESULT=""
+  local FILE=""
+
+  for FILE in "$@"
+  do
+    [ -z "$RESULT" -a -e "$FILE" ] && RESULT="$FILE"
+  done
+
+  [ -z "$RESULT" ] && RESULT="$FILE"
+  echo "$RESULT"
+}
+
+
+# Isabelle
+
+ISABELLE_TOOL="$(choosefrom \
+  "$THIS/Isabelle/bin/isabelle" \
+  "$SUPER_APP/Isabelle/bin/isabelle" \
+  "$HOME/bin/isabelle" \
+  isabelle)"
+
+
+# Proof General / Emacs
+
+PROOFGENERAL_EMACS="$(choosefrom \
+  "$THIS/Emacs.app/Contents/MacOS/Emacs" \
+  "$SUPER_APP/Emacs.app/Contents/MacOS/Emacs" \
+  /Applications/Emacs.app/Contents/MacOS/Emacs \
+  "")"
+
+if [ -n "$PROOFGENERAL_EMACS" ]; then
+  PROOFGENERAL_OPTIONS="-p $PROOFGENERAL_EMACS $PROOFGENERAL_OPTIONS"
+fi
+
+
+# run interface with error feedback
+
+OUTPUT="/tmp/isabelle$$.out"
+
+( "$HOME/bin/isabelle" emacs "$@" ) > "$OUTPUT" 2>&1
+RC=$?
+
+if [ "$RC" != 0 ]; then
+  echo >> "$OUTPUT"
+  echo "Return code: $RC" >> "$OUTPUT"
+fi
+
+if [ $(stat -f "%z" "$OUTPUT") != 0 ]; then
+  "$THIS/CocoaDialog.app/Contents/MacOS/CocoaDialog" textbox \
+    --title "Isabelle" \
+    --informative-text "Isabelle output" \
+    --text-from-file "$OUTPUT" \
+    --button1 "OK"
+fi
+
+rm -f "$OUTPUT"
+
+exit "$RC"
Binary file Admin/MacOS/theory.icns has changed
--- a/Admin/Mercurial/isabelle-style.diff	Tue Dec 30 08:18:54 2008 +0100
+++ b/Admin/Mercurial/isabelle-style.diff	Tue Dec 30 11:10:01 2008 +0100
@@ -13,23 +13,22 @@
 > <div class="files">
 > #files#
 > </div>
-Only in isabelle: filelog.tmpl~
+diff -r gitweb/changeset.tmpl isabelle/changeset.tmpl
+19c19
+< <a class="title" href="{url}raw-rev/#node|short#">#desc|strip|escape|firstline# <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a>
+---
+> <a class="title" href="{url}raw-rev/#node|short#">#desc|strip|escape# <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a>
 diff -r gitweb/map isabelle/map
-56,57c56,57
+29c29
+< annotateline = '<tr style="font-family:monospace" class="parity#parity#"><td class="linenr" style="text-align: right;"><a href="#url#annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}#l{targetline}" title="{node|short}: {desc|escape|firstline}">#author|user#@#rev#</a></td><td><pre><a class="linenr" href="##lineid#" id="#lineid#">#linenumber#</a></pre></td><td><pre>#line|escape#</pre></td></tr>'
+---
+> annotateline = '<tr style="font-family:monospace" class="parity#parity#"><td class="linenr" style="text-align: right;"><a href="#url#annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}#l{targetline}" title="{node|short}: {desc|escape}">#author|user#@#rev#</a></td><td><pre><a class="linenr" href="##lineid#" id="#lineid#">#linenumber#</a></pre></td><td><pre>#line|escape#</pre></td></tr>'
+59,60c59,60
 < shortlogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><i>#author|person#</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|firstline|escape#</b> <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a></td><td class="link" nowrap><a href="{url}rev/#node|short#{sessionvars%urlparameter}">changeset</a> | <a href="{url}file/#node|short#{sessionvars%urlparameter}">files</a></td></tr>'
 < filelogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|firstline|escape#</b></a></td><td class="link"><a href="{url}file/#node|short#/#file|urlescape#{sessionvars%urlparameter}">file</a>&nbsp;|&nbsp;<a href="{url}diff/#node|short#/#file|urlescape#{sessionvars%urlparameter}">diff</a>&nbsp;|&nbsp;<a href="{url}annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}">annotate</a> #rename%filelogrename#</td></tr>'
 ---
 > shortlogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><i>#date|shortdate#</i></td><td><i>#author|person#</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|escape#</b> <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a></td><td class="link" nowrap><a href="{url}rev/#node|short#{sessionvars%urlparameter}">changeset</a> | <a href="{url}file/#node|short#{sessionvars%urlparameter}">files</a></td></tr>'
 > filelogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><i>#date|shortdate#</i></td><td><i>#author|person#</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|escape#</b></a></td><td class="link"><a href="{url}file/#node|short#/#file|urlescape#{sessionvars%urlparameter}">file</a>&nbsp;|&nbsp;<a href="{url}diff/#node|short#/#file|urlescape#{sessionvars%urlparameter}">diff</a>&nbsp;|&nbsp;<a href="{url}annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}">annotate</a> #rename%filelogrename#</td></tr>'
-Only in isabelle: map~
 diff -r gitweb/summary.tmpl isabelle/summary.tmpl
-33d32
+34d33
 < <tr><td>owner</td><td>#owner|obfuscate#</td></tr>
-49,55d47
-< <div><a class="title" href="#">branches</a></div>
-< <table cellspacing="0">
-< {branches%branchentry}
-< <tr class="light">
-<   <td colspan="4"><a class="list"  href="#">...</a></td>
-< </tr>
-< </table>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/Mercurial/misc.diff	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,20 @@
+diff -r hgweb/webcommands.py hgweb/webcommands.py
+653c653
+<         desc = templatefilters.firstline(ctx.description())
+---
+>         desc = ctx.description()
+diff -r templates/atom/changelogentry.tmpl templates/atom/changelogentry.tmpl
+2c2
+<   <title>#desc|strip|firstline|strip|escape#</title>
+---
+>   <title>#desc|strip|escape#</title>
+diff -r templates/rss/changelogentry.tmpl templates/rss/changelogentry.tmpl
+2c2
+<     <title>#desc|strip|firstline|strip|escape#</title>
+---
+>     <title>#desc|strip|escape#</title>
+diff -r templates/rss/filelogentry.tmpl templates/rss/filelogentry.tmpl
+2c2
+<     <title>#desc|strip|firstline|strip|escape#</title>
+---
+>     <title>#desc|strip|escape#</title>
--- a/Admin/build	Tue Dec 30 08:18:54 2008 +0100
+++ b/Admin/build	Tue Dec 30 11:10:01 2008 +0100
@@ -7,7 +7,7 @@
 #paranoia setting for sunbroy
 PATH="/usr/local/dist/DIR/j2sdk1.5.0/bin:$PATH"
 
-PATH="/home/scala/scala/bin:$PATH"
+PATH="/home/scala/current/bin:$PATH"
 
 
 ## directory layout
@@ -101,15 +101,6 @@
   pushd "$ISABELLE_HOME/src/Pure" >/dev/null
   "$ISABELLE_TOOL" make jar || fail "Failed to build Pure.jar!"
   popd >/dev/null
-
-  if [ -d "$HOME/lib/jedit/current" ]; then
-    pushd "$ISABELLE_HOME/lib/jedit/plugin" >/dev/null
-    ./mk
-    [ -f ../isabelle.jar ] || fail "Failed to build jEdit plugin!"
-    popd >/dev/null
-  else
-    echo "Warning: skipping jedit plugin"
-  fi
 }
 
 
--- a/Admin/isatest/settings/at-mac-poly-5.1-para	Tue Dec 30 08:18:54 2008 +0100
+++ b/Admin/isatest/settings/at-mac-poly-5.1-para	Tue Dec 30 11:10:01 2008 +0100
@@ -4,7 +4,7 @@
   ML_SYSTEM="polyml-5.2.1"
   ML_PLATFORM="x86-darwin"
   ML_HOME="$POLYML_HOME/$ML_PLATFORM"
-  ML_OPTIONS="-H 2000"
+  ML_OPTIONS="--immutable 800 --mutable 1200"
 
 
 ISABELLE_HOME_USER=~/isabelle-at-mac-poly-e
--- a/CONTRIBUTORS	Tue Dec 30 08:18:54 2008 +0100
+++ b/CONTRIBUTORS	Tue Dec 30 11:10:01 2008 +0100
@@ -7,6 +7,9 @@
 Contributions to this Isabelle version
 --------------------------------------
 
+* December 2008: Armin Heller, TUM and Alexander Krauss, TUM
+  Method "sizechange" for advanced termination proofs.
+
 * November 2008: Timothy Bourke, NICTA
   Performance improvement (factor 50) for find_theorems.
 
@@ -204,5 +207,3 @@
 * 2004/2005: Tjark Weber, TUM
   SAT solver method using zChaff.
   Improved version of HOL/refute.
-
-$Id$
--- a/INSTALL	Tue Dec 30 08:18:54 2008 +0100
+++ b/INSTALL	Tue Dec 30 11:10:01 2008 +0100
@@ -85,6 +85,3 @@
 Note that the site-wide Isabelle installation may already provide
 Isabelle executables in some global bin directory (such as
 /usr/local/bin).
-
-
-$Id$
--- a/NEWS	Tue Dec 30 08:18:54 2008 +0100
+++ b/NEWS	Tue Dec 30 11:10:01 2008 +0100
@@ -42,6 +42,11 @@
 ISABELLE_HOME_USER can be changed in Isabelle/etc/settings of any
 Isabelle distribution.
 
+* Proofs of fully specified statements are run in parallel on
+multi-core systems.  A speedup factor of 2-3 can be expected on a
+regular 4-core machine, if the initial heap space is made reasonably
+large (cf. Poly/ML option -H).  [Poly/ML 5.2.1 or later]
+
 * The Isabelle System Manual (system) has been updated, with formally
 checked references as hyperlinks.
 
@@ -55,8 +60,8 @@
 * Removed exotic 'token_translation' command.  INCOMPATIBILITY, use ML
 interface instead.
 
-* There is a new lexical item "float" with syntax ["-"] digit+ "." digit+,
-without spaces.
+* There is a new syntactic category "float_const" for signed decimal
+fractions (e.g. 123.45 or -123.45).
 
 
 *** Pure ***
@@ -152,11 +157,12 @@
 
 *** HOL ***
 
-* Made repository layout more coherent with logical
-distribution structure:
+* Made source layout more coherent with logical distribution
+structure:
 
     src/HOL/Library/RType.thy ~> src/HOL/Typerep.thy
     src/HOL/Library/Code_Message.thy ~> src/HOL/
+    src/HOL/Library/Dense_Linear_Order.thy ~> src/HOL/
     src/HOL/Library/GCD.thy ~> src/HOL/
     src/HOL/Library/Order_Relation.thy ~> src/HOL/
     src/HOL/Library/Parity.thy ~> src/HOL/
@@ -172,6 +178,7 @@
     src/HOL/Complex/Complex_Main.thy ~> src/HOL/
     src/HOL/Complex/Complex.thy ~> src/HOL/
     src/HOL/Complex/FrechetDeriv.thy ~> src/HOL/
+    src/HOL/Complex/Fundamental_Theorem_Algebra.thy ~> src/HOL/
     src/HOL/Hyperreal/Deriv.thy ~> src/HOL/
     src/HOL/Hyperreal/Fact.thy ~> src/HOL/
     src/HOL/Hyperreal/Integration.thy ~> src/HOL/
@@ -181,9 +188,12 @@
     src/HOL/Hyperreal/MacLaurin.thy ~> src/HOL/
     src/HOL/Hyperreal/NthRoot.thy ~> src/HOL/
     src/HOL/Hyperreal/Series.thy ~> src/HOL/
+    src/HOL/Hyperreal/SEQ.thy ~> src/HOL/
     src/HOL/Hyperreal/Taylor.thy ~> src/HOL/
     src/HOL/Hyperreal/Transcendental.thy ~> src/HOL/
     src/HOL/Real/Float ~> src/HOL/Library/
+    src/HOL/Real/HahnBanach ~> src/HOL/HahnBanach
+    src/HOL/Real/RealVector.thy ~> src/HOL/
 
     src/HOL/arith_data.ML ~> src/HOL/Tools
     src/HOL/hologic.ML ~> src/HOL/Tools
@@ -239,6 +249,10 @@
 mechanisms may be specified (currently, [SML], [code] or [nbe]).  See
 further src/HOL/ex/Eval_Examples.thy.
 
+* New method "sizechange" to automate termination proofs using (a
+modification of) the size-change principle. Requires SAT solver. See
+src/HOL/ex/Termination.thy for examples.
+
 * HOL/Orderings: class "wellorder" moved here, with explicit induction
 rule "less_induct" as assumption.  For instantiation of "wellorder" by
 means of predicate "wf", use rule wf_wellorderI.  INCOMPATIBILITY.
@@ -388,6 +402,14 @@
 
 *** ML ***
 
+* High-level support for concurrent ML programming, see
+src/Pure/Cuncurrent.  The data-oriented model of "future values" is
+particularly convenient to organize independent functional
+computations.  The concept of "synchronized variables" provides a
+higher-order interface for components with shared state, avoiding the
+delicate details of mutexes and condition variables.  [Poly/ML 5.2.1
+or later]
+
 * Simplified ML oracle interface Thm.add_oracle promotes 'a -> cterm
 to 'a -> thm, while results are always tagged with an authentic oracle
 name.  The Isar command 'oracle' is now polymorphic, no argument type
@@ -857,8 +879,8 @@
 print_mode_active, PrintMode.setmp etc.  INCOMPATIBILITY.
 
 * Functions system/system_out provide a robust way to invoke external
-shell commands, with propagation of interrupts (requires Poly/ML 5.2).
-Do not use OS.Process.system etc. from the basis library!
+shell commands, with propagation of interrupts (requires Poly/ML
+5.2.1).  Do not use OS.Process.system etc. from the basis library!
 
 
 *** System ***
@@ -5953,6 +5975,3 @@
 types;
 
 :mode=text:wrap=hard:maxLineLen=72:
-
-
-$Id$
--- a/build	Tue Dec 30 08:18:54 2008 +0100
+++ b/build	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # build - compile the Isabelle system and object-logics
--- a/doc-src/IsarAdvanced/Classes/style.sty	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarAdvanced/Classes/style.sty	Tue Dec 30 11:10:01 2008 +0100
@@ -30,7 +30,7 @@
 
 \pagestyle{headings}
 \binperiod
-\underscoreon
+\underscoreoff
 
 \renewcommand{\isadigit}[1]{\isamath{#1}}
 
--- a/doc-src/IsarAdvanced/Codegen/style.sty	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarAdvanced/Codegen/style.sty	Tue Dec 30 11:10:01 2008 +0100
@@ -42,7 +42,7 @@
 
 \pagestyle{headings}
 \binperiod
-\underscoreon
+\underscoreoff
 
 \renewcommand{\isadigit}[1]{\isamath{#1}}
 
--- a/doc-src/IsarImplementation/Thy/ML.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarImplementation/Thy/ML.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -107,18 +107,23 @@
 section {* Thread-safe programming *}
 
 text {*
-  Recent versions of Poly/ML (5.2 or later) support multithreaded
-  execution based on native operating system threads of the underlying
-  platform.  Thus threads will actually be executed in parallel on
-  multi-core systems.  A speedup-factor of approximately 2--4 can be
-  expected for large well-structured Isabelle sessions, where theories
-  are organized as a graph with sufficiently many independent nodes.
+  Recent versions of Poly/ML (5.2.1 or later) support robust
+  multithreaded execution, based on native operating system threads of
+  the underlying platform.  Thus threads will actually be executed in
+  parallel on multi-core systems.  A speedup-factor of approximately
+  1.5--3 can be expected on a regular 4-core machine.\footnote{There
+  is some inherent limitation of the speedup factor due to garbage
+  collection, which is still sequential.  It helps to provide initial
+  heap space generously, using the \texttt{-H} option of Poly/ML.}
+  Threads also help to organize advanced operations of the system,
+  with explicit communication between sub-components, real-time
+  conditions, time-outs etc.
 
-  Threads lack the memory protection of separate processes, but
+  Threads lack the memory protection of separate processes, and
   operate concurrently on shared heap memory.  This has the advantage
   that results of independent computations are immediately available
-  to other threads, without requiring explicit communication,
-  reloading, or even recoding of data.
+  to other threads, without requiring untyped character streams,
+  awkward serialization etc.
 
   On the other hand, some programming guidelines need to be observed
   in order to make unprotected parallelism work out smoothly.  While
@@ -143,27 +148,29 @@
 
   \end{itemize}
 
-  Note that ML bindings within the toplevel environment (@{verbatim
-  "type"}, @{verbatim val}, @{verbatim "structure"} etc.) due to
-  run-time invocation of the compiler are non-critical, because
-  Isabelle/Isar incorporates such bindings within the theory or proof
-  context.
-
   The majority of tools implemented within the Isabelle/Isar framework
   will not require any of these critical elements: nothing special
   needs to be observed when staying in the purely functional fragment
   of ML.  Note that output via the official Isabelle channels does not
-  even count as direct I/O in the above sense, so the operations @{ML
-  "writeln"}, @{ML "warning"}, @{ML "tracing"} etc.\ are safe.
+  count as direct I/O, so the operations @{ML "writeln"}, @{ML
+  "warning"}, @{ML "tracing"} etc.\ are safe.
+
+  Moreover, ML bindings within the toplevel environment (@{verbatim
+  "type"}, @{verbatim val}, @{verbatim "structure"} etc.) due to
+  run-time invocation of the compiler are also safe, because
+  Isabelle/Isar manages this as part of the theory or proof context.
 
-  \paragraph{Multithreading in Isabelle/Isar.}  Our parallel execution
-  model is centered around the theory loader.  Whenever a given
-  subgraph of theories needs to be updated, the system schedules a
-  number of threads to process the sources as required, while
-  observing their dependencies.  Thus concurrency is limited to
-  independent nodes according to the theory import relation.
+  \paragraph{Multithreading in Isabelle/Isar.}  The theory loader
+  automatically exploits the overall parallelism of independent nodes
+  in the development graph, as well as the inherent irrelevance of
+  proofs for goals being fully specified in advance.  This means,
+  checking of individual Isar proofs is parallelized by default.
+  Beyond that, very sophisticated proof tools may use local
+  parallelism internally, via the general programming model of
+  ``future values'' (see also @{"file"
+  "~~/src/Pure/Concurrent/future.ML"}).
 
-  Any user-code that works relatively to the present background theory
+  Any ML code that works relatively to the present background theory
   is already safe.  Contextual data may be easily stored within the
   theory or proof context, thanks to the generic data concept of
   Isabelle/Isar (see \secref{sec:context-data}).  This greatly
@@ -179,9 +186,13 @@
   quickly, otherwise parallel execution performance may degrade
   significantly.
 
-  Despite this potential bottle-neck, we refrain from fine-grained
-  locking mechanism within user-code: the restriction to a single lock
-  prevents deadlocks without demanding special precautions.
+  Despite this potential bottle-neck, centralized locking is
+  convenient, because it prevents deadlocks without demanding special
+  precautions.  Explicit communication demands other means, though.
+  The high-level abstraction of synchronized variables @{"file"
+  "~~/src/Pure/Concurrent/synchronized.ML"} enables parallel
+  components to communicate via shared state; see also @{"file"
+  "~~/src/Pure/Concurrent/mailbox.ML"} as canonical example.
 
   \paragraph{Good conduct of impure programs.} The following
   guidelines enable non-functional programs to participate in
--- a/doc-src/IsarImplementation/Thy/document/ML.tex	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarImplementation/Thy/document/ML.tex	Tue Dec 30 11:10:01 2008 +0100
@@ -128,18 +128,23 @@
 \isamarkuptrue%
 %
 \begin{isamarkuptext}%
-Recent versions of Poly/ML (5.2 or later) support multithreaded
-  execution based on native operating system threads of the underlying
-  platform.  Thus threads will actually be executed in parallel on
-  multi-core systems.  A speedup-factor of approximately 2--4 can be
-  expected for large well-structured Isabelle sessions, where theories
-  are organized as a graph with sufficiently many independent nodes.
+Recent versions of Poly/ML (5.2.1 or later) support robust
+  multithreaded execution, based on native operating system threads of
+  the underlying platform.  Thus threads will actually be executed in
+  parallel on multi-core systems.  A speedup-factor of approximately
+  1.5--3 can be expected on a regular 4-core machine.\footnote{There
+  is some inherent limitation of the speedup factor due to garbage
+  collection, which is still sequential.  It helps to provide initial
+  heap space generously, using the \texttt{-H} option of Poly/ML.}
+  Threads also help to organize advanced operations of the system,
+  with explicit communication between sub-components, real-time
+  conditions, time-outs etc.
 
-  Threads lack the memory protection of separate processes, but
+  Threads lack the memory protection of separate processes, and
   operate concurrently on shared heap memory.  This has the advantage
   that results of independent computations are immediately available
-  to other threads, without requiring explicit communication,
-  reloading, or even recoding of data.
+  to other threads, without requiring untyped character streams,
+  awkward serialization etc.
 
   On the other hand, some programming guidelines need to be observed
   in order to make unprotected parallelism work out smoothly.  While
@@ -163,25 +168,26 @@
 
   \end{itemize}
 
-  Note that ML bindings within the toplevel environment (\verb|type|, \verb|val|, \verb|structure| etc.) due to
-  run-time invocation of the compiler are non-critical, because
-  Isabelle/Isar incorporates such bindings within the theory or proof
-  context.
-
   The majority of tools implemented within the Isabelle/Isar framework
   will not require any of these critical elements: nothing special
   needs to be observed when staying in the purely functional fragment
   of ML.  Note that output via the official Isabelle channels does not
-  even count as direct I/O in the above sense, so the operations \verb|writeln|, \verb|warning|, \verb|tracing| etc.\ are safe.
+  count as direct I/O, so the operations \verb|writeln|, \verb|warning|, \verb|tracing| etc.\ are safe.
+
+  Moreover, ML bindings within the toplevel environment (\verb|type|, \verb|val|, \verb|structure| etc.) due to
+  run-time invocation of the compiler are also safe, because
+  Isabelle/Isar manages this as part of the theory or proof context.
 
-  \paragraph{Multithreading in Isabelle/Isar.}  Our parallel execution
-  model is centered around the theory loader.  Whenever a given
-  subgraph of theories needs to be updated, the system schedules a
-  number of threads to process the sources as required, while
-  observing their dependencies.  Thus concurrency is limited to
-  independent nodes according to the theory import relation.
+  \paragraph{Multithreading in Isabelle/Isar.}  The theory loader
+  automatically exploits the overall parallelism of independent nodes
+  in the development graph, as well as the inherent irrelevance of
+  proofs for goals being fully specified in advance.  This means,
+  checking of individual Isar proofs is parallelized by default.
+  Beyond that, very sophisticated proof tools may use local
+  parallelism internally, via the general programming model of
+  ``future values'' (see also \hyperlink{file.~~/src/Pure/Concurrent/future.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Concurrent{\isacharslash}future{\isachardot}ML}}}}).
 
-  Any user-code that works relatively to the present background theory
+  Any ML code that works relatively to the present background theory
   is already safe.  Contextual data may be easily stored within the
   theory or proof context, thanks to the generic data concept of
   Isabelle/Isar (see \secref{sec:context-data}).  This greatly
@@ -197,9 +203,11 @@
   quickly, otherwise parallel execution performance may degrade
   significantly.
 
-  Despite this potential bottle-neck, we refrain from fine-grained
-  locking mechanism within user-code: the restriction to a single lock
-  prevents deadlocks without demanding special precautions.
+  Despite this potential bottle-neck, centralized locking is
+  convenient, because it prevents deadlocks without demanding special
+  precautions.  Explicit communication demands other means, though.
+  The high-level abstraction of synchronized variables \hyperlink{file.~~/src/Pure/Concurrent/synchronized.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Concurrent{\isacharslash}synchronized{\isachardot}ML}}}} enables parallel
+  components to communicate via shared state; see also \hyperlink{file.~~/src/Pure/Concurrent/mailbox.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Concurrent{\isacharslash}mailbox{\isachardot}ML}}}} as canonical example.
 
   \paragraph{Good conduct of impure programs.} The following
   guidelines enable non-functional programs to participate in
--- a/doc-src/IsarRef/Thy/HOL_Specific.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarRef/Thy/HOL_Specific.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -804,12 +804,15 @@
     @{command_def (HOL) "print_atps"}@{text "\<^sup>*"} & : & @{text "context \<rightarrow>"} \\
     @{command_def (HOL) "atp_info"}@{text "\<^sup>*"} & : & @{text "any \<rightarrow>"} \\
     @{command_def (HOL) "atp_kill"}@{text "\<^sup>*"} & : & @{text "any \<rightarrow>"} \\
+    @{command_def (HOL) "atp_messages"}@{text "\<^sup>*"} & : & @{text "any \<rightarrow>"} \\
     @{method_def (HOL) metis} & : & @{text method} \\
   \end{matharray}
 
   \begin{rail}
   'sledgehammer' (nameref *)
   ;
+  'atp\_messages' ('(' nat ')')?
+  ;
 
   'metis' thmrefs
   ;
@@ -842,6 +845,12 @@
   \item @{command (HOL) atp_kill} terminates all presently running
   provers.
 
+  \item @{command (HOL) atp_messages} displays recent messages issued
+  by automated theorem provers.  This allows to examine results that
+  might have got lost due to the asynchronous nature of default
+  @{command (HOL) sledgehammer} output.  An optional message limit may
+  be specified (default 5).
+
   \item @{method (HOL) metis}~@{text "facts"} invokes the Metis prover
   with the given facts.  Metis is an automated proof tool of medium
   strength, but is fully integrated into Isabelle/HOL, with explicit
--- a/doc-src/IsarRef/Thy/Inner_Syntax.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarRef/Thy/Inner_Syntax.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -683,17 +683,23 @@
     @{syntax_def (inner) tid} & = & @{syntax_ref typefree} \\
     @{syntax_def (inner) tvar} & = & @{syntax_ref typevar} \\
     @{syntax_def (inner) num} & = & @{syntax_ref nat}@{text "  |  "}@{verbatim "-"}@{syntax_ref nat} \\
+    @{syntax_def (inner) float_token} & = & @{syntax_ref nat}@{verbatim "."}@{syntax_ref nat}@{text "  |  "}@{verbatim "-"}@{syntax_ref nat}@{verbatim "."}@{syntax_ref nat} \\
     @{syntax_def (inner) xnum} & = & @{verbatim "#"}@{syntax_ref nat}@{text "  |  "}@{verbatim "#-"}@{syntax_ref nat} \\
 
     @{syntax_def (inner) xstr} & = & @{verbatim "''"} @{text "\<dots>"} @{verbatim "''"} \\
   \end{supertabular}
   \end{center}
 
-  The token categories @{syntax_ref (inner) num}, @{syntax_ref (inner)
-  xnum}, and @{syntax_ref (inner) xstr} are not used in Pure.
-  Object-logics may implement numerals and string constants by adding
-  appropriate syntax declarations, together with some translation
-  functions (e.g.\ see Isabelle/HOL).
+  The token categories @{syntax (inner) num}, @{syntax (inner)
+  float_token}, @{syntax (inner) xnum}, and @{syntax (inner) xstr} are
+  not used in Pure.  Object-logics may implement numerals and string
+  constants by adding appropriate syntax declarations, together with
+  some translation functions (e.g.\ see Isabelle/HOL).
+
+  The derived categories @{syntax_def (inner) num_const} and
+  @{syntax_def (inner) float_const} provide robust access to @{syntax
+  (inner) num}, and @{syntax (inner) float_token}, respectively: the
+  syntax tree holds a syntactic constant instead of a free variable.
 *}
 
 
--- a/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Tue Dec 30 11:10:01 2008 +0100
@@ -814,12 +814,15 @@
     \indexdef{HOL}{command}{print\_atps}\hypertarget{command.HOL.print-atps}{\hyperlink{command.HOL.print-atps}{\mbox{\isa{\isacommand{print{\isacharunderscore}atps}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}context\ {\isasymrightarrow}{\isachardoublequote}} \\
     \indexdef{HOL}{command}{atp\_info}\hypertarget{command.HOL.atp-info}{\hyperlink{command.HOL.atp-info}{\mbox{\isa{\isacommand{atp{\isacharunderscore}info}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}any\ {\isasymrightarrow}{\isachardoublequote}} \\
     \indexdef{HOL}{command}{atp\_kill}\hypertarget{command.HOL.atp-kill}{\hyperlink{command.HOL.atp-kill}{\mbox{\isa{\isacommand{atp{\isacharunderscore}kill}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}any\ {\isasymrightarrow}{\isachardoublequote}} \\
+    \indexdef{HOL}{command}{atp\_messages}\hypertarget{command.HOL.atp-messages}{\hyperlink{command.HOL.atp-messages}{\mbox{\isa{\isacommand{atp{\isacharunderscore}messages}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}any\ {\isasymrightarrow}{\isachardoublequote}} \\
     \indexdef{HOL}{method}{metis}\hypertarget{method.HOL.metis}{\hyperlink{method.HOL.metis}{\mbox{\isa{metis}}}} & : & \isa{method} \\
   \end{matharray}
 
   \begin{rail}
   'sledgehammer' (nameref *)
   ;
+  'atp\_messages' ('(' nat ')')?
+  ;
 
   'metis' thmrefs
   ;
@@ -850,6 +853,12 @@
   \item \hyperlink{command.HOL.atp-kill}{\mbox{\isa{\isacommand{atp{\isacharunderscore}kill}}}} terminates all presently running
   provers.
 
+  \item \hyperlink{command.HOL.atp-messages}{\mbox{\isa{\isacommand{atp{\isacharunderscore}messages}}}} displays recent messages issued
+  by automated theorem provers.  This allows to examine results that
+  might have got lost due to the asynchronous nature of default
+  \hyperlink{command.HOL.sledgehammer}{\mbox{\isa{\isacommand{sledgehammer}}}} output.  An optional message limit may
+  be specified (default 5).
+
   \item \hyperlink{method.HOL.metis}{\mbox{\isa{metis}}}~\isa{{\isachardoublequote}facts{\isachardoublequote}} invokes the Metis prover
   with the given facts.  Metis is an automated proof tool of medium
   strength, but is fully integrated into Isabelle/HOL, with explicit
--- a/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Tue Dec 30 08:18:54 2008 +0100
+++ b/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Tue Dec 30 11:10:01 2008 +0100
@@ -702,16 +702,21 @@
     \indexdef{inner}{syntax}{tid}\hypertarget{syntax.inner.tid}{\hyperlink{syntax.inner.tid}{\mbox{\isa{tid}}}} & = & \indexref{}{syntax}{typefree}\hyperlink{syntax.typefree}{\mbox{\isa{typefree}}} \\
     \indexdef{inner}{syntax}{tvar}\hypertarget{syntax.inner.tvar}{\hyperlink{syntax.inner.tvar}{\mbox{\isa{tvar}}}} & = & \indexref{}{syntax}{typevar}\hyperlink{syntax.typevar}{\mbox{\isa{typevar}}} \\
     \indexdef{inner}{syntax}{num}\hypertarget{syntax.inner.num}{\hyperlink{syntax.inner.num}{\mbox{\isa{num}}}} & = & \indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|-|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}} \\
+    \indexdef{inner}{syntax}{float\_token}\hypertarget{syntax.inner.float-token}{\hyperlink{syntax.inner.float-token}{\mbox{\isa{float{\isacharunderscore}token}}}} & = & \indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\verb|.|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|-|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\verb|.|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}} \\
     \indexdef{inner}{syntax}{xnum}\hypertarget{syntax.inner.xnum}{\hyperlink{syntax.inner.xnum}{\mbox{\isa{xnum}}}} & = & \verb|#|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|#-|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}} \\
 
     \indexdef{inner}{syntax}{xstr}\hypertarget{syntax.inner.xstr}{\hyperlink{syntax.inner.xstr}{\mbox{\isa{xstr}}}} & = & \verb|''| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|''| \\
   \end{supertabular}
   \end{center}
 
-  The token categories \indexref{inner}{syntax}{num}\hyperlink{syntax.inner.num}{\mbox{\isa{num}}}, \indexref{inner}{syntax}{xnum}\hyperlink{syntax.inner.xnum}{\mbox{\isa{xnum}}}, and \indexref{inner}{syntax}{xstr}\hyperlink{syntax.inner.xstr}{\mbox{\isa{xstr}}} are not used in Pure.
-  Object-logics may implement numerals and string constants by adding
-  appropriate syntax declarations, together with some translation
-  functions (e.g.\ see Isabelle/HOL).%
+  The token categories \hyperlink{syntax.inner.num}{\mbox{\isa{num}}}, \hyperlink{syntax.inner.float-token}{\mbox{\isa{float{\isacharunderscore}token}}}, \hyperlink{syntax.inner.xnum}{\mbox{\isa{xnum}}}, and \hyperlink{syntax.inner.xstr}{\mbox{\isa{xstr}}} are
+  not used in Pure.  Object-logics may implement numerals and string
+  constants by adding appropriate syntax declarations, together with
+  some translation functions (e.g.\ see Isabelle/HOL).
+
+  The derived categories \indexdef{inner}{syntax}{num\_const}\hypertarget{syntax.inner.num-const}{\hyperlink{syntax.inner.num-const}{\mbox{\isa{num{\isacharunderscore}const}}}} and
+  \indexdef{inner}{syntax}{float\_const}\hypertarget{syntax.inner.float-const}{\hyperlink{syntax.inner.float-const}{\mbox{\isa{float{\isacharunderscore}const}}}} provide robust access to \hyperlink{syntax.inner.num}{\mbox{\isa{num}}}, and \hyperlink{syntax.inner.float-token}{\mbox{\isa{float{\isacharunderscore}token}}}, respectively: the
+  syntax tree holds a syntactic constant instead of a free variable.%
 \end{isamarkuptext}%
 \isamarkuptrue%
 %
--- a/etc/isar-keywords-ZF.el	Tue Dec 30 08:18:54 2008 +0100
+++ b/etc/isar-keywords-ZF.el	Tue Dec 30 11:10:01 2008 +0100
@@ -200,7 +200,6 @@
     "use"
     "use_thy"
     "using"
-    "value"
     "welcome"
     "with"
     "{"
@@ -323,7 +322,6 @@
     "typ"
     "unused_thms"
     "use_thy"
-    "value"
     "welcome"))
 
 (defconst isar-keywords-theory-begin
--- a/etc/isar-keywords.el	Tue Dec 30 08:18:54 2008 +0100
+++ b/etc/isar-keywords.el	Tue Dec 30 11:10:01 2008 +0100
@@ -32,6 +32,7 @@
     "atom_decl"
     "atp_info"
     "atp_kill"
+    "atp_messages"
     "automaton"
     "ax_specification"
     "axclass"
@@ -334,6 +335,7 @@
     "ML_val"
     "atp_info"
     "atp_kill"
+    "atp_messages"
     "cd"
     "class_deps"
     "code_deps"
--- a/etc/proofgeneral-settings.el	Tue Dec 30 08:18:54 2008 +0100
+++ b/etc/proofgeneral-settings.el	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,3 @@
-;;;
-;;; $Id$
-;;;
 ;;; Options for Proof General
 
 ;; Examples for sensible settings:
--- a/etc/settings	Tue Dec 30 08:18:54 2008 +0100
+++ b/etc/settings	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 # -*- shell-script -*- :mode=shellscript:
-# $Id$
 #
 # Isabelle settings -- site defaults.
 #
@@ -202,9 +201,8 @@
   "/opt/ProofGeneral" \
   "")
 
-PROOFGENERAL_EMACS=$(choosefrom /Applications/Emacs.app/Contents/MacOS/Emacs emacs22)
-PROOFGENERAL_OPTIONS="-p $PROOFGENERAL_EMACS"
-#PROOFGENERAL_OPTIONS="-m no_brackets -m no_type_brackets -x true -p $PROOFGENERAL_EMACS"
+PROOFGENERAL_OPTIONS=""
+#PROOFGENERAL_OPTIONS="-m no_brackets -m no_type_brackets"
 
 # Automatic setup of remote fonts
 #XSYMBOL_INSTALLFONTS="xset fp+ tcp/isafonts.informatik.tu-muenchen.de:7200"
--- a/etc/symbols	Tue Dec 30 08:18:54 2008 +0100
+++ b/etc/symbols	Tue Dec 30 11:10:01 2008 +0100
@@ -1,4 +1,3 @@
-# $Id$
 # Default interpretation of some Isabelle symbols
 
 \<zero>                 code: 0x01d7ec  font: Isabelle
--- a/etc/user-settings.sample	Tue Dec 30 08:18:54 2008 +0100
+++ b/etc/user-settings.sample	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 # -*- shell-script -*-
-# $Id$
 #
 # Isabelle user settings sample -- for use in ~/.isabelle/etc/settings
 
--- a/lib/Tools/browser	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/browser	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: Isabelle graph browser
--- a/lib/Tools/codegen	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/codegen	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Florian Haftmann, TUM
 #
 # DESCRIPTION: issue code generation from shell
--- a/lib/Tools/dimacs2hol	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/dimacs2hol	Tue Dec 30 11:10:01 2008 +0100
@@ -1,8 +1,6 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Tjark Weber
-# Copyright 2004
 #
 # DESCRIPTION: convert DIMACS CNF files into Isabelle/HOL theories
 
--- a/lib/Tools/display	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/display	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: display document (in DVI or PDF format)
--- a/lib/Tools/doc	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/doc	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: view Isabelle documentation
--- a/lib/Tools/document	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/document	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: prepare theory session document
--- a/lib/Tools/emacs	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/emacs	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: Proof General / Emacs interface wrapper
--- a/lib/Tools/env	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/env	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: run a program in a modified environment
--- a/lib/Tools/findlogics	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/findlogics	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: collect heap names from ISABELLE_PATH
--- a/lib/Tools/getenv	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/getenv	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: get values from Isabelle settings environment
--- a/lib/Tools/install	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/install	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: install standalone Isabelle executables
--- a/lib/Tools/java	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/java	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: invoke Java within the Isabelle environment
--- a/lib/Tools/jedit	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/jedit	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: Isabelle/jEdit interface wrapper
--- a/lib/Tools/keywords	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/keywords	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: generate outer syntax keyword files from session logs
--- a/lib/Tools/latex	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/latex	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: run LaTeX (and related tools)
--- a/lib/Tools/logo	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/logo	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: create an instance of the Isabelle logo
--- a/lib/Tools/make	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/make	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: Isabelle make utility
--- a/lib/Tools/makeall	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/makeall	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: apply make utility to all logics
--- a/lib/Tools/mkdir	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/mkdir	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: prepare logic session directory
--- a/lib/Tools/mkfifo	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/mkfifo	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: create named pipe
--- a/lib/Tools/mkproject	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/mkproject	Tue Dec 30 11:10:01 2008 +0100
@@ -1,7 +1,6 @@
 #!/usr/bin/env bash
 #
-# $Id$
-# Author: David Aspinall and Makarius Wenzel
+# Author: David Aspinall
 #
 # DESCRIPTION: prepare a session directory for PG-Eclipse
 
--- a/lib/Tools/print	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/print	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: print document
--- a/lib/Tools/rmfifo	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/rmfifo	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: remove named pipe
--- a/lib/Tools/scala	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/scala	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: invoke Scala within the Isabelle environment
--- a/lib/Tools/tty	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/tty	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: run Isabelle process with plain tty interaction
--- a/lib/Tools/unsymbolize	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/unsymbolize	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: remove unreadable symbol names from sources
--- a/lib/Tools/usedir	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/usedir	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # DESCRIPTION: build object-logic or run examples
@@ -40,6 +39,11 @@
   echo "  ISABELLE_USEDIR_OPTIONS=$ISABELLE_USEDIR_OPTIONS"
   echo "  HOL_USEDIR_OPTIONS=$HOL_USEDIR_OPTIONS"
   echo
+  echo "  ML_PLATFORM=$ML_PLATFORM"
+  echo "  ML_HOME=$ML_HOME"
+  echo "  ML_SYSTEM=$ML_SYSTEM"
+  echo "  ML_OPTIONS=$ML_OPTIONS"
+  echo
   exit 1
 }
 
--- a/lib/Tools/version	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/version	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Stefan Berghofer, TU Muenchen
 #
 # DESCRIPTION: display Isabelle version
--- a/lib/Tools/yxml	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/Tools/yxml	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # DESCRIPTION: simple XML to YXML converter
--- a/lib/jedit/isabelle.xml	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/jedit/isabelle.xml	Tue Dec 30 11:10:01 2008 +0100
@@ -56,6 +56,7 @@
       <OPERATOR>atom_decl</OPERATOR>
       <LABEL>atp_info</LABEL>
       <LABEL>atp_kill</LABEL>
+      <LABEL>atp_messages</LABEL>
       <KEYWORD4>attach</KEYWORD4>
       <OPERATOR>automaton</OPERATOR>
       <KEYWORD4>avoids</KEYWORD4>
@@ -154,7 +155,6 @@
       <KEYWORD4>if</KEYWORD4>
       <KEYWORD4>imports</KEYWORD4>
       <KEYWORD4>in</KEYWORD4>
-      <KEYWORD4>includes</KEYWORD4>
       <KEYWORD4>induction</KEYWORD4>
       <OPERATOR>inductive</OPERATOR>
       <KEYWORD1>inductive_cases</KEYWORD1>
@@ -286,6 +286,7 @@
       <OPERATOR>statespace</OPERATOR>
       <KEYWORD4>structure</KEYWORD4>
       <OPERATOR>subclass</OPERATOR>
+      <OPERATOR>sublocale</OPERATOR>
       <OPERATOR>subsect</OPERATOR>
       <OPERATOR>subsection</OPERATOR>
       <OPERATOR>subsubsect</OPERATOR>
--- a/lib/scripts/dimacs2hol.pl	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/dimacs2hol.pl	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,3 @@
-#
-# $Id$
 #
 # dimacs2hol.pl - convert files in DIMACS CNF format [1] into Isabelle/HOL
 #                 theories
--- a/lib/scripts/feeder	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/feeder	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # feeder - feed isabelle session
--- a/lib/scripts/feeder.pl	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/feeder.pl	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # feeder.pl - feed isabelle session
--- a/lib/scripts/fileident	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/fileident	Tue Dec 30 11:10:01 2008 +0100
@@ -1,7 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
-#
 # fileident --- produce file identification based
 
 FILE="$1"
--- a/lib/scripts/getsettings	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/getsettings	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,5 @@
 # -*- shell-script -*- :mode=shellscript:
-# $Id$
+#
 # Author: Markus Wenzel, TU Muenchen
 #
 # getsettings - bash source script to augment current env.
--- a/lib/scripts/keywords.pl	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/keywords.pl	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 #
-# $Id$
 # Author: Makarius
 #
 # keywords.pl - generate outer syntax keyword files from session logs
@@ -79,8 +78,6 @@
   print ";; Generated from ${sessions}.\n";
   print ";; *** DO NOT EDIT *** DO NOT EDIT *** DO NOT EDIT ***\n";
   print ";;\n";
-  print ";; \$", "Id\$\n";
-  print ";;\n";
 
   for my $kind (@kinds) {
     my @names;
@@ -154,7 +151,6 @@
 EOF
   print "<!-- Generated from ${sessions}. -->\n";
   print "<!-- *** DO NOT EDIT *** DO NOT EDIT *** DO NOT EDIT *** -->\n";
-  print "<!-- \$", "Id\$ -->\n";
   print <<'EOF';
 <MODE>
   <PROPS>
--- a/lib/scripts/polyml-platform	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/polyml-platform	Tue Dec 30 11:10:01 2008 +0100
@@ -1,7 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
-#
 # polyml-platform --- determine Poly/ML's idea of current hardware and
 # operating system type
 #
--- a/lib/scripts/polyml-version	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/polyml-version	Tue Dec 30 11:10:01 2008 +0100
@@ -1,7 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
-#
 # polyml-version --- determine Poly/ML runtime system version
 
 echo -n polyml
--- a/lib/scripts/run-mosml	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-mosml	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # Moscow ML 2.00 startup script
--- a/lib/scripts/run-polyml	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-polyml	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # Poly/ML 5.1/5.2 startup script.
--- a/lib/scripts/run-polyml-4.1.3	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-polyml-4.1.3	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # Poly/ML 4.x startup script.
--- a/lib/scripts/run-polyml-4.1.4	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-polyml-4.1.4	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # Poly/ML 4.x startup script.
--- a/lib/scripts/run-polyml-4.2.0	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-polyml-4.2.0	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # Poly/ML 4.x startup script.
--- a/lib/scripts/run-polyml-5.0	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-polyml-5.0	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Makarius
 #
 # Poly/ML 5.0 startup script.
--- a/lib/scripts/run-smlnj	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/run-smlnj	Tue Dec 30 11:10:01 2008 +0100
@@ -1,6 +1,5 @@
 #!/usr/bin/env bash
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # SML/NJ startup script (for 110 or later).
--- a/lib/scripts/system.pl	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/system.pl	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 #
-# $Id$
 # Author: Makarius
 #
 # system.pl - invoke shell command line (with robust signal handling)
--- a/lib/scripts/timestart.bash	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/timestart.bash	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,5 @@
 # -*- shell-script -*-
-# $Id$
+#
 # Author: Makarius
 #
 # timestart - setup bash environment for timing.
--- a/lib/scripts/timestop.bash	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/timestop.bash	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,5 @@
 # -*- shell-script -*-
-# $Id$
+#
 # Author: Makarius
 #
 # timestop - report timing based on environment (cf. timestart.bash)
--- a/lib/scripts/unsymbolize.pl	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/unsymbolize.pl	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 #
-# $Id$
 # Author: Markus Wenzel, TU Muenchen
 #
 # unsymbolize.pl - remove unreadable symbol names from sources
--- a/lib/scripts/yxml.pl	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/scripts/yxml.pl	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,4 @@
 #
-# $Id$
 # Author: Makarius
 #
 # yxml.pl - simple XML to YXML converter
--- a/lib/texinputs/draft.tex	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/texinputs/draft.tex	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,3 @@
-%%
-%% $Id$
 %%
 %% root for draft documents
 %%
--- a/lib/texinputs/isabelle.sty	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/texinputs/isabelle.sty	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,3 @@
-%%
-%% $Id$
 %%
 %% macros for Isabelle generated LaTeX output
 %%
--- a/lib/texinputs/isabellesym.sty	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/texinputs/isabellesym.sty	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,3 @@
-%%
-%% $Id$
 %%
 %% definitions of standard Isabelle symbols
 %%
--- a/lib/texinputs/pdfsetup.sty	Tue Dec 30 08:18:54 2008 +0100
+++ b/lib/texinputs/pdfsetup.sty	Tue Dec 30 11:10:01 2008 +0100
@@ -1,5 +1,3 @@
-%%
-%% $Id$
 %%
 %% default hyperref setup (both for pdf and dvi output)
 %%
--- a/src/HOL/Code_Setup.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/Code_Setup.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -198,6 +198,10 @@
 
 subsection {* Evaluation and normalization by evaluation *}
 
+setup {*
+  Value.add_evaluator ("SML", Codegen.eval_term o ProofContext.theory_of)
+*}
+
 ML {*
 structure Eval_Method =
 struct
@@ -240,6 +244,10 @@
 
 subsection {* Quickcheck *}
 
+setup {*
+  Quickcheck.add_generator ("SML", Codegen.test_term)
+*}
+
 quickcheck_params [size = 5, iterations = 50]
 
 end
--- a/src/HOL/Complex/Fundamental_Theorem_Algebra.thy	Tue Dec 30 08:18:54 2008 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1329 +0,0 @@
-(*  Title:       Fundamental_Theorem_Algebra.thy
-    Author:      Amine Chaieb
-*)
-
-header{*Fundamental Theorem of Algebra*}
-
-theory Fundamental_Theorem_Algebra
-imports "~~/src/HOL/Univ_Poly" "~~/src/HOL/Library/Dense_Linear_Order" "~~/src/HOL/Complex"
-begin
-
-subsection {* Square root of complex numbers *}
-definition csqrt :: "complex \<Rightarrow> complex" where
-"csqrt z = (if Im z = 0 then
-            if 0 \<le> Re z then Complex (sqrt(Re z)) 0
-            else Complex 0 (sqrt(- Re z))
-           else Complex (sqrt((cmod z + Re z) /2))
-                        ((Im z / abs(Im z)) * sqrt((cmod z - Re z) /2)))"
-
-lemma csqrt[algebra]: "csqrt z ^ 2 = z"
-proof-
-  obtain x y where xy: "z = Complex x y" by (cases z, simp_all)
-  {assume y0: "y = 0"
-    {assume x0: "x \<ge> 0" 
-      then have ?thesis using y0 xy real_sqrt_pow2[OF x0]
-	by (simp add: csqrt_def power2_eq_square)}
-    moreover
-    {assume "\<not> x \<ge> 0" hence x0: "- x \<ge> 0" by arith
-      then have ?thesis using y0 xy real_sqrt_pow2[OF x0] 
-	by (simp add: csqrt_def power2_eq_square) }
-    ultimately have ?thesis by blast}
-  moreover
-  {assume y0: "y\<noteq>0"
-    {fix x y
-      let ?z = "Complex x y"
-      from abs_Re_le_cmod[of ?z] have tha: "abs x \<le> cmod ?z" by auto
-      hence "cmod ?z - x \<ge> 0" "cmod ?z + x \<ge> 0" by arith+ 
-      hence "(sqrt (x * x + y * y) + x) / 2 \<ge> 0" "(sqrt (x * x + y * y) - x) / 2 \<ge> 0" by (simp_all add: power2_eq_square) }
-    note th = this
-    have sq4: "\<And>x::real. x^2 / 4 = (x / 2) ^ 2" 
-      by (simp add: power2_eq_square) 
-    from th[of x y]
-    have sq4': "sqrt (((sqrt (x * x + y * y) + x)^2 / 4)) = (sqrt (x * x + y * y) + x) / 2" "sqrt (((sqrt (x * x + y * y) - x)^2 / 4)) = (sqrt (x * x + y * y) - x) / 2" unfolding sq4 by simp_all
-    then have th1: "sqrt ((sqrt (x * x + y * y) + x) * (sqrt (x * x + y * y) + x) / 4) - sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) - x) / 4) = x"
-      unfolding power2_eq_square by simp 
-    have "sqrt 4 = sqrt (2^2)" by simp 
-    hence sqrt4: "sqrt 4 = 2" by (simp only: real_sqrt_abs)
-    have th2: "2 *(y * sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) + x) / 4)) / \<bar>y\<bar> = y"
-      using iffD2[OF real_sqrt_pow2_iff sum_power2_ge_zero[of x y]] y0
-      unfolding power2_eq_square 
-      by (simp add: ring_simps real_sqrt_divide sqrt4)
-     from y0 xy have ?thesis  apply (simp add: csqrt_def power2_eq_square)
-       apply (simp add: real_sqrt_sum_squares_mult_ge_zero[of x y] real_sqrt_pow2[OF th(1)[of x y], unfolded power2_eq_square] real_sqrt_pow2[OF th(2)[of x y], unfolded power2_eq_square] real_sqrt_mult[symmetric])
-      using th1 th2  ..}
-  ultimately show ?thesis by blast
-qed
-
-
-subsection{* More lemmas about module of complex numbers *}
-
-lemma complex_of_real_power: "complex_of_real x ^ n = complex_of_real (x^n)"
-  by (rule of_real_power [symmetric])
-
-lemma real_down2: "(0::real) < d1 \<Longrightarrow> 0 < d2 ==> EX e. 0 < e & e < d1 & e < d2"
-  apply ferrack apply arith done
-
-text{* The triangle inequality for cmod *}
-lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
-  using complex_mod_triangle_ineq2[of "w + z" "-z"] by auto
-
-subsection{* Basic lemmas about complex polynomials *}
-
-lemma poly_bound_exists:
-  shows "\<exists>m. m > 0 \<and> (\<forall>z. cmod z <= r \<longrightarrow> cmod (poly p z) \<le> m)"
-proof(induct p)
-  case Nil thus ?case by (rule exI[where x=1], simp) 
-next
-  case (Cons c cs)
-  from Cons.hyps obtain m where m: "\<forall>z. cmod z \<le> r \<longrightarrow> cmod (poly cs z) \<le> m"
-    by blast
-  let ?k = " 1 + cmod c + \<bar>r * m\<bar>"
-  have kp: "?k > 0" using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
-  {fix z
-    assume H: "cmod z \<le> r"
-    from m H have th: "cmod (poly cs z) \<le> m" by blast
-    from H have rp: "r \<ge> 0" using norm_ge_zero[of z] by arith
-    have "cmod (poly (c # cs) z) \<le> cmod c + cmod (z* poly cs z)"
-      using norm_triangle_ineq[of c "z* poly cs z"] by simp
-    also have "\<dots> \<le> cmod c + r*m" using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]] by (simp add: norm_mult)
-    also have "\<dots> \<le> ?k" by simp
-    finally have "cmod (poly (c # cs) z) \<le> ?k" .}
-  with kp show ?case by blast
-qed
-
-
-text{* Offsetting the variable in a polynomial gives another of same degree *}
-  (* FIXME : Lemma holds also in locale --- fix it later *)
-lemma  poly_offset_lemma:
-  shows "\<exists>b q. (length q = length p) \<and> (\<forall>x. poly (b#q) (x::complex) = (a + x) * poly p x)"
-proof(induct p)
-  case Nil thus ?case by simp
-next
-  case (Cons c cs)
-  from Cons.hyps obtain b q where 
-    bq: "length q = length cs" "\<forall>x. poly (b # q) x = (a + x) * poly cs x"
-    by blast
-  let ?b = "a*c"
-  let ?q = "(b+c)#q"
-  have lg: "length ?q = length (c#cs)" using bq(1) by simp
-  {fix x
-    from bq(2)[rule_format, of x]
-    have "x*poly (b # q) x = x*((a + x) * poly cs x)" by simp
-    hence "poly (?b# ?q) x = (a + x) * poly (c # cs) x"
-      by (simp add: ring_simps)}
-  with lg  show ?case by blast 
-qed
-
-    (* FIXME : This one too*)
-lemma poly_offset: "\<exists> q. length q = length p \<and> (\<forall>x. poly q (x::complex) = poly p (a + x))"
-proof (induct p)
-  case Nil thus ?case by simp
-next
-  case (Cons c cs)
-  from Cons.hyps obtain q where q: "length q = length cs" "\<forall>x. poly q x = poly cs (a + x)" by blast
-  from poly_offset_lemma[of q a] obtain b p where 
-    bp: "length p = length q" "\<forall>x. poly (b # p) x = (a + x) * poly q x"
-    by blast
-  thus ?case using q bp by - (rule exI[where x="(c + b)#p"], simp)
-qed
-
-text{* An alternative useful formulation of completeness of the reals *}
-lemma real_sup_exists: assumes ex: "\<exists>x. P x" and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
-  shows "\<exists>(s::real). \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
-proof-
-  from ex bz obtain x Y where x: "P x" and Y: "\<And>x. P x \<Longrightarrow> x < Y"  by blast
-  from ex have thx:"\<exists>x. x \<in> Collect P" by blast
-  from bz have thY: "\<exists>Y. isUb UNIV (Collect P) Y" 
-    by(auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def order_le_less)
-  from reals_complete[OF thx thY] obtain L where L: "isLub UNIV (Collect P) L"
-    by blast
-  from Y[OF x] have xY: "x < Y" .
-  from L have L': "\<forall>x. P x \<longrightarrow> x \<le> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)  
-  from Y have Y': "\<forall>x. P x \<longrightarrow> x \<le> Y" 
-    apply (clarsimp, atomize (full)) by auto 
-  from L Y' have "L \<le> Y" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)
-  {fix y
-    {fix z assume z: "P z" "y < z"
-      from L' z have "y < L" by auto }
-    moreover
-    {assume yL: "y < L" "\<forall>z. P z \<longrightarrow> \<not> y < z"
-      hence nox: "\<forall>z. P z \<longrightarrow> y \<ge> z" by auto
-      from nox L have "y \<ge> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def) 
-      with yL(1) have False  by arith}
-    ultimately have "(\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < L" by blast}
-  thus ?thesis by blast
-qed
-
-
-subsection{* Some theorems about Sequences*}
-text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
-
-lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
-  unfolding Ex1_def
-  apply (rule_tac x="nat_rec e f" in exI)
-  apply (rule conjI)+
-apply (rule def_nat_rec_0, simp)
-apply (rule allI, rule def_nat_rec_Suc, simp)
-apply (rule allI, rule impI, rule ext)
-apply (erule conjE)
-apply (induct_tac x)
-apply (simp add: nat_rec_0)
-apply (erule_tac x="n" in allE)
-apply (simp)
-done
-
- text{* An equivalent formulation of monotony -- Not used here, but might be useful *}
-lemma mono_Suc: "mono f = (\<forall>n. (f n :: 'a :: order) \<le> f (Suc n))"
-unfolding mono_def
-proof auto
-  fix A B :: nat
-  assume H: "\<forall>n. f n \<le> f (Suc n)" "A \<le> B"
-  hence "\<exists>k. B = A + k" apply -  apply (thin_tac "\<forall>n. f n \<le> f (Suc n)") 
-    by presburger
-  then obtain k where k: "B = A + k" by blast
-  {fix a k
-    have "f a \<le> f (a + k)"
-    proof (induct k)
-      case 0 thus ?case by simp
-    next
-      case (Suc k)
-      from Suc.hyps H(1)[rule_format, of "a + k"] show ?case by simp
-    qed}
-  with k show "f A \<le> f B" by blast
-qed
-
-text{* for any sequence, there is a mootonic subsequence *}
-lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
-proof-
-  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
-    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
-    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
-    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
-    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
-      using H apply - 
-      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
-      unfolding order_le_less by blast 
-    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
-    {fix n
-      have "?P (f (Suc n)) (f n)" 
-	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
-	using H apply - 
-      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
-      unfolding order_le_less by blast 
-    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
-  note fSuc = this
-    {fix p q assume pq: "p \<ge> f q"
-      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
-	by (cases q, simp_all) }
-    note pqth = this
-    {fix q
-      have "f (Suc q) > f q" apply (induct q) 
-	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
-    note fss = this
-    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
-    {fix a b 
-      have "f a \<le> f (a + b)"
-      proof(induct b)
-	case 0 thus ?case by simp
-      next
-	case (Suc b)
-	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
-      qed}
-    note fmon0 = this
-    have "monoseq (\<lambda>n. s (f n))" 
-    proof-
-      {fix n
-	have "s (f n) \<ge> s (f (Suc n))" 
-	proof(cases n)
-	  case 0
-	  assume n0: "n = 0"
-	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
-	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
-	next
-	  case (Suc m)
-	  assume m: "n = Suc m"
-	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
-	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
-	qed}
-      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
-    qed
-    with th1 have ?thesis by blast}
-  moreover
-  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
-    {fix p assume p: "p \<ge> Suc N" 
-      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
-      have "m \<noteq> p" using m(2) by auto 
-      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
-    note th0 = this
-    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
-    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
-    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
-      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
-    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
-      using N apply - 
-      apply (erule allE[where x="Suc N"], clarsimp)
-      apply (rule_tac x="m" in exI)
-      apply auto
-      apply (subgoal_tac "Suc N \<noteq> m")
-      apply simp
-      apply (rule ccontr, simp)
-      done
-    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
-    {fix n
-      have "f n > N \<and> ?P (f (Suc n)) (f n)"
-	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
-      proof (induct n)
-	case 0 thus ?case
-	  using f0 N apply auto 
-	  apply (erule allE[where x="f 0"], clarsimp) 
-	  apply (rule_tac x="m" in exI, simp)
-	  by (subgoal_tac "f 0 \<noteq> m", auto)
-      next
-	case (Suc n)
-	from Suc.hyps have Nfn: "N < f n" by blast
-	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
-	with Nfn have mN: "m > N" by arith
-	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
-	
-	from key have th0: "f (Suc n) > N" by simp
-	from N[rule_format, OF th0]
-	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
-	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
-	hence "m' > f (Suc n)" using m'(1) by simp
-	with key m'(2) show ?case by auto
-      qed}
-    note fSuc = this
-    {fix n
-      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
-      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
-    note thf = this
-    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
-    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
-      apply -
-      apply (rule disjI1)
-      apply auto
-      apply (rule order_less_imp_le)
-      apply blast
-      done
-    then have ?thesis  using sqf by blast}
-  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
-qed
-
-lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
-proof(induct n)
-  case 0 thus ?case by simp
-next
-  case (Suc n)
-  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
-  have "n < f (Suc n)" by arith 
-  thus ?case by arith
-qed
-
-subsection {* Fundamental theorem of algebra *}
-lemma  unimodular_reduce_norm:
-  assumes md: "cmod z = 1"
-  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + ii) < 1 \<or> cmod (z - ii) < 1"
-proof-
-  obtain x y where z: "z = Complex x y " by (cases z, auto)
-  from md z have xy: "x^2 + y^2 = 1" by (simp add: cmod_def)
-  {assume C: "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + ii) \<ge> 1" "cmod (z - ii) \<ge> 1"
-    from C z xy have "2*x \<le> 1" "2*x \<ge> -1" "2*y \<le> 1" "2*y \<ge> -1"
-      by (simp_all add: cmod_def power2_eq_square ring_simps)
-    hence "abs (2*x) \<le> 1" "abs (2*y) \<le> 1" by simp_all
-    hence "(abs (2 * x))^2 <= 1^2" "(abs (2 * y)) ^2 <= 1^2"
-      by - (rule power_mono, simp, simp)+
-    hence th0: "4*x^2 \<le> 1" "4*y^2 \<le> 1" 
-      by (simp_all  add: power2_abs power_mult_distrib)
-    from add_mono[OF th0] xy have False by simp }
-  thus ?thesis unfolding linorder_not_le[symmetric] by blast
-qed
-
-text{* Hence we can always reduce modulus of @{text "1 + b z^n"} if nonzero *}
-lemma reduce_poly_simple:
- assumes b: "b \<noteq> 0" and n: "n\<noteq>0"
-  shows "\<exists>z. cmod (1 + b * z^n) < 1"
-using n
-proof(induct n rule: nat_less_induct)
-  fix n
-  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)" and n: "n \<noteq> 0"
-  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
-  {assume e: "even n"
-    hence "\<exists>m. n = 2*m" by presburger
-    then obtain m where m: "n = 2*m" by blast
-    from n m have "m\<noteq>0" "m < n" by presburger+
-    with IH[rule_format, of m] obtain z where z: "?P z m" by blast
-    from z have "?P (csqrt z) n" by (simp add: m power_mult csqrt)
-    hence "\<exists>z. ?P z n" ..}
-  moreover
-  {assume o: "odd n"
-    from b have b': "b^2 \<noteq> 0" unfolding power2_eq_square by simp
-    have "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
-    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) = 
-    ((Re (inverse b))^2 + (Im (inverse b))^2) * \<bar>Im b * Im b + Re b * Re b\<bar>" by algebra
-    also have "\<dots> = cmod (inverse b) ^2 * cmod b ^ 2" 
-      apply (simp add: cmod_def) using realpow_two_le_add_order[of "Re b" "Im b"]
-      by (simp add: power2_eq_square)
-    finally 
-    have th0: "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
-    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) =
-    1" 
-      apply (simp add: power2_eq_square norm_mult[symmetric] norm_inverse[symmetric])
-      using right_inverse[OF b']
-      by (simp add: power2_eq_square[symmetric] power_inverse[symmetric] ring_simps)
-    have th0: "cmod (complex_of_real (cmod b) / b) = 1"
-      apply (simp add: complex_Re_mult cmod_def power2_eq_square Re_complex_of_real Im_complex_of_real divide_inverse ring_simps )
-      by (simp add: real_sqrt_mult[symmetric] th0)        
-    from o have "\<exists>m. n = Suc (2*m)" by presburger+
-    then obtain m where m: "n = Suc (2*m)" by blast
-    from unimodular_reduce_norm[OF th0] o
-    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
-      apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
-      apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp add: diff_def)
-      apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
-      apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
-      apply (rule_tac x="- ii" in exI, simp add: m power_mult)
-      apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult diff_def)
-      apply (rule_tac x="ii" in exI, simp add: m power_mult diff_def)
-      done
-    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
-    let ?w = "v / complex_of_real (root n (cmod b))"
-    from odd_real_root_pow[OF o, of "cmod b"]
-    have th1: "?w ^ n = v^n / complex_of_real (cmod b)" 
-      by (simp add: power_divide complex_of_real_power)
-    have th2:"cmod (complex_of_real (cmod b) / b) = 1" using b by (simp add: norm_divide)
-    hence th3: "cmod (complex_of_real (cmod b) / b) \<ge> 0" by simp
-    have th4: "cmod (complex_of_real (cmod b) / b) *
-   cmod (1 + b * (v ^ n / complex_of_real (cmod b)))
-   < cmod (complex_of_real (cmod b) / b) * 1"
-      apply (simp only: norm_mult[symmetric] right_distrib)
-      using b v by (simp add: th2)
-
-    from mult_less_imp_less_left[OF th4 th3]
-    have "?P ?w n" unfolding th1 . 
-    hence "\<exists>z. ?P z n" .. }
-  ultimately show "\<exists>z. ?P z n" by blast
-qed
-
-
-text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
-
-lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
-  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y" ]
-  unfolding cmod_def by simp
-
-lemma bolzano_weierstrass_complex_disc:
-  assumes r: "\<forall>n. cmod (s n) \<le> r"
-  shows "\<exists>f z. subseq f \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
-proof-
-  from seq_monosub[of "Re o s"] 
-  obtain f g where f: "subseq f" "monoseq (\<lambda>n. Re (s (f n)))" 
-    unfolding o_def by blast
-  from seq_monosub[of "Im o s o f"] 
-  obtain g where g: "subseq g" "monoseq (\<lambda>n. Im (s(f(g n))))" unfolding o_def by blast  
-  let ?h = "f o g"
-  from r[rule_format, of 0] have rp: "r \<ge> 0" using norm_ge_zero[of "s 0"] by arith 
-  have th:"\<forall>n. r + 1 \<ge> \<bar> Re (s n)\<bar>" 
-  proof
-    fix n
-    from abs_Re_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Re (s n)\<bar> \<le> r + 1" by arith
-  qed
-  have conv1: "convergent (\<lambda>n. Re (s ( f n)))"
-    apply (rule Bseq_monoseq_convergent)
-    apply (simp add: Bseq_def)
-    apply (rule exI[where x= "r + 1"])
-    using th rp apply simp
-    using f(2) .
-  have th:"\<forall>n. r + 1 \<ge> \<bar> Im (s n)\<bar>" 
-  proof
-    fix n
-    from abs_Im_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Im (s n)\<bar> \<le> r + 1" by arith
-  qed
-
-  have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
-    apply (rule Bseq_monoseq_convergent)
-    apply (simp add: Bseq_def)
-    apply (rule exI[where x= "r + 1"])
-    using th rp apply simp
-    using g(2) .
-
-  from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\<lambda>n. Re (s (f n))) x" 
-    by blast 
-  hence  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Re (s (f n)) - x \<bar> < r" 
-    unfolding LIMSEQ_def real_norm_def .
-
-  from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\<lambda>n. Im (s (f (g n)))) y" 
-    by blast 
-  hence  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Im (s (f (g n))) - y \<bar> < r" 
-    unfolding LIMSEQ_def real_norm_def .
-  let ?w = "Complex x y"
-  from f(1) g(1) have hs: "subseq ?h" unfolding subseq_def by auto 
-  {fix e assume ep: "e > (0::real)"
-    hence e2: "e/2 > 0" by simp
-    from x[rule_format, OF e2] y[rule_format, OF e2]
-    obtain N1 N2 where N1: "\<forall>n\<ge>N1. \<bar>Re (s (f n)) - x\<bar> < e / 2" and N2: "\<forall>n\<ge>N2. \<bar>Im (s (f (g n))) - y\<bar> < e / 2" by blast
-    {fix n assume nN12: "n \<ge> N1 + N2"
-      hence nN1: "g n \<ge> N1" and nN2: "n \<ge> N2" using seq_suble[OF g(1), of n] by arith+
-      from add_strict_mono[OF N1[rule_format, OF nN1] N2[rule_format, OF nN2]]
-      have "cmod (s (?h n) - ?w) < e" 
-	using metric_bound_lemma[of "s (f (g n))" ?w] by simp }
-    hence "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" by blast }
-  with hs show ?thesis  by blast  
-qed
-
-text{* Polynomial is continuous. *}
-
-lemma poly_cont:
-  assumes ep: "e > 0" 
-  shows "\<exists>d >0. \<forall>w. 0 < cmod (w - z) \<and> cmod (w - z) < d \<longrightarrow> cmod (poly p w - poly p z) < e"
-proof-
-  from poly_offset[of p z] obtain q where q: "length q = length p" "\<And>x. poly q x = poly p (z + x)" by blast
-  {fix w
-    note q(2)[of "w - z", simplified]}
-  note th = this
-  show ?thesis unfolding th[symmetric]
-  proof(induct q)
-    case Nil thus ?case  using ep by auto
-  next
-    case (Cons c cs)
-    from poly_bound_exists[of 1 "cs"] 
-    obtain m where m: "m > 0" "\<And>z. cmod z \<le> 1 \<Longrightarrow> cmod (poly cs z) \<le> m" by blast
-    from ep m(1) have em0: "e/m > 0" by (simp add: field_simps)
-    have one0: "1 > (0::real)"  by arith
-    from real_lbound_gt_zero[OF one0 em0] 
-    obtain d where d: "d >0" "d < 1" "d < e / m" by blast
-    from d(1,3) m(1) have dm: "d*m > 0" "d*m < e" 
-      by (simp_all add: field_simps real_mult_order)
-    show ?case 
-      proof(rule ex_forward[OF real_lbound_gt_zero[OF one0 em0]], clarsimp simp add: norm_mult)
-	fix d w
-	assume H: "d > 0" "d < 1" "d < e/m" "w\<noteq>z" "cmod (w-z) < d"
-	hence d1: "cmod (w-z) \<le> 1" "d \<ge> 0" by simp_all
-	from H(3) m(1) have dme: "d*m < e" by (simp add: field_simps)
-	from H have th: "cmod (w-z) \<le> d" by simp 
-	from mult_mono[OF th m(2)[OF d1(1)] d1(2) norm_ge_zero] dme
-	show "cmod (w - z) * cmod (poly cs (w - z)) < e" by simp
-      qed  
-    qed
-qed
-
-text{* Hence a polynomial attains minimum on a closed disc 
-  in the complex plane. *}
-lemma  poly_minimum_modulus_disc:
-  "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
-proof-
-  {assume "\<not> r \<ge> 0" hence ?thesis unfolding linorder_not_le
-      apply -
-      apply (rule exI[where x=0]) 
-      apply auto
-      apply (subgoal_tac "cmod w < 0")
-      apply simp
-      apply arith
-      done }
-  moreover
-  {assume rp: "r \<ge> 0"
-    from rp have "cmod 0 \<le> r \<and> cmod (poly p 0) = - (- cmod (poly p 0))" by simp 
-    hence mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"  by blast
-    {fix x z
-      assume H: "cmod z \<le> r" "cmod (poly p z) = - x" "\<not>x < 1"
-      hence "- x < 0 " by arith
-      with H(2) norm_ge_zero[of "poly p z"]  have False by simp }
-    then have mth2: "\<exists>z. \<forall>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<longrightarrow> x < z" by blast
-    from real_sup_exists[OF mth1 mth2] obtain s where 
-      s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow>(y < s)" by blast
-    let ?m = "-s"
-    {fix y
-      from s[rule_format, of "-y"] have 
-    "(\<exists>z x. cmod z \<le> r \<and> -(- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" 
-	unfolding minus_less_iff[of y ] equation_minus_iff by blast }
-    note s1 = this[unfolded minus_minus]
-    from s1[of ?m] have s1m: "\<And>z x. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m" 
-      by auto
-    {fix n::nat
-      from s1[rule_format, of "?m + 1/real (Suc n)"] 
-      have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)"
-	by simp}
-    hence th: "\<forall>n. \<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" ..
-    from choice[OF th] obtain g where 
-      g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m+1 /real(Suc n)" 
-      by blast
-    from bolzano_weierstrass_complex_disc[OF g(1)] 
-    obtain f z where fz: "subseq f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
-      by blast    
-    {fix w 
-      assume wr: "cmod w \<le> r"
-      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
-      {assume e: "?e > 0"
-	hence e2: "?e/2 > 0" by simp
-	from poly_cont[OF e2, of z p] obtain d where
-	  d: "d>0" "\<forall>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2" by blast
-	{fix w assume w: "cmod (w - z) < d"
-	  have "cmod(poly p w - poly p z) < ?e / 2"
-	    using d(2)[rule_format, of w] w e by (cases "w=z", simp_all)}
-	note th1 = this
-	
-	from fz(2)[rule_format, OF d(1)] obtain N1 where 
-	  N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d" by blast
-	from reals_Archimedean2[of "2/?e"] obtain N2::nat where
-	  N2: "2/?e < real N2" by blast
-	have th2: "cmod(poly p (g(f(N1 + N2))) - poly p z) < ?e/2"
-	  using N1[rule_format, of "N1 + N2"] th1 by simp
-	{fix a b e2 m :: real
-	have "a < e2 \<Longrightarrow> abs(b - m) < e2 \<Longrightarrow> 2 * e2 <= abs(b - m) + a
-          ==> False" by arith}
-      note th0 = this
-      have ath: 
-	"\<And>m x e. m <= x \<Longrightarrow>  x < m + e ==> abs(x - m::real) < e" by arith
-      from s1m[OF g(1)[rule_format]]
-      have th31: "?m \<le> cmod(poly p (g (f (N1 + N2))))" .
-      from seq_suble[OF fz(1), of "N1+N2"]
-      have th00: "real (Suc (N1+N2)) \<le> real (Suc (f (N1+N2)))" by simp
-      have th000: "0 \<le> (1::real)" "(1::real) \<le> 1" "real (Suc (N1+N2)) > 0"  
-	using N2 by auto
-      from frac_le[OF th000 th00] have th00: "?m +1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))" by simp
-      from g(2)[rule_format, of "f (N1 + N2)"]
-      have th01:"cmod (poly p (g (f (N1 + N2)))) < - s + 1 / real (Suc (f (N1 + N2)))" .
-      from order_less_le_trans[OF th01 th00]
-      have th32: "cmod(poly p (g (f (N1 + N2)))) < ?m + (1/ real(Suc (N1 + N2)))" .
-      from N2 have "2/?e < real (Suc (N1 + N2))" by arith
-      with e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
-      have "?e/2 > 1/ real (Suc (N1 + N2))" by (simp add: inverse_eq_divide)
-      with ath[OF th31 th32]
-      have thc1:"\<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar>< ?e/2" by arith  
-      have ath2: "\<And>(a::real) b c m. \<bar>a - b\<bar> <= c ==> \<bar>b - m\<bar> <= \<bar>a - m\<bar> + c" 
-	by arith
-      have th22: "\<bar>cmod (poly p (g (f (N1 + N2)))) - cmod (poly p z)\<bar>
-\<le> cmod (poly p (g (f (N1 + N2))) - poly p z)" 
-	by (simp add: norm_triangle_ineq3)
-      from ath2[OF th22, of ?m]
-      have thc2: "2*(?e/2) \<le> \<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar> + cmod (poly p (g (f (N1 + N2))) - poly p z)" by simp
-      from th0[OF th2 thc1 thc2] have False .}
-      hence "?e = 0" by auto
-      then have "cmod (poly p z) = ?m" by simp  
-      with s1m[OF wr]
-      have "cmod (poly p z) \<le> cmod (poly p w)" by simp }
-    hence ?thesis by blast}
-  ultimately show ?thesis by blast
-qed
-
-lemma "(rcis (sqrt (abs r)) (a/2)) ^ 2 = rcis (abs r) a"
-  unfolding power2_eq_square
-  apply (simp add: rcis_mult)
-  apply (simp add: power2_eq_square[symmetric])
-  done
-
-lemma cispi: "cis pi = -1" 
-  unfolding cis_def
-  by simp
-
-lemma "(rcis (sqrt (abs r)) ((pi + a)/2)) ^ 2 = rcis (- abs r) a"
-  unfolding power2_eq_square
-  apply (simp add: rcis_mult add_divide_distrib)
-  apply (simp add: power2_eq_square[symmetric] rcis_def cispi cis_mult[symmetric])
-  done
-
-text {* Nonzero polynomial in z goes to infinity as z does. *}
-
-instance complex::idom_char_0 by (intro_classes)
-instance complex :: recpower_idom_char_0 by intro_classes
-
-lemma poly_infinity:
-  assumes ex: "list_ex (\<lambda>c. c \<noteq> 0) p"
-  shows "\<exists>r. \<forall>z. r \<le> cmod z \<longrightarrow> d \<le> cmod (poly (a#p) z)"
-using ex
-proof(induct p arbitrary: a d)
-  case (Cons c cs a d) 
-  {assume H: "list_ex (\<lambda>c. c\<noteq>0) cs"
-    with Cons.hyps obtain r where r: "\<forall>z. r \<le> cmod z \<longrightarrow> d + cmod a \<le> cmod (poly (c # cs) z)" by blast
-    let ?r = "1 + \<bar>r\<bar>"
-    {fix z assume h: "1 + \<bar>r\<bar> \<le> cmod z"
-      have r0: "r \<le> cmod z" using h by arith
-      from r[rule_format, OF r0]
-      have th0: "d + cmod a \<le> 1 * cmod(poly (c#cs) z)" by arith
-      from h have z1: "cmod z \<ge> 1" by arith
-      from order_trans[OF th0 mult_right_mono[OF z1 norm_ge_zero[of "poly (c#cs) z"]]]
-      have th1: "d \<le> cmod(z * poly (c#cs) z) - cmod a"
-	unfolding norm_mult by (simp add: ring_simps)
-      from complex_mod_triangle_sub[of "z * poly (c#cs) z" a]
-      have th2: "cmod(z * poly (c#cs) z) - cmod a \<le> cmod (poly (a#c#cs) z)" 
-	by (simp add: diff_le_eq ring_simps) 
-      from th1 th2 have "d \<le> cmod (poly (a#c#cs) z)"  by arith}
-    hence ?case by blast}
-  moreover
-  {assume cs0: "\<not> (list_ex (\<lambda>c. c \<noteq> 0) cs)"
-    with Cons.prems have c0: "c \<noteq> 0" by simp
-    from cs0 have cs0': "list_all (\<lambda>c. c = 0) cs" 
-      by (auto simp add: list_all_iff list_ex_iff)
-    {fix z
-      assume h: "(\<bar>d\<bar> + cmod a) / cmod c \<le> cmod z"
-      from c0 have "cmod c > 0" by simp
-      from h c0 have th0: "\<bar>d\<bar> + cmod a \<le> cmod (z*c)" 
-	by (simp add: field_simps norm_mult)
-      have ath: "\<And>mzh mazh ma. mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh" by arith
-      from complex_mod_triangle_sub[of "z*c" a ]
-      have th1: "cmod (z * c) \<le> cmod (a + z * c) + cmod a"
-	by (simp add: ring_simps)
-      from ath[OF th1 th0] have "d \<le> cmod (poly (a # c # cs) z)" 
-	using poly_0[OF cs0'] by simp}
-    then have ?case  by blast}
-  ultimately show ?case by blast
-qed simp
-
-text {* Hence polynomial's modulus attains its minimum somewhere. *}
-lemma poly_minimum_modulus:
-  "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
-proof(induct p)
-  case (Cons c cs) 
-  {assume cs0: "list_ex (\<lambda>c. c \<noteq> 0) cs"
-    from poly_infinity[OF cs0, of "cmod (poly (c#cs) 0)" c]
-    obtain r where r: "\<And>z. r \<le> cmod z \<Longrightarrow> cmod (poly (c # cs) 0) \<le> cmod (poly (c # cs) z)" by blast
-    have ath: "\<And>z r. r \<le> cmod z \<or> cmod z \<le> \<bar>r\<bar>" by arith
-    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "c#cs"] 
-    obtain v where v: "\<And>w. cmod w \<le> \<bar>r\<bar> \<Longrightarrow> cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) w)" by blast
-    {fix z assume z: "r \<le> cmod z"
-      from v[of 0] r[OF z] 
-      have "cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) z)"
-	by simp }
-    note v0 = this
-    from v0 v ath[of r] have ?case by blast}
-  moreover
-  {assume cs0: "\<not> (list_ex (\<lambda>c. c\<noteq>0) cs)"
-    hence th:"list_all (\<lambda>c. c = 0) cs" by (simp add: list_all_iff list_ex_iff)
-    from poly_0[OF th] Cons.hyps have ?case by simp}
-  ultimately show ?case by blast
-qed simp
-
-text{* Constant function (non-syntactic characterization). *}
-definition "constant f = (\<forall>x y. f x = f y)"
-
-lemma nonconstant_length: "\<not> (constant (poly p)) \<Longrightarrow> length p \<ge> 2"
-  unfolding constant_def
-  apply (induct p, auto)
-  apply (unfold not_less[symmetric])
-  apply simp
-  apply (rule ccontr)
-  apply auto
-  done
- 
-lemma poly_replicate_append:
-  "poly ((replicate n 0)@p) (x::'a::{recpower, comm_ring}) = x^n * poly p x"
-  by(induct n, auto simp add: power_Suc ring_simps)
-
-text {* Decomposition of polynomial, skipping zero coefficients 
-  after the first.  *}
-
-lemma poly_decompose_lemma:
- assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
-  shows "\<exists>k a q. a\<noteq>0 \<and> Suc (length q + k) = length p \<and> 
-                 (\<forall>z. poly p z = z^k * poly (a#q) z)"
-using nz
-proof(induct p)
-  case Nil thus ?case by simp
-next
-  case (Cons c cs)
-  {assume c0: "c = 0"
-    
-    from Cons.hyps Cons.prems c0 have ?case apply auto
-      apply (rule_tac x="k+1" in exI)
-      apply (rule_tac x="a" in exI, clarsimp)
-      apply (rule_tac x="q" in exI)
-      by (auto simp add: power_Suc)}
-  moreover
-  {assume c0: "c\<noteq>0"
-    hence ?case apply-
-      apply (rule exI[where x=0])
-      apply (rule exI[where x=c], clarsimp)
-      apply (rule exI[where x=cs])
-      apply auto
-      done}
-  ultimately show ?case by blast
-qed
-
-lemma poly_decompose:
-  assumes nc: "~constant(poly p)"
-  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
-               length q + k + 1 = length p \<and> 
-              (\<forall>z. poly p z = poly p 0 + z^k * poly (a#q) z)"
-using nc 
-proof(induct p)
-  case Nil thus ?case by (simp add: constant_def)
-next
-  case (Cons c cs)
-  {assume C:"\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0"
-    {fix x y
-      from C have "poly (c#cs) x = poly (c#cs) y" by (cases "x=0", auto)}
-    with Cons.prems have False by (auto simp add: constant_def)}
-  hence th: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)" ..
-  from poly_decompose_lemma[OF th] 
-  show ?case 
-    apply clarsimp    
-    apply (rule_tac x="k+1" in exI)
-    apply (rule_tac x="a" in exI)
-    apply simp
-    apply (rule_tac x="q" in exI)
-    apply (auto simp add: power_Suc)
-    done
-qed
-
-text{* Fundamental theorem of algebral *}
-
-lemma fundamental_theorem_of_algebra:
-  assumes nc: "~constant(poly p)"
-  shows "\<exists>z::complex. poly p z = 0"
-using nc
-proof(induct n\<equiv> "length p" arbitrary: p rule: nat_less_induct)
-  fix n fix p :: "complex list"
-  let ?p = "poly p"
-  assume H: "\<forall>m<n. \<forall>p. \<not> constant (poly p) \<longrightarrow> m = length p \<longrightarrow> (\<exists>(z::complex). poly p z = 0)" and nc: "\<not> constant ?p" and n: "n = length p"
-  let ?ths = "\<exists>z. ?p z = 0"
-
-  from nonconstant_length[OF nc] have n2: "n\<ge> 2" by (simp add: n)
-  from poly_minimum_modulus obtain c where 
-    c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)" by blast
-  {assume pc: "?p c = 0" hence ?ths by blast}
-  moreover
-  {assume pc0: "?p c \<noteq> 0"
-    from poly_offset[of p c] obtain q where
-      q: "length q = length p" "\<forall>x. poly q x = ?p (c+x)" by blast
-    {assume h: "constant (poly q)"
-      from q(2) have th: "\<forall>x. poly q (x - c) = ?p x" by auto
-      {fix x y
-	from th have "?p x = poly q (x - c)" by auto 
-	also have "\<dots> = poly q (y - c)" 
-	  using h unfolding constant_def by blast
-	also have "\<dots> = ?p y" using th by auto
-	finally have "?p x = ?p y" .}
-      with nc have False unfolding constant_def by blast }
-    hence qnc: "\<not> constant (poly q)" by blast
-    from q(2) have pqc0: "?p c = poly q 0" by simp
-    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)" by simp 
-    let ?a0 = "poly q 0"
-    from pc0 pqc0 have a00: "?a0 \<noteq> 0" by simp 
-    from a00 
-    have qr: "\<forall>z. poly q z = poly (map (op * (inverse ?a0)) q) z * ?a0"
-      by (simp add: poly_cmult_map)
-    let ?r = "map (op * (inverse ?a0)) q"
-    have lgqr: "length q = length ?r" by simp 
-    {assume h: "\<And>x y. poly ?r x = poly ?r y"
-      {fix x y
-	from qr[rule_format, of x] 
-	have "poly q x = poly ?r x * ?a0" by auto
-	also have "\<dots> = poly ?r y * ?a0" using h by simp
-	also have "\<dots> = poly q y" using qr[rule_format, of y] by simp
-	finally have "poly q x = poly q y" .} 
-      with qnc have False unfolding constant_def by blast}
-    hence rnc: "\<not> constant (poly ?r)" unfolding constant_def by blast
-    from qr[rule_format, of 0] a00  have r01: "poly ?r 0 = 1" by auto
-    {fix w 
-      have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w / ?a0) < 1"
-	using qr[rule_format, of w] a00 by simp
-      also have "\<dots> \<longleftrightarrow> cmod (poly q w) < cmod ?a0"
-	using a00 unfolding norm_divide by (simp add: field_simps)
-      finally have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" .}
-    note mrmq_eq = this
-    from poly_decompose[OF rnc] obtain k a s where 
-      kas: "a\<noteq>0" "k\<noteq>0" "length s + k + 1 = length ?r" 
-      "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (a#s) z" by blast
-    {assume "k + 1 = n"
-      with kas(3) lgqr[symmetric] q(1) n[symmetric] have s0:"s=[]" by auto
-      {fix w
-	have "cmod (poly ?r w) = cmod (1 + a * w ^ k)" 
-	  using kas(4)[rule_format, of w] s0 r01 by (simp add: ring_simps)}
-      note hth = this [symmetric]
-	from reduce_poly_simple[OF kas(1,2)] 
-      have "\<exists>w. cmod (poly ?r w) < 1" unfolding hth by blast}
-    moreover
-    {assume kn: "k+1 \<noteq> n"
-      from kn kas(3) q(1) n[symmetric] have k1n: "k + 1 < n" by simp
-      have th01: "\<not> constant (poly (1#((replicate (k - 1) 0)@[a])))" 
-	unfolding constant_def poly_Nil poly_Cons poly_replicate_append
-	using kas(1) apply simp 
-	by (rule exI[where x=0], rule exI[where x=1], simp)
-      from kas(2) have th02: "k+1 = length (1#((replicate (k - 1) 0)@[a]))" 
-	by simp
-      from H[rule_format, OF k1n th01 th02]
-      obtain w where w: "1 + w^k * a = 0"
-	unfolding poly_Nil poly_Cons poly_replicate_append
-	using kas(2) by (auto simp add: power_Suc[symmetric, of _ "k - Suc 0"] 
-	  mult_assoc[of _ _ a, symmetric])
-      from poly_bound_exists[of "cmod w" s] obtain m where 
-	m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
-      have w0: "w\<noteq>0" using kas(2) w by (auto simp add: power_0_left)
-      from w have "(1 + w ^ k * a) - 1 = 0 - 1" by simp
-      then have wm1: "w^k * a = - 1" by simp
-      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)" 
-	using norm_ge_zero[of w] w0 m(1)
-	  by (simp add: inverse_eq_divide zero_less_mult_iff)
-      with real_down2[OF zero_less_one] obtain t where
-	t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
-      let ?ct = "complex_of_real t"
-      let ?w = "?ct * w"
-      have "1 + ?w^k * (a + ?w * poly s ?w) = 1 + ?ct^k * (w^k * a) + ?w^k * ?w * poly s ?w" using kas(1) by (simp add: ring_simps power_mult_distrib)
-      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
-	unfolding wm1 by (simp)
-      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) = cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)" 
-	apply -
-	apply (rule cong[OF refl[of cmod]])
-	apply assumption
-	done
-      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"] 
-      have th11: "cmod (1 + ?w^k * (a + ?w * poly s ?w)) \<le> \<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w)" unfolding norm_of_real by simp 
-      have ath: "\<And>x (t::real). 0\<le> x \<Longrightarrow> x < t \<Longrightarrow> t\<le>1 \<Longrightarrow> \<bar>1 - t\<bar> + x < 1" by arith
-      have "t *cmod w \<le> 1 * cmod w" apply (rule mult_mono) using t(1,2) by auto
-      then have tw: "cmod ?w \<le> cmod w" using t(1) by (simp add: norm_mult) 
-      from t inv0 have "t* (cmod w ^ (k + 1) * m) < 1"
-	by (simp add: inverse_eq_divide field_simps)
-      with zero_less_power[OF t(1), of k] 
-      have th30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k * 1" 
-	apply - apply (rule mult_strict_left_mono) by simp_all
-      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k+1) * cmod (poly s ?w)))"  using w0 t(1)
-	by (simp add: ring_simps power_mult_distrib norm_of_real norm_power norm_mult)
-      then have "cmod (?w^k * ?w * poly s ?w) \<le> t^k * (t* (cmod w ^ (k + 1) * m))"
-	using t(1,2) m(2)[rule_format, OF tw] w0
-	apply (simp only: )
-	apply auto
-	apply (rule mult_mono, simp_all add: norm_ge_zero)+
-	apply (simp add: zero_le_mult_iff zero_le_power)
-	done
-      with th30 have th120: "cmod (?w^k * ?w * poly s ?w) < t^k" by simp 
-      from power_strict_mono[OF t(2), of k] t(1) kas(2) have th121: "t^k \<le> 1" 
-	by auto
-      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] th120 th121]
-      have th12: "\<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w) < 1" . 
-      from th11 th12
-      have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) < 1"  by arith 
-      then have "cmod (poly ?r ?w) < 1" 
-	unfolding kas(4)[rule_format, of ?w] r01 by simp 
-      then have "\<exists>w. cmod (poly ?r w) < 1" by blast}
-    ultimately have cr0_contr: "\<exists>w. cmod (poly ?r w) < 1" by blast
-    from cr0_contr cq0 q(2)
-    have ?ths unfolding mrmq_eq not_less[symmetric] by auto}
-  ultimately show ?ths by blast
-qed
-
-text {* Alternative version with a syntactic notion of constant polynomial. *}
-
-lemma fundamental_theorem_of_algebra_alt:
-  assumes nc: "~(\<exists>a l. a\<noteq> 0 \<and> list_all(\<lambda>b. b = 0) l \<and> p = a#l)"
-  shows "\<exists>z. poly p z = (0::complex)"
-using nc
-proof(induct p)
-  case (Cons c cs)
-  {assume "c=0" hence ?case by auto}
-  moreover
-  {assume c0: "c\<noteq>0"
-    {assume nc: "constant (poly (c#cs))"
-      from nc[unfolded constant_def, rule_format, of 0] 
-      have "\<forall>w. w \<noteq> 0 \<longrightarrow> poly cs w = 0" by auto 
-      hence "list_all (\<lambda>c. c=0) cs"
-	proof(induct cs)
-	  case (Cons d ds)
-	  {assume "d=0" hence ?case using Cons.prems Cons.hyps by simp}
-	  moreover
-	  {assume d0: "d\<noteq>0"
-	    from poly_bound_exists[of 1 ds] obtain m where 
-	      m: "m > 0" "\<forall>z. \<forall>z. cmod z \<le> 1 \<longrightarrow> cmod (poly ds z) \<le> m" by blast
-	    have dm: "cmod d / m > 0" using d0 m(1) by (simp add: field_simps)
-	    from real_down2[OF dm zero_less_one] obtain x where 
-	      x: "x > 0" "x < cmod d / m" "x < 1" by blast
-	    let ?x = "complex_of_real x"
-	    from x have cx: "?x \<noteq> 0"  "cmod ?x \<le> 1" by simp_all
-	    from Cons.prems[rule_format, OF cx(1)]
-	    have cth: "cmod (?x*poly ds ?x) = cmod d" by (simp add: eq_diff_eq[symmetric])
-	    from m(2)[rule_format, OF cx(2)] x(1)
-	    have th0: "cmod (?x*poly ds ?x) \<le> x*m"
-	      by (simp add: norm_mult)
-	    from x(2) m(1) have "x*m < cmod d" by (simp add: field_simps)
-	    with th0 have "cmod (?x*poly ds ?x) \<noteq> cmod d" by auto
-	    with cth  have ?case by blast}
-	  ultimately show ?case by blast 
-	qed simp}
-      then have nc: "\<not> constant (poly (c#cs))" using Cons.prems c0 
-	by blast
-      from fundamental_theorem_of_algebra[OF nc] have ?case .}
-  ultimately show ?case by blast  
-qed simp
-
-subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
-
-lemma nullstellensatz_lemma:
-  fixes p :: "complex list"
-  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
-  and "degree p = n" and "n \<noteq> 0"
-  shows "p divides (pexp q n)"
-using prems
-proof(induct n arbitrary: p q rule: nat_less_induct)
-  fix n::nat fix p q :: "complex list"
-  assume IH: "\<forall>m<n. \<forall>p q.
-                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
-                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p divides (q %^ m)"
-    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0" 
-    and dpn: "degree p = n" and n0: "n \<noteq> 0"
-  let ?ths = "p divides (q %^ n)"
-  {fix a assume a: "poly p a = 0"
-    {assume p0: "poly p = poly []" 
-      hence ?ths unfolding divides_def  using pq0 n0
-	apply - apply (rule exI[where x="[]"], rule ext)
-	by (auto simp add: poly_mult poly_exp)}
-    moreover
-    {assume p0: "poly p \<noteq> poly []" 
-      and oa: "order  a p \<noteq> 0"
-      from p0 have pne: "p \<noteq> []" by auto
-      let ?op = "order a p"
-      from p0 have ap: "([- a, 1] %^ ?op) divides p" 
-	"\<not> pexp [- a, 1] (Suc ?op) divides p" using order by blast+ 
-      note oop = order_degree[OF p0, unfolded dpn]
-      {assume q0: "q = []"
-	hence ?ths using n0 unfolding divides_def 
-	  apply simp
-	  apply (rule exI[where x="[]"], rule ext)
-	  by (simp add: divides_def poly_exp poly_mult)}
-      moreover
-      {assume q0: "q\<noteq>[]"
-	from pq0[rule_format, OF a, unfolded poly_linear_divides] q0
-	obtain r where r: "q = pmult [- a, 1] r" by blast
-	from ap[unfolded divides_def] obtain s where
-	  s: "poly p = poly (pmult (pexp [- a, 1] ?op) s)" by blast
-	have s0: "poly s \<noteq> poly []"
-	  using s p0 by (simp add: poly_entire)
-	hence pns0: "poly (pnormalize s) \<noteq> poly []" and sne: "s\<noteq>[]" by auto
-	{assume ds0: "degree s = 0"
-	  from ds0 pns0 have "\<exists>k. pnormalize s = [k]" unfolding degree_def 
-	    by (cases "pnormalize s", auto)
-	  then obtain k where kpn: "pnormalize s = [k]" by blast
-	  from pns0[unfolded poly_zero] kpn have k: "k \<noteq>0" "poly s = poly [k]"
-	    using poly_normalize[of s] by simp_all
-	  let ?w = "pmult (pmult [1/k] (pexp [-a,1] (n - ?op))) (pexp r n)"
-	  from k r s oop have "poly (pexp q n) = poly (pmult p ?w)"
-	    by - (rule ext, simp add: poly_mult poly_exp poly_cmult poly_add power_add[symmetric] ring_simps power_mult_distrib[symmetric])
-	  hence ?ths unfolding divides_def by blast}
-	moreover
-	{assume ds0: "degree s \<noteq> 0"
-	  from ds0 s0 dpn degree_unique[OF s, unfolded linear_pow_mul_degree] oa
-	    have dsn: "degree s < n" by auto 
-	    {fix x assume h: "poly s x = 0"
-	      {assume xa: "x = a"
-		from h[unfolded xa poly_linear_divides] sne obtain u where
-		  u: "s = pmult [- a, 1] u" by blast
-		have "poly p = poly (pmult (pexp [- a, 1] (Suc ?op)) u)"
-		  unfolding s u
-		  apply (rule ext)
-		  by (simp add: ring_simps power_mult_distrib[symmetric] poly_mult poly_cmult poly_add poly_exp)
-		with ap(2)[unfolded divides_def] have False by blast}
-	      note xa = this
-	      from h s have "poly p x = 0" by (simp add: poly_mult)
-	      with pq0 have "poly q x = 0" by blast
-	      with r xa have "poly r x = 0"
-		by (auto simp add: poly_mult poly_add poly_cmult eq_diff_eq[symmetric])}
-	    note impth = this
-	    from IH[rule_format, OF dsn, of s r] impth ds0
-	    have "s divides (pexp r (degree s))" by blast
-	    then obtain u where u: "poly (pexp r (degree s)) = poly (pmult s u)"
-	      unfolding divides_def by blast
-	    hence u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
-	      by (simp add: poly_mult[symmetric] poly_exp[symmetric])
-	    let ?w = "pmult (pmult u (pexp [-a,1] (n - ?op))) (pexp r (n - degree s))"
-	    from u' s r oop[of a] dsn have "poly (pexp q n) = poly (pmult p ?w)"
-	      apply - apply (rule ext)
-	      apply (simp only:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult ring_simps)
-	      
-	      apply (simp add:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult mult_assoc[symmetric])
-	      done
-	    hence ?ths unfolding divides_def by blast}
-      ultimately have ?ths by blast }
-      ultimately have ?ths by blast}
-    ultimately have ?ths using a order_root by blast}
-  moreover
-  {assume exa: "\<not> (\<exists>a. poly p a = 0)"
-    from fundamental_theorem_of_algebra_alt[of p] exa obtain c cs where
-      ccs: "c\<noteq>0" "list_all (\<lambda>c. c = 0) cs" "p = c#cs" by blast
-    
-    from poly_0[OF ccs(2)] ccs(3) 
-    have pp: "\<And>x. poly p x =  c" by simp
-    let ?w = "pmult [1/c] (pexp q n)"
-    from pp ccs(1) 
-    have "poly (pexp q n) = poly (pmult p ?w) "
-      apply - apply (rule ext)
-      unfolding poly_mult_assoc[symmetric] by (simp add: poly_mult)
-    hence ?ths unfolding divides_def by blast}
-  ultimately show ?ths by blast
-qed
-
-lemma nullstellensatz_univariate:
-  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> 
-    p divides (q %^ (degree p)) \<or> (poly p = poly [] \<and> poly q = poly [])"
-proof-
-  {assume pe: "poly p = poly []"
-    hence eq: "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> poly q = poly []"
-      apply auto
-      by (rule ext, simp)
-    {assume "p divides (pexp q (degree p))"
-      then obtain r where r: "poly (pexp q (degree p)) = poly (pmult p r)" 
-	unfolding divides_def by blast
-      from cong[OF r refl] pe degree_unique[OF pe]
-      have False by (simp add: poly_mult degree_def)}
-    with eq pe have ?thesis by blast}
-  moreover
-  {assume pe: "poly p \<noteq> poly []"
-    have p0: "poly [0] = poly []" by (rule ext, simp)
-    {assume dp: "degree p = 0"
-      then obtain k where "pnormalize p = [k]" using pe poly_normalize[of p]
-	unfolding degree_def by (cases "pnormalize p", auto)
-      hence k: "pnormalize p = [k]" "poly p = poly [k]" "k\<noteq>0"
-	using pe poly_normalize[of p] by (auto simp add: p0)
-      hence th1: "\<forall>x. poly p x \<noteq> 0" by simp
-      from k(2,3) dp have "poly (pexp q (degree p)) = poly (pmult p [1/k]) "
-	by - (rule ext, simp add: poly_mult poly_exp)
-      hence th2: "p divides (pexp q (degree p))" unfolding divides_def by blast
-      from th1 th2 pe have ?thesis by blast}
-    moreover
-    {assume dp: "degree p \<noteq> 0"
-      then obtain n where n: "degree p = Suc n " by (cases "degree p", auto)
-      {assume "p divides (pexp q (Suc n))"
-	then obtain u where u: "poly (pexp q (Suc n)) = poly (pmult p u)"
-	  unfolding divides_def by blast
-	hence u' :"\<And>x. poly (pexp q (Suc n)) x = poly (pmult p u) x" by simp_all
-	{fix x assume h: "poly p x = 0" "poly q x \<noteq> 0"
-	  hence "poly (pexp q (Suc n)) x \<noteq> 0" by (simp only: poly_exp) simp	  
-	  hence False using u' h(1) by (simp only: poly_mult poly_exp) simp}}
-	with n nullstellensatz_lemma[of p q "degree p"] dp 
-	have ?thesis by auto}
-    ultimately have ?thesis by blast}
-  ultimately show ?thesis by blast
-qed
-
-text{* Useful lemma *}
-
-lemma (in idom_char_0) constant_degree: "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
-proof
-  assume l: ?lhs
-  from l[unfolded constant_def, rule_format, of _ "zero"]
-  have th: "poly p = poly [poly p 0]" apply - by (rule ext, simp)
-  from degree_unique[OF th] show ?rhs by (simp add: degree_def)
-next
-  assume r: ?rhs
-  from r have "pnormalize p = [] \<or> (\<exists>k. pnormalize p = [k])"
-    unfolding degree_def by (cases "pnormalize p", auto)
-  then show ?lhs unfolding constant_def poly_normalize[of p, symmetric]
-    by (auto simp del: poly_normalize)
-qed
-
-(* It would be nicer to prove this without using algebraic closure...        *)
-
-lemma divides_degree_lemma: assumes dpn: "degree (p::complex list) = n"
-  shows "n \<le> degree (p *** q) \<or> poly (p *** q) = poly []"
-  using dpn
-proof(induct n arbitrary: p q)
-  case 0 thus ?case by simp
-next
-  case (Suc n p q)
-  from Suc.prems fundamental_theorem_of_algebra[of p] constant_degree[of p]
-  obtain a where a: "poly p a = 0" by auto
-  then obtain r where r: "p = pmult [-a, 1] r" unfolding poly_linear_divides
-    using Suc.prems by (auto simp add: degree_def)
-  {assume h: "poly (pmult r q) = poly []"
-    hence "poly (pmult p q) = poly []" using r
-      apply - apply (rule ext)  by (auto simp add: poly_entire poly_mult poly_add poly_cmult) hence ?case by blast}
-  moreover
-  {assume h: "poly (pmult r q) \<noteq> poly []" 
-    hence r0: "poly r \<noteq> poly []" and q0: "poly q \<noteq> poly []"
-      by (auto simp add: poly_entire)
-    have eq: "poly (pmult p q) = poly (pmult [-a, 1] (pmult r q))"
-      apply - apply (rule ext)
-      by (simp add: r poly_mult poly_add poly_cmult ring_simps)
-    from linear_mul_degree[OF h, of "- a"]
-    have dqe: "degree (pmult p q) = degree (pmult r q) + 1"
-      unfolding degree_unique[OF eq] .
-    from linear_mul_degree[OF r0, of "- a", unfolded r[symmetric]] r Suc.prems 
-    have dr: "degree r = n" by auto
-    from  Suc.hyps[OF dr, of q] have "Suc n \<le> degree (pmult p q)"
-      unfolding dqe using h by (auto simp del: poly.simps) 
-    hence ?case by blast}
-  ultimately show ?case by blast
-qed
-
-lemma divides_degree: assumes pq: "p divides (q:: complex list)"
-  shows "degree p \<le> degree q \<or> poly q = poly []"
-using pq  divides_degree_lemma[OF refl, of p]
-apply (auto simp add: divides_def poly_entire)
-apply atomize
-apply (erule_tac x="qa" in allE, auto)
-apply (subgoal_tac "degree q = degree (p *** qa)", simp)
-apply (rule degree_unique, simp)
-done
-
-(* Arithmetic operations on multivariate polynomials.                        *)
-
-lemma mpoly_base_conv: 
-  "(0::complex) \<equiv> poly [] x" "c \<equiv> poly [c] x" "x \<equiv> poly [0,1] x" by simp_all
-
-lemma mpoly_norm_conv: 
-  "poly [0] (x::complex) \<equiv> poly [] x" "poly [poly [] y] x \<equiv> poly [] x" by simp_all
-
-lemma mpoly_sub_conv: 
-  "poly p (x::complex) - poly q x \<equiv> poly p x + -1 * poly q x"
-  by (simp add: diff_def)
-
-lemma poly_pad_rule: "poly p x = 0 ==> poly (0#p) x = (0::complex)" by simp
-
-lemma poly_cancel_eq_conv: "p = (0::complex) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (q = 0) \<equiv> (a * q - b * p = 0)" apply (atomize (full)) by auto
-
-lemma resolve_eq_raw:  "poly [] x \<equiv> 0" "poly [c] x \<equiv> (c::complex)" by auto
-lemma  resolve_eq_then: "(P \<Longrightarrow> (Q \<equiv> Q1)) \<Longrightarrow> (\<not>P \<Longrightarrow> (Q \<equiv> Q2))
-  \<Longrightarrow> Q \<equiv> P \<and> Q1 \<or> \<not>P\<and> Q2" apply (atomize (full)) by blast 
-lemma expand_ex_beta_conv: "list_ex P [c] \<equiv> P c" by simp
-
-lemma poly_divides_pad_rule: 
-  fixes p q :: "complex list"
-  assumes pq: "p divides q"
-  shows "p divides ((0::complex)#q)"
-proof-
-  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
-  hence "poly (0#q) = poly (p *** ([0,1] *** r))" 
-    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
-  thus ?thesis unfolding divides_def by blast
-qed
-
-lemma poly_divides_pad_const_rule: 
-  fixes p q :: "complex list"
-  assumes pq: "p divides q"
-  shows "p divides (a %* q)"
-proof-
-  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
-  hence "poly (a %* q) = poly (p *** (a %* r))" 
-    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
-  thus ?thesis unfolding divides_def by blast
-qed
-
-
-lemma poly_divides_conv0:  
-  fixes p :: "complex list"
-  assumes lgpq: "length q < length p" and lq:"last p \<noteq> 0"
-  shows "p divides q \<equiv> (\<not> (list_ex (\<lambda>c. c \<noteq> 0) q))" (is "?lhs \<equiv> ?rhs")
-proof-
-  {assume r: ?rhs 
-    hence eq: "poly q = poly []" unfolding poly_zero 
-      by (simp add: list_all_iff list_ex_iff)
-    hence "poly q = poly (p *** [])" by - (rule ext, simp add: poly_mult)
-    hence ?lhs unfolding divides_def  by blast}
-  moreover
-  {assume l: ?lhs
-    have ath: "\<And>lq lp dq::nat. lq < lp ==> lq \<noteq> 0 \<Longrightarrow> dq <= lq - 1 ==> dq < lp - 1"
-      by arith
-    {assume q0: "length q = 0"
-      hence "q = []" by simp
-      hence ?rhs by simp}
-    moreover
-    {assume lgq0: "length q \<noteq> 0"
-      from pnormalize_length[of q] have dql: "degree q \<le> length q - 1" 
-	unfolding degree_def by simp
-      from ath[OF lgpq lgq0 dql, unfolded pnormal_degree[OF lq, symmetric]] divides_degree[OF l] have "poly q = poly []" by auto
-      hence ?rhs unfolding poly_zero by (simp add: list_all_iff list_ex_iff)}
-    ultimately have ?rhs by blast }
-  ultimately show "?lhs \<equiv> ?rhs" by - (atomize (full), blast) 
-qed
-
-lemma poly_divides_conv1: 
-  assumes a0: "a\<noteq> (0::complex)" and pp': "(p::complex list) divides p'"
-  and qrp': "\<And>x. a * poly q x - poly p' x \<equiv> poly r x"
-  shows "p divides q \<equiv> p divides (r::complex list)" (is "?lhs \<equiv> ?rhs")
-proof-
-  {
-  from pp' obtain t where t: "poly p' = poly (p *** t)" 
-    unfolding divides_def by blast
-  {assume l: ?lhs
-    then obtain u where u: "poly q = poly (p *** u)" unfolding divides_def by blast
-     have "poly r = poly (p *** ((a %* u) +++ (-- t)))"
-       using u qrp' t
-       by - (rule ext, 
-	 simp add: poly_add poly_mult poly_cmult poly_minus ring_simps)
-     then have ?rhs unfolding divides_def by blast}
-  moreover
-  {assume r: ?rhs
-    then obtain u where u: "poly r = poly (p *** u)" unfolding divides_def by blast
-    from u t qrp' a0 have "poly q = poly (p *** ((1/a) %* (u +++ t)))"
-      by - (rule ext, atomize (full), simp add: poly_mult poly_add poly_cmult field_simps)
-    hence ?lhs  unfolding divides_def by blast}
-  ultimately have "?lhs = ?rhs" by blast }
-thus "?lhs \<equiv> ?rhs"  by - (atomize(full), blast) 
-qed
-
-lemma basic_cqe_conv1:
-  "(\<exists>x. poly p x = 0 \<and> poly [] x \<noteq> 0) \<equiv> False"
-  "(\<exists>x. poly [] x \<noteq> 0) \<equiv> False"
-  "(\<exists>x. poly [c] x \<noteq> 0) \<equiv> c\<noteq>0"
-  "(\<exists>x. poly [] x = 0) \<equiv> True"
-  "(\<exists>x. poly [c] x = 0) \<equiv> c = 0" by simp_all
-
-lemma basic_cqe_conv2: 
-  assumes l:"last (a#b#p) \<noteq> 0" 
-  shows "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True"
-proof-
-  {fix h t
-    assume h: "h\<noteq>0" "list_all (\<lambda>c. c=(0::complex)) t"  "a#b#p = h#t"
-    hence "list_all (\<lambda>c. c= 0) (b#p)" by simp
-    moreover have "last (b#p) \<in> set (b#p)" by simp
-    ultimately have "last (b#p) = 0" by (simp add: list_all_iff)
-    with l have False by simp}
-  hence th: "\<not> (\<exists> h t. h\<noteq>0 \<and> list_all (\<lambda>c. c=0) t \<and> a#b#p = h#t)"
-    by blast
-  from fundamental_theorem_of_algebra_alt[OF th] 
-  show "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True" by auto
-qed
-
-lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
-proof-
-  have "\<not> (list_ex (\<lambda>c. c \<noteq> 0) p) \<longleftrightarrow> poly p = poly []" 
-    by (simp add: poly_zero list_all_iff list_ex_iff)
-  also have "\<dots> \<longleftrightarrow> (\<not> (\<exists>x. poly p x \<noteq> 0))" by (auto intro: ext)
-  finally show "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
-    by - (atomize (full), blast)
-qed
-
-lemma basic_cqe_conv3:
-  fixes p q :: "complex list"
-  assumes l: "last (a#p) \<noteq> 0" 
-  shows "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
-proof-
-  note np = pnormalize_eq[OF l]
-  {assume "poly (a#p) = poly []" hence False using l
-      unfolding poly_zero apply (auto simp add: list_all_iff del: last.simps)
-      apply (cases p, simp_all) done}
-  then have p0: "poly (a#p) \<noteq> poly []"  by blast
-  from np have dp:"degree (a#p) = length p" by (simp add: degree_def)
-  from nullstellensatz_univariate[of "a#p" q] p0 dp
-  show "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
-    by - (atomize (full), auto)
-qed
-
-lemma basic_cqe_conv4:
-  fixes p q :: "complex list"
-  assumes h: "\<And>x. poly (q %^ n) x \<equiv> poly r x"
-  shows "p divides (q %^ n) \<equiv> p divides r"
-proof-
-  from h have "poly (q %^ n) = poly r" by (auto intro: ext)  
-  thus "p divides (q %^ n) \<equiv> p divides r" unfolding divides_def by simp
-qed
-
-lemma pmult_Cons_Cons: "((a::complex)#b#p) *** q = (a %*q) +++ (0#((b#p) *** q))"
-  by simp
-
-lemma elim_neg_conv: "- z \<equiv> (-1) * (z::complex)" by simp
-lemma eqT_intr: "PROP P \<Longrightarrow> (True \<Longrightarrow> PROP P )" "PROP P \<Longrightarrow> True" by blast+
-lemma negate_negate_rule: "Trueprop P \<equiv> \<not> P \<equiv> False" by (atomize (full), auto)
-lemma last_simps: "last [x] = x" "last (x#y#ys) = last (y#ys)" by simp_all
-lemma length_simps: "length [] = 0" "length (x#y#xs) = length xs + 2" "length [x] = 1" by simp_all
-
-lemma complex_entire: "(z::complex) \<noteq> 0 \<and> w \<noteq> 0 \<equiv> z*w \<noteq> 0" by simp
-lemma resolve_eq_ne: "(P \<equiv> True) \<equiv> (\<not>P \<equiv> False)" "(P \<equiv> False) \<equiv> (\<not>P \<equiv> True)" 
-  by (atomize (full)) simp_all
-lemma cqe_conv1: "poly [] x = 0 \<longleftrightarrow> True"  by simp
-lemma cqe_conv2: "(p \<Longrightarrow> (q \<equiv> r)) \<equiv> ((p \<and> q) \<equiv> (p \<and> r))"  (is "?l \<equiv> ?r")
-proof
-  assume "p \<Longrightarrow> q \<equiv> r" thus "p \<and> q \<equiv> p \<and> r" apply - apply (atomize (full)) by blast
-next
-  assume "p \<and> q \<equiv> p \<and> r" "p"
-  thus "q \<equiv> r" apply - apply (atomize (full)) apply blast done
-qed
-lemma poly_const_conv: "poly [c] (x::complex) = y \<longleftrightarrow> c = y" by simp
-
-end
\ No newline at end of file
--- a/src/HOL/Complex/README.html	Tue Dec 30 08:18:54 2008 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
-
-<!-- $Id$ -->
-
-<HTML>
-
-<HEAD>
-  <meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
-  <TITLE>HOL/Complex/README</TITLE>
-</HEAD>
-
-<BODY>
-
-<H1>Complex: The Complex Numbers</H1>
-		<P>This directory defines the type <KBD>complex</KBD> of the complex numbers,
-with numeric constants and some complex analysis.  The development includes
-nonstandard analysis for the complex numbers.  Note that the image
-<KBD>HOL-Complex</KBD> includes theories from the directories 
-<KBD><a href="#Anchor-Real">HOL/Real</a></KBD>  and <KBD><a href="#Anchor-Hyperreal">HOL/Hyperreal</a></KBD>. They define other types including <kbd>real</kbd> (the real numbers) and <kbd>hypreal</kbd> (the hyperreal or non-standard reals).
-
-<ul>
-<li><a href="CLim.html">CLim</a> Limits, continuous functions, and derivatives for the complex numbers
-<li><a href="CSeries.html">CSeries</a> Finite summation and infinite series for the complex numbers
-<li><a href="CStar.html">CStar</a> Star-transforms for the complex numbers, to form non-standard extensions of sets and functions
-<li><a href="Complex.html">Complex</a> The complex numbers
-<li><a href="NSCA.html">NSCA</a> Nonstandard complex analysis
-<li><a href="NSComplex.html">NSComplex</a> Ultrapower construction of the nonstandard complex numbers
-</ul>
-
-<h2><a name="Anchor-Real" id="Anchor-Real"></a>Real: Dedekind Cut Construction of the Real Line</h2>
-
-<ul>
-<li><a href="Lubs.html">Lubs</a> Definition of upper bounds, lubs and so on, to support completeness proofs.
-<li><a href="PReal.html">PReal</a> The positive reals constructed using Dedekind cuts
-<li><a href="Rational.html">Rational</a> The rational numbers constructed as equivalence classes of integers
-<li><a href="RComplete.html">RComplete</a> The reals are complete: they satisfy the supremum property. They also have the Archimedean property.
-<li><a href="RealDef.html">RealDef</a> The real numbers, their ordering properties, and embedding of the integers and the natural numbers
-<li><a href="RealPow.html">RealPow</a> Real numbers raised to natural number powers
-</ul>
-<h2><a name="Anchor-Hyperreal" id="Anchor-Hyperreal"></a>Hyperreal: Ultrafilter Construction of the Non-Standard Reals</h2>
-See J. D. Fleuriot and L. C. Paulson. Mechanizing Nonstandard Real Analysis. LMS J. Computation and Mathematics 3 (2000), 140-190.
-<ul>
-<li><a href="Filter.html">Filter</a> Theory of Filters and Ultrafilters. Main result is a version of the Ultrafilter Theorem proved using Zorn's Lemma.
-<li><a href="HLog.html">HLog</a> Non-standard logarithms
-<li><a href="HSeries.html">HSeries</a> Non-standard theory of finite summation and infinite series
-<li><a href="HTranscendental.html">HTranscendental</a> Non-standard extensions of transcendental functions
-<li><a href="HyperDef.html">HyperDef</a> Ultrapower construction of the hyperreals
-<li><a href="HyperNat.html">HyperNat</a> Ultrapower construction of the hypernaturals
-<li><a href="HyperPow.html">HyperPow</a> Powers theory for the hyperreals
-<!-- <li><a href="IntFloor.html">IntFloor</a> Floor and Ceiling functions relating the reals and integers -->
-<li><a href="Integration.html">Integration</a> Gage integrals
-<li><a href="Lim.html">Lim</a> Theory of limits, continuous functions, and derivatives
-<li><a href="Log.html">Log</a> Logarithms for the reals
-<li><a href="MacLaurin.html">MacLaurin</a> MacLaurin series
-<li><a href="NatStar.html">NatStar</a> Star-transforms for the hypernaturals, to form non-standard extensions of sets and functions involving the naturals or reals
-<li><a href="NthRoot.html">NthRoot</a> Existence of n-th roots of real numbers
-<li><a href="NSA.html">NSA</a> Theory defining sets of infinite numbers, infinitesimals, the infinitely close relation, and their various algebraic properties.
-<li><a href="Poly.html">Poly</a> Univariate real polynomials
-<li><a href="SEQ.html">SEQ</a> Convergence of sequences and series using standard and nonstandard analysis
-<li><a href="Series.html">Series</a> Finite summation and infinite series for the reals
-<li><a href="Star.html">Star</a> Nonstandard extensions of real sets and real functions
-<li><a href="Transcendental.html">Transcendental</a> Power series and transcendental functions
-</ul>
-<HR>
-<P>Last modified $Date$
-</BODY>
-</HTML>
--- a/src/HOL/Complex/document/root.tex	Tue Dec 30 08:18:54 2008 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,32 +0,0 @@
-
-% $Id$
-
-\documentclass[11pt,a4paper]{article}
-\usepackage{graphicx,isabelle,isabellesym,latexsym}
-\usepackage[latin1]{inputenc}
-\usepackage{pdfsetup}
-
-\urlstyle{rm}
-\isabellestyle{it}
-\pagestyle{myheadings}
-
-\begin{document}
-
-\title{Isabelle/HOL-Complex --- Higher-Order Logic with Complex Numbers}
-\maketitle
-
-\tableofcontents
-
-\begin{center}
-  \includegraphics[width=\textwidth,height=\textheight,keepaspectratio]{session_graph}
-\end{center}
-
-\newpage
-
-\renewcommand{\isamarkupheader}[1]%
-{\section{\isabellecontext: #1}\markright{THEORY~``\isabellecontext''}}
-
-\parindent 0pt\parskip 0.5ex
-\input{session}
-
-\end{document}
--- a/src/HOL/Complex_Main.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/Complex_Main.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -9,7 +9,7 @@
 imports
   Main
   Real
-  "~~/src/HOL/Complex/Fundamental_Theorem_Algebra"
+  Fundamental_Theorem_Algebra
   Log
   Ln
   Taylor
--- a/src/HOL/Datatype.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/Datatype.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -578,7 +578,13 @@
 lemma Sumr_inject: "Sumr f = Sumr g ==> f = g"
   by (unfold Sumr_def) (erule sum_case_inject)
 
-hide (open) const Suml Sumr
+primrec Projl :: "'a + 'b => 'a"
+where Projl_Inl: "Projl (Inl x) = x"
+
+primrec Projr :: "'a + 'b => 'b"
+where Projr_Inr: "Projr (Inr x) = x"
+
+hide (open) const Suml Sumr Projl Projr
 
 
 subsection {* The option datatype *}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Dense_Linear_Order.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,877 @@
+(* Author: Amine Chaieb, TU Muenchen *)
+
+header {* Dense linear order without endpoints
+  and a quantifier elimination procedure in Ferrante and Rackoff style *}
+
+theory Dense_Linear_Order
+imports Plain Groebner_Basis
+uses
+  "~~/src/HOL/Tools/Qelim/langford_data.ML"
+  "~~/src/HOL/Tools/Qelim/ferrante_rackoff_data.ML"
+  ("~~/src/HOL/Tools/Qelim/langford.ML")
+  ("~~/src/HOL/Tools/Qelim/ferrante_rackoff.ML")
+begin
+
+setup {* Langford_Data.setup #> Ferrante_Rackoff_Data.setup *}
+
+context linorder
+begin
+
+lemma less_not_permute: "\<not> (x < y \<and> y < x)" by (simp add: not_less linear)
+
+lemma gather_simps: 
+  shows 
+  "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> x < u \<and> P x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> (insert u U). x < y) \<and> P x)"
+  and "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> l < x \<and> P x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> (insert l L). y < x) \<and> (\<forall>y \<in> U. x < y) \<and> P x)"
+  "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> x < u) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> (insert u U). x < y))"
+  and "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> l < x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> (insert l L). y < x) \<and> (\<forall>y \<in> U. x < y))"  by auto
+
+lemma 
+  gather_start: "(\<exists>x. P x) \<equiv> (\<exists>x. (\<forall>y \<in> {}. y < x) \<and> (\<forall>y\<in> {}. x < y) \<and> P x)" 
+  by simp
+
+text{* Theorems for @{text "\<exists>z. \<forall>x. x < z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>-\<infinity>\<^esub>)"}*}
+lemma minf_lt:  "\<exists>z . \<forall>x. x < z \<longrightarrow> (x < t \<longleftrightarrow> True)" by auto
+lemma minf_gt: "\<exists>z . \<forall>x. x < z \<longrightarrow>  (t < x \<longleftrightarrow>  False)"
+  by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le)
+
+lemma minf_le: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x \<le> t \<longleftrightarrow> True)" by (auto simp add: less_le)
+lemma minf_ge: "\<exists>z. \<forall>x. x < z \<longrightarrow> (t \<le> x \<longleftrightarrow> False)"
+  by (auto simp add: less_le not_less not_le)
+lemma minf_eq: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x = t \<longleftrightarrow> False)" by auto
+lemma minf_neq: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x \<noteq> t \<longleftrightarrow> True)" by auto
+lemma minf_P: "\<exists>z. \<forall>x. x < z \<longrightarrow> (P \<longleftrightarrow> P)" by blast
+
+text{* Theorems for @{text "\<exists>z. \<forall>x. x < z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>+\<infinity>\<^esub>)"}*}
+lemma pinf_gt:  "\<exists>z . \<forall>x. z < x \<longrightarrow> (t < x \<longleftrightarrow> True)" by auto
+lemma pinf_lt: "\<exists>z . \<forall>x. z < x \<longrightarrow>  (x < t \<longleftrightarrow>  False)"
+  by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le)
+
+lemma pinf_ge: "\<exists>z. \<forall>x. z < x \<longrightarrow> (t \<le> x \<longleftrightarrow> True)" by (auto simp add: less_le)
+lemma pinf_le: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x \<le> t \<longleftrightarrow> False)"
+  by (auto simp add: less_le not_less not_le)
+lemma pinf_eq: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x = t \<longleftrightarrow> False)" by auto
+lemma pinf_neq: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x \<noteq> t \<longleftrightarrow> True)" by auto
+lemma pinf_P: "\<exists>z. \<forall>x. z < x \<longrightarrow> (P \<longleftrightarrow> P)" by blast
+
+lemma nmi_lt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x < t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma nmi_gt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and> t < x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)"
+  by (auto simp add: le_less)
+lemma  nmi_le: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x\<le> t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma  nmi_ge: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and> t\<le> x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma  nmi_eq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x = t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma  nmi_neq: "t \<in> U \<Longrightarrow>\<forall>x. \<not>True \<and> x \<noteq> t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma  nmi_P: "\<forall> x. ~P \<and> P \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma  nmi_conj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x) ;
+  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)\<rbrakk> \<Longrightarrow>
+  \<forall>x. \<not>(P1' \<and> P2') \<and> (P1 x \<and> P2 x) \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+lemma  nmi_disj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x) ;
+  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)\<rbrakk> \<Longrightarrow>
+  \<forall>x. \<not>(P1' \<or> P2') \<and> (P1 x \<or> P2 x) \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
+
+lemma  npi_lt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x < t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by (auto simp add: le_less)
+lemma  npi_gt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> t < x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+lemma  npi_le: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x \<le> t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+lemma  npi_ge: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> t \<le> x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+lemma  npi_eq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x = t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+lemma  npi_neq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x \<noteq> t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u )" by auto
+lemma  npi_P: "\<forall> x. ~P \<and> P \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+lemma  npi_conj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u) ;  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)\<rbrakk>
+  \<Longrightarrow>  \<forall>x. \<not>(P1' \<and> P2') \<and> (P1 x \<and> P2 x) \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+lemma  npi_disj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u) ; \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)\<rbrakk>
+  \<Longrightarrow> \<forall>x. \<not>(P1' \<or> P2') \<and> (P1 x \<or> P2 x) \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
+
+lemma lin_dense_lt: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t < u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x < t \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y < t)"
+proof(clarsimp)
+  fix x l u y  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x"
+    and xu: "x<u"  and px: "x < t" and ly: "l<y" and yu:"y < u"
+  from tU noU ly yu have tny: "t\<noteq>y" by auto
+  {assume H: "t < y"
+    from less_trans[OF lx px] less_trans[OF H yu]
+    have "l < t \<and> t < u"  by simp
+    with tU noU have "False" by auto}
+  hence "\<not> t < y"  by auto hence "y \<le> t" by (simp add: not_less)
+  thus "y < t" using tny by (simp add: less_le)
+qed
+
+lemma lin_dense_gt: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l < x \<and> x < u \<and> t < x \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> t < y)"
+proof(clarsimp)
+  fix x l u y
+  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
+  and px: "t < x" and ly: "l<y" and yu:"y < u"
+  from tU noU ly yu have tny: "t\<noteq>y" by auto
+  {assume H: "y< t"
+    from less_trans[OF ly H] less_trans[OF px xu] have "l < t \<and> t < u" by simp
+    with tU noU have "False" by auto}
+  hence "\<not> y<t"  by auto hence "t \<le> y" by (auto simp add: not_less)
+  thus "t < y" using tny by (simp add:less_le)
+qed
+
+lemma lin_dense_le: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x \<le> t \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y\<le> t)"
+proof(clarsimp)
+  fix x l u y
+  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
+  and px: "x \<le> t" and ly: "l<y" and yu:"y < u"
+  from tU noU ly yu have tny: "t\<noteq>y" by auto
+  {assume H: "t < y"
+    from less_le_trans[OF lx px] less_trans[OF H yu]
+    have "l < t \<and> t < u" by simp
+    with tU noU have "False" by auto}
+  hence "\<not> t < y"  by auto thus "y \<le> t" by (simp add: not_less)
+qed
+
+lemma lin_dense_ge: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> t \<le> x \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> t \<le> y)"
+proof(clarsimp)
+  fix x l u y
+  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
+  and px: "t \<le> x" and ly: "l<y" and yu:"y < u"
+  from tU noU ly yu have tny: "t\<noteq>y" by auto
+  {assume H: "y< t"
+    from less_trans[OF ly H] le_less_trans[OF px xu]
+    have "l < t \<and> t < u" by simp
+    with tU noU have "False" by auto}
+  hence "\<not> y<t"  by auto thus "t \<le> y" by (simp add: not_less)
+qed
+lemma lin_dense_eq: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x = t   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y= t)"  by auto
+lemma lin_dense_neq: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x \<noteq> t   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y\<noteq> t)"  by auto
+lemma lin_dense_P: "\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P)"  by auto
+
+lemma lin_dense_conj:
+  "\<lbrakk>\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P1 x
+  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P1 y) ;
+  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P2 x
+  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P2 y)\<rbrakk> \<Longrightarrow>
+  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> (P1 x \<and> P2 x)
+  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> (P1 y \<and> P2 y))"
+  by blast
+lemma lin_dense_disj:
+  "\<lbrakk>\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P1 x
+  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P1 y) ;
+  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P2 x
+  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P2 y)\<rbrakk> \<Longrightarrow>
+  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> (P1 x \<or> P2 x)
+  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> (P1 y \<or> P2 y))"
+  by blast
+
+lemma npmibnd: "\<lbrakk>\<forall>x. \<not> MP \<and> P x \<longrightarrow> (\<exists> u\<in> U. u \<le> x); \<forall>x. \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. x \<le> u)\<rbrakk>
+  \<Longrightarrow> \<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<le> x \<and> x \<le> u')"
+by auto
+
+lemma finite_set_intervals:
+  assumes px: "P x" and lx: "l \<le> x" and xu: "x \<le> u" and linS: "l\<in> S"
+  and uinS: "u \<in> S" and fS:"finite S" and lS: "\<forall> x\<in> S. l \<le> x" and Su: "\<forall> x\<in> S. x \<le> u"
+  shows "\<exists> a \<in> S. \<exists> b \<in> S. (\<forall> y. a < y \<and> y < b \<longrightarrow> y \<notin> S) \<and> a \<le> x \<and> x \<le> b \<and> P x"
+proof-
+  let ?Mx = "{y. y\<in> S \<and> y \<le> x}"
+  let ?xM = "{y. y\<in> S \<and> x \<le> y}"
+  let ?a = "Max ?Mx"
+  let ?b = "Min ?xM"
+  have MxS: "?Mx \<subseteq> S" by blast
+  hence fMx: "finite ?Mx" using fS finite_subset by auto
+  from lx linS have linMx: "l \<in> ?Mx" by blast
+  hence Mxne: "?Mx \<noteq> {}" by blast
+  have xMS: "?xM \<subseteq> S" by blast
+  hence fxM: "finite ?xM" using fS finite_subset by auto
+  from xu uinS have linxM: "u \<in> ?xM" by blast
+  hence xMne: "?xM \<noteq> {}" by blast
+  have ax:"?a \<le> x" using Mxne fMx by auto
+  have xb:"x \<le> ?b" using xMne fxM by auto
+  have "?a \<in> ?Mx" using Max_in[OF fMx Mxne] by simp hence ainS: "?a \<in> S" using MxS by blast
+  have "?b \<in> ?xM" using Min_in[OF fxM xMne] by simp hence binS: "?b \<in> S" using xMS by blast
+  have noy:"\<forall> y. ?a < y \<and> y < ?b \<longrightarrow> y \<notin> S"
+  proof(clarsimp)
+    fix y   assume ay: "?a < y" and yb: "y < ?b" and yS: "y \<in> S"
+    from yS have "y\<in> ?Mx \<or> y\<in> ?xM" by (auto simp add: linear)
+    moreover {assume "y \<in> ?Mx" hence "y \<le> ?a" using Mxne fMx by auto with ay have "False" by (simp add: not_le[symmetric])}
+    moreover {assume "y \<in> ?xM" hence "?b \<le> y" using xMne fxM by auto with yb have "False" by (simp add: not_le[symmetric])}
+    ultimately show "False" by blast
+  qed
+  from ainS binS noy ax xb px show ?thesis by blast
+qed
+
+lemma finite_set_intervals2:
+  assumes px: "P x" and lx: "l \<le> x" and xu: "x \<le> u" and linS: "l\<in> S"
+  and uinS: "u \<in> S" and fS:"finite S" and lS: "\<forall> x\<in> S. l \<le> x" and Su: "\<forall> x\<in> S. x \<le> u"
+  shows "(\<exists> s\<in> S. P s) \<or> (\<exists> a \<in> S. \<exists> b \<in> S. (\<forall> y. a < y \<and> y < b \<longrightarrow> y \<notin> S) \<and> a < x \<and> x < b \<and> P x)"
+proof-
+  from finite_set_intervals[where P="P", OF px lx xu linS uinS fS lS Su]
+  obtain a and b where
+    as: "a\<in> S" and bs: "b\<in> S" and noS:"\<forall>y. a < y \<and> y < b \<longrightarrow> y \<notin> S"
+    and axb: "a \<le> x \<and> x \<le> b \<and> P x"  by auto
+  from axb have "x= a \<or> x= b \<or> (a < x \<and> x < b)" by (auto simp add: le_less)
+  thus ?thesis using px as bs noS by blast
+qed
+
+end
+
+section {* The classical QE after Langford for dense linear orders *}
+
+context dense_linear_order
+begin
+
+lemma interval_empty_iff:
+  "{y. x < y \<and> y < z} = {} \<longleftrightarrow> \<not> x < z"
+  by (auto dest: dense)
+
+lemma dlo_qe_bnds: 
+  assumes ne: "L \<noteq> {}" and neU: "U \<noteq> {}" and fL: "finite L" and fU: "finite U"
+  shows "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y)) \<equiv> (\<forall> l \<in> L. \<forall>u \<in> U. l < u)"
+proof (simp only: atomize_eq, rule iffI)
+  assume H: "\<exists>x. (\<forall>y\<in>L. y < x) \<and> (\<forall>y\<in>U. x < y)"
+  then obtain x where xL: "\<forall>y\<in>L. y < x" and xU: "\<forall>y\<in>U. x < y" by blast
+  {fix l u assume l: "l \<in> L" and u: "u \<in> U"
+    have "l < x" using xL l by blast
+    also have "x < u" using xU u by blast
+    finally (less_trans) have "l < u" .}
+  thus "\<forall>l\<in>L. \<forall>u\<in>U. l < u" by blast
+next
+  assume H: "\<forall>l\<in>L. \<forall>u\<in>U. l < u"
+  let ?ML = "Max L"
+  let ?MU = "Min U"  
+  from fL ne have th1: "?ML \<in> L" and th1': "\<forall>l\<in>L. l \<le> ?ML" by auto
+  from fU neU have th2: "?MU \<in> U" and th2': "\<forall>u\<in>U. ?MU \<le> u" by auto
+  from th1 th2 H have "?ML < ?MU" by auto
+  with dense obtain w where th3: "?ML < w" and th4: "w < ?MU" by blast
+  from th3 th1' have "\<forall>l \<in> L. l < w" by auto
+  moreover from th4 th2' have "\<forall>u \<in> U. w < u" by auto
+  ultimately show "\<exists>x. (\<forall>y\<in>L. y < x) \<and> (\<forall>y\<in>U. x < y)" by auto
+qed
+
+lemma dlo_qe_noub: 
+  assumes ne: "L \<noteq> {}" and fL: "finite L"
+  shows "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> {}. x < y)) \<equiv> True"
+proof(simp add: atomize_eq)
+  from gt_ex[of "Max L"] obtain M where M: "Max L < M" by blast
+  from ne fL have "\<forall>x \<in> L. x \<le> Max L" by simp
+  with M have "\<forall>x\<in>L. x < M" by (auto intro: le_less_trans)
+  thus "\<exists>x. \<forall>y\<in>L. y < x" by blast
+qed
+
+lemma dlo_qe_nolb: 
+  assumes ne: "U \<noteq> {}" and fU: "finite U"
+  shows "(\<exists>x. (\<forall>y \<in> {}. y < x) \<and> (\<forall>y \<in> U. x < y)) \<equiv> True"
+proof(simp add: atomize_eq)
+  from lt_ex[of "Min U"] obtain M where M: "M < Min U" by blast
+  from ne fU have "\<forall>x \<in> U. Min U \<le> x" by simp
+  with M have "\<forall>x\<in>U. M < x" by (auto intro: less_le_trans)
+  thus "\<exists>x. \<forall>y\<in>U. x < y" by blast
+qed
+
+lemma exists_neq: "\<exists>(x::'a). x \<noteq> t" "\<exists>(x::'a). t \<noteq> x" 
+  using gt_ex[of t] by auto
+
+lemmas dlo_simps = order_refl less_irrefl not_less not_le exists_neq 
+  le_less neq_iff linear less_not_permute
+
+lemma axiom: "dense_linear_order (op \<le>) (op <)" by (rule dense_linear_order_axioms)
+lemma atoms:
+  shows "TERM (less :: 'a \<Rightarrow> _)"
+    and "TERM (less_eq :: 'a \<Rightarrow> _)"
+    and "TERM (op = :: 'a \<Rightarrow> _)" .
+
+declare axiom[langford qe: dlo_qe_bnds dlo_qe_nolb dlo_qe_noub gather: gather_start gather_simps atoms: atoms]
+declare dlo_simps[langfordsimp]
+
+end
+
+(* FIXME: Move to HOL -- together with the conj_aci_rule in langford.ML *)
+lemma dnf:
+  "(P & (Q | R)) = ((P&Q) | (P&R))" 
+  "((Q | R) & P) = ((Q&P) | (R&P))"
+  by blast+
+
+lemmas weak_dnf_simps = simp_thms dnf
+
+lemma nnf_simps:
+    "(\<not>(P \<and> Q)) = (\<not>P \<or> \<not>Q)" "(\<not>(P \<or> Q)) = (\<not>P \<and> \<not>Q)" "(P \<longrightarrow> Q) = (\<not>P \<or> Q)"
+    "(P = Q) = ((P \<and> Q) \<or> (\<not>P \<and> \<not> Q))" "(\<not> \<not>(P)) = P"
+  by blast+
+
+lemma ex_distrib: "(\<exists>x. P x \<or> Q x) \<longleftrightarrow> ((\<exists>x. P x) \<or> (\<exists>x. Q x))" by blast
+
+lemmas dnf_simps = weak_dnf_simps nnf_simps ex_distrib
+
+use "~~/src/HOL/Tools/Qelim/langford.ML"
+method_setup dlo = {*
+  Method.ctxt_args (Method.SIMPLE_METHOD' o LangfordQE.dlo_tac)
+*} "Langford's algorithm for quantifier elimination in dense linear orders"
+
+
+section {* Contructive dense linear orders yield QE for linear arithmetic over ordered Fields -- see @{text "Arith_Tools.thy"} *}
+
+text {* Linear order without upper bounds *}
+
+class_locale linorder_stupid_syntax = linorder
+begin
+notation
+  less_eq  ("op \<sqsubseteq>") and
+  less_eq  ("(_/ \<sqsubseteq> _)" [51, 51] 50) and
+  less  ("op \<sqsubset>") and
+  less  ("(_/ \<sqsubset> _)"  [51, 51] 50)
+
+end
+
+class_locale linorder_no_ub = linorder_stupid_syntax +
+  assumes gt_ex: "\<exists>y. less x y"
+begin
+lemma ge_ex: "\<exists>y. x \<sqsubseteq> y" using gt_ex by auto
+
+text {* Theorems for @{text "\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>+\<infinity>\<^esub>)"} *}
+lemma pinf_conj:
+  assumes ex1: "\<exists>z1. \<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
+  and ex2: "\<exists>z2. \<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
+  shows "\<exists>z. \<forall>x. z \<sqsubset>  x \<longrightarrow> ((P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2'))"
+proof-
+  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
+     and z2: "\<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
+  from gt_ex obtain z where z:"ord.max less_eq z1 z2 \<sqsubset> z" by blast
+  from z have zz1: "z1 \<sqsubset> z" and zz2: "z2 \<sqsubset> z" by simp_all
+  {fix x assume H: "z \<sqsubset> x"
+    from less_trans[OF zz1 H] less_trans[OF zz2 H]
+    have "(P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2')"  using z1 zz1 z2 zz2 by auto
+  }
+  thus ?thesis by blast
+qed
+
+lemma pinf_disj:
+  assumes ex1: "\<exists>z1. \<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
+  and ex2: "\<exists>z2. \<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
+  shows "\<exists>z. \<forall>x. z \<sqsubset>  x \<longrightarrow> ((P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2'))"
+proof-
+  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
+     and z2: "\<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
+  from gt_ex obtain z where z:"ord.max less_eq z1 z2 \<sqsubset> z" by blast
+  from z have zz1: "z1 \<sqsubset> z" and zz2: "z2 \<sqsubset> z" by simp_all
+  {fix x assume H: "z \<sqsubset> x"
+    from less_trans[OF zz1 H] less_trans[OF zz2 H]
+    have "(P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2')"  using z1 zz1 z2 zz2 by auto
+  }
+  thus ?thesis by blast
+qed
+
+lemma pinf_ex: assumes ex:"\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P1)" and p1: P1 shows "\<exists> x. P x"
+proof-
+  from ex obtain z where z: "\<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P1)" by blast
+  from gt_ex obtain x where x: "z \<sqsubset> x" by blast
+  from z x p1 show ?thesis by blast
+qed
+
+end
+
+text {* Linear order without upper bounds *}
+
+class_locale linorder_no_lb = linorder_stupid_syntax +
+  assumes lt_ex: "\<exists>y. less y x"
+begin
+lemma le_ex: "\<exists>y. y \<sqsubseteq> x" using lt_ex by auto
+
+
+text {* Theorems for @{text "\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>-\<infinity>\<^esub>)"} *}
+lemma minf_conj:
+  assumes ex1: "\<exists>z1. \<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
+  and ex2: "\<exists>z2. \<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
+  shows "\<exists>z. \<forall>x. x \<sqsubset>  z \<longrightarrow> ((P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2'))"
+proof-
+  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"and z2: "\<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
+  from lt_ex obtain z where z:"z \<sqsubset> ord.min less_eq z1 z2" by blast
+  from z have zz1: "z \<sqsubset> z1" and zz2: "z \<sqsubset> z2" by simp_all
+  {fix x assume H: "x \<sqsubset> z"
+    from less_trans[OF H zz1] less_trans[OF H zz2]
+    have "(P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2')"  using z1 zz1 z2 zz2 by auto
+  }
+  thus ?thesis by blast
+qed
+
+lemma minf_disj:
+  assumes ex1: "\<exists>z1. \<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
+  and ex2: "\<exists>z2. \<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
+  shows "\<exists>z. \<forall>x. x \<sqsubset>  z \<longrightarrow> ((P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2'))"
+proof-
+  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"and z2: "\<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
+  from lt_ex obtain z where z:"z \<sqsubset> ord.min less_eq z1 z2" by blast
+  from z have zz1: "z \<sqsubset> z1" and zz2: "z \<sqsubset> z2" by simp_all
+  {fix x assume H: "x \<sqsubset> z"
+    from less_trans[OF H zz1] less_trans[OF H zz2]
+    have "(P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2')"  using z1 zz1 z2 zz2 by auto
+  }
+  thus ?thesis by blast
+qed
+
+lemma minf_ex: assumes ex:"\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P1)" and p1: P1 shows "\<exists> x. P x"
+proof-
+  from ex obtain z where z: "\<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P1)" by blast
+  from lt_ex obtain x where x: "x \<sqsubset> z" by blast
+  from z x p1 show ?thesis by blast
+qed
+
+end
+
+
+class_locale constr_dense_linear_order = linorder_no_lb + linorder_no_ub +
+  fixes between
+  assumes between_less: "less x y \<Longrightarrow> less x (between x y) \<and> less (between x y) y"
+     and  between_same: "between x x = x"
+
+class_interpretation  constr_dense_linear_order < dense_linear_order 
+  apply unfold_locales
+  using gt_ex lt_ex between_less
+    by (auto, rule_tac x="between x y" in exI, simp)
+
+context  constr_dense_linear_order
+begin
+
+lemma rinf_U:
+  assumes fU: "finite U"
+  and lin_dense: "\<forall>x l u. (\<forall> t. l \<sqsubset> t \<and> t\<sqsubset> u \<longrightarrow> t \<notin> U) \<and> l\<sqsubset> x \<and> x \<sqsubset> u \<and> P x
+  \<longrightarrow> (\<forall> y. l \<sqsubset> y \<and> y \<sqsubset> u \<longrightarrow> P y )"
+  and nmpiU: "\<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u')"
+  and nmi: "\<not> MP"  and npi: "\<not> PP"  and ex: "\<exists> x.  P x"
+  shows "\<exists> u\<in> U. \<exists> u' \<in> U. P (between u u')"
+proof-
+  from ex obtain x where px: "P x" by blast
+  from px nmi npi nmpiU have "\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u'" by auto
+  then obtain u and u' where uU:"u\<in> U" and uU': "u' \<in> U" and ux:"u \<sqsubseteq> x" and xu':"x \<sqsubseteq> u'" by auto
+  from uU have Une: "U \<noteq> {}" by auto
+  term "linorder.Min less_eq"
+  let ?l = "linorder.Min less_eq U"
+  let ?u = "linorder.Max less_eq U"
+  have linM: "?l \<in> U" using fU Une by simp
+  have uinM: "?u \<in> U" using fU Une by simp
+  have lM: "\<forall> t\<in> U. ?l \<sqsubseteq> t" using Une fU by auto
+  have Mu: "\<forall> t\<in> U. t \<sqsubseteq> ?u" using Une fU by auto
+  have th:"?l \<sqsubseteq> u" using uU Une lM by auto
+  from order_trans[OF th ux] have lx: "?l \<sqsubseteq> x" .
+  have th: "u' \<sqsubseteq> ?u" using uU' Une Mu by simp
+  from order_trans[OF xu' th] have xu: "x \<sqsubseteq> ?u" .
+  from finite_set_intervals2[where P="P",OF px lx xu linM uinM fU lM Mu]
+  have "(\<exists> s\<in> U. P s) \<or>
+      (\<exists> t1\<in> U. \<exists> t2 \<in> U. (\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U) \<and> t1 \<sqsubset> x \<and> x \<sqsubset> t2 \<and> P x)" .
+  moreover { fix u assume um: "u\<in>U" and pu: "P u"
+    have "between u u = u" by (simp add: between_same)
+    with um pu have "P (between u u)" by simp
+    with um have ?thesis by blast}
+  moreover{
+    assume "\<exists> t1\<in> U. \<exists> t2 \<in> U. (\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U) \<and> t1 \<sqsubset> x \<and> x \<sqsubset> t2 \<and> P x"
+      then obtain t1 and t2 where t1M: "t1 \<in> U" and t2M: "t2\<in> U"
+        and noM: "\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U" and t1x: "t1 \<sqsubset> x" and xt2: "x \<sqsubset> t2" and px: "P x"
+        by blast
+      from less_trans[OF t1x xt2] have t1t2: "t1 \<sqsubset> t2" .
+      let ?u = "between t1 t2"
+      from between_less t1t2 have t1lu: "t1 \<sqsubset> ?u" and ut2: "?u \<sqsubset> t2" by auto
+      from lin_dense noM t1x xt2 px t1lu ut2 have "P ?u" by blast
+      with t1M t2M have ?thesis by blast}
+    ultimately show ?thesis by blast
+  qed
+
+theorem fr_eq:
+  assumes fU: "finite U"
+  and lin_dense: "\<forall>x l u. (\<forall> t. l \<sqsubset> t \<and> t\<sqsubset> u \<longrightarrow> t \<notin> U) \<and> l\<sqsubset> x \<and> x \<sqsubset> u \<and> P x
+   \<longrightarrow> (\<forall> y. l \<sqsubset> y \<and> y \<sqsubset> u \<longrightarrow> P y )"
+  and nmibnd: "\<forall>x. \<not> MP \<and> P x \<longrightarrow> (\<exists> u\<in> U. u \<sqsubseteq> x)"
+  and npibnd: "\<forall>x. \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. x \<sqsubseteq> u)"
+  and mi: "\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x = MP)"  and pi: "\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x = PP)"
+  shows "(\<exists> x. P x) \<equiv> (MP \<or> PP \<or> (\<exists> u \<in> U. \<exists> u'\<in> U. P (between u u')))"
+  (is "_ \<equiv> (_ \<or> _ \<or> ?F)" is "?E \<equiv> ?D")
+proof-
+ {
+   assume px: "\<exists> x. P x"
+   have "MP \<or> PP \<or> (\<not> MP \<and> \<not> PP)" by blast
+   moreover {assume "MP \<or> PP" hence "?D" by blast}
+   moreover {assume nmi: "\<not> MP" and npi: "\<not> PP"
+     from npmibnd[OF nmibnd npibnd]
+     have nmpiU: "\<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u')" .
+     from rinf_U[OF fU lin_dense nmpiU nmi npi px] have "?D" by blast}
+   ultimately have "?D" by blast}
+ moreover
+ { assume "?D"
+   moreover {assume m:"MP" from minf_ex[OF mi m] have "?E" .}
+   moreover {assume p: "PP" from pinf_ex[OF pi p] have "?E" . }
+   moreover {assume f:"?F" hence "?E" by blast}
+   ultimately have "?E" by blast}
+ ultimately have "?E = ?D" by blast thus "?E \<equiv> ?D" by simp
+qed
+
+lemmas minf_thms = minf_conj minf_disj minf_eq minf_neq minf_lt minf_le minf_gt minf_ge minf_P
+lemmas pinf_thms = pinf_conj pinf_disj pinf_eq pinf_neq pinf_lt pinf_le pinf_gt pinf_ge pinf_P
+
+lemmas nmi_thms = nmi_conj nmi_disj nmi_eq nmi_neq nmi_lt nmi_le nmi_gt nmi_ge nmi_P
+lemmas npi_thms = npi_conj npi_disj npi_eq npi_neq npi_lt npi_le npi_gt npi_ge npi_P
+lemmas lin_dense_thms = lin_dense_conj lin_dense_disj lin_dense_eq lin_dense_neq lin_dense_lt lin_dense_le lin_dense_gt lin_dense_ge lin_dense_P
+
+lemma ferrack_axiom: "constr_dense_linear_order less_eq less between"
+  by (rule constr_dense_linear_order_axioms)
+lemma atoms:
+  shows "TERM (less :: 'a \<Rightarrow> _)"
+    and "TERM (less_eq :: 'a \<Rightarrow> _)"
+    and "TERM (op = :: 'a \<Rightarrow> _)" .
+
+declare ferrack_axiom [ferrack minf: minf_thms pinf: pinf_thms
+    nmi: nmi_thms npi: npi_thms lindense:
+    lin_dense_thms qe: fr_eq atoms: atoms]
+
+declaration {*
+let
+fun simps phi = map (Morphism.thm phi) [@{thm "not_less"}, @{thm "not_le"}]
+fun generic_whatis phi =
+ let
+  val [lt, le] = map (Morphism.term phi) [@{term "op \<sqsubset>"}, @{term "op \<sqsubseteq>"}]
+  fun h x t =
+   case term_of t of
+     Const("op =", _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
+                            else Ferrante_Rackoff_Data.Nox
+   | @{term "Not"}$(Const("op =", _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
+                            else Ferrante_Rackoff_Data.Nox
+   | b$y$z => if Term.could_unify (b, lt) then
+                 if term_of x aconv y then Ferrante_Rackoff_Data.Lt
+                 else if term_of x aconv z then Ferrante_Rackoff_Data.Gt
+                 else Ferrante_Rackoff_Data.Nox
+             else if Term.could_unify (b, le) then
+                 if term_of x aconv y then Ferrante_Rackoff_Data.Le
+                 else if term_of x aconv z then Ferrante_Rackoff_Data.Ge
+                 else Ferrante_Rackoff_Data.Nox
+             else Ferrante_Rackoff_Data.Nox
+   | _ => Ferrante_Rackoff_Data.Nox
+ in h end
+ fun ss phi = HOL_ss addsimps (simps phi)
+in
+ Ferrante_Rackoff_Data.funs  @{thm "ferrack_axiom"}
+  {isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss}
+end
+*}
+
+end
+
+use "~~/src/HOL/Tools/Qelim/ferrante_rackoff.ML"
+
+method_setup ferrack = {*
+  Method.ctxt_args (Method.SIMPLE_METHOD' o FerranteRackoff.dlo_tac)
+*} "Ferrante and Rackoff's algorithm for quantifier elimination in dense linear orders"
+
+subsection {* Ferrante and Rackoff algorithm over ordered fields *}
+
+lemma neg_prod_lt:"(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x < 0) == (x > 0))"
+proof-
+  assume H: "c < 0"
+  have "c*x < 0 = (0/c < x)" by (simp only: neg_divide_less_eq[OF H] ring_simps)
+  also have "\<dots> = (0 < x)" by simp
+  finally show  "(c*x < 0) == (x > 0)" by simp
+qed
+
+lemma pos_prod_lt:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x < 0) == (x < 0))"
+proof-
+  assume H: "c > 0"
+  hence "c*x < 0 = (0/c > x)" by (simp only: pos_less_divide_eq[OF H] ring_simps)
+  also have "\<dots> = (0 > x)" by simp
+  finally show  "(c*x < 0) == (x < 0)" by simp
+qed
+
+lemma neg_prod_sum_lt: "(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x + t< 0) == (x > (- 1/c)*t))"
+proof-
+  assume H: "c < 0"
+  have "c*x + t< 0 = (c*x < -t)" by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp)
+  also have "\<dots> = (-t/c < x)" by (simp only: neg_divide_less_eq[OF H] ring_simps)
+  also have "\<dots> = ((- 1/c)*t < x)" by simp
+  finally show  "(c*x + t < 0) == (x > (- 1/c)*t)" by simp
+qed
+
+lemma pos_prod_sum_lt:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x + t < 0) == (x < (- 1/c)*t))"
+proof-
+  assume H: "c > 0"
+  have "c*x + t< 0 = (c*x < -t)"  by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp)
+  also have "\<dots> = (-t/c > x)" by (simp only: pos_less_divide_eq[OF H] ring_simps)
+  also have "\<dots> = ((- 1/c)*t > x)" by simp
+  finally show  "(c*x + t < 0) == (x < (- 1/c)*t)" by simp
+qed
+
+lemma sum_lt:"((x::'a::pordered_ab_group_add) + t < 0) == (x < - t)"
+  using less_diff_eq[where a= x and b=t and c=0] by simp
+
+lemma neg_prod_le:"(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x <= 0) == (x >= 0))"
+proof-
+  assume H: "c < 0"
+  have "c*x <= 0 = (0/c <= x)" by (simp only: neg_divide_le_eq[OF H] ring_simps)
+  also have "\<dots> = (0 <= x)" by simp
+  finally show  "(c*x <= 0) == (x >= 0)" by simp
+qed
+
+lemma pos_prod_le:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x <= 0) == (x <= 0))"
+proof-
+  assume H: "c > 0"
+  hence "c*x <= 0 = (0/c >= x)" by (simp only: pos_le_divide_eq[OF H] ring_simps)
+  also have "\<dots> = (0 >= x)" by simp
+  finally show  "(c*x <= 0) == (x <= 0)" by simp
+qed
+
+lemma neg_prod_sum_le: "(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x + t <= 0) == (x >= (- 1/c)*t))"
+proof-
+  assume H: "c < 0"
+  have "c*x + t <= 0 = (c*x <= -t)"  by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp)
+  also have "\<dots> = (-t/c <= x)" by (simp only: neg_divide_le_eq[OF H] ring_simps)
+  also have "\<dots> = ((- 1/c)*t <= x)" by simp
+  finally show  "(c*x + t <= 0) == (x >= (- 1/c)*t)" by simp
+qed
+
+lemma pos_prod_sum_le:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x + t <= 0) == (x <= (- 1/c)*t))"
+proof-
+  assume H: "c > 0"
+  have "c*x + t <= 0 = (c*x <= -t)" by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp)
+  also have "\<dots> = (-t/c >= x)" by (simp only: pos_le_divide_eq[OF H] ring_simps)
+  also have "\<dots> = ((- 1/c)*t >= x)" by simp
+  finally show  "(c*x + t <= 0) == (x <= (- 1/c)*t)" by simp
+qed
+
+lemma sum_le:"((x::'a::pordered_ab_group_add) + t <= 0) == (x <= - t)"
+  using le_diff_eq[where a= x and b=t and c=0] by simp
+
+lemma nz_prod_eq:"(c\<Colon>'a\<Colon>ordered_field) \<noteq> 0 \<Longrightarrow> ((c*x = 0) == (x = 0))" by simp
+lemma nz_prod_sum_eq: "(c\<Colon>'a\<Colon>ordered_field) \<noteq> 0 \<Longrightarrow> ((c*x + t = 0) == (x = (- 1/c)*t))"
+proof-
+  assume H: "c \<noteq> 0"
+  have "c*x + t = 0 = (c*x = -t)" by (subst eq_iff_diff_eq_0 [of "c*x" "-t"], simp)
+  also have "\<dots> = (x = -t/c)" by (simp only: nonzero_eq_divide_eq[OF H] ring_simps)
+  finally show  "(c*x + t = 0) == (x = (- 1/c)*t)" by simp
+qed
+lemma sum_eq:"((x::'a::pordered_ab_group_add) + t = 0) == (x = - t)"
+  using eq_diff_eq[where a= x and b=t and c=0] by simp
+
+
+class_interpretation class_ordered_field_dense_linear_order: constr_dense_linear_order
+ ["op <=" "op <"
+   "\<lambda> x y. 1/2 * ((x::'a::{ordered_field,recpower,number_ring}) + y)"]
+proof (unfold_locales, dlo, dlo, auto)
+  fix x y::'a assume lt: "x < y"
+  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
+next
+  fix x y::'a assume lt: "x < y"
+  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
+qed
+
+declaration{*
+let
+fun earlier [] x y = false
+        | earlier (h::t) x y =
+    if h aconvc y then false else if h aconvc x then true else earlier t x y;
+
+fun dest_frac ct = case term_of ct of
+   Const (@{const_name "HOL.divide"},_) $ a $ b=>
+    Rat.rat_of_quotient (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b))
+ | t => Rat.rat_of_int (snd (HOLogic.dest_number t))
+
+fun mk_frac phi cT x =
+ let val (a, b) = Rat.quotient_of_rat x
+ in if b = 1 then Numeral.mk_cnumber cT a
+    else Thm.capply
+         (Thm.capply (Drule.cterm_rule (instantiate' [SOME cT] []) @{cpat "op /"})
+                     (Numeral.mk_cnumber cT a))
+         (Numeral.mk_cnumber cT b)
+ end
+
+fun whatis x ct = case term_of ct of
+  Const(@{const_name "HOL.plus"}, _)$(Const(@{const_name "HOL.times"},_)$_$y)$_ =>
+     if y aconv term_of x then ("c*x+t",[(funpow 2 Thm.dest_arg1) ct, Thm.dest_arg ct])
+     else ("Nox",[])
+| Const(@{const_name "HOL.plus"}, _)$y$_ =>
+     if y aconv term_of x then ("x+t",[Thm.dest_arg ct])
+     else ("Nox",[])
+| Const(@{const_name "HOL.times"}, _)$_$y =>
+     if y aconv term_of x then ("c*x",[Thm.dest_arg1 ct])
+     else ("Nox",[])
+| t => if t aconv term_of x then ("x",[]) else ("Nox",[]);
+
+fun xnormalize_conv ctxt [] ct = reflexive ct
+| xnormalize_conv ctxt (vs as (x::_)) ct =
+   case term_of ct of
+   Const(@{const_name HOL.less},_)$_$Const(@{const_name "HOL.zero"},_) =>
+    (case whatis x (Thm.dest_arg1 ct) of
+    ("c*x+t",[c,t]) =>
+       let
+        val cr = dest_frac c
+        val clt = Thm.dest_fun2 ct
+        val cz = Thm.dest_arg ct
+        val neg = cr </ Rat.zero
+        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
+               (Thm.capply @{cterm "Trueprop"}
+                  (if neg then Thm.capply (Thm.capply clt c) cz
+                    else Thm.capply (Thm.capply clt cz) c))
+        val cth = equal_elim (symmetric cthp) TrueI
+        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x,t])
+             (if neg then @{thm neg_prod_sum_lt} else @{thm pos_prod_sum_lt})) cth
+        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
+                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
+      in rth end
+    | ("x+t",[t]) =>
+       let
+        val T = ctyp_of_term x
+        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_lt"}
+        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
+              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
+       in  rth end
+    | ("c*x",[c]) =>
+       let
+        val cr = dest_frac c
+        val clt = Thm.dest_fun2 ct
+        val cz = Thm.dest_arg ct
+        val neg = cr </ Rat.zero
+        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
+               (Thm.capply @{cterm "Trueprop"}
+                  (if neg then Thm.capply (Thm.capply clt c) cz
+                    else Thm.capply (Thm.capply clt cz) c))
+        val cth = equal_elim (symmetric cthp) TrueI
+        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x])
+             (if neg then @{thm neg_prod_lt} else @{thm pos_prod_lt})) cth
+        val rth = th
+      in rth end
+    | _ => reflexive ct)
+
+
+|  Const(@{const_name HOL.less_eq},_)$_$Const(@{const_name "HOL.zero"},_) =>
+   (case whatis x (Thm.dest_arg1 ct) of
+    ("c*x+t",[c,t]) =>
+       let
+        val T = ctyp_of_term x
+        val cr = dest_frac c
+        val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
+        val cz = Thm.dest_arg ct
+        val neg = cr </ Rat.zero
+        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
+               (Thm.capply @{cterm "Trueprop"}
+                  (if neg then Thm.capply (Thm.capply clt c) cz
+                    else Thm.capply (Thm.capply clt cz) c))
+        val cth = equal_elim (symmetric cthp) TrueI
+        val th = implies_elim (instantiate' [SOME T] (map SOME [c,x,t])
+             (if neg then @{thm neg_prod_sum_le} else @{thm pos_prod_sum_le})) cth
+        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
+                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
+      in rth end
+    | ("x+t",[t]) =>
+       let
+        val T = ctyp_of_term x
+        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_le"}
+        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
+              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
+       in  rth end
+    | ("c*x",[c]) =>
+       let
+        val T = ctyp_of_term x
+        val cr = dest_frac c
+        val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
+        val cz = Thm.dest_arg ct
+        val neg = cr </ Rat.zero
+        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
+               (Thm.capply @{cterm "Trueprop"}
+                  (if neg then Thm.capply (Thm.capply clt c) cz
+                    else Thm.capply (Thm.capply clt cz) c))
+        val cth = equal_elim (symmetric cthp) TrueI
+        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x])
+             (if neg then @{thm neg_prod_le} else @{thm pos_prod_le})) cth
+        val rth = th
+      in rth end
+    | _ => reflexive ct)
+
+|  Const("op =",_)$_$Const(@{const_name "HOL.zero"},_) =>
+   (case whatis x (Thm.dest_arg1 ct) of
+    ("c*x+t",[c,t]) =>
+       let
+        val T = ctyp_of_term x
+        val cr = dest_frac c
+        val ceq = Thm.dest_fun2 ct
+        val cz = Thm.dest_arg ct
+        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
+            (Thm.capply @{cterm "Trueprop"}
+             (Thm.capply @{cterm "Not"} (Thm.capply (Thm.capply ceq c) cz)))
+        val cth = equal_elim (symmetric cthp) TrueI
+        val th = implies_elim
+                 (instantiate' [SOME T] (map SOME [c,x,t]) @{thm nz_prod_sum_eq}) cth
+        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
+                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
+      in rth end
+    | ("x+t",[t]) =>
+       let
+        val T = ctyp_of_term x
+        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_eq"}
+        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
+              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
+       in  rth end
+    | ("c*x",[c]) =>
+       let
+        val T = ctyp_of_term x
+        val cr = dest_frac c
+        val ceq = Thm.dest_fun2 ct
+        val cz = Thm.dest_arg ct
+        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
+            (Thm.capply @{cterm "Trueprop"}
+             (Thm.capply @{cterm "Not"} (Thm.capply (Thm.capply ceq c) cz)))
+        val cth = equal_elim (symmetric cthp) TrueI
+        val rth = implies_elim
+                 (instantiate' [SOME T] (map SOME [c,x]) @{thm nz_prod_eq}) cth
+      in rth end
+    | _ => reflexive ct);
+
+local
+  val less_iff_diff_less_0 = mk_meta_eq @{thm "less_iff_diff_less_0"}
+  val le_iff_diff_le_0 = mk_meta_eq @{thm "le_iff_diff_le_0"}
+  val eq_iff_diff_eq_0 = mk_meta_eq @{thm "eq_iff_diff_eq_0"}
+in
+fun field_isolate_conv phi ctxt vs ct = case term_of ct of
+  Const(@{const_name HOL.less},_)$a$b =>
+   let val (ca,cb) = Thm.dest_binop ct
+       val T = ctyp_of_term ca
+       val th = instantiate' [SOME T] [SOME ca, SOME cb] less_iff_diff_less_0
+       val nth = Conv.fconv_rule
+         (Conv.arg_conv (Conv.arg1_conv
+              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
+       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
+   in rth end
+| Const(@{const_name HOL.less_eq},_)$a$b =>
+   let val (ca,cb) = Thm.dest_binop ct
+       val T = ctyp_of_term ca
+       val th = instantiate' [SOME T] [SOME ca, SOME cb] le_iff_diff_le_0
+       val nth = Conv.fconv_rule
+         (Conv.arg_conv (Conv.arg1_conv
+              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
+       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
+   in rth end
+
+| Const("op =",_)$a$b =>
+   let val (ca,cb) = Thm.dest_binop ct
+       val T = ctyp_of_term ca
+       val th = instantiate' [SOME T] [SOME ca, SOME cb] eq_iff_diff_eq_0
+       val nth = Conv.fconv_rule
+         (Conv.arg_conv (Conv.arg1_conv
+              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
+       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
+   in rth end
+| @{term "Not"} $(Const("op =",_)$a$b) => Conv.arg_conv (field_isolate_conv phi ctxt vs) ct
+| _ => reflexive ct
+end;
+
+fun classfield_whatis phi =
+ let
+  fun h x t =
+   case term_of t of
+     Const("op =", _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
+                            else Ferrante_Rackoff_Data.Nox
+   | @{term "Not"}$(Const("op =", _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
+                            else Ferrante_Rackoff_Data.Nox
+   | Const(@{const_name HOL.less},_)$y$z =>
+       if term_of x aconv y then Ferrante_Rackoff_Data.Lt
+        else if term_of x aconv z then Ferrante_Rackoff_Data.Gt
+        else Ferrante_Rackoff_Data.Nox
+   | Const (@{const_name HOL.less_eq},_)$y$z =>
+         if term_of x aconv y then Ferrante_Rackoff_Data.Le
+         else if term_of x aconv z then Ferrante_Rackoff_Data.Ge
+         else Ferrante_Rackoff_Data.Nox
+   | _ => Ferrante_Rackoff_Data.Nox
+ in h end;
+fun class_field_ss phi =
+   HOL_basic_ss addsimps ([@{thm "linorder_not_less"}, @{thm "linorder_not_le"}])
+   addsplits [@{thm "abs_split"},@{thm "split_max"}, @{thm "split_min"}]
+
+in
+Ferrante_Rackoff_Data.funs @{thm "class_ordered_field_dense_linear_order.ferrack_axiom"}
+  {isolate_conv = field_isolate_conv, whatis = classfield_whatis, simpset = class_field_ss}
+end
+*}
+
+
+end 
--- a/src/HOL/Deriv.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/Deriv.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -20,12 +20,6 @@
           ("(DERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60) where
   "DERIV f x :> D = ((%h. (f(x + h) - f x) / h) -- 0 --> D)"
 
-definition
-  differentiable :: "['a::real_normed_field \<Rightarrow> 'a, 'a] \<Rightarrow> bool"
-    (infixl "differentiable" 60) where
-  "f differentiable x = (\<exists>D. DERIV f x :> D)"
-
-
 consts
   Bolzano_bisect :: "[real*real=>bool, real, real, nat] => (real*real)"
 primrec
@@ -316,63 +310,104 @@
 
 subsection {* Differentiability predicate *}
 
+definition
+  differentiable :: "['a::real_normed_field \<Rightarrow> 'a, 'a] \<Rightarrow> bool"
+    (infixl "differentiable" 60) where
+  "f differentiable x = (\<exists>D. DERIV f x :> D)"
+
+lemma differentiableE [elim?]:
+  assumes "f differentiable x"
+  obtains df where "DERIV f x :> df"
+  using prems unfolding differentiable_def ..
+
 lemma differentiableD: "f differentiable x ==> \<exists>D. DERIV f x :> D"
 by (simp add: differentiable_def)
 
 lemma differentiableI: "DERIV f x :> D ==> f differentiable x"
 by (force simp add: differentiable_def)
 
-lemma differentiable_const: "(\<lambda>z. a) differentiable x"
-  apply (unfold differentiable_def)
-  apply (rule_tac x=0 in exI)
-  apply simp
-  done
+lemma differentiable_ident [simp]: "(\<lambda>x. x) differentiable x"
+  by (rule DERIV_ident [THEN differentiableI])
+
+lemma differentiable_const [simp]: "(\<lambda>z. a) differentiable x"
+  by (rule DERIV_const [THEN differentiableI])
 
-lemma differentiable_sum:
+lemma differentiable_compose:
+  assumes f: "f differentiable (g x)"
+  assumes g: "g differentiable x"
+  shows "(\<lambda>x. f (g x)) differentiable x"
+proof -
+  from `f differentiable (g x)` obtain df where "DERIV f (g x) :> df" ..
+  moreover
+  from `g differentiable x` obtain dg where "DERIV g x :> dg" ..
+  ultimately
+  have "DERIV (\<lambda>x. f (g x)) x :> df * dg" by (rule DERIV_chain2)
+  thus ?thesis by (rule differentiableI)
+qed
+
+lemma differentiable_sum [simp]:
   assumes "f differentiable x"
   and "g differentiable x"
   shows "(\<lambda>x. f x + g x) differentiable x"
 proof -
-  from prems have "\<exists>D. DERIV f x :> D" by (unfold differentiable_def)
-  then obtain df where "DERIV f x :> df" ..
-  moreover from prems have "\<exists>D. DERIV g x :> D" by (unfold differentiable_def)
-  then obtain dg where "DERIV g x :> dg" ..
-  ultimately have "DERIV (\<lambda>x. f x + g x) x :> df + dg" by (rule DERIV_add)
-  hence "\<exists>D. DERIV (\<lambda>x. f x + g x) x :> D" by auto
-  thus ?thesis by (fold differentiable_def)
+  from `f differentiable x` obtain df where "DERIV f x :> df" ..
+  moreover
+  from `g differentiable x` obtain dg where "DERIV g x :> dg" ..
+  ultimately
+  have "DERIV (\<lambda>x. f x + g x) x :> df + dg" by (rule DERIV_add)
+  thus ?thesis by (rule differentiableI)
+qed
+
+lemma differentiable_minus [simp]:
+  assumes "f differentiable x"
+  shows "(\<lambda>x. - f x) differentiable x"
+proof -
+  from `f differentiable x` obtain df where "DERIV f x :> df" ..
+  hence "DERIV (\<lambda>x. - f x) x :> - df" by (rule DERIV_minus)
+  thus ?thesis by (rule differentiableI)
 qed
 
-lemma differentiable_diff:
+lemma differentiable_diff [simp]:
   assumes "f differentiable x"
-  and "g differentiable x"
+  assumes "g differentiable x"
   shows "(\<lambda>x. f x - g x) differentiable x"
+  unfolding diff_minus using prems by simp
+
+lemma differentiable_mult [simp]:
+  assumes "f differentiable x"
+  assumes "g differentiable x"
+  shows "(\<lambda>x. f x * g x) differentiable x"
 proof -
-  from prems have "f differentiable x" by simp
+  from `f differentiable x` obtain df where "DERIV f x :> df" ..
   moreover
-  from prems have "\<exists>D. DERIV g x :> D" by (unfold differentiable_def)
-  then obtain dg where "DERIV g x :> dg" ..
-  then have "DERIV (\<lambda>x. - g x) x :> -dg" by (rule DERIV_minus)
-  hence "\<exists>D. DERIV (\<lambda>x. - g x) x :> D" by auto
-  hence "(\<lambda>x. - g x) differentiable x" by (fold differentiable_def)
-  ultimately 
-  show ?thesis
-    by (auto simp: diff_def dest: differentiable_sum)
+  from `g differentiable x` obtain dg where "DERIV g x :> dg" ..
+  ultimately
+  have "DERIV (\<lambda>x. f x * g x) x :> df * g x + dg * f x" by (rule DERIV_mult)
+  thus ?thesis by (rule differentiableI)
 qed
 
-lemma differentiable_mult:
-  assumes "f differentiable x"
-  and "g differentiable x"
-  shows "(\<lambda>x. f x * g x) differentiable x"
+lemma differentiable_inverse [simp]:
+  assumes "f differentiable x" and "f x \<noteq> 0"
+  shows "(\<lambda>x. inverse (f x)) differentiable x"
 proof -
-  from prems have "\<exists>D. DERIV f x :> D" by (unfold differentiable_def)
-  then obtain df where "DERIV f x :> df" ..
-  moreover from prems have "\<exists>D. DERIV g x :> D" by (unfold differentiable_def)
-  then obtain dg where "DERIV g x :> dg" ..
-  ultimately have "DERIV (\<lambda>x. f x * g x) x :> df * g x + dg * f x" by (simp add: DERIV_mult)
-  hence "\<exists>D. DERIV (\<lambda>x. f x * g x) x :> D" by auto
-  thus ?thesis by (fold differentiable_def)
+  from `f differentiable x` obtain df where "DERIV f x :> df" ..
+  hence "DERIV (\<lambda>x. inverse (f x)) x :> - (inverse (f x) * df * inverse (f x))"
+    using `f x \<noteq> 0` by (rule DERIV_inverse')
+  thus ?thesis by (rule differentiableI)
 qed
 
+lemma differentiable_divide [simp]:
+  assumes "f differentiable x"
+  assumes "g differentiable x" and "g x \<noteq> 0"
+  shows "(\<lambda>x. f x / g x) differentiable x"
+  unfolding divide_inverse using prems by simp
+
+lemma differentiable_power [simp]:
+  fixes f :: "'a::{recpower,real_normed_field} \<Rightarrow> 'a"
+  assumes "f differentiable x"
+  shows "(\<lambda>x. f x ^ n) differentiable x"
+  by (induct n, simp, simp add: power_Suc prems)
+
 
 subsection {* Nested Intervals and Bisection *}
 
@@ -1722,4 +1757,60 @@
 apply (simp add: poly_entire del: pmult_Cons)
 done
 
+
+subsection {* Theorems about Limits *}
+
+(* need to rename second isCont_inverse *)
+
+lemma isCont_inv_fun:
+  fixes f g :: "real \<Rightarrow> real"
+  shows "[| 0 < d; \<forall>z. \<bar>z - x\<bar> \<le> d --> g(f(z)) = z;  
+         \<forall>z. \<bar>z - x\<bar> \<le> d --> isCont f z |]  
+      ==> isCont g (f x)"
+by (rule isCont_inverse_function)
+
+lemma isCont_inv_fun_inv:
+  fixes f g :: "real \<Rightarrow> real"
+  shows "[| 0 < d;  
+         \<forall>z. \<bar>z - x\<bar> \<le> d --> g(f(z)) = z;  
+         \<forall>z. \<bar>z - x\<bar> \<le> d --> isCont f z |]  
+       ==> \<exists>e. 0 < e &  
+             (\<forall>y. 0 < \<bar>y - f(x)\<bar> & \<bar>y - f(x)\<bar> < e --> f(g(y)) = y)"
+apply (drule isCont_inj_range)
+prefer 2 apply (assumption, assumption, auto)
+apply (rule_tac x = e in exI, auto)
+apply (rotate_tac 2)
+apply (drule_tac x = y in spec, auto)
+done
+
+
+text{*Bartle/Sherbert: Introduction to Real Analysis, Theorem 4.2.9, p. 110*}
+lemma LIM_fun_gt_zero:
+     "[| f -- c --> (l::real); 0 < l |]  
+         ==> \<exists>r. 0 < r & (\<forall>x::real. x \<noteq> c & \<bar>c - x\<bar> < r --> 0 < f x)"
+apply (auto simp add: LIM_def)
+apply (drule_tac x = "l/2" in spec, safe, force)
+apply (rule_tac x = s in exI)
+apply (auto simp only: abs_less_iff)
+done
+
+lemma LIM_fun_less_zero:
+     "[| f -- c --> (l::real); l < 0 |]  
+      ==> \<exists>r. 0 < r & (\<forall>x::real. x \<noteq> c & \<bar>c - x\<bar> < r --> f x < 0)"
+apply (auto simp add: LIM_def)
+apply (drule_tac x = "-l/2" in spec, safe, force)
+apply (rule_tac x = s in exI)
+apply (auto simp only: abs_less_iff)
+done
+
+
+lemma LIM_fun_not_zero:
+     "[| f -- c --> (l::real); l \<noteq> 0 |] 
+      ==> \<exists>r. 0 < r & (\<forall>x::real. x \<noteq> c & \<bar>c - x\<bar> < r --> f x \<noteq> 0)"
+apply (cut_tac x = l and y = 0 in linorder_less_linear, auto)
+apply (drule LIM_fun_less_zero)
+apply (drule_tac [3] LIM_fun_gt_zero)
+apply force+
+done
+
 end
--- a/src/HOL/Divides.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/Divides.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -127,7 +127,7 @@
   note that ultimately show thesis by blast
 qed
 
-lemma dvd_eq_mod_eq_0 [code]: "a dvd b \<longleftrightarrow> b mod a = 0"
+lemma dvd_eq_mod_eq_0 [code unfold]: "a dvd b \<longleftrightarrow> b mod a = 0"
 proof
   assume "b mod a = 0"
   with mod_div_equality [of b a] have "b div a * a = b" by simp
--- a/src/HOL/FunDef.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/FunDef.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -3,11 +3,13 @@
     Author:     Alexander Krauss, TU Muenchen
 *)
 
-header {* General recursive function definitions *}
+header {* Function Definitions and Termination Proofs *}
 
 theory FunDef
 imports Wellfounded
 uses
+  "Tools/prop_logic.ML"
+  "Tools/sat_solver.ML"
   ("Tools/function_package/fundef_lib.ML")
   ("Tools/function_package/fundef_common.ML")
   ("Tools/function_package/inductive_wrap.ML")
@@ -22,9 +24,14 @@
   ("Tools/function_package/lexicographic_order.ML")
   ("Tools/function_package/fundef_datatype.ML")
   ("Tools/function_package/induction_scheme.ML")
+  ("Tools/function_package/termination.ML")
+  ("Tools/function_package/decompose.ML")
+  ("Tools/function_package/descent.ML")
+  ("Tools/function_package/scnp_solve.ML")
+  ("Tools/function_package/scnp_reconstruct.ML")
 begin
 
-text {* Definitions with default value. *}
+subsection {* Definitions with default value. *}
 
 definition
   THE_default :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a" where
@@ -97,9 +104,6 @@
   "wf R \<Longrightarrow> wfP (in_rel R)"
   by (simp add: wfP_def)
 
-inductive is_measure :: "('a \<Rightarrow> nat) \<Rightarrow> bool"
-where is_measure_trivial: "is_measure f"
-
 use "Tools/function_package/fundef_lib.ML"
 use "Tools/function_package/fundef_common.ML"
 use "Tools/function_package/inductive_wrap.ML"
@@ -110,19 +114,37 @@
 use "Tools/function_package/pattern_split.ML"
 use "Tools/function_package/auto_term.ML"
 use "Tools/function_package/fundef_package.ML"
-use "Tools/function_package/measure_functions.ML"
-use "Tools/function_package/lexicographic_order.ML"
 use "Tools/function_package/fundef_datatype.ML"
 use "Tools/function_package/induction_scheme.ML"
 
 setup {* 
   FundefPackage.setup 
+  #> FundefDatatype.setup
   #> InductionScheme.setup
-  #> MeasureFunctions.setup
-  #> LexicographicOrder.setup 
-  #> FundefDatatype.setup
 *}
 
+subsection {* Measure Functions *}
+
+inductive is_measure :: "('a \<Rightarrow> nat) \<Rightarrow> bool"
+where is_measure_trivial: "is_measure f"
+
+use "Tools/function_package/measure_functions.ML"
+setup MeasureFunctions.setup
+
+lemma measure_size[measure_function]: "is_measure size"
+by (rule is_measure_trivial)
+
+lemma measure_fst[measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (fst p))"
+by (rule is_measure_trivial)
+lemma measure_snd[measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (snd p))"
+by (rule is_measure_trivial)
+
+use "Tools/function_package/lexicographic_order.ML"
+setup LexicographicOrder.setup 
+
+
+subsection {* Congruence Rules *}
+
 lemma let_cong [fundef_cong]:
   "M = N \<Longrightarrow> (\<And>x. x = N \<Longrightarrow> f x = g x) \<Longrightarrow> Let M f = Let N g"
   unfolding Let_def by blast
@@ -140,17 +162,7 @@
   "f (g x) = f' (g' x') \<Longrightarrow> (f o g) x = (f' o g') x'"
   unfolding o_apply .
 
-subsection {* Setup for termination proofs *}
-
-text {* Rules for generating measure functions *}
-
-lemma [measure_function]: "is_measure size"
-by (rule is_measure_trivial)
-
-lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (fst p))"
-by (rule is_measure_trivial)
-lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (snd p))"
-by (rule is_measure_trivial)
+subsection {* Simp rules for termination proofs *}
 
 lemma termination_basic_simps[termination_simp]:
   "x < (y::nat) \<Longrightarrow> x < y + z" 
@@ -166,5 +178,150 @@
   "prod_size f g p = f (fst p) + g (snd p) + Suc 0"
 by (induct p) auto
 
+subsection {* Decomposition *}
+
+lemma less_by_empty: 
+  "A = {} \<Longrightarrow> A \<subseteq> B"
+and  union_comp_emptyL:
+  "\<lbrakk> A O C = {}; B O C = {} \<rbrakk> \<Longrightarrow> (A \<union> B) O C = {}"
+and union_comp_emptyR:
+  "\<lbrakk> A O B = {}; A O C = {} \<rbrakk> \<Longrightarrow> A O (B \<union> C) = {}"
+and wf_no_loop: 
+  "R O R = {} \<Longrightarrow> wf R"
+by (auto simp add: wf_comp_self[of R])
+
+
+subsection {* Reduction Pairs *}
+
+definition
+  "reduction_pair P = (wf (fst P) \<and> snd P O fst P \<subseteq> fst P)"
+
+lemma reduction_pairI[intro]: "wf R \<Longrightarrow> S O R \<subseteq> R \<Longrightarrow> reduction_pair (R, S)"
+unfolding reduction_pair_def by auto
+
+lemma reduction_pair_lemma:
+  assumes rp: "reduction_pair P"
+  assumes "R \<subseteq> fst P"
+  assumes "S \<subseteq> snd P"
+  assumes "wf S"
+  shows "wf (R \<union> S)"
+proof -
+  from rp `S \<subseteq> snd P` have "wf (fst P)" "S O fst P \<subseteq> fst P"
+    unfolding reduction_pair_def by auto
+  with `wf S` have "wf (fst P \<union> S)" 
+    by (auto intro: wf_union_compatible)
+  moreover from `R \<subseteq> fst P` have "R \<union> S \<subseteq> fst P \<union> S" by auto
+  ultimately show ?thesis by (rule wf_subset) 
+qed
+
+definition
+  "rp_inv_image = (\<lambda>(R,S) f. (inv_image R f, inv_image S f))"
+
+lemma rp_inv_image_rp:
+  "reduction_pair P \<Longrightarrow> reduction_pair (rp_inv_image P f)"
+  unfolding reduction_pair_def rp_inv_image_def split_def
+  by force
+
+
+subsection {* Concrete orders for SCNP termination proofs *}
+
+definition "pair_less = less_than <*lex*> less_than"
+definition "pair_leq = pair_less^="
+definition "max_strict = max_ext pair_less"
+definition "max_weak = max_ext pair_leq \<union> {({}, {})}"
+definition "min_strict = min_ext pair_less"
+definition "min_weak = min_ext pair_leq \<union> {({}, {})}"
+
+lemma wf_pair_less[simp]: "wf pair_less"
+  by (auto simp: pair_less_def)
+
+text {* Introduction rules for @{text pair_less}/@{text pair_leq} *}
+lemma pair_leqI1: "a < b \<Longrightarrow> ((a, s), (b, t)) \<in> pair_leq"
+  and pair_leqI2: "a \<le> b \<Longrightarrow> s \<le> t \<Longrightarrow> ((a, s), (b, t)) \<in> pair_leq"
+  and pair_lessI1: "a < b  \<Longrightarrow> ((a, s), (b, t)) \<in> pair_less"
+  and pair_lessI2: "a \<le> b \<Longrightarrow> s < t \<Longrightarrow> ((a, s), (b, t)) \<in> pair_less"
+  unfolding pair_leq_def pair_less_def by auto
+
+text {* Introduction rules for max *}
+lemma smax_emptyI: 
+  "finite Y \<Longrightarrow> Y \<noteq> {} \<Longrightarrow> ({}, Y) \<in> max_strict" 
+  and smax_insertI: 
+  "\<lbrakk>y \<in> Y; (x, y) \<in> pair_less; (X, Y) \<in> max_strict\<rbrakk> \<Longrightarrow> (insert x X, Y) \<in> max_strict"
+  and wmax_emptyI: 
+  "finite X \<Longrightarrow> ({}, X) \<in> max_weak" 
+  and wmax_insertI:
+  "\<lbrakk>y \<in> YS; (x, y) \<in> pair_leq; (XS, YS) \<in> max_weak\<rbrakk> \<Longrightarrow> (insert x XS, YS) \<in> max_weak" 
+unfolding max_strict_def max_weak_def by (auto elim!: max_ext.cases)
+
+text {* Introduction rules for min *}
+lemma smin_emptyI: 
+  "X \<noteq> {} \<Longrightarrow> (X, {}) \<in> min_strict" 
+  and smin_insertI: 
+  "\<lbrakk>x \<in> XS; (x, y) \<in> pair_less; (XS, YS) \<in> min_strict\<rbrakk> \<Longrightarrow> (XS, insert y YS) \<in> min_strict"
+  and wmin_emptyI: 
+  "(X, {}) \<in> min_weak" 
+  and wmin_insertI: 
+  "\<lbrakk>x \<in> XS; (x, y) \<in> pair_leq; (XS, YS) \<in> min_weak\<rbrakk> \<Longrightarrow> (XS, insert y YS) \<in> min_weak" 
+by (auto simp: min_strict_def min_weak_def min_ext_def)
+
+text {* Reduction Pairs *}
+
+lemma max_ext_compat: 
+  assumes "S O R \<subseteq> R"
+  shows "(max_ext S \<union> {({},{})}) O max_ext R \<subseteq> max_ext R"
+using assms 
+apply auto
+apply (elim max_ext.cases)
+apply rule
+apply auto[3]
+apply (drule_tac x=xa in meta_spec)
+apply simp
+apply (erule bexE)
+apply (drule_tac x=xb in meta_spec)
+by auto
+
+lemma max_rpair_set: "reduction_pair (max_strict, max_weak)"
+  unfolding max_strict_def max_weak_def 
+apply (intro reduction_pairI max_ext_wf)
+apply simp
+apply (rule max_ext_compat)
+by (auto simp: pair_less_def pair_leq_def)
+
+lemma min_ext_compat: 
+  assumes "S O R \<subseteq> R"
+  shows "(min_ext S \<union> {({},{})}) O min_ext R \<subseteq> min_ext R"
+using assms 
+apply (auto simp: min_ext_def)
+apply (drule_tac x=ya in bspec, assumption)
+apply (erule bexE)
+apply (drule_tac x=xc in bspec)
+apply assumption
+by auto
+
+lemma min_rpair_set: "reduction_pair (min_strict, min_weak)"
+  unfolding min_strict_def min_weak_def 
+apply (intro reduction_pairI min_ext_wf)
+apply simp
+apply (rule min_ext_compat)
+by (auto simp: pair_less_def pair_leq_def)
+
+
+subsection {* Tool setup *}
+
+use "Tools/function_package/termination.ML"
+use "Tools/function_package/decompose.ML"
+use "Tools/function_package/descent.ML"
+use "Tools/function_package/scnp_solve.ML"
+use "Tools/function_package/scnp_reconstruct.ML"
+
+setup {* ScnpReconstruct.setup *}
+(*
+setup {*
+  Context.theory_map (FundefCommon.set_termination_prover (ScnpReconstruct.decomp_scnp 
+  [ScnpSolve.MAX, ScnpSolve.MIN, ScnpSolve.MS])) 
+*}
+*)
+
+
 
 end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Fundamental_Theorem_Algebra.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,1327 @@
+(* Author: Amine Chaieb, TU Muenchen *)
+
+header{*Fundamental Theorem of Algebra*}
+
+theory Fundamental_Theorem_Algebra
+imports Univ_Poly Dense_Linear_Order Complex
+begin
+
+subsection {* Square root of complex numbers *}
+definition csqrt :: "complex \<Rightarrow> complex" where
+"csqrt z = (if Im z = 0 then
+            if 0 \<le> Re z then Complex (sqrt(Re z)) 0
+            else Complex 0 (sqrt(- Re z))
+           else Complex (sqrt((cmod z + Re z) /2))
+                        ((Im z / abs(Im z)) * sqrt((cmod z - Re z) /2)))"
+
+lemma csqrt[algebra]: "csqrt z ^ 2 = z"
+proof-
+  obtain x y where xy: "z = Complex x y" by (cases z, simp_all)
+  {assume y0: "y = 0"
+    {assume x0: "x \<ge> 0" 
+      then have ?thesis using y0 xy real_sqrt_pow2[OF x0]
+	by (simp add: csqrt_def power2_eq_square)}
+    moreover
+    {assume "\<not> x \<ge> 0" hence x0: "- x \<ge> 0" by arith
+      then have ?thesis using y0 xy real_sqrt_pow2[OF x0] 
+	by (simp add: csqrt_def power2_eq_square) }
+    ultimately have ?thesis by blast}
+  moreover
+  {assume y0: "y\<noteq>0"
+    {fix x y
+      let ?z = "Complex x y"
+      from abs_Re_le_cmod[of ?z] have tha: "abs x \<le> cmod ?z" by auto
+      hence "cmod ?z - x \<ge> 0" "cmod ?z + x \<ge> 0" by arith+ 
+      hence "(sqrt (x * x + y * y) + x) / 2 \<ge> 0" "(sqrt (x * x + y * y) - x) / 2 \<ge> 0" by (simp_all add: power2_eq_square) }
+    note th = this
+    have sq4: "\<And>x::real. x^2 / 4 = (x / 2) ^ 2" 
+      by (simp add: power2_eq_square) 
+    from th[of x y]
+    have sq4': "sqrt (((sqrt (x * x + y * y) + x)^2 / 4)) = (sqrt (x * x + y * y) + x) / 2" "sqrt (((sqrt (x * x + y * y) - x)^2 / 4)) = (sqrt (x * x + y * y) - x) / 2" unfolding sq4 by simp_all
+    then have th1: "sqrt ((sqrt (x * x + y * y) + x) * (sqrt (x * x + y * y) + x) / 4) - sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) - x) / 4) = x"
+      unfolding power2_eq_square by simp 
+    have "sqrt 4 = sqrt (2^2)" by simp 
+    hence sqrt4: "sqrt 4 = 2" by (simp only: real_sqrt_abs)
+    have th2: "2 *(y * sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) + x) / 4)) / \<bar>y\<bar> = y"
+      using iffD2[OF real_sqrt_pow2_iff sum_power2_ge_zero[of x y]] y0
+      unfolding power2_eq_square 
+      by (simp add: ring_simps real_sqrt_divide sqrt4)
+     from y0 xy have ?thesis  apply (simp add: csqrt_def power2_eq_square)
+       apply (simp add: real_sqrt_sum_squares_mult_ge_zero[of x y] real_sqrt_pow2[OF th(1)[of x y], unfolded power2_eq_square] real_sqrt_pow2[OF th(2)[of x y], unfolded power2_eq_square] real_sqrt_mult[symmetric])
+      using th1 th2  ..}
+  ultimately show ?thesis by blast
+qed
+
+
+subsection{* More lemmas about module of complex numbers *}
+
+lemma complex_of_real_power: "complex_of_real x ^ n = complex_of_real (x^n)"
+  by (rule of_real_power [symmetric])
+
+lemma real_down2: "(0::real) < d1 \<Longrightarrow> 0 < d2 ==> EX e. 0 < e & e < d1 & e < d2"
+  apply ferrack apply arith done
+
+text{* The triangle inequality for cmod *}
+lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
+  using complex_mod_triangle_ineq2[of "w + z" "-z"] by auto
+
+subsection{* Basic lemmas about complex polynomials *}
+
+lemma poly_bound_exists:
+  shows "\<exists>m. m > 0 \<and> (\<forall>z. cmod z <= r \<longrightarrow> cmod (poly p z) \<le> m)"
+proof(induct p)
+  case Nil thus ?case by (rule exI[where x=1], simp) 
+next
+  case (Cons c cs)
+  from Cons.hyps obtain m where m: "\<forall>z. cmod z \<le> r \<longrightarrow> cmod (poly cs z) \<le> m"
+    by blast
+  let ?k = " 1 + cmod c + \<bar>r * m\<bar>"
+  have kp: "?k > 0" using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
+  {fix z
+    assume H: "cmod z \<le> r"
+    from m H have th: "cmod (poly cs z) \<le> m" by blast
+    from H have rp: "r \<ge> 0" using norm_ge_zero[of z] by arith
+    have "cmod (poly (c # cs) z) \<le> cmod c + cmod (z* poly cs z)"
+      using norm_triangle_ineq[of c "z* poly cs z"] by simp
+    also have "\<dots> \<le> cmod c + r*m" using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]] by (simp add: norm_mult)
+    also have "\<dots> \<le> ?k" by simp
+    finally have "cmod (poly (c # cs) z) \<le> ?k" .}
+  with kp show ?case by blast
+qed
+
+
+text{* Offsetting the variable in a polynomial gives another of same degree *}
+  (* FIXME : Lemma holds also in locale --- fix it later *)
+lemma  poly_offset_lemma:
+  shows "\<exists>b q. (length q = length p) \<and> (\<forall>x. poly (b#q) (x::complex) = (a + x) * poly p x)"
+proof(induct p)
+  case Nil thus ?case by simp
+next
+  case (Cons c cs)
+  from Cons.hyps obtain b q where 
+    bq: "length q = length cs" "\<forall>x. poly (b # q) x = (a + x) * poly cs x"
+    by blast
+  let ?b = "a*c"
+  let ?q = "(b+c)#q"
+  have lg: "length ?q = length (c#cs)" using bq(1) by simp
+  {fix x
+    from bq(2)[rule_format, of x]
+    have "x*poly (b # q) x = x*((a + x) * poly cs x)" by simp
+    hence "poly (?b# ?q) x = (a + x) * poly (c # cs) x"
+      by (simp add: ring_simps)}
+  with lg  show ?case by blast 
+qed
+
+    (* FIXME : This one too*)
+lemma poly_offset: "\<exists> q. length q = length p \<and> (\<forall>x. poly q (x::complex) = poly p (a + x))"
+proof (induct p)
+  case Nil thus ?case by simp
+next
+  case (Cons c cs)
+  from Cons.hyps obtain q where q: "length q = length cs" "\<forall>x. poly q x = poly cs (a + x)" by blast
+  from poly_offset_lemma[of q a] obtain b p where 
+    bp: "length p = length q" "\<forall>x. poly (b # p) x = (a + x) * poly q x"
+    by blast
+  thus ?case using q bp by - (rule exI[where x="(c + b)#p"], simp)
+qed
+
+text{* An alternative useful formulation of completeness of the reals *}
+lemma real_sup_exists: assumes ex: "\<exists>x. P x" and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
+  shows "\<exists>(s::real). \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
+proof-
+  from ex bz obtain x Y where x: "P x" and Y: "\<And>x. P x \<Longrightarrow> x < Y"  by blast
+  from ex have thx:"\<exists>x. x \<in> Collect P" by blast
+  from bz have thY: "\<exists>Y. isUb UNIV (Collect P) Y" 
+    by(auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def order_le_less)
+  from reals_complete[OF thx thY] obtain L where L: "isLub UNIV (Collect P) L"
+    by blast
+  from Y[OF x] have xY: "x < Y" .
+  from L have L': "\<forall>x. P x \<longrightarrow> x \<le> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)  
+  from Y have Y': "\<forall>x. P x \<longrightarrow> x \<le> Y" 
+    apply (clarsimp, atomize (full)) by auto 
+  from L Y' have "L \<le> Y" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)
+  {fix y
+    {fix z assume z: "P z" "y < z"
+      from L' z have "y < L" by auto }
+    moreover
+    {assume yL: "y < L" "\<forall>z. P z \<longrightarrow> \<not> y < z"
+      hence nox: "\<forall>z. P z \<longrightarrow> y \<ge> z" by auto
+      from nox L have "y \<ge> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def) 
+      with yL(1) have False  by arith}
+    ultimately have "(\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < L" by blast}
+  thus ?thesis by blast
+qed
+
+
+subsection{* Some theorems about Sequences*}
+text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
+
+lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
+  unfolding Ex1_def
+  apply (rule_tac x="nat_rec e f" in exI)
+  apply (rule conjI)+
+apply (rule def_nat_rec_0, simp)
+apply (rule allI, rule def_nat_rec_Suc, simp)
+apply (rule allI, rule impI, rule ext)
+apply (erule conjE)
+apply (induct_tac x)
+apply (simp add: nat_rec_0)
+apply (erule_tac x="n" in allE)
+apply (simp)
+done
+
+ text{* An equivalent formulation of monotony -- Not used here, but might be useful *}
+lemma mono_Suc: "mono f = (\<forall>n. (f n :: 'a :: order) \<le> f (Suc n))"
+unfolding mono_def
+proof auto
+  fix A B :: nat
+  assume H: "\<forall>n. f n \<le> f (Suc n)" "A \<le> B"
+  hence "\<exists>k. B = A + k" apply -  apply (thin_tac "\<forall>n. f n \<le> f (Suc n)") 
+    by presburger
+  then obtain k where k: "B = A + k" by blast
+  {fix a k
+    have "f a \<le> f (a + k)"
+    proof (induct k)
+      case 0 thus ?case by simp
+    next
+      case (Suc k)
+      from Suc.hyps H(1)[rule_format, of "a + k"] show ?case by simp
+    qed}
+  with k show "f A \<le> f B" by blast
+qed
+
+text{* for any sequence, there is a mootonic subsequence *}
+lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
+proof-
+  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
+    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
+    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
+    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
+    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
+      using H apply - 
+      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
+      unfolding order_le_less by blast 
+    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
+    {fix n
+      have "?P (f (Suc n)) (f n)" 
+	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
+	using H apply - 
+      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
+      unfolding order_le_less by blast 
+    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
+  note fSuc = this
+    {fix p q assume pq: "p \<ge> f q"
+      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
+	by (cases q, simp_all) }
+    note pqth = this
+    {fix q
+      have "f (Suc q) > f q" apply (induct q) 
+	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
+    note fss = this
+    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
+    {fix a b 
+      have "f a \<le> f (a + b)"
+      proof(induct b)
+	case 0 thus ?case by simp
+      next
+	case (Suc b)
+	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
+      qed}
+    note fmon0 = this
+    have "monoseq (\<lambda>n. s (f n))" 
+    proof-
+      {fix n
+	have "s (f n) \<ge> s (f (Suc n))" 
+	proof(cases n)
+	  case 0
+	  assume n0: "n = 0"
+	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
+	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
+	next
+	  case (Suc m)
+	  assume m: "n = Suc m"
+	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
+	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
+	qed}
+      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
+    qed
+    with th1 have ?thesis by blast}
+  moreover
+  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
+    {fix p assume p: "p \<ge> Suc N" 
+      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
+      have "m \<noteq> p" using m(2) by auto 
+      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
+    note th0 = this
+    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
+    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
+    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
+      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
+    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
+      using N apply - 
+      apply (erule allE[where x="Suc N"], clarsimp)
+      apply (rule_tac x="m" in exI)
+      apply auto
+      apply (subgoal_tac "Suc N \<noteq> m")
+      apply simp
+      apply (rule ccontr, simp)
+      done
+    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
+    {fix n
+      have "f n > N \<and> ?P (f (Suc n)) (f n)"
+	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
+      proof (induct n)
+	case 0 thus ?case
+	  using f0 N apply auto 
+	  apply (erule allE[where x="f 0"], clarsimp) 
+	  apply (rule_tac x="m" in exI, simp)
+	  by (subgoal_tac "f 0 \<noteq> m", auto)
+      next
+	case (Suc n)
+	from Suc.hyps have Nfn: "N < f n" by blast
+	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
+	with Nfn have mN: "m > N" by arith
+	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
+	
+	from key have th0: "f (Suc n) > N" by simp
+	from N[rule_format, OF th0]
+	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
+	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
+	hence "m' > f (Suc n)" using m'(1) by simp
+	with key m'(2) show ?case by auto
+      qed}
+    note fSuc = this
+    {fix n
+      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
+      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
+    note thf = this
+    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
+    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
+      apply -
+      apply (rule disjI1)
+      apply auto
+      apply (rule order_less_imp_le)
+      apply blast
+      done
+    then have ?thesis  using sqf by blast}
+  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
+qed
+
+lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
+proof(induct n)
+  case 0 thus ?case by simp
+next
+  case (Suc n)
+  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
+  have "n < f (Suc n)" by arith 
+  thus ?case by arith
+qed
+
+subsection {* Fundamental theorem of algebra *}
+lemma  unimodular_reduce_norm:
+  assumes md: "cmod z = 1"
+  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + ii) < 1 \<or> cmod (z - ii) < 1"
+proof-
+  obtain x y where z: "z = Complex x y " by (cases z, auto)
+  from md z have xy: "x^2 + y^2 = 1" by (simp add: cmod_def)
+  {assume C: "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + ii) \<ge> 1" "cmod (z - ii) \<ge> 1"
+    from C z xy have "2*x \<le> 1" "2*x \<ge> -1" "2*y \<le> 1" "2*y \<ge> -1"
+      by (simp_all add: cmod_def power2_eq_square ring_simps)
+    hence "abs (2*x) \<le> 1" "abs (2*y) \<le> 1" by simp_all
+    hence "(abs (2 * x))^2 <= 1^2" "(abs (2 * y)) ^2 <= 1^2"
+      by - (rule power_mono, simp, simp)+
+    hence th0: "4*x^2 \<le> 1" "4*y^2 \<le> 1" 
+      by (simp_all  add: power2_abs power_mult_distrib)
+    from add_mono[OF th0] xy have False by simp }
+  thus ?thesis unfolding linorder_not_le[symmetric] by blast
+qed
+
+text{* Hence we can always reduce modulus of @{text "1 + b z^n"} if nonzero *}
+lemma reduce_poly_simple:
+ assumes b: "b \<noteq> 0" and n: "n\<noteq>0"
+  shows "\<exists>z. cmod (1 + b * z^n) < 1"
+using n
+proof(induct n rule: nat_less_induct)
+  fix n
+  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)" and n: "n \<noteq> 0"
+  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
+  {assume e: "even n"
+    hence "\<exists>m. n = 2*m" by presburger
+    then obtain m where m: "n = 2*m" by blast
+    from n m have "m\<noteq>0" "m < n" by presburger+
+    with IH[rule_format, of m] obtain z where z: "?P z m" by blast
+    from z have "?P (csqrt z) n" by (simp add: m power_mult csqrt)
+    hence "\<exists>z. ?P z n" ..}
+  moreover
+  {assume o: "odd n"
+    from b have b': "b^2 \<noteq> 0" unfolding power2_eq_square by simp
+    have "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
+    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) = 
+    ((Re (inverse b))^2 + (Im (inverse b))^2) * \<bar>Im b * Im b + Re b * Re b\<bar>" by algebra
+    also have "\<dots> = cmod (inverse b) ^2 * cmod b ^ 2" 
+      apply (simp add: cmod_def) using realpow_two_le_add_order[of "Re b" "Im b"]
+      by (simp add: power2_eq_square)
+    finally 
+    have th0: "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
+    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) =
+    1" 
+      apply (simp add: power2_eq_square norm_mult[symmetric] norm_inverse[symmetric])
+      using right_inverse[OF b']
+      by (simp add: power2_eq_square[symmetric] power_inverse[symmetric] ring_simps)
+    have th0: "cmod (complex_of_real (cmod b) / b) = 1"
+      apply (simp add: complex_Re_mult cmod_def power2_eq_square Re_complex_of_real Im_complex_of_real divide_inverse ring_simps )
+      by (simp add: real_sqrt_mult[symmetric] th0)        
+    from o have "\<exists>m. n = Suc (2*m)" by presburger+
+    then obtain m where m: "n = Suc (2*m)" by blast
+    from unimodular_reduce_norm[OF th0] o
+    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
+      apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
+      apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp add: diff_def)
+      apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
+      apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
+      apply (rule_tac x="- ii" in exI, simp add: m power_mult)
+      apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult diff_def)
+      apply (rule_tac x="ii" in exI, simp add: m power_mult diff_def)
+      done
+    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
+    let ?w = "v / complex_of_real (root n (cmod b))"
+    from odd_real_root_pow[OF o, of "cmod b"]
+    have th1: "?w ^ n = v^n / complex_of_real (cmod b)" 
+      by (simp add: power_divide complex_of_real_power)
+    have th2:"cmod (complex_of_real (cmod b) / b) = 1" using b by (simp add: norm_divide)
+    hence th3: "cmod (complex_of_real (cmod b) / b) \<ge> 0" by simp
+    have th4: "cmod (complex_of_real (cmod b) / b) *
+   cmod (1 + b * (v ^ n / complex_of_real (cmod b)))
+   < cmod (complex_of_real (cmod b) / b) * 1"
+      apply (simp only: norm_mult[symmetric] right_distrib)
+      using b v by (simp add: th2)
+
+    from mult_less_imp_less_left[OF th4 th3]
+    have "?P ?w n" unfolding th1 . 
+    hence "\<exists>z. ?P z n" .. }
+  ultimately show "\<exists>z. ?P z n" by blast
+qed
+
+
+text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
+
+lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
+  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y" ]
+  unfolding cmod_def by simp
+
+lemma bolzano_weierstrass_complex_disc:
+  assumes r: "\<forall>n. cmod (s n) \<le> r"
+  shows "\<exists>f z. subseq f \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
+proof-
+  from seq_monosub[of "Re o s"] 
+  obtain f g where f: "subseq f" "monoseq (\<lambda>n. Re (s (f n)))" 
+    unfolding o_def by blast
+  from seq_monosub[of "Im o s o f"] 
+  obtain g where g: "subseq g" "monoseq (\<lambda>n. Im (s(f(g n))))" unfolding o_def by blast  
+  let ?h = "f o g"
+  from r[rule_format, of 0] have rp: "r \<ge> 0" using norm_ge_zero[of "s 0"] by arith 
+  have th:"\<forall>n. r + 1 \<ge> \<bar> Re (s n)\<bar>" 
+  proof
+    fix n
+    from abs_Re_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Re (s n)\<bar> \<le> r + 1" by arith
+  qed
+  have conv1: "convergent (\<lambda>n. Re (s ( f n)))"
+    apply (rule Bseq_monoseq_convergent)
+    apply (simp add: Bseq_def)
+    apply (rule exI[where x= "r + 1"])
+    using th rp apply simp
+    using f(2) .
+  have th:"\<forall>n. r + 1 \<ge> \<bar> Im (s n)\<bar>" 
+  proof
+    fix n
+    from abs_Im_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Im (s n)\<bar> \<le> r + 1" by arith
+  qed
+
+  have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
+    apply (rule Bseq_monoseq_convergent)
+    apply (simp add: Bseq_def)
+    apply (rule exI[where x= "r + 1"])
+    using th rp apply simp
+    using g(2) .
+
+  from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\<lambda>n. Re (s (f n))) x" 
+    by blast 
+  hence  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Re (s (f n)) - x \<bar> < r" 
+    unfolding LIMSEQ_def real_norm_def .
+
+  from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\<lambda>n. Im (s (f (g n)))) y" 
+    by blast 
+  hence  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Im (s (f (g n))) - y \<bar> < r" 
+    unfolding LIMSEQ_def real_norm_def .
+  let ?w = "Complex x y"
+  from f(1) g(1) have hs: "subseq ?h" unfolding subseq_def by auto 
+  {fix e assume ep: "e > (0::real)"
+    hence e2: "e/2 > 0" by simp
+    from x[rule_format, OF e2] y[rule_format, OF e2]
+    obtain N1 N2 where N1: "\<forall>n\<ge>N1. \<bar>Re (s (f n)) - x\<bar> < e / 2" and N2: "\<forall>n\<ge>N2. \<bar>Im (s (f (g n))) - y\<bar> < e / 2" by blast
+    {fix n assume nN12: "n \<ge> N1 + N2"
+      hence nN1: "g n \<ge> N1" and nN2: "n \<ge> N2" using seq_suble[OF g(1), of n] by arith+
+      from add_strict_mono[OF N1[rule_format, OF nN1] N2[rule_format, OF nN2]]
+      have "cmod (s (?h n) - ?w) < e" 
+	using metric_bound_lemma[of "s (f (g n))" ?w] by simp }
+    hence "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" by blast }
+  with hs show ?thesis  by blast  
+qed
+
+text{* Polynomial is continuous. *}
+
+lemma poly_cont:
+  assumes ep: "e > 0" 
+  shows "\<exists>d >0. \<forall>w. 0 < cmod (w - z) \<and> cmod (w - z) < d \<longrightarrow> cmod (poly p w - poly p z) < e"
+proof-
+  from poly_offset[of p z] obtain q where q: "length q = length p" "\<And>x. poly q x = poly p (z + x)" by blast
+  {fix w
+    note q(2)[of "w - z", simplified]}
+  note th = this
+  show ?thesis unfolding th[symmetric]
+  proof(induct q)
+    case Nil thus ?case  using ep by auto
+  next
+    case (Cons c cs)
+    from poly_bound_exists[of 1 "cs"] 
+    obtain m where m: "m > 0" "\<And>z. cmod z \<le> 1 \<Longrightarrow> cmod (poly cs z) \<le> m" by blast
+    from ep m(1) have em0: "e/m > 0" by (simp add: field_simps)
+    have one0: "1 > (0::real)"  by arith
+    from real_lbound_gt_zero[OF one0 em0] 
+    obtain d where d: "d >0" "d < 1" "d < e / m" by blast
+    from d(1,3) m(1) have dm: "d*m > 0" "d*m < e" 
+      by (simp_all add: field_simps real_mult_order)
+    show ?case 
+      proof(rule ex_forward[OF real_lbound_gt_zero[OF one0 em0]], clarsimp simp add: norm_mult)
+	fix d w
+	assume H: "d > 0" "d < 1" "d < e/m" "w\<noteq>z" "cmod (w-z) < d"
+	hence d1: "cmod (w-z) \<le> 1" "d \<ge> 0" by simp_all
+	from H(3) m(1) have dme: "d*m < e" by (simp add: field_simps)
+	from H have th: "cmod (w-z) \<le> d" by simp 
+	from mult_mono[OF th m(2)[OF d1(1)] d1(2) norm_ge_zero] dme
+	show "cmod (w - z) * cmod (poly cs (w - z)) < e" by simp
+      qed  
+    qed
+qed
+
+text{* Hence a polynomial attains minimum on a closed disc 
+  in the complex plane. *}
+lemma  poly_minimum_modulus_disc:
+  "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
+proof-
+  {assume "\<not> r \<ge> 0" hence ?thesis unfolding linorder_not_le
+      apply -
+      apply (rule exI[where x=0]) 
+      apply auto
+      apply (subgoal_tac "cmod w < 0")
+      apply simp
+      apply arith
+      done }
+  moreover
+  {assume rp: "r \<ge> 0"
+    from rp have "cmod 0 \<le> r \<and> cmod (poly p 0) = - (- cmod (poly p 0))" by simp 
+    hence mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"  by blast
+    {fix x z
+      assume H: "cmod z \<le> r" "cmod (poly p z) = - x" "\<not>x < 1"
+      hence "- x < 0 " by arith
+      with H(2) norm_ge_zero[of "poly p z"]  have False by simp }
+    then have mth2: "\<exists>z. \<forall>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<longrightarrow> x < z" by blast
+    from real_sup_exists[OF mth1 mth2] obtain s where 
+      s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow>(y < s)" by blast
+    let ?m = "-s"
+    {fix y
+      from s[rule_format, of "-y"] have 
+    "(\<exists>z x. cmod z \<le> r \<and> -(- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" 
+	unfolding minus_less_iff[of y ] equation_minus_iff by blast }
+    note s1 = this[unfolded minus_minus]
+    from s1[of ?m] have s1m: "\<And>z x. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m" 
+      by auto
+    {fix n::nat
+      from s1[rule_format, of "?m + 1/real (Suc n)"] 
+      have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)"
+	by simp}
+    hence th: "\<forall>n. \<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" ..
+    from choice[OF th] obtain g where 
+      g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m+1 /real(Suc n)" 
+      by blast
+    from bolzano_weierstrass_complex_disc[OF g(1)] 
+    obtain f z where fz: "subseq f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
+      by blast    
+    {fix w 
+      assume wr: "cmod w \<le> r"
+      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
+      {assume e: "?e > 0"
+	hence e2: "?e/2 > 0" by simp
+	from poly_cont[OF e2, of z p] obtain d where
+	  d: "d>0" "\<forall>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2" by blast
+	{fix w assume w: "cmod (w - z) < d"
+	  have "cmod(poly p w - poly p z) < ?e / 2"
+	    using d(2)[rule_format, of w] w e by (cases "w=z", simp_all)}
+	note th1 = this
+	
+	from fz(2)[rule_format, OF d(1)] obtain N1 where 
+	  N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d" by blast
+	from reals_Archimedean2[of "2/?e"] obtain N2::nat where
+	  N2: "2/?e < real N2" by blast
+	have th2: "cmod(poly p (g(f(N1 + N2))) - poly p z) < ?e/2"
+	  using N1[rule_format, of "N1 + N2"] th1 by simp
+	{fix a b e2 m :: real
+	have "a < e2 \<Longrightarrow> abs(b - m) < e2 \<Longrightarrow> 2 * e2 <= abs(b - m) + a
+          ==> False" by arith}
+      note th0 = this
+      have ath: 
+	"\<And>m x e. m <= x \<Longrightarrow>  x < m + e ==> abs(x - m::real) < e" by arith
+      from s1m[OF g(1)[rule_format]]
+      have th31: "?m \<le> cmod(poly p (g (f (N1 + N2))))" .
+      from seq_suble[OF fz(1), of "N1+N2"]
+      have th00: "real (Suc (N1+N2)) \<le> real (Suc (f (N1+N2)))" by simp
+      have th000: "0 \<le> (1::real)" "(1::real) \<le> 1" "real (Suc (N1+N2)) > 0"  
+	using N2 by auto
+      from frac_le[OF th000 th00] have th00: "?m +1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))" by simp
+      from g(2)[rule_format, of "f (N1 + N2)"]
+      have th01:"cmod (poly p (g (f (N1 + N2)))) < - s + 1 / real (Suc (f (N1 + N2)))" .
+      from order_less_le_trans[OF th01 th00]
+      have th32: "cmod(poly p (g (f (N1 + N2)))) < ?m + (1/ real(Suc (N1 + N2)))" .
+      from N2 have "2/?e < real (Suc (N1 + N2))" by arith
+      with e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
+      have "?e/2 > 1/ real (Suc (N1 + N2))" by (simp add: inverse_eq_divide)
+      with ath[OF th31 th32]
+      have thc1:"\<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar>< ?e/2" by arith  
+      have ath2: "\<And>(a::real) b c m. \<bar>a - b\<bar> <= c ==> \<bar>b - m\<bar> <= \<bar>a - m\<bar> + c" 
+	by arith
+      have th22: "\<bar>cmod (poly p (g (f (N1 + N2)))) - cmod (poly p z)\<bar>
+\<le> cmod (poly p (g (f (N1 + N2))) - poly p z)" 
+	by (simp add: norm_triangle_ineq3)
+      from ath2[OF th22, of ?m]
+      have thc2: "2*(?e/2) \<le> \<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar> + cmod (poly p (g (f (N1 + N2))) - poly p z)" by simp
+      from th0[OF th2 thc1 thc2] have False .}
+      hence "?e = 0" by auto
+      then have "cmod (poly p z) = ?m" by simp  
+      with s1m[OF wr]
+      have "cmod (poly p z) \<le> cmod (poly p w)" by simp }
+    hence ?thesis by blast}
+  ultimately show ?thesis by blast
+qed
+
+lemma "(rcis (sqrt (abs r)) (a/2)) ^ 2 = rcis (abs r) a"
+  unfolding power2_eq_square
+  apply (simp add: rcis_mult)
+  apply (simp add: power2_eq_square[symmetric])
+  done
+
+lemma cispi: "cis pi = -1" 
+  unfolding cis_def
+  by simp
+
+lemma "(rcis (sqrt (abs r)) ((pi + a)/2)) ^ 2 = rcis (- abs r) a"
+  unfolding power2_eq_square
+  apply (simp add: rcis_mult add_divide_distrib)
+  apply (simp add: power2_eq_square[symmetric] rcis_def cispi cis_mult[symmetric])
+  done
+
+text {* Nonzero polynomial in z goes to infinity as z does. *}
+
+instance complex::idom_char_0 by (intro_classes)
+instance complex :: recpower_idom_char_0 by intro_classes
+
+lemma poly_infinity:
+  assumes ex: "list_ex (\<lambda>c. c \<noteq> 0) p"
+  shows "\<exists>r. \<forall>z. r \<le> cmod z \<longrightarrow> d \<le> cmod (poly (a#p) z)"
+using ex
+proof(induct p arbitrary: a d)
+  case (Cons c cs a d) 
+  {assume H: "list_ex (\<lambda>c. c\<noteq>0) cs"
+    with Cons.hyps obtain r where r: "\<forall>z. r \<le> cmod z \<longrightarrow> d + cmod a \<le> cmod (poly (c # cs) z)" by blast
+    let ?r = "1 + \<bar>r\<bar>"
+    {fix z assume h: "1 + \<bar>r\<bar> \<le> cmod z"
+      have r0: "r \<le> cmod z" using h by arith
+      from r[rule_format, OF r0]
+      have th0: "d + cmod a \<le> 1 * cmod(poly (c#cs) z)" by arith
+      from h have z1: "cmod z \<ge> 1" by arith
+      from order_trans[OF th0 mult_right_mono[OF z1 norm_ge_zero[of "poly (c#cs) z"]]]
+      have th1: "d \<le> cmod(z * poly (c#cs) z) - cmod a"
+	unfolding norm_mult by (simp add: ring_simps)
+      from complex_mod_triangle_sub[of "z * poly (c#cs) z" a]
+      have th2: "cmod(z * poly (c#cs) z) - cmod a \<le> cmod (poly (a#c#cs) z)" 
+	by (simp add: diff_le_eq ring_simps) 
+      from th1 th2 have "d \<le> cmod (poly (a#c#cs) z)"  by arith}
+    hence ?case by blast}
+  moreover
+  {assume cs0: "\<not> (list_ex (\<lambda>c. c \<noteq> 0) cs)"
+    with Cons.prems have c0: "c \<noteq> 0" by simp
+    from cs0 have cs0': "list_all (\<lambda>c. c = 0) cs" 
+      by (auto simp add: list_all_iff list_ex_iff)
+    {fix z
+      assume h: "(\<bar>d\<bar> + cmod a) / cmod c \<le> cmod z"
+      from c0 have "cmod c > 0" by simp
+      from h c0 have th0: "\<bar>d\<bar> + cmod a \<le> cmod (z*c)" 
+	by (simp add: field_simps norm_mult)
+      have ath: "\<And>mzh mazh ma. mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh" by arith
+      from complex_mod_triangle_sub[of "z*c" a ]
+      have th1: "cmod (z * c) \<le> cmod (a + z * c) + cmod a"
+	by (simp add: ring_simps)
+      from ath[OF th1 th0] have "d \<le> cmod (poly (a # c # cs) z)" 
+	using poly_0[OF cs0'] by simp}
+    then have ?case  by blast}
+  ultimately show ?case by blast
+qed simp
+
+text {* Hence polynomial's modulus attains its minimum somewhere. *}
+lemma poly_minimum_modulus:
+  "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
+proof(induct p)
+  case (Cons c cs) 
+  {assume cs0: "list_ex (\<lambda>c. c \<noteq> 0) cs"
+    from poly_infinity[OF cs0, of "cmod (poly (c#cs) 0)" c]
+    obtain r where r: "\<And>z. r \<le> cmod z \<Longrightarrow> cmod (poly (c # cs) 0) \<le> cmod (poly (c # cs) z)" by blast
+    have ath: "\<And>z r. r \<le> cmod z \<or> cmod z \<le> \<bar>r\<bar>" by arith
+    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "c#cs"] 
+    obtain v where v: "\<And>w. cmod w \<le> \<bar>r\<bar> \<Longrightarrow> cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) w)" by blast
+    {fix z assume z: "r \<le> cmod z"
+      from v[of 0] r[OF z] 
+      have "cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) z)"
+	by simp }
+    note v0 = this
+    from v0 v ath[of r] have ?case by blast}
+  moreover
+  {assume cs0: "\<not> (list_ex (\<lambda>c. c\<noteq>0) cs)"
+    hence th:"list_all (\<lambda>c. c = 0) cs" by (simp add: list_all_iff list_ex_iff)
+    from poly_0[OF th] Cons.hyps have ?case by simp}
+  ultimately show ?case by blast
+qed simp
+
+text{* Constant function (non-syntactic characterization). *}
+definition "constant f = (\<forall>x y. f x = f y)"
+
+lemma nonconstant_length: "\<not> (constant (poly p)) \<Longrightarrow> length p \<ge> 2"
+  unfolding constant_def
+  apply (induct p, auto)
+  apply (unfold not_less[symmetric])
+  apply simp
+  apply (rule ccontr)
+  apply auto
+  done
+ 
+lemma poly_replicate_append:
+  "poly ((replicate n 0)@p) (x::'a::{recpower, comm_ring}) = x^n * poly p x"
+  by(induct n, auto simp add: power_Suc ring_simps)
+
+text {* Decomposition of polynomial, skipping zero coefficients 
+  after the first.  *}
+
+lemma poly_decompose_lemma:
+ assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
+  shows "\<exists>k a q. a\<noteq>0 \<and> Suc (length q + k) = length p \<and> 
+                 (\<forall>z. poly p z = z^k * poly (a#q) z)"
+using nz
+proof(induct p)
+  case Nil thus ?case by simp
+next
+  case (Cons c cs)
+  {assume c0: "c = 0"
+    
+    from Cons.hyps Cons.prems c0 have ?case apply auto
+      apply (rule_tac x="k+1" in exI)
+      apply (rule_tac x="a" in exI, clarsimp)
+      apply (rule_tac x="q" in exI)
+      by (auto simp add: power_Suc)}
+  moreover
+  {assume c0: "c\<noteq>0"
+    hence ?case apply-
+      apply (rule exI[where x=0])
+      apply (rule exI[where x=c], clarsimp)
+      apply (rule exI[where x=cs])
+      apply auto
+      done}
+  ultimately show ?case by blast
+qed
+
+lemma poly_decompose:
+  assumes nc: "~constant(poly p)"
+  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
+               length q + k + 1 = length p \<and> 
+              (\<forall>z. poly p z = poly p 0 + z^k * poly (a#q) z)"
+using nc 
+proof(induct p)
+  case Nil thus ?case by (simp add: constant_def)
+next
+  case (Cons c cs)
+  {assume C:"\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0"
+    {fix x y
+      from C have "poly (c#cs) x = poly (c#cs) y" by (cases "x=0", auto)}
+    with Cons.prems have False by (auto simp add: constant_def)}
+  hence th: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)" ..
+  from poly_decompose_lemma[OF th] 
+  show ?case 
+    apply clarsimp    
+    apply (rule_tac x="k+1" in exI)
+    apply (rule_tac x="a" in exI)
+    apply simp
+    apply (rule_tac x="q" in exI)
+    apply (auto simp add: power_Suc)
+    done
+qed
+
+text{* Fundamental theorem of algebral *}
+
+lemma fundamental_theorem_of_algebra:
+  assumes nc: "~constant(poly p)"
+  shows "\<exists>z::complex. poly p z = 0"
+using nc
+proof(induct n\<equiv> "length p" arbitrary: p rule: nat_less_induct)
+  fix n fix p :: "complex list"
+  let ?p = "poly p"
+  assume H: "\<forall>m<n. \<forall>p. \<not> constant (poly p) \<longrightarrow> m = length p \<longrightarrow> (\<exists>(z::complex). poly p z = 0)" and nc: "\<not> constant ?p" and n: "n = length p"
+  let ?ths = "\<exists>z. ?p z = 0"
+
+  from nonconstant_length[OF nc] have n2: "n\<ge> 2" by (simp add: n)
+  from poly_minimum_modulus obtain c where 
+    c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)" by blast
+  {assume pc: "?p c = 0" hence ?ths by blast}
+  moreover
+  {assume pc0: "?p c \<noteq> 0"
+    from poly_offset[of p c] obtain q where
+      q: "length q = length p" "\<forall>x. poly q x = ?p (c+x)" by blast
+    {assume h: "constant (poly q)"
+      from q(2) have th: "\<forall>x. poly q (x - c) = ?p x" by auto
+      {fix x y
+	from th have "?p x = poly q (x - c)" by auto 
+	also have "\<dots> = poly q (y - c)" 
+	  using h unfolding constant_def by blast
+	also have "\<dots> = ?p y" using th by auto
+	finally have "?p x = ?p y" .}
+      with nc have False unfolding constant_def by blast }
+    hence qnc: "\<not> constant (poly q)" by blast
+    from q(2) have pqc0: "?p c = poly q 0" by simp
+    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)" by simp 
+    let ?a0 = "poly q 0"
+    from pc0 pqc0 have a00: "?a0 \<noteq> 0" by simp 
+    from a00 
+    have qr: "\<forall>z. poly q z = poly (map (op * (inverse ?a0)) q) z * ?a0"
+      by (simp add: poly_cmult_map)
+    let ?r = "map (op * (inverse ?a0)) q"
+    have lgqr: "length q = length ?r" by simp 
+    {assume h: "\<And>x y. poly ?r x = poly ?r y"
+      {fix x y
+	from qr[rule_format, of x] 
+	have "poly q x = poly ?r x * ?a0" by auto
+	also have "\<dots> = poly ?r y * ?a0" using h by simp
+	also have "\<dots> = poly q y" using qr[rule_format, of y] by simp
+	finally have "poly q x = poly q y" .} 
+      with qnc have False unfolding constant_def by blast}
+    hence rnc: "\<not> constant (poly ?r)" unfolding constant_def by blast
+    from qr[rule_format, of 0] a00  have r01: "poly ?r 0 = 1" by auto
+    {fix w 
+      have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w / ?a0) < 1"
+	using qr[rule_format, of w] a00 by simp
+      also have "\<dots> \<longleftrightarrow> cmod (poly q w) < cmod ?a0"
+	using a00 unfolding norm_divide by (simp add: field_simps)
+      finally have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" .}
+    note mrmq_eq = this
+    from poly_decompose[OF rnc] obtain k a s where 
+      kas: "a\<noteq>0" "k\<noteq>0" "length s + k + 1 = length ?r" 
+      "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (a#s) z" by blast
+    {assume "k + 1 = n"
+      with kas(3) lgqr[symmetric] q(1) n[symmetric] have s0:"s=[]" by auto
+      {fix w
+	have "cmod (poly ?r w) = cmod (1 + a * w ^ k)" 
+	  using kas(4)[rule_format, of w] s0 r01 by (simp add: ring_simps)}
+      note hth = this [symmetric]
+	from reduce_poly_simple[OF kas(1,2)] 
+      have "\<exists>w. cmod (poly ?r w) < 1" unfolding hth by blast}
+    moreover
+    {assume kn: "k+1 \<noteq> n"
+      from kn kas(3) q(1) n[symmetric] have k1n: "k + 1 < n" by simp
+      have th01: "\<not> constant (poly (1#((replicate (k - 1) 0)@[a])))" 
+	unfolding constant_def poly_Nil poly_Cons poly_replicate_append
+	using kas(1) apply simp 
+	by (rule exI[where x=0], rule exI[where x=1], simp)
+      from kas(2) have th02: "k+1 = length (1#((replicate (k - 1) 0)@[a]))" 
+	by simp
+      from H[rule_format, OF k1n th01 th02]
+      obtain w where w: "1 + w^k * a = 0"
+	unfolding poly_Nil poly_Cons poly_replicate_append
+	using kas(2) by (auto simp add: power_Suc[symmetric, of _ "k - Suc 0"] 
+	  mult_assoc[of _ _ a, symmetric])
+      from poly_bound_exists[of "cmod w" s] obtain m where 
+	m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
+      have w0: "w\<noteq>0" using kas(2) w by (auto simp add: power_0_left)
+      from w have "(1 + w ^ k * a) - 1 = 0 - 1" by simp
+      then have wm1: "w^k * a = - 1" by simp
+      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)" 
+	using norm_ge_zero[of w] w0 m(1)
+	  by (simp add: inverse_eq_divide zero_less_mult_iff)
+      with real_down2[OF zero_less_one] obtain t where
+	t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
+      let ?ct = "complex_of_real t"
+      let ?w = "?ct * w"
+      have "1 + ?w^k * (a + ?w * poly s ?w) = 1 + ?ct^k * (w^k * a) + ?w^k * ?w * poly s ?w" using kas(1) by (simp add: ring_simps power_mult_distrib)
+      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
+	unfolding wm1 by (simp)
+      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) = cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)" 
+	apply -
+	apply (rule cong[OF refl[of cmod]])
+	apply assumption
+	done
+      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"] 
+      have th11: "cmod (1 + ?w^k * (a + ?w * poly s ?w)) \<le> \<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w)" unfolding norm_of_real by simp 
+      have ath: "\<And>x (t::real). 0\<le> x \<Longrightarrow> x < t \<Longrightarrow> t\<le>1 \<Longrightarrow> \<bar>1 - t\<bar> + x < 1" by arith
+      have "t *cmod w \<le> 1 * cmod w" apply (rule mult_mono) using t(1,2) by auto
+      then have tw: "cmod ?w \<le> cmod w" using t(1) by (simp add: norm_mult) 
+      from t inv0 have "t* (cmod w ^ (k + 1) * m) < 1"
+	by (simp add: inverse_eq_divide field_simps)
+      with zero_less_power[OF t(1), of k] 
+      have th30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k * 1" 
+	apply - apply (rule mult_strict_left_mono) by simp_all
+      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k+1) * cmod (poly s ?w)))"  using w0 t(1)
+	by (simp add: ring_simps power_mult_distrib norm_of_real norm_power norm_mult)
+      then have "cmod (?w^k * ?w * poly s ?w) \<le> t^k * (t* (cmod w ^ (k + 1) * m))"
+	using t(1,2) m(2)[rule_format, OF tw] w0
+	apply (simp only: )
+	apply auto
+	apply (rule mult_mono, simp_all add: norm_ge_zero)+
+	apply (simp add: zero_le_mult_iff zero_le_power)
+	done
+      with th30 have th120: "cmod (?w^k * ?w * poly s ?w) < t^k" by simp 
+      from power_strict_mono[OF t(2), of k] t(1) kas(2) have th121: "t^k \<le> 1" 
+	by auto
+      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] th120 th121]
+      have th12: "\<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w) < 1" . 
+      from th11 th12
+      have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) < 1"  by arith 
+      then have "cmod (poly ?r ?w) < 1" 
+	unfolding kas(4)[rule_format, of ?w] r01 by simp 
+      then have "\<exists>w. cmod (poly ?r w) < 1" by blast}
+    ultimately have cr0_contr: "\<exists>w. cmod (poly ?r w) < 1" by blast
+    from cr0_contr cq0 q(2)
+    have ?ths unfolding mrmq_eq not_less[symmetric] by auto}
+  ultimately show ?ths by blast
+qed
+
+text {* Alternative version with a syntactic notion of constant polynomial. *}
+
+lemma fundamental_theorem_of_algebra_alt:
+  assumes nc: "~(\<exists>a l. a\<noteq> 0 \<and> list_all(\<lambda>b. b = 0) l \<and> p = a#l)"
+  shows "\<exists>z. poly p z = (0::complex)"
+using nc
+proof(induct p)
+  case (Cons c cs)
+  {assume "c=0" hence ?case by auto}
+  moreover
+  {assume c0: "c\<noteq>0"
+    {assume nc: "constant (poly (c#cs))"
+      from nc[unfolded constant_def, rule_format, of 0] 
+      have "\<forall>w. w \<noteq> 0 \<longrightarrow> poly cs w = 0" by auto 
+      hence "list_all (\<lambda>c. c=0) cs"
+	proof(induct cs)
+	  case (Cons d ds)
+	  {assume "d=0" hence ?case using Cons.prems Cons.hyps by simp}
+	  moreover
+	  {assume d0: "d\<noteq>0"
+	    from poly_bound_exists[of 1 ds] obtain m where 
+	      m: "m > 0" "\<forall>z. \<forall>z. cmod z \<le> 1 \<longrightarrow> cmod (poly ds z) \<le> m" by blast
+	    have dm: "cmod d / m > 0" using d0 m(1) by (simp add: field_simps)
+	    from real_down2[OF dm zero_less_one] obtain x where 
+	      x: "x > 0" "x < cmod d / m" "x < 1" by blast
+	    let ?x = "complex_of_real x"
+	    from x have cx: "?x \<noteq> 0"  "cmod ?x \<le> 1" by simp_all
+	    from Cons.prems[rule_format, OF cx(1)]
+	    have cth: "cmod (?x*poly ds ?x) = cmod d" by (simp add: eq_diff_eq[symmetric])
+	    from m(2)[rule_format, OF cx(2)] x(1)
+	    have th0: "cmod (?x*poly ds ?x) \<le> x*m"
+	      by (simp add: norm_mult)
+	    from x(2) m(1) have "x*m < cmod d" by (simp add: field_simps)
+	    with th0 have "cmod (?x*poly ds ?x) \<noteq> cmod d" by auto
+	    with cth  have ?case by blast}
+	  ultimately show ?case by blast 
+	qed simp}
+      then have nc: "\<not> constant (poly (c#cs))" using Cons.prems c0 
+	by blast
+      from fundamental_theorem_of_algebra[OF nc] have ?case .}
+  ultimately show ?case by blast  
+qed simp
+
+subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
+
+lemma nullstellensatz_lemma:
+  fixes p :: "complex list"
+  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
+  and "degree p = n" and "n \<noteq> 0"
+  shows "p divides (pexp q n)"
+using prems
+proof(induct n arbitrary: p q rule: nat_less_induct)
+  fix n::nat fix p q :: "complex list"
+  assume IH: "\<forall>m<n. \<forall>p q.
+                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
+                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p divides (q %^ m)"
+    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0" 
+    and dpn: "degree p = n" and n0: "n \<noteq> 0"
+  let ?ths = "p divides (q %^ n)"
+  {fix a assume a: "poly p a = 0"
+    {assume p0: "poly p = poly []" 
+      hence ?ths unfolding divides_def  using pq0 n0
+	apply - apply (rule exI[where x="[]"], rule ext)
+	by (auto simp add: poly_mult poly_exp)}
+    moreover
+    {assume p0: "poly p \<noteq> poly []" 
+      and oa: "order  a p \<noteq> 0"
+      from p0 have pne: "p \<noteq> []" by auto
+      let ?op = "order a p"
+      from p0 have ap: "([- a, 1] %^ ?op) divides p" 
+	"\<not> pexp [- a, 1] (Suc ?op) divides p" using order by blast+ 
+      note oop = order_degree[OF p0, unfolded dpn]
+      {assume q0: "q = []"
+	hence ?ths using n0 unfolding divides_def 
+	  apply simp
+	  apply (rule exI[where x="[]"], rule ext)
+	  by (simp add: divides_def poly_exp poly_mult)}
+      moreover
+      {assume q0: "q\<noteq>[]"
+	from pq0[rule_format, OF a, unfolded poly_linear_divides] q0
+	obtain r where r: "q = pmult [- a, 1] r" by blast
+	from ap[unfolded divides_def] obtain s where
+	  s: "poly p = poly (pmult (pexp [- a, 1] ?op) s)" by blast
+	have s0: "poly s \<noteq> poly []"
+	  using s p0 by (simp add: poly_entire)
+	hence pns0: "poly (pnormalize s) \<noteq> poly []" and sne: "s\<noteq>[]" by auto
+	{assume ds0: "degree s = 0"
+	  from ds0 pns0 have "\<exists>k. pnormalize s = [k]" unfolding degree_def 
+	    by (cases "pnormalize s", auto)
+	  then obtain k where kpn: "pnormalize s = [k]" by blast
+	  from pns0[unfolded poly_zero] kpn have k: "k \<noteq>0" "poly s = poly [k]"
+	    using poly_normalize[of s] by simp_all
+	  let ?w = "pmult (pmult [1/k] (pexp [-a,1] (n - ?op))) (pexp r n)"
+	  from k r s oop have "poly (pexp q n) = poly (pmult p ?w)"
+	    by - (rule ext, simp add: poly_mult poly_exp poly_cmult poly_add power_add[symmetric] ring_simps power_mult_distrib[symmetric])
+	  hence ?ths unfolding divides_def by blast}
+	moreover
+	{assume ds0: "degree s \<noteq> 0"
+	  from ds0 s0 dpn degree_unique[OF s, unfolded linear_pow_mul_degree] oa
+	    have dsn: "degree s < n" by auto 
+	    {fix x assume h: "poly s x = 0"
+	      {assume xa: "x = a"
+		from h[unfolded xa poly_linear_divides] sne obtain u where
+		  u: "s = pmult [- a, 1] u" by blast
+		have "poly p = poly (pmult (pexp [- a, 1] (Suc ?op)) u)"
+		  unfolding s u
+		  apply (rule ext)
+		  by (simp add: ring_simps power_mult_distrib[symmetric] poly_mult poly_cmult poly_add poly_exp)
+		with ap(2)[unfolded divides_def] have False by blast}
+	      note xa = this
+	      from h s have "poly p x = 0" by (simp add: poly_mult)
+	      with pq0 have "poly q x = 0" by blast
+	      with r xa have "poly r x = 0"
+		by (auto simp add: poly_mult poly_add poly_cmult eq_diff_eq[symmetric])}
+	    note impth = this
+	    from IH[rule_format, OF dsn, of s r] impth ds0
+	    have "s divides (pexp r (degree s))" by blast
+	    then obtain u where u: "poly (pexp r (degree s)) = poly (pmult s u)"
+	      unfolding divides_def by blast
+	    hence u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
+	      by (simp add: poly_mult[symmetric] poly_exp[symmetric])
+	    let ?w = "pmult (pmult u (pexp [-a,1] (n - ?op))) (pexp r (n - degree s))"
+	    from u' s r oop[of a] dsn have "poly (pexp q n) = poly (pmult p ?w)"
+	      apply - apply (rule ext)
+	      apply (simp only:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult ring_simps)
+	      
+	      apply (simp add:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult mult_assoc[symmetric])
+	      done
+	    hence ?ths unfolding divides_def by blast}
+      ultimately have ?ths by blast }
+      ultimately have ?ths by blast}
+    ultimately have ?ths using a order_root by blast}
+  moreover
+  {assume exa: "\<not> (\<exists>a. poly p a = 0)"
+    from fundamental_theorem_of_algebra_alt[of p] exa obtain c cs where
+      ccs: "c\<noteq>0" "list_all (\<lambda>c. c = 0) cs" "p = c#cs" by blast
+    
+    from poly_0[OF ccs(2)] ccs(3) 
+    have pp: "\<And>x. poly p x =  c" by simp
+    let ?w = "pmult [1/c] (pexp q n)"
+    from pp ccs(1) 
+    have "poly (pexp q n) = poly (pmult p ?w) "
+      apply - apply (rule ext)
+      unfolding poly_mult_assoc[symmetric] by (simp add: poly_mult)
+    hence ?ths unfolding divides_def by blast}
+  ultimately show ?ths by blast
+qed
+
+lemma nullstellensatz_univariate:
+  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> 
+    p divides (q %^ (degree p)) \<or> (poly p = poly [] \<and> poly q = poly [])"
+proof-
+  {assume pe: "poly p = poly []"
+    hence eq: "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> poly q = poly []"
+      apply auto
+      by (rule ext, simp)
+    {assume "p divides (pexp q (degree p))"
+      then obtain r where r: "poly (pexp q (degree p)) = poly (pmult p r)" 
+	unfolding divides_def by blast
+      from cong[OF r refl] pe degree_unique[OF pe]
+      have False by (simp add: poly_mult degree_def)}
+    with eq pe have ?thesis by blast}
+  moreover
+  {assume pe: "poly p \<noteq> poly []"
+    have p0: "poly [0] = poly []" by (rule ext, simp)
+    {assume dp: "degree p = 0"
+      then obtain k where "pnormalize p = [k]" using pe poly_normalize[of p]
+	unfolding degree_def by (cases "pnormalize p", auto)
+      hence k: "pnormalize p = [k]" "poly p = poly [k]" "k\<noteq>0"
+	using pe poly_normalize[of p] by (auto simp add: p0)
+      hence th1: "\<forall>x. poly p x \<noteq> 0" by simp
+      from k(2,3) dp have "poly (pexp q (degree p)) = poly (pmult p [1/k]) "
+	by - (rule ext, simp add: poly_mult poly_exp)
+      hence th2: "p divides (pexp q (degree p))" unfolding divides_def by blast
+      from th1 th2 pe have ?thesis by blast}
+    moreover
+    {assume dp: "degree p \<noteq> 0"
+      then obtain n where n: "degree p = Suc n " by (cases "degree p", auto)
+      {assume "p divides (pexp q (Suc n))"
+	then obtain u where u: "poly (pexp q (Suc n)) = poly (pmult p u)"
+	  unfolding divides_def by blast
+	hence u' :"\<And>x. poly (pexp q (Suc n)) x = poly (pmult p u) x" by simp_all
+	{fix x assume h: "poly p x = 0" "poly q x \<noteq> 0"
+	  hence "poly (pexp q (Suc n)) x \<noteq> 0" by (simp only: poly_exp) simp	  
+	  hence False using u' h(1) by (simp only: poly_mult poly_exp) simp}}
+	with n nullstellensatz_lemma[of p q "degree p"] dp 
+	have ?thesis by auto}
+    ultimately have ?thesis by blast}
+  ultimately show ?thesis by blast
+qed
+
+text{* Useful lemma *}
+
+lemma (in idom_char_0) constant_degree: "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
+proof
+  assume l: ?lhs
+  from l[unfolded constant_def, rule_format, of _ "zero"]
+  have th: "poly p = poly [poly p 0]" apply - by (rule ext, simp)
+  from degree_unique[OF th] show ?rhs by (simp add: degree_def)
+next
+  assume r: ?rhs
+  from r have "pnormalize p = [] \<or> (\<exists>k. pnormalize p = [k])"
+    unfolding degree_def by (cases "pnormalize p", auto)
+  then show ?lhs unfolding constant_def poly_normalize[of p, symmetric]
+    by (auto simp del: poly_normalize)
+qed
+
+(* It would be nicer to prove this without using algebraic closure...        *)
+
+lemma divides_degree_lemma: assumes dpn: "degree (p::complex list) = n"
+  shows "n \<le> degree (p *** q) \<or> poly (p *** q) = poly []"
+  using dpn
+proof(induct n arbitrary: p q)
+  case 0 thus ?case by simp
+next
+  case (Suc n p q)
+  from Suc.prems fundamental_theorem_of_algebra[of p] constant_degree[of p]
+  obtain a where a: "poly p a = 0" by auto
+  then obtain r where r: "p = pmult [-a, 1] r" unfolding poly_linear_divides
+    using Suc.prems by (auto simp add: degree_def)
+  {assume h: "poly (pmult r q) = poly []"
+    hence "poly (pmult p q) = poly []" using r
+      apply - apply (rule ext)  by (auto simp add: poly_entire poly_mult poly_add poly_cmult) hence ?case by blast}
+  moreover
+  {assume h: "poly (pmult r q) \<noteq> poly []" 
+    hence r0: "poly r \<noteq> poly []" and q0: "poly q \<noteq> poly []"
+      by (auto simp add: poly_entire)
+    have eq: "poly (pmult p q) = poly (pmult [-a, 1] (pmult r q))"
+      apply - apply (rule ext)
+      by (simp add: r poly_mult poly_add poly_cmult ring_simps)
+    from linear_mul_degree[OF h, of "- a"]
+    have dqe: "degree (pmult p q) = degree (pmult r q) + 1"
+      unfolding degree_unique[OF eq] .
+    from linear_mul_degree[OF r0, of "- a", unfolded r[symmetric]] r Suc.prems 
+    have dr: "degree r = n" by auto
+    from  Suc.hyps[OF dr, of q] have "Suc n \<le> degree (pmult p q)"
+      unfolding dqe using h by (auto simp del: poly.simps) 
+    hence ?case by blast}
+  ultimately show ?case by blast
+qed
+
+lemma divides_degree: assumes pq: "p divides (q:: complex list)"
+  shows "degree p \<le> degree q \<or> poly q = poly []"
+using pq  divides_degree_lemma[OF refl, of p]
+apply (auto simp add: divides_def poly_entire)
+apply atomize
+apply (erule_tac x="qa" in allE, auto)
+apply (subgoal_tac "degree q = degree (p *** qa)", simp)
+apply (rule degree_unique, simp)
+done
+
+(* Arithmetic operations on multivariate polynomials.                        *)
+
+lemma mpoly_base_conv: 
+  "(0::complex) \<equiv> poly [] x" "c \<equiv> poly [c] x" "x \<equiv> poly [0,1] x" by simp_all
+
+lemma mpoly_norm_conv: 
+  "poly [0] (x::complex) \<equiv> poly [] x" "poly [poly [] y] x \<equiv> poly [] x" by simp_all
+
+lemma mpoly_sub_conv: 
+  "poly p (x::complex) - poly q x \<equiv> poly p x + -1 * poly q x"
+  by (simp add: diff_def)
+
+lemma poly_pad_rule: "poly p x = 0 ==> poly (0#p) x = (0::complex)" by simp
+
+lemma poly_cancel_eq_conv: "p = (0::complex) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (q = 0) \<equiv> (a * q - b * p = 0)" apply (atomize (full)) by auto
+
+lemma resolve_eq_raw:  "poly [] x \<equiv> 0" "poly [c] x \<equiv> (c::complex)" by auto
+lemma  resolve_eq_then: "(P \<Longrightarrow> (Q \<equiv> Q1)) \<Longrightarrow> (\<not>P \<Longrightarrow> (Q \<equiv> Q2))
+  \<Longrightarrow> Q \<equiv> P \<and> Q1 \<or> \<not>P\<and> Q2" apply (atomize (full)) by blast 
+lemma expand_ex_beta_conv: "list_ex P [c] \<equiv> P c" by simp
+
+lemma poly_divides_pad_rule: 
+  fixes p q :: "complex list"
+  assumes pq: "p divides q"
+  shows "p divides ((0::complex)#q)"
+proof-
+  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
+  hence "poly (0#q) = poly (p *** ([0,1] *** r))" 
+    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
+  thus ?thesis unfolding divides_def by blast
+qed
+
+lemma poly_divides_pad_const_rule: 
+  fixes p q :: "complex list"
+  assumes pq: "p divides q"
+  shows "p divides (a %* q)"
+proof-
+  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
+  hence "poly (a %* q) = poly (p *** (a %* r))" 
+    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
+  thus ?thesis unfolding divides_def by blast
+qed
+
+
+lemma poly_divides_conv0:  
+  fixes p :: "complex list"
+  assumes lgpq: "length q < length p" and lq:"last p \<noteq> 0"
+  shows "p divides q \<equiv> (\<not> (list_ex (\<lambda>c. c \<noteq> 0) q))" (is "?lhs \<equiv> ?rhs")
+proof-
+  {assume r: ?rhs 
+    hence eq: "poly q = poly []" unfolding poly_zero 
+      by (simp add: list_all_iff list_ex_iff)
+    hence "poly q = poly (p *** [])" by - (rule ext, simp add: poly_mult)
+    hence ?lhs unfolding divides_def  by blast}
+  moreover
+  {assume l: ?lhs
+    have ath: "\<And>lq lp dq::nat. lq < lp ==> lq \<noteq> 0 \<Longrightarrow> dq <= lq - 1 ==> dq < lp - 1"
+      by arith
+    {assume q0: "length q = 0"
+      hence "q = []" by simp
+      hence ?rhs by simp}
+    moreover
+    {assume lgq0: "length q \<noteq> 0"
+      from pnormalize_length[of q] have dql: "degree q \<le> length q - 1" 
+	unfolding degree_def by simp
+      from ath[OF lgpq lgq0 dql, unfolded pnormal_degree[OF lq, symmetric]] divides_degree[OF l] have "poly q = poly []" by auto
+      hence ?rhs unfolding poly_zero by (simp add: list_all_iff list_ex_iff)}
+    ultimately have ?rhs by blast }
+  ultimately show "?lhs \<equiv> ?rhs" by - (atomize (full), blast) 
+qed
+
+lemma poly_divides_conv1: 
+  assumes a0: "a\<noteq> (0::complex)" and pp': "(p::complex list) divides p'"
+  and qrp': "\<And>x. a * poly q x - poly p' x \<equiv> poly r x"
+  shows "p divides q \<equiv> p divides (r::complex list)" (is "?lhs \<equiv> ?rhs")
+proof-
+  {
+  from pp' obtain t where t: "poly p' = poly (p *** t)" 
+    unfolding divides_def by blast
+  {assume l: ?lhs
+    then obtain u where u: "poly q = poly (p *** u)" unfolding divides_def by blast
+     have "poly r = poly (p *** ((a %* u) +++ (-- t)))"
+       using u qrp' t
+       by - (rule ext, 
+	 simp add: poly_add poly_mult poly_cmult poly_minus ring_simps)
+     then have ?rhs unfolding divides_def by blast}
+  moreover
+  {assume r: ?rhs
+    then obtain u where u: "poly r = poly (p *** u)" unfolding divides_def by blast
+    from u t qrp' a0 have "poly q = poly (p *** ((1/a) %* (u +++ t)))"
+      by - (rule ext, atomize (full), simp add: poly_mult poly_add poly_cmult field_simps)
+    hence ?lhs  unfolding divides_def by blast}
+  ultimately have "?lhs = ?rhs" by blast }
+thus "?lhs \<equiv> ?rhs"  by - (atomize(full), blast) 
+qed
+
+lemma basic_cqe_conv1:
+  "(\<exists>x. poly p x = 0 \<and> poly [] x \<noteq> 0) \<equiv> False"
+  "(\<exists>x. poly [] x \<noteq> 0) \<equiv> False"
+  "(\<exists>x. poly [c] x \<noteq> 0) \<equiv> c\<noteq>0"
+  "(\<exists>x. poly [] x = 0) \<equiv> True"
+  "(\<exists>x. poly [c] x = 0) \<equiv> c = 0" by simp_all
+
+lemma basic_cqe_conv2: 
+  assumes l:"last (a#b#p) \<noteq> 0" 
+  shows "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True"
+proof-
+  {fix h t
+    assume h: "h\<noteq>0" "list_all (\<lambda>c. c=(0::complex)) t"  "a#b#p = h#t"
+    hence "list_all (\<lambda>c. c= 0) (b#p)" by simp
+    moreover have "last (b#p) \<in> set (b#p)" by simp
+    ultimately have "last (b#p) = 0" by (simp add: list_all_iff)
+    with l have False by simp}
+  hence th: "\<not> (\<exists> h t. h\<noteq>0 \<and> list_all (\<lambda>c. c=0) t \<and> a#b#p = h#t)"
+    by blast
+  from fundamental_theorem_of_algebra_alt[OF th] 
+  show "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True" by auto
+qed
+
+lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
+proof-
+  have "\<not> (list_ex (\<lambda>c. c \<noteq> 0) p) \<longleftrightarrow> poly p = poly []" 
+    by (simp add: poly_zero list_all_iff list_ex_iff)
+  also have "\<dots> \<longleftrightarrow> (\<not> (\<exists>x. poly p x \<noteq> 0))" by (auto intro: ext)
+  finally show "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
+    by - (atomize (full), blast)
+qed
+
+lemma basic_cqe_conv3:
+  fixes p q :: "complex list"
+  assumes l: "last (a#p) \<noteq> 0" 
+  shows "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
+proof-
+  note np = pnormalize_eq[OF l]
+  {assume "poly (a#p) = poly []" hence False using l
+      unfolding poly_zero apply (auto simp add: list_all_iff del: last.simps)
+      apply (cases p, simp_all) done}
+  then have p0: "poly (a#p) \<noteq> poly []"  by blast
+  from np have dp:"degree (a#p) = length p" by (simp add: degree_def)
+  from nullstellensatz_univariate[of "a#p" q] p0 dp
+  show "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
+    by - (atomize (full), auto)
+qed
+
+lemma basic_cqe_conv4:
+  fixes p q :: "complex list"
+  assumes h: "\<And>x. poly (q %^ n) x \<equiv> poly r x"
+  shows "p divides (q %^ n) \<equiv> p divides r"
+proof-
+  from h have "poly (q %^ n) = poly r" by (auto intro: ext)  
+  thus "p divides (q %^ n) \<equiv> p divides r" unfolding divides_def by simp
+qed
+
+lemma pmult_Cons_Cons: "((a::complex)#b#p) *** q = (a %*q) +++ (0#((b#p) *** q))"
+  by simp
+
+lemma elim_neg_conv: "- z \<equiv> (-1) * (z::complex)" by simp
+lemma eqT_intr: "PROP P \<Longrightarrow> (True \<Longrightarrow> PROP P )" "PROP P \<Longrightarrow> True" by blast+
+lemma negate_negate_rule: "Trueprop P \<equiv> \<not> P \<equiv> False" by (atomize (full), auto)
+lemma last_simps: "last [x] = x" "last (x#y#ys) = last (y#ys)" by simp_all
+lemma length_simps: "length [] = 0" "length (x#y#xs) = length xs + 2" "length [x] = 1" by simp_all
+
+lemma complex_entire: "(z::complex) \<noteq> 0 \<and> w \<noteq> 0 \<equiv> z*w \<noteq> 0" by simp
+lemma resolve_eq_ne: "(P \<equiv> True) \<equiv> (\<not>P \<equiv> False)" "(P \<equiv> False) \<equiv> (\<not>P \<equiv> True)" 
+  by (atomize (full)) simp_all
+lemma cqe_conv1: "poly [] x = 0 \<longleftrightarrow> True"  by simp
+lemma cqe_conv2: "(p \<Longrightarrow> (q \<equiv> r)) \<equiv> ((p \<and> q) \<equiv> (p \<and> r))"  (is "?l \<equiv> ?r")
+proof
+  assume "p \<Longrightarrow> q \<equiv> r" thus "p \<and> q \<equiv> p \<and> r" apply - apply (atomize (full)) by blast
+next
+  assume "p \<and> q \<equiv> p \<and> r" "p"
+  thus "q \<equiv> r" apply - apply (atomize (full)) apply blast done
+qed
+lemma poly_const_conv: "poly [c] (x::complex) = y \<longleftrightarrow> c = y" by simp
+
+end
\ No newline at end of file
--- a/src/HOL/HOL.thy	Tue Dec 30 08:18:54 2008 +0100
+++ b/src/HOL/HOL.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -26,6 +26,7 @@
   "~~/src/Tools/atomize_elim.ML"
   "~~/src/Tools/induct.ML"
   ("~~/src/Tools/induct_tacs.ML")
+  "~~/src/Tools/value.ML"
   "~~/src/Tools/code/code_name.ML"
   "~~/src/Tools/code/code_funcgr.ML"
   "~~/src/Tools/code/code_thingol.ML"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/Bounds.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,82 @@
+(*  Title:      HOL/Real/HahnBanach/Bounds.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Bounds *}
+
+theory Bounds
+imports Main ContNotDenum
+begin
+
+locale lub =
+  fixes A and x
+  assumes least [intro?]: "(\<And>a. a \<in> A \<Longrightarrow> a \<le> b) \<Longrightarrow> x \<le> b"
+    and upper [intro?]: "a \<in> A \<Longrightarrow> a \<le> x"
+
+lemmas [elim?] = lub.least lub.upper
+
+definition
+  the_lub :: "'a::order set \<Rightarrow> 'a" where
+  "the_lub A = The (lub A)"
+
+notation (xsymbols)
+  the_lub  ("\<Squnion>_" [90] 90)
+
+lemma the_lub_equality [elim?]:
+  assumes "lub A x"
+  shows "\<Squnion>A = (x::'a::order)"
+proof -
+  interpret lub A x by fact
+  show ?thesis
+  proof (unfold the_lub_def)
+    from `lub A x` show "The (lub A) = x"
+    proof
+      fix x' assume lub': "lub A x'"
+      show "x' = x"
+      proof (rule order_antisym)
+	from lub' show "x' \<le> x"
+	proof
+          fix a assume "a \<in> A"
+          then show "a \<le> x" ..
+	qed
+	show "x \<le> x'"
+	proof
+          fix a assume "a \<in> A"
+          with lub' show "a \<le> x'" ..
+	qed
+      qed
+    qed
+  qed
+qed
+
+lemma the_lubI_ex:
+  assumes ex: "\<exists>x. lub A x"
+  shows "lub A (\<Squnion>A)"
+proof -
+  from ex obtain x where x: "lub A x" ..
+  also from x have [symmetric]: "\<Squnion>A = x" ..
+  finally show ?thesis .
+qed
+
+lemma lub_compat: "lub A x = isLub UNIV A x"
+proof -
+  have "isUb UNIV A = (\<lambda>x. A *<= x \<and> x \<in> UNIV)"
+    by (rule ext) (simp only: isUb_def)
+  then show ?thesis
+    by (simp only: lub_def isLub_def leastP_def setge_def setle_def) blast
+qed
+
+lemma real_complete:
+  fixes A :: "real set"
+  assumes nonempty: "\<exists>a. a \<in> A"
+    and ex_upper: "\<exists>y. \<forall>a \<in> A. a \<le> y"
+  shows "\<exists>x. lub A x"
+proof -
+  from ex_upper have "\<exists>y. isUb UNIV A y"
+    unfolding isUb_def setle_def by blast
+  with nonempty have "\<exists>x. isLub UNIV A x"
+    by (rule reals_complete)
+  then show ?thesis by (simp only: lub_compat)
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/FunctionNorm.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,278 @@
+(*  Title:      HOL/Real/HahnBanach/FunctionNorm.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* The norm of a function *}
+
+theory FunctionNorm
+imports NormedSpace FunctionOrder
+begin
+
+subsection {* Continuous linear forms*}
+
+text {*
+  A linear form @{text f} on a normed vector space @{text "(V, \<parallel>\<cdot>\<parallel>)"}
+  is \emph{continuous}, iff it is bounded, i.e.
+  \begin{center}
+  @{text "\<exists>c \<in> R. \<forall>x \<in> V. \<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
+  \end{center}
+  In our application no other functions than linear forms are
+  considered, so we can define continuous linear forms as bounded
+  linear forms:
+*}
+
+locale continuous = var_V + norm_syntax + linearform +
+  assumes bounded: "\<exists>c. \<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>"
+
+declare continuous.intro [intro?] continuous_axioms.intro [intro?]
+
+lemma continuousI [intro]:
+  fixes norm :: "_ \<Rightarrow> real"  ("\<parallel>_\<parallel>")
+  assumes "linearform V f"
+  assumes r: "\<And>x. x \<in> V \<Longrightarrow> \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>"
+  shows "continuous V norm f"
+proof
+  show "linearform V f" by fact
+  from r have "\<exists>c. \<forall>x\<in>V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" by blast
+  then show "continuous_axioms V norm f" ..
+qed
+
+
+subsection {* The norm of a linear form *}
+
+text {*
+  The least real number @{text c} for which holds
+  \begin{center}
+  @{text "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
+  \end{center}
+  is called the \emph{norm} of @{text f}.
+
+  For non-trivial vector spaces @{text "V \<noteq> {0}"} the norm can be
+  defined as
+  \begin{center}
+  @{text "\<parallel>f\<parallel> = \<sup>x \<noteq> 0. \<bar>f x\<bar> / \<parallel>x\<parallel>"}
+  \end{center}
+
+  For the case @{text "V = {0}"} the supremum would be taken from an
+  empty set. Since @{text \<real>} is unbounded, there would be no supremum.
+  To avoid this situation it must be guaranteed that there is an
+  element in this set. This element must be @{text "{} \<ge> 0"} so that
+  @{text fn_norm} has the norm properties. Furthermore it does not
+  have to change the norm in all other cases, so it must be @{text 0},
+  as all other elements are @{text "{} \<ge> 0"}.
+
+  Thus we define the set @{text B} where the supremum is taken from as
+  follows:
+  \begin{center}
+  @{text "{0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel>. x \<noteq> 0 \<and> x \<in> F}"}
+  \end{center}
+
+  @{text fn_norm} is equal to the supremum of @{text B}, if the
+  supremum exists (otherwise it is undefined).
+*}
+
+locale fn_norm = norm_syntax +
+  fixes B defines "B V f \<equiv> {0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel> | x. x \<noteq> 0 \<and> x \<in> V}"
+  fixes fn_norm ("\<parallel>_\<parallel>\<hyphen>_" [0, 1000] 999)
+  defines "\<parallel>f\<parallel>\<hyphen>V \<equiv> \<Squnion>(B V f)"
+
+locale normed_vectorspace_with_fn_norm = normed_vectorspace + fn_norm
+
+lemma (in fn_norm) B_not_empty [intro]: "0 \<in> B V f"
+  by (simp add: B_def)
+
+text {*
+  The following lemma states that every continuous linear form on a
+  normed space @{text "(V, \<parallel>\<cdot>\<parallel>)"} has a function norm.
+*}
+
+lemma (in normed_vectorspace_with_fn_norm) fn_norm_works:
+  assumes "continuous V norm f"
+  shows "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
+proof -
+  interpret continuous V norm f by fact
+  txt {* The existence of the supremum is shown using the
+    completeness of the reals. Completeness means, that every
+    non-empty bounded set of reals has a supremum. *}
+  have "\<exists>a. lub (B V f) a"
+  proof (rule real_complete)
+    txt {* First we have to show that @{text B} is non-empty: *}
+    have "0 \<in> B V f" ..
+    then show "\<exists>x. x \<in> B V f" ..
+
+    txt {* Then we have to show that @{text B} is bounded: *}
+    show "\<exists>c. \<forall>y \<in> B V f. y \<le> c"
+    proof -
+      txt {* We know that @{text f} is bounded by some value @{text c}. *}
+      from bounded obtain c where c: "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
+
+      txt {* To prove the thesis, we have to show that there is some
+        @{text b}, such that @{text "y \<le> b"} for all @{text "y \<in>
+        B"}. Due to the definition of @{text B} there are two cases. *}
+
+      def b \<equiv> "max c 0"
+      have "\<forall>y \<in> B V f. y \<le> b"
+      proof
+        fix y assume y: "y \<in> B V f"
+        show "y \<le> b"
+        proof cases
+          assume "y = 0"
+          then show ?thesis unfolding b_def by arith
+        next
+          txt {* The second case is @{text "y = \<bar>f x\<bar> / \<parallel>x\<parallel>"} for some
+            @{text "x \<in> V"} with @{text "x \<noteq> 0"}. *}
+          assume "y \<noteq> 0"
+          with y obtain x where y_rep: "y = \<bar>f x\<bar> * inverse \<parallel>x\<parallel>"
+              and x: "x \<in> V" and neq: "x \<noteq> 0"
+            by (auto simp add: B_def real_divide_def)
+          from x neq have gt: "0 < \<parallel>x\<parallel>" ..
+
+          txt {* The thesis follows by a short calculation using the
+            fact that @{text f} is bounded. *}
+
+          note y_rep
+          also have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> (c * \<parallel>x\<parallel>) * inverse \<parallel>x\<parallel>"
+          proof (rule mult_right_mono)
+            from c x show "\<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
+            from gt have "0 < inverse \<parallel>x\<parallel>" 
+              by (rule positive_imp_inverse_positive)
+            then show "0 \<le> inverse \<parallel>x\<parallel>" by (rule order_less_imp_le)
+          qed
+          also have "\<dots> = c * (\<parallel>x\<parallel> * inverse \<parallel>x\<parallel>)"
+            by (rule real_mult_assoc)
+          also
+          from gt have "\<parallel>x\<parallel> \<noteq> 0" by simp
+          then have "\<parallel>x\<parallel> * inverse \<parallel>x\<parallel> = 1" by simp 
+          also have "c * 1 \<le> b" by (simp add: b_def le_maxI1)
+          finally show "y \<le> b" .
+        qed
+      qed
+      then show ?thesis ..
+    qed
+  qed
+  then show ?thesis unfolding fn_norm_def by (rule the_lubI_ex)
+qed
+
+lemma (in normed_vectorspace_with_fn_norm) fn_norm_ub [iff?]:
+  assumes "continuous V norm f"
+  assumes b: "b \<in> B V f"
+  shows "b \<le> \<parallel>f\<parallel>\<hyphen>V"
+proof -
+  interpret continuous V norm f by fact
+  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
+    using `continuous V norm f` by (rule fn_norm_works)
+  from this and b show ?thesis ..
+qed
+
+lemma (in normed_vectorspace_with_fn_norm) fn_norm_leastB:
+  assumes "continuous V norm f"
+  assumes b: "\<And>b. b \<in> B V f \<Longrightarrow> b \<le> y"
+  shows "\<parallel>f\<parallel>\<hyphen>V \<le> y"
+proof -
+  interpret continuous V norm f by fact
+  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
+    using `continuous V norm f` by (rule fn_norm_works)
+  from this and b show ?thesis ..
+qed
+
+text {* The norm of a continuous function is always @{text "\<ge> 0"}. *}
+
+lemma (in normed_vectorspace_with_fn_norm) fn_norm_ge_zero [iff]:
+  assumes "continuous V norm f"
+  shows "0 \<le> \<parallel>f\<parallel>\<hyphen>V"
+proof -
+  interpret continuous V norm f by fact
+  txt {* The function norm is defined as the supremum of @{text B}.
+    So it is @{text "\<ge> 0"} if all elements in @{text B} are @{text "\<ge>
+    0"}, provided the supremum exists and @{text B} is not empty. *}
+  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
+    using `continuous V norm f` by (rule fn_norm_works)
+  moreover have "0 \<in> B V f" ..
+  ultimately show ?thesis ..
+qed
+
+text {*
+  \medskip The fundamental property of function norms is:
+  \begin{center}
+  @{text "\<bar>f x\<bar> \<le> \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"}
+  \end{center}
+*}
+
+lemma (in normed_vectorspace_with_fn_norm) fn_norm_le_cong:
+  assumes "continuous V norm f" "linearform V f"
+  assumes x: "x \<in> V"
+  shows "\<bar>f x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>"
+proof -
+  interpret continuous V norm f by fact
+  interpret linearform V f .
+  show ?thesis
+  proof cases
+    assume "x = 0"
+    then have "\<bar>f x\<bar> = \<bar>f 0\<bar>" by simp
+    also have "f 0 = 0" by rule unfold_locales
+    also have "\<bar>\<dots>\<bar> = 0" by simp
+    also have a: "0 \<le> \<parallel>f\<parallel>\<hyphen>V"
+      using `continuous V norm f` by (rule fn_norm_ge_zero)
+    from x have "0 \<le> norm x" ..
+    with a have "0 \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>" by (simp add: zero_le_mult_iff)
+    finally show "\<bar>f x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>" .
+  next
+    assume "x \<noteq> 0"
+    with x have neq: "\<parallel>x\<parallel> \<noteq> 0" by simp
+    then have "\<bar>f x\<bar> = (\<bar>f x\<bar> * inverse \<parallel>x\<parallel>) * \<parallel>x\<parallel>" by simp
+    also have "\<dots> \<le>  \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>"
+    proof (rule mult_right_mono)
+      from x show "0 \<le> \<parallel>x\<parallel>" ..
+      from x and neq have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<in> B V f"
+	by (auto simp add: B_def real_divide_def)
+      with `continuous V norm f` show "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> \<parallel>f\<parallel>\<hyphen>V"
+	by (rule fn_norm_ub)
+    qed
+    finally show ?thesis .
+  qed
+qed
+
+text {*
+  \medskip The function norm is the least positive real number for
+  which the following inequation holds:
+  \begin{center}
+    @{text "\<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
+  \end{center}
+*}
+
+lemma (in normed_vectorspace_with_fn_norm) fn_norm_least [intro?]:
+  assumes "continuous V norm f"
+  assumes ineq: "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" and ge: "0 \<le> c"
+  shows "\<parallel>f\<parallel>\<hyphen>V \<le> c"
+proof -
+  interpret continuous V norm f by fact
+  show ?thesis
+  proof (rule fn_norm_leastB [folded B_def fn_norm_def])
+    fix b assume b: "b \<in> B V f"
+    show "b \<le> c"
+    proof cases
+      assume "b = 0"
+      with ge show ?thesis by simp
+    next
+      assume "b \<noteq> 0"
+      with b obtain x where b_rep: "b = \<bar>f x\<bar> * inverse \<parallel>x\<parallel>"
+        and x_neq: "x \<noteq> 0" and x: "x \<in> V"
+	by (auto simp add: B_def real_divide_def)
+      note b_rep
+      also have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> (c * \<parallel>x\<parallel>) * inverse \<parallel>x\<parallel>"
+      proof (rule mult_right_mono)
+	have "0 < \<parallel>x\<parallel>" using x x_neq ..
+	then show "0 \<le> inverse \<parallel>x\<parallel>" by simp
+	from ineq and x show "\<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
+      qed
+      also have "\<dots> = c"
+      proof -
+	from x_neq and x have "\<parallel>x\<parallel> \<noteq> 0" by simp
+	then show ?thesis by simp
+      qed
+      finally show ?thesis .
+    qed
+  qed (insert `continuous V norm f`, simp_all add: continuous_def)
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/FunctionOrder.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,142 @@
+(*  Title:      HOL/Real/HahnBanach/FunctionOrder.thy
+    ID:         $Id$
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* An order on functions *}
+
+theory FunctionOrder
+imports Subspace Linearform
+begin
+
+subsection {* The graph of a function *}
+
+text {*
+  We define the \emph{graph} of a (real) function @{text f} with
+  domain @{text F} as the set
+  \begin{center}
+  @{text "{(x, f x). x \<in> F}"}
+  \end{center}
+  So we are modeling partial functions by specifying the domain and
+  the mapping function. We use the term ``function'' also for its
+  graph.
+*}
+
+types 'a graph = "('a \<times> real) set"
+
+definition
+  graph :: "'a set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> 'a graph" where
+  "graph F f = {(x, f x) | x. x \<in> F}"
+
+lemma graphI [intro]: "x \<in> F \<Longrightarrow> (x, f x) \<in> graph F f"
+  unfolding graph_def by blast
+
+lemma graphI2 [intro?]: "x \<in> F \<Longrightarrow> \<exists>t \<in> graph F f. t = (x, f x)"
+  unfolding graph_def by blast
+
+lemma graphE [elim?]:
+    "(x, y) \<in> graph F f \<Longrightarrow> (x \<in> F \<Longrightarrow> y = f x \<Longrightarrow> C) \<Longrightarrow> C"
+  unfolding graph_def by blast
+
+
+subsection {* Functions ordered by domain extension *}
+
+text {*
+  A function @{text h'} is an extension of @{text h}, iff the graph of
+  @{text h} is a subset of the graph of @{text h'}.
+*}
+
+lemma graph_extI:
+  "(\<And>x. x \<in> H \<Longrightarrow> h x = h' x) \<Longrightarrow> H \<subseteq> H'
+    \<Longrightarrow> graph H h \<subseteq> graph H' h'"
+  unfolding graph_def by blast
+
+lemma graph_extD1 [dest?]:
+  "graph H h \<subseteq> graph H' h' \<Longrightarrow> x \<in> H \<Longrightarrow> h x = h' x"
+  unfolding graph_def by blast
+
+lemma graph_extD2 [dest?]:
+  "graph H h \<subseteq> graph H' h' \<Longrightarrow> H \<subseteq> H'"
+  unfolding graph_def by blast
+
+
+subsection {* Domain and function of a graph *}
+
+text {*
+  The inverse functions to @{text graph} are @{text domain} and @{text
+  funct}.
+*}
+
+definition
+  "domain" :: "'a graph \<Rightarrow> 'a set" where
+  "domain g = {x. \<exists>y. (x, y) \<in> g}"
+
+definition
+  funct :: "'a graph \<Rightarrow> ('a \<Rightarrow> real)" where
+  "funct g = (\<lambda>x. (SOME y. (x, y) \<in> g))"
+
+text {*
+  The following lemma states that @{text g} is the graph of a function
+  if the relation induced by @{text g} is unique.
+*}
+
+lemma graph_domain_funct:
+  assumes uniq: "\<And>x y z. (x, y) \<in> g \<Longrightarrow> (x, z) \<in> g \<Longrightarrow> z = y"
+  shows "graph (domain g) (funct g) = g"
+  unfolding domain_def funct_def graph_def
+proof auto  (* FIXME !? *)
+  fix a b assume g: "(a, b) \<in> g"
+  from g show "(a, SOME y. (a, y) \<in> g) \<in> g" by (rule someI2)
+  from g show "\<exists>y. (a, y) \<in> g" ..
+  from g show "b = (SOME y. (a, y) \<in> g)"
+  proof (rule some_equality [symmetric])
+    fix y assume "(a, y) \<in> g"
+    with g show "y = b" by (rule uniq)
+  qed
+qed
+
+
+subsection {* Norm-preserving extensions of a function *}
+
+text {*
+  Given a linear form @{text f} on the space @{text F} and a seminorm
+  @{text p} on @{text E}. The set of all linear extensions of @{text
+  f}, to superspaces @{text H} of @{text F}, which are bounded by
+  @{text p}, is defined as follows.
+*}
+
+definition
+  norm_pres_extensions ::
+    "'a::{plus, minus, uminus, zero} set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> real)
+      \<Rightarrow> 'a graph set" where
+    "norm_pres_extensions E p F f
+      = {g. \<exists>H h. g = graph H h
+          \<and> linearform H h
+          \<and> H \<unlhd> E
+          \<and> F \<unlhd> H
+          \<and> graph F f \<subseteq> graph H h
+          \<and> (\<forall>x \<in> H. h x \<le> p x)}"
+
+lemma norm_pres_extensionE [elim]:
+  "g \<in> norm_pres_extensions E p F f
+  \<Longrightarrow> (\<And>H h. g = graph H h \<Longrightarrow> linearform H h
+        \<Longrightarrow> H \<unlhd> E \<Longrightarrow> F \<unlhd> H \<Longrightarrow> graph F f \<subseteq> graph H h
+        \<Longrightarrow> \<forall>x \<in> H. h x \<le> p x \<Longrightarrow> C) \<Longrightarrow> C"
+  unfolding norm_pres_extensions_def by blast
+
+lemma norm_pres_extensionI2 [intro]:
+  "linearform H h \<Longrightarrow> H \<unlhd> E \<Longrightarrow> F \<unlhd> H
+    \<Longrightarrow> graph F f \<subseteq> graph H h \<Longrightarrow> \<forall>x \<in> H. h x \<le> p x
+    \<Longrightarrow> graph H h \<in> norm_pres_extensions E p F f"
+  unfolding norm_pres_extensions_def by blast
+
+lemma norm_pres_extensionI:  (* FIXME ? *)
+  "\<exists>H h. g = graph H h
+    \<and> linearform H h
+    \<and> H \<unlhd> E
+    \<and> F \<unlhd> H
+    \<and> graph F f \<subseteq> graph H h
+    \<and> (\<forall>x \<in> H. h x \<le> p x) \<Longrightarrow> g \<in> norm_pres_extensions E p F f"
+  unfolding norm_pres_extensions_def by blast
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/HahnBanach.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,509 @@
+(*  Title:      HOL/Real/HahnBanach/HahnBanach.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* The Hahn-Banach Theorem *}
+
+theory HahnBanach
+imports HahnBanachLemmas
+begin
+
+text {*
+  We present the proof of two different versions of the Hahn-Banach
+  Theorem, closely following \cite[\S36]{Heuser:1986}.
+*}
+
+subsection {* The Hahn-Banach Theorem for vector spaces *}
+
+text {*
+  \textbf{Hahn-Banach Theorem.} Let @{text F} be a subspace of a real
+  vector space @{text E}, let @{text p} be a semi-norm on @{text E},
+  and @{text f} be a linear form defined on @{text F} such that @{text
+  f} is bounded by @{text p}, i.e.  @{text "\<forall>x \<in> F. f x \<le> p x"}.  Then
+  @{text f} can be extended to a linear form @{text h} on @{text E}
+  such that @{text h} is norm-preserving, i.e. @{text h} is also
+  bounded by @{text p}.
+
+  \bigskip
+  \textbf{Proof Sketch.}
+  \begin{enumerate}
+
+  \item Define @{text M} as the set of norm-preserving extensions of
+  @{text f} to subspaces of @{text E}. The linear forms in @{text M}
+  are ordered by domain extension.
+
+  \item We show that every non-empty chain in @{text M} has an upper
+  bound in @{text M}.
+
+  \item With Zorn's Lemma we conclude that there is a maximal function
+  @{text g} in @{text M}.
+
+  \item The domain @{text H} of @{text g} is the whole space @{text
+  E}, as shown by classical contradiction:
+
+  \begin{itemize}
+
+  \item Assuming @{text g} is not defined on whole @{text E}, it can
+  still be extended in a norm-preserving way to a super-space @{text
+  H'} of @{text H}.
+
+  \item Thus @{text g} can not be maximal. Contradiction!
+
+  \end{itemize}
+  \end{enumerate}
+*}
+
+theorem HahnBanach:
+  assumes E: "vectorspace E" and "subspace F E"
+    and "seminorm E p" and "linearform F f"
+  assumes fp: "\<forall>x \<in> F. f x \<le> p x"
+  shows "\<exists>h. linearform E h \<and> (\<forall>x \<in> F. h x = f x) \<and> (\<forall>x \<in> E. h x \<le> p x)"
+    -- {* Let @{text E} be a vector space, @{text F} a subspace of @{text E}, @{text p} a seminorm on @{text E}, *}
+    -- {* and @{text f} a linear form on @{text F} such that @{text f} is bounded by @{text p}, *}
+    -- {* then @{text f} can be extended to a linear form @{text h} on @{text E} in a norm-preserving way. \skp *}
+proof -
+  interpret vectorspace E by fact
+  interpret subspace F E by fact
+  interpret seminorm E p by fact
+  interpret linearform F f by fact
+  def M \<equiv> "norm_pres_extensions E p F f"
+  then have M: "M = \<dots>" by (simp only:)
+  from E have F: "vectorspace F" ..
+  note FE = `F \<unlhd> E`
+  {
+    fix c assume cM: "c \<in> chain M" and ex: "\<exists>x. x \<in> c"
+    have "\<Union>c \<in> M"
+      -- {* Show that every non-empty chain @{text c} of @{text M} has an upper bound in @{text M}: *}
+      -- {* @{text "\<Union>c"} is greater than any element of the chain @{text c}, so it suffices to show @{text "\<Union>c \<in> M"}. *}
+      unfolding M_def
+    proof (rule norm_pres_extensionI)
+      let ?H = "domain (\<Union>c)"
+      let ?h = "funct (\<Union>c)"
+
+      have a: "graph ?H ?h = \<Union>c"
+      proof (rule graph_domain_funct)
+        fix x y z assume "(x, y) \<in> \<Union>c" and "(x, z) \<in> \<Union>c"
+        with M_def cM show "z = y" by (rule sup_definite)
+      qed
+      moreover from M cM a have "linearform ?H ?h"
+        by (rule sup_lf)
+      moreover from a M cM ex FE E have "?H \<unlhd> E"
+        by (rule sup_subE)
+      moreover from a M cM ex FE have "F \<unlhd> ?H"
+        by (rule sup_supF)
+      moreover from a M cM ex have "graph F f \<subseteq> graph ?H ?h"
+        by (rule sup_ext)
+      moreover from a M cM have "\<forall>x \<in> ?H. ?h x \<le> p x"
+        by (rule sup_norm_pres)
+      ultimately show "\<exists>H h. \<Union>c = graph H h
+          \<and> linearform H h
+          \<and> H \<unlhd> E
+          \<and> F \<unlhd> H
+          \<and> graph F f \<subseteq> graph H h
+          \<and> (\<forall>x \<in> H. h x \<le> p x)" by blast
+    qed
+  }
+  then have "\<exists>g \<in> M. \<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x"
+  -- {* With Zorn's Lemma we can conclude that there is a maximal element in @{text M}. \skp *}
+  proof (rule Zorn's_Lemma)
+      -- {* We show that @{text M} is non-empty: *}
+    show "graph F f \<in> M"
+      unfolding M_def
+    proof (rule norm_pres_extensionI2)
+      show "linearform F f" by fact
+      show "F \<unlhd> E" by fact
+      from F show "F \<unlhd> F" by (rule vectorspace.subspace_refl)
+      show "graph F f \<subseteq> graph F f" ..
+      show "\<forall>x\<in>F. f x \<le> p x" by fact
+    qed
+  qed
+  then obtain g where gM: "g \<in> M" and gx: "\<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x"
+    by blast
+  from gM obtain H h where
+      g_rep: "g = graph H h"
+    and linearform: "linearform H h"
+    and HE: "H \<unlhd> E" and FH: "F \<unlhd> H"
+    and graphs: "graph F f \<subseteq> graph H h"
+    and hp: "\<forall>x \<in> H. h x \<le> p x" unfolding M_def ..
+      -- {* @{text g} is a norm-preserving extension of @{text f}, in other words: *}
+      -- {* @{text g} is the graph of some linear form @{text h} defined on a subspace @{text H} of @{text E}, *}
+      -- {* and @{text h} is an extension of @{text f} that is again bounded by @{text p}. \skp *}
+  from HE E have H: "vectorspace H"
+    by (rule subspace.vectorspace)
+
+  have HE_eq: "H = E"
+    -- {* We show that @{text h} is defined on whole @{text E} by classical contradiction. \skp *}
+  proof (rule classical)
+    assume neq: "H \<noteq> E"
+      -- {* Assume @{text h} is not defined on whole @{text E}. Then show that @{text h} can be extended *}
+      -- {* in a norm-preserving way to a function @{text h'} with the graph @{text g'}. \skp *}
+    have "\<exists>g' \<in> M. g \<subseteq> g' \<and> g \<noteq> g'"
+    proof -
+      from HE have "H \<subseteq> E" ..
+      with neq obtain x' where x'E: "x' \<in> E" and "x' \<notin> H" by blast
+      obtain x': "x' \<noteq> 0"
+      proof
+        show "x' \<noteq> 0"
+        proof
+          assume "x' = 0"
+          with H have "x' \<in> H" by (simp only: vectorspace.zero)
+          with `x' \<notin> H` show False by contradiction
+        qed
+      qed
+
+      def H' \<equiv> "H + lin x'"
+        -- {* Define @{text H'} as the direct sum of @{text H} and the linear closure of @{text x'}. \skp *}
+      have HH': "H \<unlhd> H'"
+      proof (unfold H'_def)
+        from x'E have "vectorspace (lin x')" ..
+        with H show "H \<unlhd> H + lin x'" ..
+      qed
+
+      obtain xi where
+        xi: "\<forall>y \<in> H. - p (y + x') - h y \<le> xi
+          \<and> xi \<le> p (y + x') - h y"
+        -- {* Pick a real number @{text \<xi>} that fulfills certain inequations; this will *}
+        -- {* be used to establish that @{text h'} is a norm-preserving extension of @{text h}.
+           \label{ex-xi-use}\skp *}
+      proof -
+        from H have "\<exists>xi. \<forall>y \<in> H. - p (y + x') - h y \<le> xi
+            \<and> xi \<le> p (y + x') - h y"
+        proof (rule ex_xi)
+          fix u v assume u: "u \<in> H" and v: "v \<in> H"
+          with HE have uE: "u \<in> E" and vE: "v \<in> E" by auto
+          from H u v linearform have "h v - h u = h (v - u)"
+            by (simp add: linearform.diff)
+          also from hp and H u v have "\<dots> \<le> p (v - u)"
+            by (simp only: vectorspace.diff_closed)
+          also from x'E uE vE have "v - u = x' + - x' + v + - u"
+            by (simp add: diff_eq1)
+          also from x'E uE vE have "\<dots> = v + x' + - (u + x')"
+            by (simp add: add_ac)
+          also from x'E uE vE have "\<dots> = (v + x') - (u + x')"
+            by (simp add: diff_eq1)
+          also from x'E uE vE E have "p \<dots> \<le> p (v + x') + p (u + x')"
+            by (simp add: diff_subadditive)
+          finally have "h v - h u \<le> p (v + x') + p (u + x')" .
+          then show "- p (u + x') - h u \<le> p (v + x') - h v" by simp
+        qed
+        then show thesis by (blast intro: that)
+      qed
+
+      def h' \<equiv> "\<lambda>x. let (y, a) =
+          SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H in h y + a * xi"
+        -- {* Define the extension @{text h'} of @{text h} to @{text H'} using @{text \<xi>}. \skp *}
+
+      have "g \<subseteq> graph H' h' \<and> g \<noteq> graph H' h'"
+        -- {* @{text h'} is an extension of @{text h} \dots \skp *}
+      proof
+        show "g \<subseteq> graph H' h'"
+        proof -
+          have  "graph H h \<subseteq> graph H' h'"
+          proof (rule graph_extI)
+            fix t assume t: "t \<in> H"
+            from E HE t have "(SOME (y, a). t = y + a \<cdot> x' \<and> y \<in> H) = (t, 0)"
+	      using `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` by (rule decomp_H'_H)
+            with h'_def show "h t = h' t" by (simp add: Let_def)
+          next
+            from HH' show "H \<subseteq> H'" ..
+          qed
+          with g_rep show ?thesis by (simp only:)
+        qed
+
+        show "g \<noteq> graph H' h'"
+        proof -
+          have "graph H h \<noteq> graph H' h'"
+          proof
+            assume eq: "graph H h = graph H' h'"
+            have "x' \<in> H'"
+	      unfolding H'_def
+            proof
+              from H show "0 \<in> H" by (rule vectorspace.zero)
+              from x'E show "x' \<in> lin x'" by (rule x_lin_x)
+              from x'E show "x' = 0 + x'" by simp
+            qed
+            then have "(x', h' x') \<in> graph H' h'" ..
+            with eq have "(x', h' x') \<in> graph H h" by (simp only:)
+            then have "x' \<in> H" ..
+            with `x' \<notin> H` show False by contradiction
+          qed
+          with g_rep show ?thesis by simp
+        qed
+      qed
+      moreover have "graph H' h' \<in> M"
+        -- {* and @{text h'} is norm-preserving. \skp *}
+      proof (unfold M_def)
+        show "graph H' h' \<in> norm_pres_extensions E p F f"
+        proof (rule norm_pres_extensionI2)
+          show "linearform H' h'"
+	    using h'_def H'_def HE linearform `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` E
+	    by (rule h'_lf)
+          show "H' \<unlhd> E"
+	  unfolding H'_def
+          proof
+            show "H \<unlhd> E" by fact
+            show "vectorspace E" by fact
+            from x'E show "lin x' \<unlhd> E" ..
+          qed
+          from H `F \<unlhd> H` HH' show FH': "F \<unlhd> H'"
+            by (rule vectorspace.subspace_trans)
+          show "graph F f \<subseteq> graph H' h'"
+          proof (rule graph_extI)
+            fix x assume x: "x \<in> F"
+            with graphs have "f x = h x" ..
+            also have "\<dots> = h x + 0 * xi" by simp
+            also have "\<dots> = (let (y, a) = (x, 0) in h y + a * xi)"
+              by (simp add: Let_def)
+            also have "(x, 0) =
+                (SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H)"
+	      using E HE
+            proof (rule decomp_H'_H [symmetric])
+              from FH x show "x \<in> H" ..
+              from x' show "x' \<noteq> 0" .
+	      show "x' \<notin> H" by fact
+	      show "x' \<in> E" by fact
+            qed
+            also have
+              "(let (y, a) = (SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H)
+              in h y + a * xi) = h' x" by (simp only: h'_def)
+            finally show "f x = h' x" .
+          next
+            from FH' show "F \<subseteq> H'" ..
+          qed
+          show "\<forall>x \<in> H'. h' x \<le> p x"
+	    using h'_def H'_def `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` E HE
+	      `seminorm E p` linearform and hp xi
+	    by (rule h'_norm_pres)
+        qed
+      qed
+      ultimately show ?thesis ..
+    qed
+    then have "\<not> (\<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x)" by simp
+      -- {* So the graph @{text g} of @{text h} cannot be maximal. Contradiction! \skp *}
+    with gx show "H = E" by contradiction
+  qed
+
+  from HE_eq and linearform have "linearform E h"
+    by (simp only:)
+  moreover have "\<forall>x \<in> F. h x = f x"
+  proof
+    fix x assume "x \<in> F"
+    with graphs have "f x = h x" ..
+    then show "h x = f x" ..
+  qed
+  moreover from HE_eq and hp have "\<forall>x \<in> E. h x \<le> p x"
+    by (simp only:)
+  ultimately show ?thesis by blast
+qed
+
+
+subsection  {* Alternative formulation *}
+
+text {*
+  The following alternative formulation of the Hahn-Banach
+  Theorem\label{abs-HahnBanach} uses the fact that for a real linear
+  form @{text f} and a seminorm @{text p} the following inequations
+  are equivalent:\footnote{This was shown in lemma @{thm [source]
+  abs_ineq_iff} (see page \pageref{abs-ineq-iff}).}
+  \begin{center}
+  \begin{tabular}{lll}
+  @{text "\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x"} & and &
+  @{text "\<forall>x \<in> H. h x \<le> p x"} \\
+  \end{tabular}
+  \end{center}
+*}
+
+theorem abs_HahnBanach:
+  assumes E: "vectorspace E" and FE: "subspace F E"
+    and lf: "linearform F f" and sn: "seminorm E p"
+  assumes fp: "\<forall>x \<in> F. \<bar>f x\<bar> \<le> p x"
+  shows "\<exists>g. linearform E g
+    \<and> (\<forall>x \<in> F. g x = f x)
+    \<and> (\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x)"
+proof -
+  interpret vectorspace E by fact
+  interpret subspace F E by fact
+  interpret linearform F f by fact
+  interpret seminorm E p by fact
+  have "\<exists>g. linearform E g \<and> (\<forall>x \<in> F. g x = f x) \<and> (\<forall>x \<in> E. g x \<le> p x)"
+    using E FE sn lf
+  proof (rule HahnBanach)
+    show "\<forall>x \<in> F. f x \<le> p x"
+      using FE E sn lf and fp by (rule abs_ineq_iff [THEN iffD1])
+  qed
+  then obtain g where lg: "linearform E g" and *: "\<forall>x \<in> F. g x = f x"
+      and **: "\<forall>x \<in> E. g x \<le> p x" by blast
+  have "\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x"
+    using _ E sn lg **
+  proof (rule abs_ineq_iff [THEN iffD2])
+    show "E \<unlhd> E" ..
+  qed
+  with lg * show ?thesis by blast
+qed
+
+
+subsection {* The Hahn-Banach Theorem for normed spaces *}
+
+text {*
+  Every continuous linear form @{text f} on a subspace @{text F} of a
+  norm space @{text E}, can be extended to a continuous linear form
+  @{text g} on @{text E} such that @{text "\<parallel>f\<parallel> = \<parallel>g\<parallel>"}.
+*}
+
+theorem norm_HahnBanach:
+  fixes V and norm ("\<parallel>_\<parallel>")
+  fixes B defines "\<And>V f. B V f \<equiv> {0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel> | x. x \<noteq> 0 \<and> x \<in> V}"
+  fixes fn_norm ("\<parallel>_\<parallel>\<hyphen>_" [0, 1000] 999)
+  defines "\<And>V f. \<parallel>f\<parallel>\<hyphen>V \<equiv> \<Squnion>(B V f)"
+  assumes E_norm: "normed_vectorspace E norm" and FE: "subspace F E"
+    and linearform: "linearform F f" and "continuous F norm f"
+  shows "\<exists>g. linearform E g
+     \<and> continuous E norm g
+     \<and> (\<forall>x \<in> F. g x = f x)
+     \<and> \<parallel>g\<parallel>\<hyphen>E = \<parallel>f\<parallel>\<hyphen>F"
+proof -
+  interpret normed_vectorspace E norm by fact
+  interpret normed_vectorspace_with_fn_norm E norm B fn_norm
+    by (auto simp: B_def fn_norm_def) intro_locales
+  interpret subspace F E by fact
+  interpret linearform F f by fact
+  interpret continuous F norm f by fact
+  have E: "vectorspace E" by intro_locales
+  have F: "vectorspace F" by rule intro_locales
+  have F_norm: "normed_vectorspace F norm"
+    using FE E_norm by (rule subspace_normed_vs)
+  have ge_zero: "0 \<le> \<parallel>f\<parallel>\<hyphen>F"
+    by (rule normed_vectorspace_with_fn_norm.fn_norm_ge_zero
+      [OF normed_vectorspace_with_fn_norm.intro,
+       OF F_norm `continuous F norm f` , folded B_def fn_norm_def])
+  txt {* We define a function @{text p} on @{text E} as follows:
+    @{text "p x = \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"} *}
+  def p \<equiv> "\<lambda>x. \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
+
+  txt {* @{text p} is a seminorm on @{text E}: *}
+  have q: "seminorm E p"
+  proof
+    fix x y a assume x: "x \<in> E" and y: "y \<in> E"
+    
+    txt {* @{text p} is positive definite: *}
+    have "0 \<le> \<parallel>f\<parallel>\<hyphen>F" by (rule ge_zero)
+    moreover from x have "0 \<le> \<parallel>x\<parallel>" ..
+    ultimately show "0 \<le> p x"  
+      by (simp add: p_def zero_le_mult_iff)
+
+    txt {* @{text p} is absolutely homogenous: *}
+
+    show "p (a \<cdot> x) = \<bar>a\<bar> * p x"
+    proof -
+      have "p (a \<cdot> x) = \<parallel>f\<parallel>\<hyphen>F * \<parallel>a \<cdot> x\<parallel>" by (simp only: p_def)
+      also from x have "\<parallel>a \<cdot> x\<parallel> = \<bar>a\<bar> * \<parallel>x\<parallel>" by (rule abs_homogenous)
+      also have "\<parallel>f\<parallel>\<hyphen>F * (\<bar>a\<bar> * \<parallel>x\<parallel>) = \<bar>a\<bar> * (\<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>)" by simp
+      also have "\<dots> = \<bar>a\<bar> * p x" by (simp only: p_def)
+      finally show ?thesis .
+    qed
+
+    txt {* Furthermore, @{text p} is subadditive: *}
+
+    show "p (x + y) \<le> p x + p y"
+    proof -
+      have "p (x + y) = \<parallel>f\<parallel>\<hyphen>F * \<parallel>x + y\<parallel>" by (simp only: p_def)
+      also have a: "0 \<le> \<parallel>f\<parallel>\<hyphen>F" by (rule ge_zero)
+      from x y have "\<parallel>x + y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>" ..
+      with a have " \<parallel>f\<parallel>\<hyphen>F * \<parallel>x + y\<parallel> \<le> \<parallel>f\<parallel>\<hyphen>F * (\<parallel>x\<parallel> + \<parallel>y\<parallel>)"
+        by (simp add: mult_left_mono)
+      also have "\<dots> = \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel> + \<parallel>f\<parallel>\<hyphen>F * \<parallel>y\<parallel>" by (simp only: right_distrib)
+      also have "\<dots> = p x + p y" by (simp only: p_def)
+      finally show ?thesis .
+    qed
+  qed
+
+  txt {* @{text f} is bounded by @{text p}. *}
+
+  have "\<forall>x \<in> F. \<bar>f x\<bar> \<le> p x"
+  proof
+    fix x assume "x \<in> F"
+    with `continuous F norm f` and linearform
+    show "\<bar>f x\<bar> \<le> p x"
+      unfolding p_def by (rule normed_vectorspace_with_fn_norm.fn_norm_le_cong
+        [OF normed_vectorspace_with_fn_norm.intro,
+         OF F_norm, folded B_def fn_norm_def])
+  qed
+
+  txt {* Using the fact that @{text p} is a seminorm and @{text f} is bounded
+    by @{text p} we can apply the Hahn-Banach Theorem for real vector
+    spaces. So @{text f} can be extended in a norm-preserving way to
+    some function @{text g} on the whole vector space @{text E}. *}
+
+  with E FE linearform q obtain g where
+      linearformE: "linearform E g"
+    and a: "\<forall>x \<in> F. g x = f x"
+    and b: "\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x"
+    by (rule abs_HahnBanach [elim_format]) iprover
+
+  txt {* We furthermore have to show that @{text g} is also continuous: *}
+
+  have g_cont: "continuous E norm g" using linearformE
+  proof
+    fix x assume "x \<in> E"
+    with b show "\<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
+      by (simp only: p_def)
+  qed
+
+  txt {* To complete the proof, we show that @{text "\<parallel>g\<parallel> = \<parallel>f\<parallel>"}. *}
+
+  have "\<parallel>g\<parallel>\<hyphen>E = \<parallel>f\<parallel>\<hyphen>F"
+  proof (rule order_antisym)
+    txt {*
+      First we show @{text "\<parallel>g\<parallel> \<le> \<parallel>f\<parallel>"}.  The function norm @{text
+      "\<parallel>g\<parallel>"} is defined as the smallest @{text "c \<in> \<real>"} such that
+      \begin{center}
+      \begin{tabular}{l}
+      @{text "\<forall>x \<in> E. \<bar>g x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
+      \end{tabular}
+      \end{center}
+      \noindent Furthermore holds
+      \begin{center}
+      \begin{tabular}{l}
+      @{text "\<forall>x \<in> E. \<bar>g x\<bar> \<le> \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"}
+      \end{tabular}
+      \end{center}
+    *}
+
+    have "\<forall>x \<in> E. \<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
+    proof
+      fix x assume "x \<in> E"
+      with b show "\<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
+        by (simp only: p_def)
+    qed
+    from g_cont this ge_zero
+    show "\<parallel>g\<parallel>\<hyphen>E \<le> \<parallel>f\<parallel>\<hyphen>F"
+      by (rule fn_norm_least [of g, folded B_def fn_norm_def])
+
+    txt {* The other direction is achieved by a similar argument. *}
+
+    show "\<parallel>f\<parallel>\<hyphen>F \<le> \<parallel>g\<parallel>\<hyphen>E"
+    proof (rule normed_vectorspace_with_fn_norm.fn_norm_least
+	[OF normed_vectorspace_with_fn_norm.intro,
+	 OF F_norm, folded B_def fn_norm_def])
+      show "\<forall>x \<in> F. \<bar>f x\<bar> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>"
+      proof
+	fix x assume x: "x \<in> F"
+	from a x have "g x = f x" ..
+	then have "\<bar>f x\<bar> = \<bar>g x\<bar>" by (simp only:)
+	also from g_cont
+	have "\<dots> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>"
+	proof (rule fn_norm_le_cong [of g, folded B_def fn_norm_def])
+	  from FE x show "x \<in> E" ..
+	qed
+	finally show "\<bar>f x\<bar> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>" .
+      qed
+      show "0 \<le> \<parallel>g\<parallel>\<hyphen>E"
+	using g_cont
+	by (rule fn_norm_ge_zero [of g, folded B_def fn_norm_def])
+      show "continuous F norm f" by fact
+    qed
+  qed
+  with linearformE a g_cont show ?thesis by blast
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/HahnBanachExtLemmas.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,280 @@
+(*  Title:      HOL/Real/HahnBanach/HahnBanachExtLemmas.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Extending non-maximal functions *}
+
+theory HahnBanachExtLemmas
+imports FunctionNorm
+begin
+
+text {*
+  In this section the following context is presumed.  Let @{text E} be
+  a real vector space with a seminorm @{text q} on @{text E}. @{text
+  F} is a subspace of @{text E} and @{text f} a linear function on
+  @{text F}. We consider a subspace @{text H} of @{text E} that is a
+  superspace of @{text F} and a linear form @{text h} on @{text
+  H}. @{text H} is a not equal to @{text E} and @{text "x\<^sub>0"} is
+  an element in @{text "E - H"}.  @{text H} is extended to the direct
+  sum @{text "H' = H + lin x\<^sub>0"}, so for any @{text "x \<in> H'"}
+  the decomposition of @{text "x = y + a \<cdot> x"} with @{text "y \<in> H"} is
+  unique. @{text h'} is defined on @{text H'} by @{text "h' x = h y +
+  a \<cdot> \<xi>"} for a certain @{text \<xi>}.
+
+  Subsequently we show some properties of this extension @{text h'} of
+  @{text h}.
+
+  \medskip This lemma will be used to show the existence of a linear
+  extension of @{text f} (see page \pageref{ex-xi-use}). It is a
+  consequence of the completeness of @{text \<real>}. To show
+  \begin{center}
+  \begin{tabular}{l}
+  @{text "\<exists>\<xi>. \<forall>y \<in> F. a y \<le> \<xi> \<and> \<xi> \<le> b y"}
+  \end{tabular}
+  \end{center}
+  \noindent it suffices to show that
+  \begin{center}
+  \begin{tabular}{l}
+  @{text "\<forall>u \<in> F. \<forall>v \<in> F. a u \<le> b v"}
+  \end{tabular}
+  \end{center}
+*}
+
+lemma ex_xi:
+  assumes "vectorspace F"
+  assumes r: "\<And>u v. u \<in> F \<Longrightarrow> v \<in> F \<Longrightarrow> a u \<le> b v"
+  shows "\<exists>xi::real. \<forall>y \<in> F. a y \<le> xi \<and> xi \<le> b y"
+proof -
+  interpret vectorspace F by fact
+  txt {* From the completeness of the reals follows:
+    The set @{text "S = {a u. u \<in> F}"} has a supremum, if it is
+    non-empty and has an upper bound. *}
+
+  let ?S = "{a u | u. u \<in> F}"
+  have "\<exists>xi. lub ?S xi"
+  proof (rule real_complete)
+    have "a 0 \<in> ?S" by blast
+    then show "\<exists>X. X \<in> ?S" ..
+    have "\<forall>y \<in> ?S. y \<le> b 0"
+    proof
+      fix y assume y: "y \<in> ?S"
+      then obtain u where u: "u \<in> F" and y: "y = a u" by blast
+      from u and zero have "a u \<le> b 0" by (rule r)
+      with y show "y \<le> b 0" by (simp only:)
+    qed
+    then show "\<exists>u. \<forall>y \<in> ?S. y \<le> u" ..
+  qed
+  then obtain xi where xi: "lub ?S xi" ..
+  {
+    fix y assume "y \<in> F"
+    then have "a y \<in> ?S" by blast
+    with xi have "a y \<le> xi" by (rule lub.upper)
+  } moreover {
+    fix y assume y: "y \<in> F"
+    from xi have "xi \<le> b y"
+    proof (rule lub.least)
+      fix au assume "au \<in> ?S"
+      then obtain u where u: "u \<in> F" and au: "au = a u" by blast
+      from u y have "a u \<le> b y" by (rule r)
+      with au show "au \<le> b y" by (simp only:)
+    qed
+  } ultimately show "\<exists>xi. \<forall>y \<in> F. a y \<le> xi \<and> xi \<le> b y" by blast
+qed
+
+text {*
+  \medskip The function @{text h'} is defined as a @{text "h' x = h y
+  + a \<cdot> \<xi>"} where @{text "x = y + a \<cdot> \<xi>"} is a linear extension of
+  @{text h} to @{text H'}.
+*}
+
+lemma h'_lf:
+  assumes h'_def: "h' \<equiv> \<lambda>x. let (y, a) =
+      SOME (y, a). x = y + a \<cdot> x0 \<and> y \<in> H in h y + a * xi"
+    and H'_def: "H' \<equiv> H + lin x0"
+    and HE: "H \<unlhd> E"
+  assumes "linearform H h"
+  assumes x0: "x0 \<notin> H"  "x0 \<in> E"  "x0 \<noteq> 0"
+  assumes E: "vectorspace E"
+  shows "linearform H' h'"
+proof -
+  interpret linearform H h by fact
+  interpret vectorspace E by fact
+  show ?thesis
+  proof
+    note E = `vectorspace E`
+    have H': "vectorspace H'"
+    proof (unfold H'_def)
+      from `x0 \<in> E`
+      have "lin x0 \<unlhd> E" ..
+      with HE show "vectorspace (H + lin x0)" using E ..
+    qed
+    {
+      fix x1 x2 assume x1: "x1 \<in> H'" and x2: "x2 \<in> H'"
+      show "h' (x1 + x2) = h' x1 + h' x2"
+      proof -
+	from H' x1 x2 have "x1 + x2 \<in> H'"
+          by (rule vectorspace.add_closed)
+	with x1 x2 obtain y y1 y2 a a1 a2 where
+          x1x2: "x1 + x2 = y + a \<cdot> x0" and y: "y \<in> H"
+          and x1_rep: "x1 = y1 + a1 \<cdot> x0" and y1: "y1 \<in> H"
+          and x2_rep: "x2 = y2 + a2 \<cdot> x0" and y2: "y2 \<in> H"
+          unfolding H'_def sum_def lin_def by blast
+	
+	have ya: "y1 + y2 = y \<and> a1 + a2 = a" using E HE _ y x0
+	proof (rule decomp_H') txt_raw {* \label{decomp-H-use} *}
+          from HE y1 y2 show "y1 + y2 \<in> H"
+            by (rule subspace.add_closed)
+          from x0 and HE y y1 y2
+          have "x0 \<in> E"  "y \<in> E"  "y1 \<in> E"  "y2 \<in> E" by auto
+          with x1_rep x2_rep have "(y1 + y2) + (a1 + a2) \<cdot> x0 = x1 + x2"
+            by (simp add: add_ac add_mult_distrib2)
+          also note x1x2
+          finally show "(y1 + y2) + (a1 + a2) \<cdot> x0 = y + a \<cdot> x0" .
+	qed
+	
+	from h'_def x1x2 E HE y x0
+	have "h' (x1 + x2) = h y + a * xi"
+          by (rule h'_definite)
+	also have "\<dots> = h (y1 + y2) + (a1 + a2) * xi"
+          by (simp only: ya)
+	also from y1 y2 have "h (y1 + y2) = h y1 + h y2"
+          by simp
+	also have "\<dots> + (a1 + a2) * xi = (h y1 + a1 * xi) + (h y2 + a2 * xi)"
+          by (simp add: left_distrib)
+	also from h'_def x1_rep E HE y1 x0
+	have "h y1 + a1 * xi = h' x1"
+          by (rule h'_definite [symmetric])
+	also from h'_def x2_rep E HE y2 x0
+	have "h y2 + a2 * xi = h' x2"
+          by (rule h'_definite [symmetric])
+	finally show ?thesis .
+      qed
+    next
+      fix x1 c assume x1: "x1 \<in> H'"
+      show "h' (c \<cdot> x1) = c * (h' x1)"
+      proof -
+	from H' x1 have ax1: "c \<cdot> x1 \<in> H'"
+          by (rule vectorspace.mult_closed)
+	with x1 obtain y a y1 a1 where
+            cx1_rep: "c \<cdot> x1 = y + a \<cdot> x0" and y: "y \<in> H"
+          and x1_rep: "x1 = y1 + a1 \<cdot> x0" and y1: "y1 \<in> H"
+          unfolding H'_def sum_def lin_def by blast
+	
+	have ya: "c \<cdot> y1 = y \<and> c * a1 = a" using E HE _ y x0
+	proof (rule decomp_H')
+          from HE y1 show "c \<cdot> y1 \<in> H"
+            by (rule subspace.mult_closed)
+          from x0 and HE y y1
+          have "x0 \<in> E"  "y \<in> E"  "y1 \<in> E" by auto
+          with x1_rep have "c \<cdot> y1 + (c * a1) \<cdot> x0 = c \<cdot> x1"
+            by (simp add: mult_assoc add_mult_distrib1)
+          also note cx1_rep
+          finally show "c \<cdot> y1 + (c * a1) \<cdot> x0 = y + a \<cdot> x0" .
+	qed
+	
+	from h'_def cx1_rep E HE y x0 have "h' (c \<cdot> x1) = h y + a * xi"
+          by (rule h'_definite)
+	also have "\<dots> = h (c \<cdot> y1) + (c * a1) * xi"
+          by (simp only: ya)
+	also from y1 have "h (c \<cdot> y1) = c * h y1"
+          by simp
+	also have "\<dots> + (c * a1) * xi = c * (h y1 + a1 * xi)"
+          by (simp only: right_distrib)
+	also from h'_def x1_rep E HE y1 x0 have "h y1 + a1 * xi = h' x1"
+          by (rule h'_definite [symmetric])
+	finally show ?thesis .
+      qed
+    }
+  qed
+qed
+
+text {* \medskip The linear extension @{text h'} of @{text h}
+  is bounded by the seminorm @{text p}. *}
+
+lemma h'_norm_pres:
+  assumes h'_def: "h' \<equiv> \<lambda>x. let (y, a) =
+      SOME (y, a). x = y + a \<cdot> x0 \<and> y \<in> H in h y + a * xi"
+    and H'_def: "H' \<equiv> H + lin x0"
+    and x0: "x0 \<notin> H"  "x0 \<in> E"  "x0 \<noteq> 0"
+  assumes E: "vectorspace E" and HE: "subspace H E"
+    and "seminorm E p" and "linearform H h"
+  assumes a: "\<forall>y \<in> H. h y \<le> p y"
+    and a': "\<forall>y \<in> H. - p (y + x0) - h y \<le> xi \<and> xi \<le> p (y + x0) - h y"
+  shows "\<forall>x \<in> H'. h' x \<le> p x"
+proof -
+  interpret vectorspace E by fact
+  interpret subspace H E by fact
+  interpret seminorm E p by fact
+  interpret linearform H h by fact
+  show ?thesis
+  proof
+    fix x assume x': "x \<in> H'"
+    show "h' x \<le> p x"
+    proof -
+      from a' have a1: "\<forall>ya \<in> H. - p (ya + x0) - h ya \<le> xi"
+	and a2: "\<forall>ya \<in> H. xi \<le> p (ya + x0) - h ya" by auto
+      from x' obtain y a where
+          x_rep: "x = y + a \<cdot> x0" and y: "y \<in> H"
+	unfolding H'_def sum_def lin_def by blast
+      from y have y': "y \<in> E" ..
+      from y have ay: "inverse a \<cdot> y \<in> H" by simp
+      
+      from h'_def x_rep E HE y x0 have "h' x = h y + a * xi"
+	by (rule h'_definite)
+      also have "\<dots> \<le> p (y + a \<cdot> x0)"
+      proof (rule linorder_cases)
+	assume z: "a = 0"
+	then have "h y + a * xi = h y" by simp
+	also from a y have "\<dots> \<le> p y" ..
+	also from x0 y' z have "p y = p (y + a \<cdot> x0)" by simp
+	finally show ?thesis .
+      next
+	txt {* In the case @{text "a < 0"}, we use @{text "a\<^sub>1"}
+          with @{text ya} taken as @{text "y / a"}: *}
+	assume lz: "a < 0" then have nz: "a \<noteq> 0" by simp
+	from a1 ay
+	have "- p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y) \<le> xi" ..
+	with lz have "a * xi \<le>
+          a * (- p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y))"
+          by (simp add: mult_left_mono_neg order_less_imp_le)
+	
+	also have "\<dots> =
+          - a * (p (inverse a \<cdot> y + x0)) - a * (h (inverse a \<cdot> y))"
+	  by (simp add: right_diff_distrib)
+	also from lz x0 y' have "- a * (p (inverse a \<cdot> y + x0)) =
+          p (a \<cdot> (inverse a \<cdot> y + x0))"
+          by (simp add: abs_homogenous)
+	also from nz x0 y' have "\<dots> = p (y + a \<cdot> x0)"
+          by (simp add: add_mult_distrib1 mult_assoc [symmetric])
+	also from nz y have "a * (h (inverse a \<cdot> y)) =  h y"
+          by simp
+	finally have "a * xi \<le> p (y + a \<cdot> x0) - h y" .
+	then show ?thesis by simp
+      next
+	txt {* In the case @{text "a > 0"}, we use @{text "a\<^sub>2"}
+          with @{text ya} taken as @{text "y / a"}: *}
+	assume gz: "0 < a" then have nz: "a \<noteq> 0" by simp
+	from a2 ay
+	have "xi \<le> p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y)" ..
+	with gz have "a * xi \<le>
+          a * (p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y))"
+          by simp
+	also have "\<dots> = a * p (inverse a \<cdot> y + x0) - a * h (inverse a \<cdot> y)"
+	  by (simp add: right_diff_distrib)
+	also from gz x0 y'
+	have "a * p (inverse a \<cdot> y + x0) = p (a \<cdot> (inverse a \<cdot> y + x0))"
+          by (simp add: abs_homogenous)
+	also from nz x0 y' have "\<dots> = p (y + a \<cdot> x0)"
+          by (simp add: add_mult_distrib1 mult_assoc [symmetric])
+	also from nz y have "a * h (inverse a \<cdot> y) = h y"
+          by simp
+	finally have "a * xi \<le> p (y + a \<cdot> x0) - h y" .
+	then show ?thesis by simp
+      qed
+      also from x_rep have "\<dots> = p x" by (simp only:)
+      finally show ?thesis .
+    qed
+  qed
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/HahnBanachLemmas.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,4 @@
+(*<*)
+theory HahnBanachLemmas imports HahnBanachSupLemmas HahnBanachExtLemmas begin
+end
+(*>*)
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/HahnBanachSupLemmas.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,446 @@
+(*  Title:      HOL/Real/HahnBanach/HahnBanachSupLemmas.thy
+    ID:         $Id$
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* The supremum w.r.t.~the function order *}
+
+theory HahnBanachSupLemmas
+imports FunctionNorm ZornLemma
+begin
+
+text {*
+  This section contains some lemmas that will be used in the proof of
+  the Hahn-Banach Theorem.  In this section the following context is
+  presumed.  Let @{text E} be a real vector space with a seminorm
+  @{text p} on @{text E}.  @{text F} is a subspace of @{text E} and
+  @{text f} a linear form on @{text F}. We consider a chain @{text c}
+  of norm-preserving extensions of @{text f}, such that @{text "\<Union>c =
+  graph H h"}.  We will show some properties about the limit function
+  @{text h}, i.e.\ the supremum of the chain @{text c}.
+
+  \medskip Let @{text c} be a chain of norm-preserving extensions of
+  the function @{text f} and let @{text "graph H h"} be the supremum
+  of @{text c}.  Every element in @{text H} is member of one of the
+  elements of the chain.
+*}
+lemmas [dest?] = chainD
+lemmas chainE2 [elim?] = chainD2 [elim_format, standard]
+
+lemma some_H'h't:
+  assumes M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and u: "graph H h = \<Union>c"
+    and x: "x \<in> H"
+  shows "\<exists>H' h'. graph H' h' \<in> c
+    \<and> (x, h x) \<in> graph H' h'
+    \<and> linearform H' h' \<and> H' \<unlhd> E
+    \<and> F \<unlhd> H' \<and> graph F f \<subseteq> graph H' h'
+    \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
+proof -
+  from x have "(x, h x) \<in> graph H h" ..
+  also from u have "\<dots> = \<Union>c" .
+  finally obtain g where gc: "g \<in> c" and gh: "(x, h x) \<in> g" by blast
+
+  from cM have "c \<subseteq> M" ..
+  with gc have "g \<in> M" ..
+  also from M have "\<dots> = norm_pres_extensions E p F f" .
+  finally obtain H' and h' where g: "g = graph H' h'"
+    and * : "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
+      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x" ..
+
+  from gc and g have "graph H' h' \<in> c" by (simp only:)
+  moreover from gh and g have "(x, h x) \<in> graph H' h'" by (simp only:)
+  ultimately show ?thesis using * by blast
+qed
+
+text {*
+  \medskip Let @{text c} be a chain of norm-preserving extensions of
+  the function @{text f} and let @{text "graph H h"} be the supremum
+  of @{text c}.  Every element in the domain @{text H} of the supremum
+  function is member of the domain @{text H'} of some function @{text
+  h'}, such that @{text h} extends @{text h'}.
+*}
+
+lemma some_H'h':
+  assumes M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and u: "graph H h = \<Union>c"
+    and x: "x \<in> H"
+  shows "\<exists>H' h'. x \<in> H' \<and> graph H' h' \<subseteq> graph H h
+    \<and> linearform H' h' \<and> H' \<unlhd> E \<and> F \<unlhd> H'
+    \<and> graph F f \<subseteq> graph H' h' \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
+proof -
+  from M cM u x obtain H' h' where
+      x_hx: "(x, h x) \<in> graph H' h'"
+    and c: "graph H' h' \<in> c"
+    and * : "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
+      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x"
+    by (rule some_H'h't [elim_format]) blast
+  from x_hx have "x \<in> H'" ..
+  moreover from cM u c have "graph H' h' \<subseteq> graph H h"
+    by (simp only: chain_ball_Union_upper)
+  ultimately show ?thesis using * by blast
+qed
+
+text {*
+  \medskip Any two elements @{text x} and @{text y} in the domain
+  @{text H} of the supremum function @{text h} are both in the domain
+  @{text H'} of some function @{text h'}, such that @{text h} extends
+  @{text h'}.
+*}
+
+lemma some_H'h'2:
+  assumes M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and u: "graph H h = \<Union>c"
+    and x: "x \<in> H"
+    and y: "y \<in> H"
+  shows "\<exists>H' h'. x \<in> H' \<and> y \<in> H'
+    \<and> graph H' h' \<subseteq> graph H h
+    \<and> linearform H' h' \<and> H' \<unlhd> E \<and> F \<unlhd> H'
+    \<and> graph F f \<subseteq> graph H' h' \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
+proof -
+  txt {* @{text y} is in the domain @{text H''} of some function @{text h''},
+  such that @{text h} extends @{text h''}. *}
+
+  from M cM u and y obtain H' h' where
+      y_hy: "(y, h y) \<in> graph H' h'"
+    and c': "graph H' h' \<in> c"
+    and * :
+      "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
+      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x"
+    by (rule some_H'h't [elim_format]) blast
+
+  txt {* @{text x} is in the domain @{text H'} of some function @{text h'},
+    such that @{text h} extends @{text h'}. *}
+
+  from M cM u and x obtain H'' h'' where
+      x_hx: "(x, h x) \<in> graph H'' h''"
+    and c'': "graph H'' h'' \<in> c"
+    and ** :
+      "linearform H'' h''"  "H'' \<unlhd> E"  "F \<unlhd> H''"
+      "graph F f \<subseteq> graph H'' h''"  "\<forall>x \<in> H''. h'' x \<le> p x"
+    by (rule some_H'h't [elim_format]) blast
+
+  txt {* Since both @{text h'} and @{text h''} are elements of the chain,
+    @{text h''} is an extension of @{text h'} or vice versa. Thus both
+    @{text x} and @{text y} are contained in the greater
+    one. \label{cases1}*}
+
+  from cM c'' c' have "graph H'' h'' \<subseteq> graph H' h' \<or> graph H' h' \<subseteq> graph H'' h''"
+    (is "?case1 \<or> ?case2") ..
+  then show ?thesis
+  proof
+    assume ?case1
+    have "(x, h x) \<in> graph H'' h''" by fact
+    also have "\<dots> \<subseteq> graph H' h'" by fact
+    finally have xh:"(x, h x) \<in> graph H' h'" .
+    then have "x \<in> H'" ..
+    moreover from y_hy have "y \<in> H'" ..
+    moreover from cM u and c' have "graph H' h' \<subseteq> graph H h"
+      by (simp only: chain_ball_Union_upper)
+    ultimately show ?thesis using * by blast
+  next
+    assume ?case2
+    from x_hx have "x \<in> H''" ..
+    moreover {
+      have "(y, h y) \<in> graph H' h'" by (rule y_hy)
+      also have "\<dots> \<subseteq> graph H'' h''" by fact
+      finally have "(y, h y) \<in> graph H'' h''" .
+    } then have "y \<in> H''" ..
+    moreover from cM u and c'' have "graph H'' h'' \<subseteq> graph H h"
+      by (simp only: chain_ball_Union_upper)
+    ultimately show ?thesis using ** by blast
+  qed
+qed
+
+text {*
+  \medskip The relation induced by the graph of the supremum of a
+  chain @{text c} is definite, i.~e.~t is the graph of a function.
+*}
+
+lemma sup_definite:
+  assumes M_def: "M \<equiv> norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and xy: "(x, y) \<in> \<Union>c"
+    and xz: "(x, z) \<in> \<Union>c"
+  shows "z = y"
+proof -
+  from cM have c: "c \<subseteq> M" ..
+  from xy obtain G1 where xy': "(x, y) \<in> G1" and G1: "G1 \<in> c" ..
+  from xz obtain G2 where xz': "(x, z) \<in> G2" and G2: "G2 \<in> c" ..
+
+  from G1 c have "G1 \<in> M" ..
+  then obtain H1 h1 where G1_rep: "G1 = graph H1 h1"
+    unfolding M_def by blast
+
+  from G2 c have "G2 \<in> M" ..
+  then obtain H2 h2 where G2_rep: "G2 = graph H2 h2"
+    unfolding M_def by blast
+
+  txt {* @{text "G\<^sub>1"} is contained in @{text "G\<^sub>2"}
+    or vice versa, since both @{text "G\<^sub>1"} and @{text
+    "G\<^sub>2"} are members of @{text c}. \label{cases2}*}
+
+  from cM G1 G2 have "G1 \<subseteq> G2 \<or> G2 \<subseteq> G1" (is "?case1 \<or> ?case2") ..
+  then show ?thesis
+  proof
+    assume ?case1
+    with xy' G2_rep have "(x, y) \<in> graph H2 h2" by blast
+    then have "y = h2 x" ..
+    also
+    from xz' G2_rep have "(x, z) \<in> graph H2 h2" by (simp only:)
+    then have "z = h2 x" ..
+    finally show ?thesis .
+  next
+    assume ?case2
+    with xz' G1_rep have "(x, z) \<in> graph H1 h1" by blast
+    then have "z = h1 x" ..
+    also
+    from xy' G1_rep have "(x, y) \<in> graph H1 h1" by (simp only:)
+    then have "y = h1 x" ..
+    finally show ?thesis ..
+  qed
+qed
+
+text {*
+  \medskip The limit function @{text h} is linear. Every element
+  @{text x} in the domain of @{text h} is in the domain of a function
+  @{text h'} in the chain of norm preserving extensions.  Furthermore,
+  @{text h} is an extension of @{text h'} so the function values of
+  @{text x} are identical for @{text h'} and @{text h}.  Finally, the
+  function @{text h'} is linear by construction of @{text M}.
+*}
+
+lemma sup_lf:
+  assumes M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and u: "graph H h = \<Union>c"
+  shows "linearform H h"
+proof
+  fix x y assume x: "x \<in> H" and y: "y \<in> H"
+  with M cM u obtain H' h' where
+        x': "x \<in> H'" and y': "y \<in> H'"
+      and b: "graph H' h' \<subseteq> graph H h"
+      and linearform: "linearform H' h'"
+      and subspace: "H' \<unlhd> E"
+    by (rule some_H'h'2 [elim_format]) blast
+
+  show "h (x + y) = h x + h y"
+  proof -
+    from linearform x' y' have "h' (x + y) = h' x + h' y"
+      by (rule linearform.add)
+    also from b x' have "h' x = h x" ..
+    also from b y' have "h' y = h y" ..
+    also from subspace x' y' have "x + y \<in> H'"
+      by (rule subspace.add_closed)
+    with b have "h' (x + y) = h (x + y)" ..
+    finally show ?thesis .
+  qed
+next
+  fix x a assume x: "x \<in> H"
+  with M cM u obtain H' h' where
+        x': "x \<in> H'"
+      and b: "graph H' h' \<subseteq> graph H h"
+      and linearform: "linearform H' h'"
+      and subspace: "H' \<unlhd> E"
+    by (rule some_H'h' [elim_format]) blast
+
+  show "h (a \<cdot> x) = a * h x"
+  proof -
+    from linearform x' have "h' (a \<cdot> x) = a * h' x"
+      by (rule linearform.mult)
+    also from b x' have "h' x = h x" ..
+    also from subspace x' have "a \<cdot> x \<in> H'"
+      by (rule subspace.mult_closed)
+    with b have "h' (a \<cdot> x) = h (a \<cdot> x)" ..
+    finally show ?thesis .
+  qed
+qed
+
+text {*
+  \medskip The limit of a non-empty chain of norm preserving
+  extensions of @{text f} is an extension of @{text f}, since every
+  element of the chain is an extension of @{text f} and the supremum
+  is an extension for every element of the chain.
+*}
+
+lemma sup_ext:
+  assumes graph: "graph H h = \<Union>c"
+    and M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and ex: "\<exists>x. x \<in> c"
+  shows "graph F f \<subseteq> graph H h"
+proof -
+  from ex obtain x where xc: "x \<in> c" ..
+  from cM have "c \<subseteq> M" ..
+  with xc have "x \<in> M" ..
+  with M have "x \<in> norm_pres_extensions E p F f"
+    by (simp only:)
+  then obtain G g where "x = graph G g" and "graph F f \<subseteq> graph G g" ..
+  then have "graph F f \<subseteq> x" by (simp only:)
+  also from xc have "\<dots> \<subseteq> \<Union>c" by blast
+  also from graph have "\<dots> = graph H h" ..
+  finally show ?thesis .
+qed
+
+text {*
+  \medskip The domain @{text H} of the limit function is a superspace
+  of @{text F}, since @{text F} is a subset of @{text H}. The
+  existence of the @{text 0} element in @{text F} and the closure
+  properties follow from the fact that @{text F} is a vector space.
+*}
+
+lemma sup_supF:
+  assumes graph: "graph H h = \<Union>c"
+    and M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and ex: "\<exists>x. x \<in> c"
+    and FE: "F \<unlhd> E"
+  shows "F \<unlhd> H"
+proof
+  from FE show "F \<noteq> {}" by (rule subspace.non_empty)
+  from graph M cM ex have "graph F f \<subseteq> graph H h" by (rule sup_ext)
+  then show "F \<subseteq> H" ..
+  fix x y assume "x \<in> F" and "y \<in> F"
+  with FE show "x + y \<in> F" by (rule subspace.add_closed)
+next
+  fix x a assume "x \<in> F"
+  with FE show "a \<cdot> x \<in> F" by (rule subspace.mult_closed)
+qed
+
+text {*
+  \medskip The domain @{text H} of the limit function is a subspace of
+  @{text E}.
+*}
+
+lemma sup_subE:
+  assumes graph: "graph H h = \<Union>c"
+    and M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+    and ex: "\<exists>x. x \<in> c"
+    and FE: "F \<unlhd> E"
+    and E: "vectorspace E"
+  shows "H \<unlhd> E"
+proof
+  show "H \<noteq> {}"
+  proof -
+    from FE E have "0 \<in> F" by (rule subspace.zero)
+    also from graph M cM ex FE have "F \<unlhd> H" by (rule sup_supF)
+    then have "F \<subseteq> H" ..
+    finally show ?thesis by blast
+  qed
+  show "H \<subseteq> E"
+  proof
+    fix x assume "x \<in> H"
+    with M cM graph
+    obtain H' h' where x: "x \<in> H'" and H'E: "H' \<unlhd> E"
+      by (rule some_H'h' [elim_format]) blast
+    from H'E have "H' \<subseteq> E" ..
+    with x show "x \<in> E" ..
+  qed
+  fix x y assume x: "x \<in> H" and y: "y \<in> H"
+  show "x + y \<in> H"
+  proof -
+    from M cM graph x y obtain H' h' where
+          x': "x \<in> H'" and y': "y \<in> H'" and H'E: "H' \<unlhd> E"
+        and graphs: "graph H' h' \<subseteq> graph H h"
+      by (rule some_H'h'2 [elim_format]) blast
+    from H'E x' y' have "x + y \<in> H'"
+      by (rule subspace.add_closed)
+    also from graphs have "H' \<subseteq> H" ..
+    finally show ?thesis .
+  qed
+next
+  fix x a assume x: "x \<in> H"
+  show "a \<cdot> x \<in> H"
+  proof -
+    from M cM graph x
+    obtain H' h' where x': "x \<in> H'" and H'E: "H' \<unlhd> E"
+        and graphs: "graph H' h' \<subseteq> graph H h"
+      by (rule some_H'h' [elim_format]) blast
+    from H'E x' have "a \<cdot> x \<in> H'" by (rule subspace.mult_closed)
+    also from graphs have "H' \<subseteq> H" ..
+    finally show ?thesis .
+  qed
+qed
+
+text {*
+  \medskip The limit function is bounded by the norm @{text p} as
+  well, since all elements in the chain are bounded by @{text p}.
+*}
+
+lemma sup_norm_pres:
+  assumes graph: "graph H h = \<Union>c"
+    and M: "M = norm_pres_extensions E p F f"
+    and cM: "c \<in> chain M"
+  shows "\<forall>x \<in> H. h x \<le> p x"
+proof
+  fix x assume "x \<in> H"
+  with M cM graph obtain H' h' where x': "x \<in> H'"
+      and graphs: "graph H' h' \<subseteq> graph H h"
+      and a: "\<forall>x \<in> H'. h' x \<le> p x"
+    by (rule some_H'h' [elim_format]) blast
+  from graphs x' have [symmetric]: "h' x = h x" ..
+  also from a x' have "h' x \<le> p x " ..
+  finally show "h x \<le> p x" .
+qed
+
+text {*
+  \medskip The following lemma is a property of linear forms on real
+  vector spaces. It will be used for the lemma @{text abs_HahnBanach}
+  (see page \pageref{abs-HahnBanach}). \label{abs-ineq-iff} For real
+  vector spaces the following inequations are equivalent:
+  \begin{center}
+  \begin{tabular}{lll}
+  @{text "\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x"} & and &
+  @{text "\<forall>x \<in> H. h x \<le> p x"} \\
+  \end{tabular}
+  \end{center}
+*}
+
+lemma abs_ineq_iff:
+  assumes "subspace H E" and "vectorspace E" and "seminorm E p"
+    and "linearform H h"
+  shows "(\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x) = (\<forall>x \<in> H. h x \<le> p x)" (is "?L = ?R")
+proof
+  interpret subspace H E by fact
+  interpret vectorspace E by fact
+  interpret seminorm E p by fact
+  interpret linearform H h by fact
+  have H: "vectorspace H" using `vectorspace E` ..
+  {
+    assume l: ?L
+    show ?R
+    proof
+      fix x assume x: "x \<in> H"
+      have "h x \<le> \<bar>h x\<bar>" by arith
+      also from l x have "\<dots> \<le> p x" ..
+      finally show "h x \<le> p x" .
+    qed
+  next
+    assume r: ?R
+    show ?L
+    proof
+      fix x assume x: "x \<in> H"
+      show "\<And>a b :: real. - a \<le> b \<Longrightarrow> b \<le> a \<Longrightarrow> \<bar>b\<bar> \<le> a"
+        by arith
+      from `linearform H h` and H x
+      have "- h x = h (- x)" by (rule linearform.neg [symmetric])
+      also
+      from H x have "- x \<in> H" by (rule vectorspace.neg_closed)
+      with r have "h (- x) \<le> p (- x)" ..
+      also have "\<dots> = p x"
+	using `seminorm E p` `vectorspace E`
+      proof (rule seminorm.minus)
+        from x show "x \<in> E" ..
+      qed
+      finally have "- h x \<le> p x" .
+      then show "- p x \<le> h x" by simp
+      from r x show "h x \<le> p x" ..
+    qed
+  }
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/Linearform.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,60 @@
+(*  Title:      HOL/Real/HahnBanach/Linearform.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Linearforms *}
+
+theory Linearform
+imports VectorSpace
+begin
+
+text {*
+  A \emph{linear form} is a function on a vector space into the reals
+  that is additive and multiplicative.
+*}
+
+locale linearform =
+  fixes V :: "'a\<Colon>{minus, plus, zero, uminus} set" and f
+  assumes add [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> f (x + y) = f x + f y"
+    and mult [iff]: "x \<in> V \<Longrightarrow> f (a \<cdot> x) = a * f x"
+
+declare linearform.intro [intro?]
+
+lemma (in linearform) neg [iff]:
+  assumes "vectorspace V"
+  shows "x \<in> V \<Longrightarrow> f (- x) = - f x"
+proof -
+  interpret vectorspace V by fact
+  assume x: "x \<in> V"
+  then have "f (- x) = f ((- 1) \<cdot> x)" by (simp add: negate_eq1)
+  also from x have "\<dots> = (- 1) * (f x)" by (rule mult)
+  also from x have "\<dots> = - (f x)" by simp
+  finally show ?thesis .
+qed
+
+lemma (in linearform) diff [iff]:
+  assumes "vectorspace V"
+  shows "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> f (x - y) = f x - f y"
+proof -
+  interpret vectorspace V by fact
+  assume x: "x \<in> V" and y: "y \<in> V"
+  then have "x - y = x + - y" by (rule diff_eq1)
+  also have "f \<dots> = f x + f (- y)" by (rule add) (simp_all add: x y)
+  also have "f (- y) = - f y" using `vectorspace V` y by (rule neg)
+  finally show ?thesis by simp
+qed
+
+text {* Every linear form yields @{text 0} for the @{text 0} vector. *}
+
+lemma (in linearform) zero [iff]:
+  assumes "vectorspace V"
+  shows "f 0 = 0"
+proof -
+  interpret vectorspace V by fact
+  have "f 0 = f (0 - 0)" by simp
+  also have "\<dots> = f 0 - f 0" using `vectorspace V` by (rule diff) simp_all
+  also have "\<dots> = 0" by simp
+  finally show ?thesis .
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/NormedSpace.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,117 @@
+(*  Title:      HOL/Real/HahnBanach/NormedSpace.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Normed vector spaces *}
+
+theory NormedSpace
+imports Subspace
+begin
+
+subsection {* Quasinorms *}
+
+text {*
+  A \emph{seminorm} @{text "\<parallel>\<cdot>\<parallel>"} is a function on a real vector space
+  into the reals that has the following properties: it is positive
+  definite, absolute homogenous and subadditive.
+*}
+
+locale norm_syntax =
+  fixes norm :: "'a \<Rightarrow> real"    ("\<parallel>_\<parallel>")
+
+locale seminorm = var_V + norm_syntax +
+  constrains V :: "'a\<Colon>{minus, plus, zero, uminus} set"
+  assumes ge_zero [iff?]: "x \<in> V \<Longrightarrow> 0 \<le> \<parallel>x\<parallel>"
+    and abs_homogenous [iff?]: "x \<in> V \<Longrightarrow> \<parallel>a \<cdot> x\<parallel> = \<bar>a\<bar> * \<parallel>x\<parallel>"
+    and subadditive [iff?]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> \<parallel>x + y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>"
+
+declare seminorm.intro [intro?]
+
+lemma (in seminorm) diff_subadditive:
+  assumes "vectorspace V"
+  shows "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> \<parallel>x - y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>"
+proof -
+  interpret vectorspace V by fact
+  assume x: "x \<in> V" and y: "y \<in> V"
+  then have "x - y = x + - 1 \<cdot> y"
+    by (simp add: diff_eq2 negate_eq2a)
+  also from x y have "\<parallel>\<dots>\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>- 1 \<cdot> y\<parallel>"
+    by (simp add: subadditive)
+  also from y have "\<parallel>- 1 \<cdot> y\<parallel> = \<bar>- 1\<bar> * \<parallel>y\<parallel>"
+    by (rule abs_homogenous)
+  also have "\<dots> = \<parallel>y\<parallel>" by simp
+  finally show ?thesis .
+qed
+
+lemma (in seminorm) minus:
+  assumes "vectorspace V"
+  shows "x \<in> V \<Longrightarrow> \<parallel>- x\<parallel> = \<parallel>x\<parallel>"
+proof -
+  interpret vectorspace V by fact
+  assume x: "x \<in> V"
+  then have "- x = - 1 \<cdot> x" by (simp only: negate_eq1)
+  also from x have "\<parallel>\<dots>\<parallel> = \<bar>- 1\<bar> * \<parallel>x\<parallel>"
+    by (rule abs_homogenous)
+  also have "\<dots> = \<parallel>x\<parallel>" by simp
+  finally show ?thesis .
+qed
+
+
+subsection {* Norms *}
+
+text {*
+  A \emph{norm} @{text "\<parallel>\<cdot>\<parallel>"} is a seminorm that maps only the
+  @{text 0} vector to @{text 0}.
+*}
+
+locale norm = seminorm +
+  assumes zero_iff [iff]: "x \<in> V \<Longrightarrow> (\<parallel>x\<parallel> = 0) = (x = 0)"
+
+
+subsection {* Normed vector spaces *}
+
+text {*
+  A vector space together with a norm is called a \emph{normed
+  space}.
+*}
+
+locale normed_vectorspace = vectorspace + norm
+
+declare normed_vectorspace.intro [intro?]
+
+lemma (in normed_vectorspace) gt_zero [intro?]:
+  "x \<in> V \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> 0 < \<parallel>x\<parallel>"
+proof -
+  assume x: "x \<in> V" and neq: "x \<noteq> 0"
+  from x have "0 \<le> \<parallel>x\<parallel>" ..
+  also have [symmetric]: "\<dots> \<noteq> 0"
+  proof
+    assume "\<parallel>x\<parallel> = 0"
+    with x have "x = 0" by simp
+    with neq show False by contradiction
+  qed
+  finally show ?thesis .
+qed
+
+text {*
+  Any subspace of a normed vector space is again a normed vectorspace.
+*}
+
+lemma subspace_normed_vs [intro?]:
+  fixes F E norm
+  assumes "subspace F E" "normed_vectorspace E norm"
+  shows "normed_vectorspace F norm"
+proof -
+  interpret subspace F E by fact
+  interpret normed_vectorspace E norm by fact
+  show ?thesis
+  proof
+    show "vectorspace F" by (rule vectorspace) unfold_locales
+  next
+    have "NormedSpace.norm E norm" ..
+    with subset show "NormedSpace.norm F norm"
+      by (simp add: norm_def seminorm_def norm_axioms_def)
+  qed
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/README.html	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,38 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+
+<!-- $Id$ -->
+
+<HTML>
+
+<HEAD>
+  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+  <TITLE>HOL/Real/HahnBanach/README</TITLE>
+</HEAD>
+
+<BODY>
+
+<H3>The Hahn-Banach Theorem for Real Vector Spaces (Isabelle/Isar)</H3>
+
+Author: Gertrud Bauer, Technische Universit&auml;t M&uuml;nchen<P>
+
+This directory contains the proof of the Hahn-Banach theorem for real vectorspaces,
+following H. Heuser, Funktionalanalysis, p. 228 -232.
+The Hahn-Banach theorem is one of the fundamental theorems of functioal analysis.
+It is a conclusion of Zorn's lemma.<P>
+
+Two different formaulations of the theorem are presented, one for general real vectorspaces
+and its application to normed vectorspaces. <P>
+
+The theorem says, that every continous linearform, defined on arbitrary subspaces
+(not only one-dimensional subspaces), can be extended to a continous linearform on
+the whole vectorspace.
+
+
+<HR>
+
+<ADDRESS>
+<A NAME="bauerg@in.tum.de" HREF="mailto:bauerg@in.tum.de">bauerg@in.tum.de</A>
+</ADDRESS>
+
+</BODY>
+</HTML>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/ROOT.ML	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,8 @@
+(*  Title:      HOL/Real/HahnBanach/ROOT.ML
+    ID:         $Id$
+    Author:     Gertrud Bauer, TU Munich
+
+The Hahn-Banach theorem for real vector spaces (Isabelle/Isar).
+*)
+
+time_use_thy "HahnBanach";
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/Subspace.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,513 @@
+(*  Title:      HOL/Real/HahnBanach/Subspace.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Subspaces *}
+
+theory Subspace
+imports VectorSpace
+begin
+
+subsection {* Definition *}
+
+text {*
+  A non-empty subset @{text U} of a vector space @{text V} is a
+  \emph{subspace} of @{text V}, iff @{text U} is closed under addition
+  and scalar multiplication.
+*}
+
+locale subspace =
+  fixes U :: "'a\<Colon>{minus, plus, zero, uminus} set" and V
+  assumes non_empty [iff, intro]: "U \<noteq> {}"
+    and subset [iff]: "U \<subseteq> V"
+    and add_closed [iff]: "x \<in> U \<Longrightarrow> y \<in> U \<Longrightarrow> x + y \<in> U"
+    and mult_closed [iff]: "x \<in> U \<Longrightarrow> a \<cdot> x \<in> U"
+
+notation (symbols)
+  subspace  (infix "\<unlhd>" 50)
+
+declare vectorspace.intro [intro?] subspace.intro [intro?]
+
+lemma subspace_subset [elim]: "U \<unlhd> V \<Longrightarrow> U \<subseteq> V"
+  by (rule subspace.subset)
+
+lemma (in subspace) subsetD [iff]: "x \<in> U \<Longrightarrow> x \<in> V"
+  using subset by blast
+
+lemma subspaceD [elim]: "U \<unlhd> V \<Longrightarrow> x \<in> U \<Longrightarrow> x \<in> V"
+  by (rule subspace.subsetD)
+
+lemma rev_subspaceD [elim?]: "x \<in> U \<Longrightarrow> U \<unlhd> V \<Longrightarrow> x \<in> V"
+  by (rule subspace.subsetD)
+
+lemma (in subspace) diff_closed [iff]:
+  assumes "vectorspace V"
+  assumes x: "x \<in> U" and y: "y \<in> U"
+  shows "x - y \<in> U"
+proof -
+  interpret vectorspace V by fact
+  from x y show ?thesis by (simp add: diff_eq1 negate_eq1)
+qed
+
+text {*
+  \medskip Similar as for linear spaces, the existence of the zero
+  element in every subspace follows from the non-emptiness of the
+  carrier set and by vector space laws.
+*}
+
+lemma (in subspace) zero [intro]:
+  assumes "vectorspace V"
+  shows "0 \<in> U"
+proof -
+  interpret V!: vectorspace V by fact
+  have "U \<noteq> {}" by (rule non_empty)
+  then obtain x where x: "x \<in> U" by blast
+  then have "x \<in> V" .. then have "0 = x - x" by simp
+  also from `vectorspace V` x x have "\<dots> \<in> U" by (rule diff_closed)
+  finally show ?thesis .
+qed
+
+lemma (in subspace) neg_closed [iff]:
+  assumes "vectorspace V"
+  assumes x: "x \<in> U"
+  shows "- x \<in> U"
+proof -
+  interpret vectorspace V by fact
+  from x show ?thesis by (simp add: negate_eq1)
+qed
+
+text {* \medskip Further derived laws: every subspace is a vector space. *}
+
+lemma (in subspace) vectorspace [iff]:
+  assumes "vectorspace V"
+  shows "vectorspace U"
+proof -
+  interpret vectorspace V by fact
+  show ?thesis
+  proof
+    show "U \<noteq> {}" ..
+    fix x y z assume x: "x \<in> U" and y: "y \<in> U" and z: "z \<in> U"
+    fix a b :: real
+    from x y show "x + y \<in> U" by simp
+    from x show "a \<cdot> x \<in> U" by simp
+    from x y z show "(x + y) + z = x + (y + z)" by (simp add: add_ac)
+    from x y show "x + y = y + x" by (simp add: add_ac)
+    from x show "x - x = 0" by simp
+    from x show "0 + x = x" by simp
+    from x y show "a \<cdot> (x + y) = a \<cdot> x + a \<cdot> y" by (simp add: distrib)
+    from x show "(a + b) \<cdot> x = a \<cdot> x + b \<cdot> x" by (simp add: distrib)
+    from x show "(a * b) \<cdot> x = a \<cdot> b \<cdot> x" by (simp add: mult_assoc)
+    from x show "1 \<cdot> x = x" by simp
+    from x show "- x = - 1 \<cdot> x" by (simp add: negate_eq1)
+    from x y show "x - y = x + - y" by (simp add: diff_eq1)
+  qed
+qed
+
+
+text {* The subspace relation is reflexive. *}
+
+lemma (in vectorspace) subspace_refl [intro]: "V \<unlhd> V"
+proof
+  show "V \<noteq> {}" ..
+  show "V \<subseteq> V" ..
+  fix x y assume x: "x \<in> V" and y: "y \<in> V"
+  fix a :: real
+  from x y show "x + y \<in> V" by simp
+  from x show "a \<cdot> x \<in> V" by simp
+qed
+
+text {* The subspace relation is transitive. *}
+
+lemma (in vectorspace) subspace_trans [trans]:
+  "U \<unlhd> V \<Longrightarrow> V \<unlhd> W \<Longrightarrow> U \<unlhd> W"
+proof
+  assume uv: "U \<unlhd> V" and vw: "V \<unlhd> W"
+  from uv show "U \<noteq> {}" by (rule subspace.non_empty)
+  show "U \<subseteq> W"
+  proof -
+    from uv have "U \<subseteq> V" by (rule subspace.subset)
+    also from vw have "V \<subseteq> W" by (rule subspace.subset)
+    finally show ?thesis .
+  qed
+  fix x y assume x: "x \<in> U" and y: "y \<in> U"
+  from uv and x y show "x + y \<in> U" by (rule subspace.add_closed)
+  from uv and x show "\<And>a. a \<cdot> x \<in> U" by (rule subspace.mult_closed)
+qed
+
+
+subsection {* Linear closure *}
+
+text {*
+  The \emph{linear closure} of a vector @{text x} is the set of all
+  scalar multiples of @{text x}.
+*}
+
+definition
+  lin :: "('a::{minus, plus, zero}) \<Rightarrow> 'a set" where
+  "lin x = {a \<cdot> x | a. True}"
+
+lemma linI [intro]: "y = a \<cdot> x \<Longrightarrow> y \<in> lin x"
+  unfolding lin_def by blast
+
+lemma linI' [iff]: "a \<cdot> x \<in> lin x"
+  unfolding lin_def by blast
+
+lemma linE [elim]: "x \<in> lin v \<Longrightarrow> (\<And>a::real. x = a \<cdot> v \<Longrightarrow> C) \<Longrightarrow> C"
+  unfolding lin_def by blast
+
+
+text {* Every vector is contained in its linear closure. *}
+
+lemma (in vectorspace) x_lin_x [iff]: "x \<in> V \<Longrightarrow> x \<in> lin x"
+proof -
+  assume "x \<in> V"
+  then have "x = 1 \<cdot> x" by simp
+  also have "\<dots> \<in> lin x" ..
+  finally show ?thesis .
+qed
+
+lemma (in vectorspace) "0_lin_x" [iff]: "x \<in> V \<Longrightarrow> 0 \<in> lin x"
+proof
+  assume "x \<in> V"
+  then show "0 = 0 \<cdot> x" by simp
+qed
+
+text {* Any linear closure is a subspace. *}
+
+lemma (in vectorspace) lin_subspace [intro]:
+  "x \<in> V \<Longrightarrow> lin x \<unlhd> V"
+proof
+  assume x: "x \<in> V"
+  then show "lin x \<noteq> {}" by (auto simp add: x_lin_x)
+  show "lin x \<subseteq> V"
+  proof
+    fix x' assume "x' \<in> lin x"
+    then obtain a where "x' = a \<cdot> x" ..
+    with x show "x' \<in> V" by simp
+  qed
+  fix x' x'' assume x': "x' \<in> lin x" and x'': "x'' \<in> lin x"
+  show "x' + x'' \<in> lin x"
+  proof -
+    from x' obtain a' where "x' = a' \<cdot> x" ..
+    moreover from x'' obtain a'' where "x'' = a'' \<cdot> x" ..
+    ultimately have "x' + x'' = (a' + a'') \<cdot> x"
+      using x by (simp add: distrib)
+    also have "\<dots> \<in> lin x" ..
+    finally show ?thesis .
+  qed
+  fix a :: real
+  show "a \<cdot> x' \<in> lin x"
+  proof -
+    from x' obtain a' where "x' = a' \<cdot> x" ..
+    with x have "a \<cdot> x' = (a * a') \<cdot> x" by (simp add: mult_assoc)
+    also have "\<dots> \<in> lin x" ..
+    finally show ?thesis .
+  qed
+qed
+
+
+text {* Any linear closure is a vector space. *}
+
+lemma (in vectorspace) lin_vectorspace [intro]:
+  assumes "x \<in> V"
+  shows "vectorspace (lin x)"
+proof -
+  from `x \<in> V` have "subspace (lin x) V"
+    by (rule lin_subspace)
+  from this and vectorspace_axioms show ?thesis
+    by (rule subspace.vectorspace)
+qed
+
+
+subsection {* Sum of two vectorspaces *}
+
+text {*
+  The \emph{sum} of two vectorspaces @{text U} and @{text V} is the
+  set of all sums of elements from @{text U} and @{text V}.
+*}
+
+instantiation "fun" :: (type, type) plus
+begin
+
+definition
+  sum_def: "plus_fun U V = {u + v | u v. u \<in> U \<and> v \<in> V}"  (* FIXME not fully general!? *)
+
+instance ..
+
+end
+
+lemma sumE [elim]:
+    "x \<in> U + V \<Longrightarrow> (\<And>u v. x = u + v \<Longrightarrow> u \<in> U \<Longrightarrow> v \<in> V \<Longrightarrow> C) \<Longrightarrow> C"
+  unfolding sum_def by blast
+
+lemma sumI [intro]:
+    "u \<in> U \<Longrightarrow> v \<in> V \<Longrightarrow> x = u + v \<Longrightarrow> x \<in> U + V"
+  unfolding sum_def by blast
+
+lemma sumI' [intro]:
+    "u \<in> U \<Longrightarrow> v \<in> V \<Longrightarrow> u + v \<in> U + V"
+  unfolding sum_def by blast
+
+text {* @{text U} is a subspace of @{text "U + V"}. *}
+
+lemma subspace_sum1 [iff]:
+  assumes "vectorspace U" "vectorspace V"
+  shows "U \<unlhd> U + V"
+proof -
+  interpret vectorspace U by fact
+  interpret vectorspace V by fact
+  show ?thesis
+  proof
+    show "U \<noteq> {}" ..
+    show "U \<subseteq> U + V"
+    proof
+      fix x assume x: "x \<in> U"
+      moreover have "0 \<in> V" ..
+      ultimately have "x + 0 \<in> U + V" ..
+      with x show "x \<in> U + V" by simp
+    qed
+    fix x y assume x: "x \<in> U" and "y \<in> U"
+    then show "x + y \<in> U" by simp
+    from x show "\<And>a. a \<cdot> x \<in> U" by simp
+  qed
+qed
+
+text {* The sum of two subspaces is again a subspace. *}
+
+lemma sum_subspace [intro?]:
+  assumes "subspace U E" "vectorspace E" "subspace V E"
+  shows "U + V \<unlhd> E"
+proof -
+  interpret subspace U E by fact
+  interpret vectorspace E by fact
+  interpret subspace V E by fact
+  show ?thesis
+  proof
+    have "0 \<in> U + V"
+    proof
+      show "0 \<in> U" using `vectorspace E` ..
+      show "0 \<in> V" using `vectorspace E` ..
+      show "(0::'a) = 0 + 0" by simp
+    qed
+    then show "U + V \<noteq> {}" by blast
+    show "U + V \<subseteq> E"
+    proof
+      fix x assume "x \<in> U + V"
+      then obtain u v where "x = u + v" and
+	"u \<in> U" and "v \<in> V" ..
+      then show "x \<in> E" by simp
+    qed
+    fix x y assume x: "x \<in> U + V" and y: "y \<in> U + V"
+    show "x + y \<in> U + V"
+    proof -
+      from x obtain ux vx where "x = ux + vx" and "ux \<in> U" and "vx \<in> V" ..
+      moreover
+      from y obtain uy vy where "y = uy + vy" and "uy \<in> U" and "vy \<in> V" ..
+      ultimately
+      have "ux + uy \<in> U"
+	and "vx + vy \<in> V"
+	and "x + y = (ux + uy) + (vx + vy)"
+	using x y by (simp_all add: add_ac)
+      then show ?thesis ..
+    qed
+    fix a show "a \<cdot> x \<in> U + V"
+    proof -
+      from x obtain u v where "x = u + v" and "u \<in> U" and "v \<in> V" ..
+      then have "a \<cdot> u \<in> U" and "a \<cdot> v \<in> V"
+	and "a \<cdot> x = (a \<cdot> u) + (a \<cdot> v)" by (simp_all add: distrib)
+      then show ?thesis ..
+    qed
+  qed
+qed
+
+text{* The sum of two subspaces is a vectorspace. *}
+
+lemma sum_vs [intro?]:
+    "U \<unlhd> E \<Longrightarrow> V \<unlhd> E \<Longrightarrow> vectorspace E \<Longrightarrow> vectorspace (U + V)"
+  by (rule subspace.vectorspace) (rule sum_subspace)
+
+
+subsection {* Direct sums *}
+
+text {*
+  The sum of @{text U} and @{text V} is called \emph{direct}, iff the
+  zero element is the only common element of @{text U} and @{text
+  V}. For every element @{text x} of the direct sum of @{text U} and
+  @{text V} the decomposition in @{text "x = u + v"} with
+  @{text "u \<in> U"} and @{text "v \<in> V"} is unique.
+*}
+
+lemma decomp:
+  assumes "vectorspace E" "subspace U E" "subspace V E"
+  assumes direct: "U \<inter> V = {0}"
+    and u1: "u1 \<in> U" and u2: "u2 \<in> U"
+    and v1: "v1 \<in> V" and v2: "v2 \<in> V"
+    and sum: "u1 + v1 = u2 + v2"
+  shows "u1 = u2 \<and> v1 = v2"
+proof -
+  interpret vectorspace E by fact
+  interpret subspace U E by fact
+  interpret subspace V E by fact
+  show ?thesis
+  proof
+    have U: "vectorspace U"  (* FIXME: use interpret *)
+      using `subspace U E` `vectorspace E` by (rule subspace.vectorspace)
+    have V: "vectorspace V"
+      using `subspace V E` `vectorspace E` by (rule subspace.vectorspace)
+    from u1 u2 v1 v2 and sum have eq: "u1 - u2 = v2 - v1"
+      by (simp add: add_diff_swap)
+    from u1 u2 have u: "u1 - u2 \<in> U"
+      by (rule vectorspace.diff_closed [OF U])
+    with eq have v': "v2 - v1 \<in> U" by (simp only:)
+    from v2 v1 have v: "v2 - v1 \<in> V"
+      by (rule vectorspace.diff_closed [OF V])
+    with eq have u': " u1 - u2 \<in> V" by (simp only:)
+    
+    show "u1 = u2"
+    proof (rule add_minus_eq)
+      from u1 show "u1 \<in> E" ..
+      from u2 show "u2 \<in> E" ..
+      from u u' and direct show "u1 - u2 = 0" by blast
+    qed
+    show "v1 = v2"
+    proof (rule add_minus_eq [symmetric])
+      from v1 show "v1 \<in> E" ..
+      from v2 show "v2 \<in> E" ..
+      from v v' and direct show "v2 - v1 = 0" by blast
+    qed
+  qed
+qed
+
+text {*
+  An application of the previous lemma will be used in the proof of
+  the Hahn-Banach Theorem (see page \pageref{decomp-H-use}): for any
+  element @{text "y + a \<cdot> x\<^sub>0"} of the direct sum of a
+  vectorspace @{text H} and the linear closure of @{text "x\<^sub>0"}
+  the components @{text "y \<in> H"} and @{text a} are uniquely
+  determined.
+*}
+
+lemma decomp_H':
+  assumes "vectorspace E" "subspace H E"
+  assumes y1: "y1 \<in> H" and y2: "y2 \<in> H"
+    and x': "x' \<notin> H"  "x' \<in> E"  "x' \<noteq> 0"
+    and eq: "y1 + a1 \<cdot> x' = y2 + a2 \<cdot> x'"
+  shows "y1 = y2 \<and> a1 = a2"
+proof -
+  interpret vectorspace E by fact
+  interpret subspace H E by fact
+  show ?thesis
+  proof
+    have c: "y1 = y2 \<and> a1 \<cdot> x' = a2 \<cdot> x'"
+    proof (rule decomp)
+      show "a1 \<cdot> x' \<in> lin x'" ..
+      show "a2 \<cdot> x' \<in> lin x'" ..
+      show "H \<inter> lin x' = {0}"
+      proof
+	show "H \<inter> lin x' \<subseteq> {0}"
+	proof
+          fix x assume x: "x \<in> H \<inter> lin x'"
+          then obtain a where xx': "x = a \<cdot> x'"
+            by blast
+          have "x = 0"
+          proof cases
+            assume "a = 0"
+            with xx' and x' show ?thesis by simp
+          next
+            assume a: "a \<noteq> 0"
+            from x have "x \<in> H" ..
+            with xx' have "inverse a \<cdot> a \<cdot> x' \<in> H" by simp
+            with a and x' have "x' \<in> H" by (simp add: mult_assoc2)
+            with `x' \<notin> H` show ?thesis by contradiction
+          qed
+          then show "x \<in> {0}" ..
+	qed
+	show "{0} \<subseteq> H \<inter> lin x'"
+	proof -
+          have "0 \<in> H" using `vectorspace E` ..
+          moreover have "0 \<in> lin x'" using `x' \<in> E` ..
+          ultimately show ?thesis by blast
+	qed
+      qed
+      show "lin x' \<unlhd> E" using `x' \<in> E` ..
+    qed (rule `vectorspace E`, rule `subspace H E`, rule y1, rule y2, rule eq)
+    then show "y1 = y2" ..
+    from c have "a1 \<cdot> x' = a2 \<cdot> x'" ..
+    with x' show "a1 = a2" by (simp add: mult_right_cancel)
+  qed
+qed
+
+text {*
+  Since for any element @{text "y + a \<cdot> x'"} of the direct sum of a
+  vectorspace @{text H} and the linear closure of @{text x'} the
+  components @{text "y \<in> H"} and @{text a} are unique, it follows from
+  @{text "y \<in> H"} that @{text "a = 0"}.
+*}
+
+lemma decomp_H'_H:
+  assumes "vectorspace E" "subspace H E"
+  assumes t: "t \<in> H"
+    and x': "x' \<notin> H"  "x' \<in> E"  "x' \<noteq> 0"
+  shows "(SOME (y, a). t = y + a \<cdot> x' \<and> y \<in> H) = (t, 0)"
+proof -
+  interpret vectorspace E by fact
+  interpret subspace H E by fact
+  show ?thesis
+  proof (rule, simp_all only: split_paired_all split_conv)
+    from t x' show "t = t + 0 \<cdot> x' \<and> t \<in> H" by simp
+    fix y and a assume ya: "t = y + a \<cdot> x' \<and> y \<in> H"
+    have "y = t \<and> a = 0"
+    proof (rule decomp_H')
+      from ya x' show "y + a \<cdot> x' = t + 0 \<cdot> x'" by simp
+      from ya show "y \<in> H" ..
+    qed (rule `vectorspace E`, rule `subspace H E`, rule t, (rule x')+)
+    with t x' show "(y, a) = (y + a \<cdot> x', 0)" by simp
+  qed
+qed
+
+text {*
+  The components @{text "y \<in> H"} and @{text a} in @{text "y + a \<cdot> x'"}
+  are unique, so the function @{text h'} defined by
+  @{text "h' (y + a \<cdot> x') = h y + a \<cdot> \<xi>"} is definite.
+*}
+
+lemma h'_definite:
+  fixes H
+  assumes h'_def:
+    "h' \<equiv> (\<lambda>x. let (y, a) = SOME (y, a). (x = y + a \<cdot> x' \<and> y \<in> H)
+                in (h y) + a * xi)"
+    and x: "x = y + a \<cdot> x'"
+  assumes "vectorspace E" "subspace H E"
+  assumes y: "y \<in> H"
+    and x': "x' \<notin> H"  "x' \<in> E"  "x' \<noteq> 0"
+  shows "h' x = h y + a * xi"
+proof -
+  interpret vectorspace E by fact
+  interpret subspace H E by fact
+  from x y x' have "x \<in> H + lin x'" by auto
+  have "\<exists>!p. (\<lambda>(y, a). x = y + a \<cdot> x' \<and> y \<in> H) p" (is "\<exists>!p. ?P p")
+  proof (rule ex_ex1I)
+    from x y show "\<exists>p. ?P p" by blast
+    fix p q assume p: "?P p" and q: "?P q"
+    show "p = q"
+    proof -
+      from p have xp: "x = fst p + snd p \<cdot> x' \<and> fst p \<in> H"
+        by (cases p) simp
+      from q have xq: "x = fst q + snd q \<cdot> x' \<and> fst q \<in> H"
+        by (cases q) simp
+      have "fst p = fst q \<and> snd p = snd q"
+      proof (rule decomp_H')
+        from xp show "fst p \<in> H" ..
+        from xq show "fst q \<in> H" ..
+        from xp and xq show "fst p + snd p \<cdot> x' = fst q + snd q \<cdot> x'"
+          by simp
+      qed (rule `vectorspace E`, rule `subspace H E`, (rule x')+)
+      then show ?thesis by (cases p, cases q) simp
+    qed
+  qed
+  then have eq: "(SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H) = (y, a)"
+    by (rule some1_equality) (simp add: x y)
+  with h'_def show "h' x = h y + a * xi" by (simp add: Let_def)
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/VectorSpace.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,419 @@
+(*  Title:      HOL/Real/HahnBanach/VectorSpace.thy
+    ID:         $Id$
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Vector spaces *}
+
+theory VectorSpace
+imports Real Bounds Zorn
+begin
+
+subsection {* Signature *}
+
+text {*
+  For the definition of real vector spaces a type @{typ 'a} of the
+  sort @{text "{plus, minus, zero}"} is considered, on which a real
+  scalar multiplication @{text \<cdot>} is declared.
+*}
+
+consts
+  prod  :: "real \<Rightarrow> 'a::{plus, minus, zero} \<Rightarrow> 'a"     (infixr "'(*')" 70)
+
+notation (xsymbols)
+  prod  (infixr "\<cdot>" 70)
+notation (HTML output)
+  prod  (infixr "\<cdot>" 70)
+
+
+subsection {* Vector space laws *}
+
+text {*
+  A \emph{vector space} is a non-empty set @{text V} of elements from
+  @{typ 'a} with the following vector space laws: The set @{text V} is
+  closed under addition and scalar multiplication, addition is
+  associative and commutative; @{text "- x"} is the inverse of @{text
+  x} w.~r.~t.~addition and @{text 0} is the neutral element of
+  addition.  Addition and multiplication are distributive; scalar
+  multiplication is associative and the real number @{text "1"} is
+  the neutral element of scalar multiplication.
+*}
+
+locale var_V = fixes V
+
+locale vectorspace = var_V +
+  assumes non_empty [iff, intro?]: "V \<noteq> {}"
+    and add_closed [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + y \<in> V"
+    and mult_closed [iff]: "x \<in> V \<Longrightarrow> a \<cdot> x \<in> V"
+    and add_assoc: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x + y) + z = x + (y + z)"
+    and add_commute: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + y = y + x"
+    and diff_self [simp]: "x \<in> V \<Longrightarrow> x - x = 0"
+    and add_zero_left [simp]: "x \<in> V \<Longrightarrow> 0 + x = x"
+    and add_mult_distrib1: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> a \<cdot> (x + y) = a \<cdot> x + a \<cdot> y"
+    and add_mult_distrib2: "x \<in> V \<Longrightarrow> (a + b) \<cdot> x = a \<cdot> x + b \<cdot> x"
+    and mult_assoc: "x \<in> V \<Longrightarrow> (a * b) \<cdot> x = a \<cdot> (b \<cdot> x)"
+    and mult_1 [simp]: "x \<in> V \<Longrightarrow> 1 \<cdot> x = x"
+    and negate_eq1: "x \<in> V \<Longrightarrow> - x = (- 1) \<cdot> x"
+    and diff_eq1: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x - y = x + - y"
+
+lemma (in vectorspace) negate_eq2: "x \<in> V \<Longrightarrow> (- 1) \<cdot> x = - x"
+  by (rule negate_eq1 [symmetric])
+
+lemma (in vectorspace) negate_eq2a: "x \<in> V \<Longrightarrow> -1 \<cdot> x = - x"
+  by (simp add: negate_eq1)
+
+lemma (in vectorspace) diff_eq2: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + - y = x - y"
+  by (rule diff_eq1 [symmetric])
+
+lemma (in vectorspace) diff_closed [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x - y \<in> V"
+  by (simp add: diff_eq1 negate_eq1)
+
+lemma (in vectorspace) neg_closed [iff]: "x \<in> V \<Longrightarrow> - x \<in> V"
+  by (simp add: negate_eq1)
+
+lemma (in vectorspace) add_left_commute:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> x + (y + z) = y + (x + z)"
+proof -
+  assume xyz: "x \<in> V"  "y \<in> V"  "z \<in> V"
+  then have "x + (y + z) = (x + y) + z"
+    by (simp only: add_assoc)
+  also from xyz have "\<dots> = (y + x) + z" by (simp only: add_commute)
+  also from xyz have "\<dots> = y + (x + z)" by (simp only: add_assoc)
+  finally show ?thesis .
+qed
+
+theorems (in vectorspace) add_ac =
+  add_assoc add_commute add_left_commute
+
+
+text {* The existence of the zero element of a vector space
+  follows from the non-emptiness of carrier set. *}
+
+lemma (in vectorspace) zero [iff]: "0 \<in> V"
+proof -
+  from non_empty obtain x where x: "x \<in> V" by blast
+  then have "0 = x - x" by (rule diff_self [symmetric])
+  also from x x have "\<dots> \<in> V" by (rule diff_closed)
+  finally show ?thesis .
+qed
+
+lemma (in vectorspace) add_zero_right [simp]:
+  "x \<in> V \<Longrightarrow>  x + 0 = x"
+proof -
+  assume x: "x \<in> V"
+  from this and zero have "x + 0 = 0 + x" by (rule add_commute)
+  also from x have "\<dots> = x" by (rule add_zero_left)
+  finally show ?thesis .
+qed
+
+lemma (in vectorspace) mult_assoc2:
+    "x \<in> V \<Longrightarrow> a \<cdot> b \<cdot> x = (a * b) \<cdot> x"
+  by (simp only: mult_assoc)
+
+lemma (in vectorspace) diff_mult_distrib1:
+    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> a \<cdot> (x - y) = a \<cdot> x - a \<cdot> y"
+  by (simp add: diff_eq1 negate_eq1 add_mult_distrib1 mult_assoc2)
+
+lemma (in vectorspace) diff_mult_distrib2:
+  "x \<in> V \<Longrightarrow> (a - b) \<cdot> x = a \<cdot> x - (b \<cdot> x)"
+proof -
+  assume x: "x \<in> V"
+  have " (a - b) \<cdot> x = (a + - b) \<cdot> x"
+    by (simp add: real_diff_def)
+  also from x have "\<dots> = a \<cdot> x + (- b) \<cdot> x"
+    by (rule add_mult_distrib2)
+  also from x have "\<dots> = a \<cdot> x + - (b \<cdot> x)"
+    by (simp add: negate_eq1 mult_assoc2)
+  also from x have "\<dots> = a \<cdot> x - (b \<cdot> x)"
+    by (simp add: diff_eq1)
+  finally show ?thesis .
+qed
+
+lemmas (in vectorspace) distrib =
+  add_mult_distrib1 add_mult_distrib2
+  diff_mult_distrib1 diff_mult_distrib2
+
+
+text {* \medskip Further derived laws: *}
+
+lemma (in vectorspace) mult_zero_left [simp]:
+  "x \<in> V \<Longrightarrow> 0 \<cdot> x = 0"
+proof -
+  assume x: "x \<in> V"
+  have "0 \<cdot> x = (1 - 1) \<cdot> x" by simp
+  also have "\<dots> = (1 + - 1) \<cdot> x" by simp
+  also from x have "\<dots> =  1 \<cdot> x + (- 1) \<cdot> x"
+    by (rule add_mult_distrib2)
+  also from x have "\<dots> = x + (- 1) \<cdot> x" by simp
+  also from x have "\<dots> = x + - x" by (simp add: negate_eq2a)
+  also from x have "\<dots> = x - x" by (simp add: diff_eq2)
+  also from x have "\<dots> = 0" by simp
+  finally show ?thesis .
+qed
+
+lemma (in vectorspace) mult_zero_right [simp]:
+  "a \<cdot> 0 = (0::'a)"
+proof -
+  have "a \<cdot> 0 = a \<cdot> (0 - (0::'a))" by simp
+  also have "\<dots> =  a \<cdot> 0 - a \<cdot> 0"
+    by (rule diff_mult_distrib1) simp_all
+  also have "\<dots> = 0" by simp
+  finally show ?thesis .
+qed
+
+lemma (in vectorspace) minus_mult_cancel [simp]:
+    "x \<in> V \<Longrightarrow> (- a) \<cdot> - x = a \<cdot> x"
+  by (simp add: negate_eq1 mult_assoc2)
+
+lemma (in vectorspace) add_minus_left_eq_diff:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> - x + y = y - x"
+proof -
+  assume xy: "x \<in> V"  "y \<in> V"
+  then have "- x + y = y + - x" by (simp add: add_commute)
+  also from xy have "\<dots> = y - x" by (simp add: diff_eq1)
+  finally show ?thesis .
+qed
+
+lemma (in vectorspace) add_minus [simp]:
+    "x \<in> V \<Longrightarrow> x + - x = 0"
+  by (simp add: diff_eq2)
+
+lemma (in vectorspace) add_minus_left [simp]:
+    "x \<in> V \<Longrightarrow> - x + x = 0"
+  by (simp add: diff_eq2 add_commute)
+
+lemma (in vectorspace) minus_minus [simp]:
+    "x \<in> V \<Longrightarrow> - (- x) = x"
+  by (simp add: negate_eq1 mult_assoc2)
+
+lemma (in vectorspace) minus_zero [simp]:
+    "- (0::'a) = 0"
+  by (simp add: negate_eq1)
+
+lemma (in vectorspace) minus_zero_iff [simp]:
+  "x \<in> V \<Longrightarrow> (- x = 0) = (x = 0)"
+proof
+  assume x: "x \<in> V"
+  {
+    from x have "x = - (- x)" by (simp add: minus_minus)
+    also assume "- x = 0"
+    also have "- \<dots> = 0" by (rule minus_zero)
+    finally show "x = 0" .
+  next
+    assume "x = 0"
+    then show "- x = 0" by simp
+  }
+qed
+
+lemma (in vectorspace) add_minus_cancel [simp]:
+    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + (- x + y) = y"
+  by (simp add: add_assoc [symmetric] del: add_commute)
+
+lemma (in vectorspace) minus_add_cancel [simp]:
+    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> - x + (x + y) = y"
+  by (simp add: add_assoc [symmetric] del: add_commute)
+
+lemma (in vectorspace) minus_add_distrib [simp]:
+    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> - (x + y) = - x + - y"
+  by (simp add: negate_eq1 add_mult_distrib1)
+
+lemma (in vectorspace) diff_zero [simp]:
+    "x \<in> V \<Longrightarrow> x - 0 = x"
+  by (simp add: diff_eq1)
+
+lemma (in vectorspace) diff_zero_right [simp]:
+    "x \<in> V \<Longrightarrow> 0 - x = - x"
+  by (simp add: diff_eq1)
+
+lemma (in vectorspace) add_left_cancel:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x + y = x + z) = (y = z)"
+proof
+  assume x: "x \<in> V" and y: "y \<in> V" and z: "z \<in> V"
+  {
+    from y have "y = 0 + y" by simp
+    also from x y have "\<dots> = (- x + x) + y" by simp
+    also from x y have "\<dots> = - x + (x + y)"
+      by (simp add: add_assoc neg_closed)
+    also assume "x + y = x + z"
+    also from x z have "- x + (x + z) = - x + x + z"
+      by (simp add: add_assoc [symmetric] neg_closed)
+    also from x z have "\<dots> = z" by simp
+    finally show "y = z" .
+  next
+    assume "y = z"
+    then show "x + y = x + z" by (simp only:)
+  }
+qed
+
+lemma (in vectorspace) add_right_cancel:
+    "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (y + x = z + x) = (y = z)"
+  by (simp only: add_commute add_left_cancel)
+
+lemma (in vectorspace) add_assoc_cong:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x' \<in> V \<Longrightarrow> y' \<in> V \<Longrightarrow> z \<in> V
+    \<Longrightarrow> x + y = x' + y' \<Longrightarrow> x + (y + z) = x' + (y' + z)"
+  by (simp only: add_assoc [symmetric])
+
+lemma (in vectorspace) mult_left_commute:
+    "x \<in> V \<Longrightarrow> a \<cdot> b \<cdot> x = b \<cdot> a \<cdot> x"
+  by (simp add: real_mult_commute mult_assoc2)
+
+lemma (in vectorspace) mult_zero_uniq:
+  "x \<in> V \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> a \<cdot> x = 0 \<Longrightarrow> a = 0"
+proof (rule classical)
+  assume a: "a \<noteq> 0"
+  assume x: "x \<in> V"  "x \<noteq> 0" and ax: "a \<cdot> x = 0"
+  from x a have "x = (inverse a * a) \<cdot> x" by simp
+  also from `x \<in> V` have "\<dots> = inverse a \<cdot> (a \<cdot> x)" by (rule mult_assoc)
+  also from ax have "\<dots> = inverse a \<cdot> 0" by simp
+  also have "\<dots> = 0" by simp
+  finally have "x = 0" .
+  with `x \<noteq> 0` show "a = 0" by contradiction
+qed
+
+lemma (in vectorspace) mult_left_cancel:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (a \<cdot> x = a \<cdot> y) = (x = y)"
+proof
+  assume x: "x \<in> V" and y: "y \<in> V" and a: "a \<noteq> 0"
+  from x have "x = 1 \<cdot> x" by simp
+  also from a have "\<dots> = (inverse a * a) \<cdot> x" by simp
+  also from x have "\<dots> = inverse a \<cdot> (a \<cdot> x)"
+    by (simp only: mult_assoc)
+  also assume "a \<cdot> x = a \<cdot> y"
+  also from a y have "inverse a \<cdot> \<dots> = y"
+    by (simp add: mult_assoc2)
+  finally show "x = y" .
+next
+  assume "x = y"
+  then show "a \<cdot> x = a \<cdot> y" by (simp only:)
+qed
+
+lemma (in vectorspace) mult_right_cancel:
+  "x \<in> V \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> (a \<cdot> x = b \<cdot> x) = (a = b)"
+proof
+  assume x: "x \<in> V" and neq: "x \<noteq> 0"
+  {
+    from x have "(a - b) \<cdot> x = a \<cdot> x - b \<cdot> x"
+      by (simp add: diff_mult_distrib2)
+    also assume "a \<cdot> x = b \<cdot> x"
+    with x have "a \<cdot> x - b \<cdot> x = 0" by simp
+    finally have "(a - b) \<cdot> x = 0" .
+    with x neq have "a - b = 0" by (rule mult_zero_uniq)
+    then show "a = b" by simp
+  next
+    assume "a = b"
+    then show "a \<cdot> x = b \<cdot> x" by (simp only:)
+  }
+qed
+
+lemma (in vectorspace) eq_diff_eq:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x = z - y) = (x + y = z)"
+proof
+  assume x: "x \<in> V" and y: "y \<in> V" and z: "z \<in> V"
+  {
+    assume "x = z - y"
+    then have "x + y = z - y + y" by simp
+    also from y z have "\<dots> = z + - y + y"
+      by (simp add: diff_eq1)
+    also have "\<dots> = z + (- y + y)"
+      by (rule add_assoc) (simp_all add: y z)
+    also from y z have "\<dots> = z + 0"
+      by (simp only: add_minus_left)
+    also from z have "\<dots> = z"
+      by (simp only: add_zero_right)
+    finally show "x + y = z" .
+  next
+    assume "x + y = z"
+    then have "z - y = (x + y) - y" by simp
+    also from x y have "\<dots> = x + y + - y"
+      by (simp add: diff_eq1)
+    also have "\<dots> = x + (y + - y)"
+      by (rule add_assoc) (simp_all add: x y)
+    also from x y have "\<dots> = x" by simp
+    finally show "x = z - y" ..
+  }
+qed
+
+lemma (in vectorspace) add_minus_eq_minus:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x + y = 0 \<Longrightarrow> x = - y"
+proof -
+  assume x: "x \<in> V" and y: "y \<in> V"
+  from x y have "x = (- y + y) + x" by simp
+  also from x y have "\<dots> = - y + (x + y)" by (simp add: add_ac)
+  also assume "x + y = 0"
+  also from y have "- y + 0 = - y" by simp
+  finally show "x = - y" .
+qed
+
+lemma (in vectorspace) add_minus_eq:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> x - y = 0 \<Longrightarrow> x = y"
+proof -
+  assume x: "x \<in> V" and y: "y \<in> V"
+  assume "x - y = 0"
+  with x y have eq: "x + - y = 0" by (simp add: diff_eq1)
+  with _ _ have "x = - (- y)"
+    by (rule add_minus_eq_minus) (simp_all add: x y)
+  with x y show "x = y" by simp
+qed
+
+lemma (in vectorspace) add_diff_swap:
+  "a \<in> V \<Longrightarrow> b \<in> V \<Longrightarrow> c \<in> V \<Longrightarrow> d \<in> V \<Longrightarrow> a + b = c + d
+    \<Longrightarrow> a - c = d - b"
+proof -
+  assume vs: "a \<in> V"  "b \<in> V"  "c \<in> V"  "d \<in> V"
+    and eq: "a + b = c + d"
+  then have "- c + (a + b) = - c + (c + d)"
+    by (simp add: add_left_cancel)
+  also have "\<dots> = d" using `c \<in> V` `d \<in> V` by (rule minus_add_cancel)
+  finally have eq: "- c + (a + b) = d" .
+  from vs have "a - c = (- c + (a + b)) + - b"
+    by (simp add: add_ac diff_eq1)
+  also from vs eq have "\<dots>  = d + - b"
+    by (simp add: add_right_cancel)
+  also from vs have "\<dots> = d - b" by (simp add: diff_eq2)
+  finally show "a - c = d - b" .
+qed
+
+lemma (in vectorspace) vs_add_cancel_21:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> u \<in> V
+    \<Longrightarrow> (x + (y + z) = y + u) = (x + z = u)"
+proof
+  assume vs: "x \<in> V"  "y \<in> V"  "z \<in> V"  "u \<in> V"
+  {
+    from vs have "x + z = - y + y + (x + z)" by simp
+    also have "\<dots> = - y + (y + (x + z))"
+      by (rule add_assoc) (simp_all add: vs)
+    also from vs have "y + (x + z) = x + (y + z)"
+      by (simp add: add_ac)
+    also assume "x + (y + z) = y + u"
+    also from vs have "- y + (y + u) = u" by simp
+    finally show "x + z = u" .
+  next
+    assume "x + z = u"
+    with vs show "x + (y + z) = y + u"
+      by (simp only: add_left_commute [of x])
+  }
+qed
+
+lemma (in vectorspace) add_cancel_end:
+  "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> z \<in> V \<Longrightarrow> (x + (y + z) = y) = (x = - z)"
+proof
+  assume vs: "x \<in> V"  "y \<in> V"  "z \<in> V"
+  {
+    assume "x + (y + z) = y"
+    with vs have "(x + z) + y = 0 + y"
+      by (simp add: add_ac)
+    with vs have "x + z = 0"
+      by (simp only: add_right_cancel add_closed zero)
+    with vs show "x = - z" by (simp add: add_minus_eq_minus)
+  next
+    assume eq: "x = - z"
+    then have "x + (y + z) = - z + (y + z)" by simp
+    also have "\<dots> = y + (- z + z)"
+      by (rule add_left_commute) (simp_all add: vs)
+    also from vs have "\<dots> = y"  by simp
+    finally show "x + (y + z) = y" .
+  }
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HahnBanach/ZornLemma.thy	Tue Dec 30 11:10:01 2008 +0100
@@ -0,0 +1,57 @@
+(*  Title:      HOL/Real/HahnBanach/ZornLemma.thy
+    Author:     Gertrud Bauer, TU Munich
+*)
+
+header {* Zorn's Lemma *}
+
+theory ZornLemma
+imports Zorn
+begin
+
+text {*
+  Zorn's Lemmas states: if every linear ordered subset of an ordered
+  set @{text S} has an upper bound in @{text S}, then there exists a
+  maximal element in @{text S}.  In our application, @{text S} is a
+  set of sets ordered by set inclusion. Since the union of a chain of
+  sets is an upper bound for all elements of the chain, the conditions
+  of Zorn's lemma can be modified: if @{text S} is non-empty, it
+  suffices to show that for every non-empty chain @{text c} in @{text
+  S} the union of @{text c} also lies in @{text S}.
+*}
+
+theorem Zorn's_Lemma:
+  assumes r: "\<And>c. c \<in> chain S \<Longrightarrow> \<exists>x. x \<in> c \<Longrightarrow> \<Union>c \<in> S"
+    and aS: "a \<in> S"
+  shows "\<exists>y \<in> S. \<forall>z \<in> S. y \<subseteq> z \<longrightarrow> y = z"
+proof (rule Zorn_Lemma2)
+  show "\<forall>c \<in> chain S. \<exists>y \<in> S. \<forall>z \<in> c. z \<subseteq> y"
+  proof
+    fix c assume "c \<in> chain S"
+    show "\<exists>y \<in> S. \<forall>z \<in> c. z \<subseteq> y"
+    proof cases
+
+      txt {* If @{text c} is an empty chain, then every element in
+	@{text S} is an upper bound of @{text c}. *}
+
+      assume "c = {}"
+      with aS show ?thesis by fast
+
+      txt {* If @{text c} is non-empty, then @{text "\<Union>c"} is an upper
+	bound of @{text c}, lying in @{text S}. *}
+
+    next
+      assume "c \<noteq> {}"
+      show ?thesis
+      proof
+        show "\<forall>z \<in> c. z \<subseteq> \<Union>c" by fast
+        show "\<Union>c \<in> S"
+        proof (rule r)
+          from `c \<noteq> {}` show "\<exists>x. x