# HG changeset patch # User berghofe # Date 1243929843 -7200 # Node ID edf74583715a4e5a5e276ae15df48d24bcef60f8 # Parent 3e640334a1b3ce5050e7d927a06cc0d651ef4c8a# Parent 3e900a2acaedd98c6ebb842dcaf112439ac91412 merged diff -r 3e900a2acaed -r edf74583715a Admin/CHECKLIST --- a/Admin/CHECKLIST Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/CHECKLIST Tue Jun 02 10:04:03 2009 +0200 @@ -1,8 +1,9 @@ Checklist for official releases =============================== -- test mosml, polyml-5.2, polyml-5.1, polyml-5.0, polyml-4.1.3, polyml-4.1.4, polyml-4.2.0, - sparc-solaris, x86-solaris; +- test mosml, polyml-5.2, polyml-5.1, polyml-5.0; + +- test sparc-solaris, x86-solaris; - test ProofGeneral; diff -r 3e900a2acaed -r edf74583715a Admin/isatest/isatest-settings --- a/Admin/isatest/isatest-settings Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/isatest-settings Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # $Id$ # Author: Gerwin Klein, NICTA # diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/annomaly --- a/Admin/isatest/settings/annomaly Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/annomaly Tue Jun 02 10:04:03 2009 +0200 @@ -1,3 +1,5 @@ +# -*- shell-script -*- :mode=shellscript: + ML_SYSTEM=annomaly ML_HOME="$SMLNJ_HOME/bin" ML_OPTIONS="-m $SMLNJ_HOME/annomaly/annomaly.cm @SMLdebug=/dev/null" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-mac-poly-5.1-para --- a/Admin/isatest/settings/at-mac-poly-5.1-para Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-mac-poly-5.1-para Tue Jun 02 10:04:03 2009 +0200 @@ -1,7 +1,7 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: - POLYML_HOME="/home/polyml/polyml-5.2.1" - ML_SYSTEM="polyml-5.2.1" + POLYML_HOME="/home/polyml/polyml-svn" + ML_SYSTEM="polyml-experimental" ML_PLATFORM="x86-darwin" ML_HOME="$POLYML_HOME/$ML_PLATFORM" ML_OPTIONS="--mutable 800 --immutable 2000" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-poly --- a/Admin/isatest/settings/at-poly Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-poly Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.2" ML_SYSTEM="polyml-5.2" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-poly-4.1.3 --- a/Admin/isatest/settings/at-poly-4.1.3 Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -# -*- shell-script -*- - - POLYML_HOME="/home/polyml/polyml-4.1.3" - ML_SYSTEM="polyml-4.1.3" - ML_PLATFORM="x86-linux" - ML_HOME="$POLYML_HOME/$ML_PLATFORM" - ML_OPTIONS="-h 30000" - -ISABELLE_HOME_USER=~/isabelle-at-poly-4.1.3 - -# Where to look for isabelle tools (multiple dirs separated by ':'). -ISABELLE_TOOLS="$ISABELLE_HOME/lib/Tools" - -# Location for temporary files (should be on a local file system). -ISABELLE_TMP_PREFIX="/tmp/isabelle-$USER" - - -# Heap input locations. ML system identifier is included in lookup. -ISABELLE_PATH="$ISABELLE_HOME_USER/heaps:$ISABELLE_HOME/heaps" - -# Heap output location. ML system identifier is appended automatically later on. -ISABELLE_OUTPUT="$ISABELLE_HOME_USER/heaps" -ISABELLE_BROWSER_INFO="$ISABELLE_HOME_USER/browser_info" - -ISABELLE_USEDIR_OPTIONS="-i true -d pdf -v true" - -HOL_USEDIR_OPTIONS="-p 2" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-poly-5.1-para-e --- a/Admin/isatest/settings/at-poly-5.1-para-e Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-poly-5.1-para-e Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.2.1" ML_SYSTEM="polyml-5.2.1" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-poly-dev-e --- a/Admin/isatest/settings/at-poly-dev-e Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-poly-dev-e Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.2" ML_SYSTEM="polyml-5.2" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-poly-e --- a/Admin/isatest/settings/at-poly-e Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -# -*- shell-script -*- - - POLYML_HOME="/home/polyml/polyml-4.2.0" - ML_SYSTEM="polyml-4.2.0" - ML_PLATFORM="x86-linux" - ML_HOME="$POLYML_HOME/$ML_PLATFORM" - ML_OPTIONS="-h 30000" - -ISABELLE_HOME_USER=~/isabelle-at-poly-e - -# Where to look for isabelle tools (multiple dirs separated by ':'). -ISABELLE_TOOLS="$ISABELLE_HOME/lib/Tools" - -# Location for temporary files (should be on a local file system). -ISABELLE_TMP_PREFIX="/tmp/isabelle-$USER" - - -# Heap input locations. ML system identifier is included in lookup. -ISABELLE_PATH="$ISABELLE_HOME_USER/heaps:$ISABELLE_HOME/heaps" - -# Heap output location. ML system identifier is appended automatically later on. -ISABELLE_OUTPUT="$ISABELLE_HOME_USER/heaps" -ISABELLE_BROWSER_INFO="$ISABELLE_HOME_USER/browser_info" - -ISABELLE_USEDIR_OPTIONS="-i true -d pdf -v true" - -HOL_USEDIR_OPTIONS="-p 2" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-sml --- a/Admin/isatest/settings/at-sml Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-sml Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110 or later ML_SYSTEM=smlnj-110.0.7 diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-sml-dev-e --- a/Admin/isatest/settings/at-sml-dev-e Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-sml-dev-e Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110 or later ML_SYSTEM=smlnj diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at-sml-dev-p --- a/Admin/isatest/settings/at-sml-dev-p Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at-sml-dev-p Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110 or later ML_SYSTEM=smlnj diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at64-poly --- a/Admin/isatest/settings/at64-poly Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at64-poly Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.2" ML_SYSTEM="polyml-5.2" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at64-poly-5.1-para --- a/Admin/isatest/settings/at64-poly-5.1-para Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at64-poly-5.1-para Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.2.1" ML_SYSTEM="polyml-5.2.1" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/at64-sml-dev --- a/Admin/isatest/settings/at64-sml-dev Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/at64-sml-dev Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110 or later ML_SYSTEM=smlnj diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/mac-poly --- a/Admin/isatest/settings/mac-poly Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/mac-poly Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.2" ML_SYSTEM="polyml-5.2" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/mac-sml-dev --- a/Admin/isatest/settings/mac-sml-dev Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/mac-sml-dev Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110 or later ML_SYSTEM=smlnj diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/sun-poly --- a/Admin/isatest/settings/sun-poly Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/sun-poly Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: POLYML_HOME="/home/polyml/polyml-5.1" ML_SYSTEM="polyml-5.1" diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/sun-sml --- a/Admin/isatest/settings/sun-sml Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/sun-sml Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110.0.7 (stable version) ML_SYSTEM=smlnj-110.0.7 diff -r 3e900a2acaed -r edf74583715a Admin/isatest/settings/sun-sml-dev --- a/Admin/isatest/settings/sun-sml-dev Tue Jun 02 10:02:52 2009 +0200 +++ b/Admin/isatest/settings/sun-sml-dev Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # Standard ML of New Jersey 110 or later ML_SYSTEM=smlnj-110 diff -r 3e900a2acaed -r edf74583715a NEWS --- a/NEWS Tue Jun 02 10:02:52 2009 +0200 +++ b/NEWS Tue Jun 02 10:04:03 2009 +0200 @@ -26,6 +26,22 @@ by the code generator; see Predicate.thy for an example. +*** ML *** + +* Eliminated old Attrib.add_attributes, Method.add_methods and related +cominators for "args". INCOMPATIBILITY, need to use simplified +Attrib/Method.setup introduced in Isabelle2009. + + +*** System *** + +* Discontinued support for Poly/ML 4.x versions. + +* Removed "compress" option from isabelle-process and isabelle usedir; +this is always enabled. + + + New in Isabelle2009 (April 2009) -------------------------------- diff -r 3e900a2acaed -r edf74583715a bin/isabelle-process --- a/bin/isabelle-process Tue Jun 02 10:02:52 2009 +0200 +++ b/bin/isabelle-process Tue Jun 02 10:04:03 2009 +0200 @@ -26,13 +26,11 @@ echo "Usage: $PRG [OPTIONS] [INPUT] [OUTPUT]" echo echo " Options are:" - echo " -C tell ML system to copy output image" echo " -I startup Isar interaction mode" echo " -P startup Proof General interaction mode" echo " -S secure mode -- disallow critical operations" echo " -X startup PGIP interaction mode" echo " -W OUTPUT startup process wrapper, with messages going to OUTPUT stream" - echo " -c tell ML system to compress output image" echo " -e MLTEXT pass MLTEXT to the ML session" echo " -f pass 'Session.finish();' to the ML session" echo " -m MODE add print mode for output" @@ -60,25 +58,20 @@ # options -COPYDB="" ISAR=false PROOFGENERAL="" SECURE="" WRAPPER_OUTPUT="" PGIP="" -COMPRESS="" MLTEXT="" MODES="" TERMINATE="" READONLY="" NOWRITE="" -while getopts "CIPSW:Xce:fm:qruw" OPT +while getopts "IPSW:Xe:fm:qruw" OPT do case "$OPT" in - C) - COPYDB=true - ;; I) ISAR=true ;; @@ -94,9 +87,6 @@ X) PGIP=true ;; - c) - COMPRESS=true - ;; e) MLTEXT="$MLTEXT $OPTARG" ;; @@ -235,8 +225,7 @@ NICE="" fi -export INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE \ - ISABELLE_PID ISABELLE_TMP +export INFILE OUTFILE MLTEXT TERMINATE NOWRITE ISABELLE_PID ISABELLE_TMP if [ -f "$ISABELLE_HOME/lib/scripts/run-$ML_SYSTEM" ]; then $NICE "$ISABELLE_HOME/lib/scripts/run-$ML_SYSTEM" diff -r 3e900a2acaed -r edf74583715a doc-src/System/Thy/Basics.thy --- a/doc-src/System/Thy/Basics.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/doc-src/System/Thy/Basics.thy Tue Jun 02 10:04:03 2009 +0200 @@ -266,13 +266,11 @@ Usage: isabelle-process [OPTIONS] [INPUT] [OUTPUT] Options are: - -C tell ML system to copy output image -I startup Isar interaction mode -P startup Proof General interaction mode -S secure mode -- disallow critical operations -W OUTPUT startup process wrapper, with messages going to OUTPUT stream -X startup PGIP interaction mode - -c tell ML system to compress output image -e MLTEXT pass MLTEXT to the ML session -f pass 'Session.finish();' to the ML session -m MODE add print mode for output @@ -320,16 +318,6 @@ read-only after terminating. Thus subsequent invocations cause the logic image to be read-only automatically. - \medskip The @{verbatim "-c"} option tells the underlying ML system - to compress the output heap (fully transparently). On Poly/ML for - example, the image is garbage collected and all stored values are - maximally shared, resulting in up to @{text "50%"} less disk space - consumption. - - \medskip The @{verbatim "-C"} option tells the ML system to produce - a completely self-contained output image, probably including a copy - of the ML runtime system itself. - \medskip Using the @{verbatim "-e"} option, arbitrary ML code may be passed to the Isabelle session from the command line. Multiple @{verbatim "-e"}'s are evaluated in the given order. Strange things diff -r 3e900a2acaed -r edf74583715a doc-src/System/Thy/Presentation.thy --- a/doc-src/System/Thy/Presentation.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/doc-src/System/Thy/Presentation.thy Tue Jun 02 10:04:03 2009 +0200 @@ -446,7 +446,6 @@ -T LEVEL multithreading: trace level (default 0) -V VERSION declare alternative document VERSION -b build mode (output heap image, using current dir) - -c BOOL tell ML system to compress output image (default true) -d FORMAT build document as FORMAT (default false) -f NAME use ML file NAME (default ROOT.ML) -g BOOL generate session graph image for document (default false) diff -r 3e900a2acaed -r edf74583715a doc-src/System/Thy/document/Basics.tex --- a/doc-src/System/Thy/document/Basics.tex Tue Jun 02 10:02:52 2009 +0200 +++ b/doc-src/System/Thy/document/Basics.tex Tue Jun 02 10:04:03 2009 +0200 @@ -275,13 +275,11 @@ Usage: isabelle-process [OPTIONS] [INPUT] [OUTPUT] Options are: - -C tell ML system to copy output image -I startup Isar interaction mode -P startup Proof General interaction mode -S secure mode -- disallow critical operations -W OUTPUT startup process wrapper, with messages going to OUTPUT stream -X startup PGIP interaction mode - -c tell ML system to compress output image -e MLTEXT pass MLTEXT to the ML session -f pass 'Session.finish();' to the ML session -m MODE add print mode for output @@ -331,16 +329,6 @@ read-only after terminating. Thus subsequent invocations cause the logic image to be read-only automatically. - \medskip The \verb|-c| option tells the underlying ML system - to compress the output heap (fully transparently). On Poly/ML for - example, the image is garbage collected and all stored values are - maximally shared, resulting in up to \isa{{\isachardoublequote}{\isadigit{5}}{\isadigit{0}}{\isacharpercent}{\isachardoublequote}} less disk space - consumption. - - \medskip The \verb|-C| option tells the ML system to produce - a completely self-contained output image, probably including a copy - of the ML runtime system itself. - \medskip Using the \verb|-e| option, arbitrary ML code may be passed to the Isabelle session from the command line. Multiple \verb|-e|'s are evaluated in the given order. Strange things diff -r 3e900a2acaed -r edf74583715a doc-src/System/Thy/document/Presentation.tex --- a/doc-src/System/Thy/document/Presentation.tex Tue Jun 02 10:02:52 2009 +0200 +++ b/doc-src/System/Thy/document/Presentation.tex Tue Jun 02 10:04:03 2009 +0200 @@ -472,7 +472,6 @@ -T LEVEL multithreading: trace level (default 0) -V VERSION declare alternative document VERSION -b build mode (output heap image, using current dir) - -c BOOL tell ML system to compress output image (default true) -d FORMAT build document as FORMAT (default false) -f NAME use ML file NAME (default ROOT.ML) -g BOOL generate session graph image for document (default false) diff -r 3e900a2acaed -r edf74583715a doc-src/antiquote_setup.ML --- a/doc-src/antiquote_setup.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/doc-src/antiquote_setup.ML Tue Jun 02 10:04:03 2009 +0200 @@ -159,9 +159,9 @@ end); fun entity_antiqs check markup kind = - [(entity check markup kind NONE), - (entity check markup kind (SOME true)), - (entity check markup kind (SOME false))]; + ((entity check markup kind NONE); + (entity check markup kind (SOME true)); + (entity check markup kind (SOME false))); in diff -r 3e900a2acaed -r edf74583715a etc/settings --- a/etc/settings Tue Jun 02 10:02:52 2009 +0200 +++ b/etc/settings Tue Jun 02 10:04:03 2009 +0200 @@ -15,7 +15,7 @@ # not invent new ML system names unless you know what you are doing. # Only one of the sections below should be activated. -# Poly/ML 4.x/5.x (automated settings) +# Poly/ML 5.x (automated settings) POLY_HOME="$(type -p poly)"; [ -n "$POLY_HOME" ] && POLY_HOME="$(dirname "$POLY_HOME")" ML_PLATFORM=$("$ISABELLE_HOME/lib/scripts/polyml-platform") ML_HOME=$(choosefrom \ @@ -29,24 +29,18 @@ ML_OPTIONS="-H 200" ML_DBASE="" -# Poly/ML 5.1 +# Poly/ML 5.2.1 #ML_PLATFORM=x86-linux #ML_HOME=/usr/local/polyml/x86-linux -#ML_SYSTEM=polyml-5.1 +#ML_SYSTEM=polyml-5.2.1 #ML_OPTIONS="-H 500" -# Poly/ML 5.1 (64 bit) +# Poly/ML 5.2.1 (64 bit) #ML_PLATFORM=x86_64-linux #ML_HOME=/usr/local/polyml/x86_64-linux -#ML_SYSTEM=polyml-5.1 +#ML_SYSTEM=polyml-5.2.1 #ML_OPTIONS="-H 1000" -# Poly/ML 4.2.0 -#ML_PLATFORM=x86-linux -#ML_HOME=/usr/local/polyml/x86-linux -#ML_SYSTEM=polyml-4.2.0 -#ML_OPTIONS="-H 80" - # Standard ML of New Jersey (slow!) #ML_SYSTEM=smlnj-110 #ML_HOME="/usr/local/smlnj/bin" diff -r 3e900a2acaed -r edf74583715a etc/user-settings.sample --- a/etc/user-settings.sample Tue Jun 02 10:02:52 2009 +0200 +++ b/etc/user-settings.sample Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # # Isabelle user settings sample -- for use in ~/.isabelle/etc/settings diff -r 3e900a2acaed -r edf74583715a lib/Tools/usedir --- a/lib/Tools/usedir Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/Tools/usedir Tue Jun 02 10:04:03 2009 +0200 @@ -23,7 +23,6 @@ echo " -T LEVEL multithreading: trace level (default 0)" echo " -V VERSION declare alternative document VERSION" echo " -b build mode (output heap image, using current dir)" - echo " -c BOOL tell ML system to compress output image (default true)" echo " -d FORMAT build document as FORMAT (default false)" echo " -f NAME use ML file NAME (default ROOT.ML)" echo " -g BOOL generate session graph image for document (default false)" @@ -77,7 +76,6 @@ TRACETHREADS="0" DOCUMENT_VERSIONS="" BUILD="" -COMPRESS=true DOCUMENT=false ROOT_FILE="ROOT.ML" DOCUMENT_GRAPH=false @@ -91,7 +89,7 @@ function getoptions() { OPTIND=1 - while getopts "C:D:M:P:Q:T:V:bc:d:f:g:i:m:p:rs:v:" OPT + while getopts "C:D:M:P:Q:T:V:bd:f:g:i:m:p:rs:v:" OPT do case "$OPT" in C) @@ -129,10 +127,6 @@ b) BUILD=true ;; - c) - check_bool "$OPTARG" - COMPRESS="$OPTARG" - ;; d) DOCUMENT="$OPTARG" ;; @@ -175,7 +169,8 @@ done } -getoptions $ISABELLE_USEDIR_OPTIONS +eval "OPTIONS=($ISABELLE_USEDIR_OPTIONS)" +getoptions "${OPTIONS[@]}" getoptions "$@" shift $(($OPTIND - 1)) @@ -233,12 +228,9 @@ echo "Building $ITEM ..." >&2 LOG="$LOGDIR/$ITEM" - OPT_C="" - [ "$COMPRESS" = true ] && OPT_C="-c" - "$ISABELLE_PROCESS" \ -e "Session.use_dir \"$ROOT_FILE\" true [$MODES] $RESET $INFO \"$DOC\" $DOCUMENT_GRAPH [$DOCUMENT_VERSIONS] \"$PARENT\" \"$SESSION\" ($COPY_DUMP, \"$DUMP\") \"$RPATH\" $PROOFS $VERBOSE $MAXTHREADS $TRACETHREADS $PARALLEL_PROOFS;" \ - $OPT_C -q -w $LOGIC $NAME > "$LOG" + -q -w $LOGIC $NAME > "$LOG" RC="$?" else ITEM=$(basename "$LOGIC")-"$SESSION" diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-mosml --- a/lib/scripts/run-mosml Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/scripts/run-mosml Tue Jun 02 10:04:03 2009 +0200 @@ -4,7 +4,7 @@ # # Moscow ML 2.00 startup script -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE +export -n INFILE OUTFILE MLTEXT TERMINATE NOWRITE ## diagnostics diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-polyml --- a/lib/scripts/run-polyml Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/scripts/run-polyml Tue Jun 02 10:04:03 2009 +0200 @@ -4,7 +4,7 @@ # # Poly/ML 5.1/5.2 startup script. -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE +export -n INFILE OUTFILE MLTEXT TERMINATE NOWRITE ## diagnostics @@ -54,11 +54,7 @@ if [ -z "$OUTFILE" ]; then COMMIT='fun commit () = (TextIO.output (TextIO.stdErr, "Error - Database is not opened for writing.\n"); false);' else - if [ -z "$COMPRESS" ]; then - COMMIT="fun commit () = (TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.SaveState.saveState \"$OUTFILE\"; true);" - else - COMMIT="fun commit () = (PolyML.shareCommonData PolyML.rootFunction; TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.SaveState.saveState \"$OUTFILE\"; true);" - fi + COMMIT="fun commit () = (PolyML.shareCommonData PolyML.rootFunction; TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.SaveState.saveState \"$OUTFILE\"; true);" [ -f "$OUTFILE" ] && { chmod +w "$OUTFILE" || fail_out; } fi diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-polyml-4.1.3 --- a/lib/scripts/run-polyml-4.1.3 Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,106 +0,0 @@ -#!/usr/bin/env bash -# -# Author: Markus Wenzel, TU Muenchen -# -# Poly/ML 4.x startup script. - -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE - - -## diagnostics - -function fail_out() -{ - echo "Unable to create output heap file: \"$OUTFILE\"" >&2 - exit 2 -} - -function check_file() -{ - if [ ! -f "$1" ]; then - echo "Unable to locate $1" >&2 - echo "Please check your ML system settings!" >&2 - exit 2 - fi -} - - -## Poly/ML executable and database - -ML_DBASE_PREFIX="" - -POLY="$ML_HOME/poly" -check_file "$POLY" - -if [ -z "$ML_DBASE" ]; then - if [ ! -e "$ML_HOME/ML_dbase" -a "$(basename "$ML_HOME")" = bin ]; then - ML_DBASE_HOME="$(cd "$ML_HOME"; cd "$(pwd -P)"; cd ../lib/poly; pwd)" - else - ML_DBASE_HOME="$ML_HOME" - fi - if [ -z "$COPYDB" ]; then - ML_DBASE_PREFIX="$ML_DBASE_HOME/" - ML_DBASE="ML_dbase" - else - ML_DBASE="$ML_DBASE_HOME/ML_dbase" - fi - export POLYPATH="$ML_DBASE_HOME" -else - export POLYPATH="$(dirname "$ML_DBASE")" -fi - -DISCGARB_OPTIONS="-d -c" - -EXIT="fun exit 0 = (OS.Process.exit OS.Process.success): unit | exit _ = OS.Process.exit OS.Process.failure;" - - -## prepare databases - -if [ -z "$INFILE" ]; then - check_file "$ML_DBASE_PREFIX$ML_DBASE" - INFILE="$ML_DBASE" - MLTEXT="val use = PolyML.use; $EXIT $MLTEXT" - DISCGARB_OPTIONS="$DISCGARB_OPTIONS -S max" -else - COPYDB=true -fi - -if [ -z "$OUTFILE" ]; then - DB="$INFILE" - ML_OPTIONS="-r $ML_OPTIONS" -elif [ "$INFILE" -ef "$OUTFILE" ]; then - DB="$INFILE" -elif [ -n "$COPYDB" ]; then - [ -f "$OUTFILE" ] && { rm -f "$OUTFILE" || fail_out; } - cp "$INFILE" "$OUTFILE" || fail_out - chmod +w "$OUTFILE" || fail_out - DB="$OUTFILE" -else - [ -f "$OUTFILE" ] && { rm -f "$OUTFILE" || fail_out; } - echo "PolyML.make_database \"$OUTFILE\"; PolyML.quit();" | "$POLY" -r "$INFILE" - [ -f "$OUTFILE" ] || fail_out - DB="$OUTFILE" -fi - - -## run it! - -if [ -z "$TERMINATE" ]; then - FEEDER_OPTS="" -else - FEEDER_OPTS="-q" -fi - -DB_INFO="$(ls -l "$DB" 2>/dev/null)" - -"$ISABELLE_HOME/lib/scripts/feeder" -p -h "$MLTEXT" $FEEDER_OPTS | { - read FPID; "$POLY" $ML_OPTIONS "$DB"; - RC="$?"; kill -HUP "$FPID"; exit "$RC"; } -RC="$?" - -NEW_DB_INFO="$(ls -l "$DB" 2>/dev/null)" -[ -n "$OUTFILE" -a -n "$COMPRESS" -a "$DB_INFO" != "$NEW_DB_INFO" ] && \ - "$POLY" $DISCGARB_OPTIONS "$OUTFILE" -[ -n "$OUTFILE" -a -f "$OUTFILE" -a -n "$NOWRITE" ] && chmod -w "$OUTFILE" - -exit "$RC" diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-polyml-4.1.4 --- a/lib/scripts/run-polyml-4.1.4 Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,106 +0,0 @@ -#!/usr/bin/env bash -# -# Author: Markus Wenzel, TU Muenchen -# -# Poly/ML 4.x startup script. - -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE - - -## diagnostics - -function fail_out() -{ - echo "Unable to create output heap file: \"$OUTFILE\"" >&2 - exit 2 -} - -function check_file() -{ - if [ ! -f "$1" ]; then - echo "Unable to locate $1" >&2 - echo "Please check your ML system settings!" >&2 - exit 2 - fi -} - - -## Poly/ML executable and database - -ML_DBASE_PREFIX="" - -POLY="$ML_HOME/poly" -check_file "$POLY" - -if [ -z "$ML_DBASE" ]; then - if [ ! -e "$ML_HOME/ML_dbase" -a "$(basename "$ML_HOME")" = bin ]; then - ML_DBASE_HOME="$(cd "$ML_HOME"; cd "$(pwd -P)"; cd ../lib/poly; pwd)" - else - ML_DBASE_HOME="$ML_HOME" - fi - if [ -z "$COPYDB" ]; then - ML_DBASE_PREFIX="$ML_DBASE_HOME/" - ML_DBASE="ML_dbase" - else - ML_DBASE="$ML_DBASE_HOME/ML_dbase" - fi - export POLYPATH="$ML_DBASE_HOME" -else - export POLYPATH="$(dirname "$ML_DBASE")" -fi - -DISCGARB_OPTIONS="-d -c" - -EXIT="fun exit 0 = (OS.Process.exit OS.Process.success): unit | exit _ = OS.Process.exit OS.Process.failure;" - - -## prepare databases - -if [ -z "$INFILE" ]; then - check_file "$ML_DBASE_PREFIX$ML_DBASE" - INFILE="$ML_DBASE" - MLTEXT="val use = PolyML.use; $EXIT $MLTEXT" - DISCGARB_OPTIONS="$DISCGARB_OPTIONS -S max" -else - COPYDB=true -fi - -if [ -z "$OUTFILE" ]; then - DB="$INFILE" - ML_OPTIONS="-r $ML_OPTIONS" -elif [ "$INFILE" -ef "$OUTFILE" ]; then - DB="$INFILE" -elif [ -n "$COPYDB" ]; then - [ -f "$OUTFILE" ] && { rm -f "$OUTFILE" || fail_out; } - cp "$INFILE" "$OUTFILE" || fail_out - chmod +w "$OUTFILE" || fail_out - DB="$OUTFILE" -else - [ -f "$OUTFILE" ] && { rm -f "$OUTFILE" || fail_out; } - echo "PolyML.make_database \"$OUTFILE\"; PolyML.quit();" | "$POLY" -r "$INFILE" - [ -f "$OUTFILE" ] || fail_out - DB="$OUTFILE" -fi - - -## run it! - -if [ -z "$TERMINATE" ]; then - FEEDER_OPTS="" -else - FEEDER_OPTS="-q" -fi - -DB_INFO="$(ls -l "$DB" 2>/dev/null)" - -"$ISABELLE_HOME/lib/scripts/feeder" -p -h "$MLTEXT" $FEEDER_OPTS | { - read FPID; "$POLY" $ML_OPTIONS "$DB"; - RC="$?"; kill -HUP "$FPID"; exit "$RC"; } -RC="$?" - -NEW_DB_INFO="$(ls -l "$DB" 2>/dev/null)" -[ -n "$OUTFILE" -a -n "$COMPRESS" -a "$DB_INFO" != "$NEW_DB_INFO" ] && \ - "$POLY" $DISCGARB_OPTIONS "$OUTFILE" -[ -n "$OUTFILE" -a -f "$OUTFILE" -a -n "$NOWRITE" ] && chmod -w "$OUTFILE" - -exit "$RC" diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-polyml-4.2.0 --- a/lib/scripts/run-polyml-4.2.0 Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,106 +0,0 @@ -#!/usr/bin/env bash -# -# Author: Markus Wenzel, TU Muenchen -# -# Poly/ML 4.x startup script. - -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE - - -## diagnostics - -function fail_out() -{ - echo "Unable to create output heap file: \"$OUTFILE\"" >&2 - exit 2 -} - -function check_file() -{ - if [ ! -f "$1" ]; then - echo "Unable to locate $1" >&2 - echo "Please check your ML system settings!" >&2 - exit 2 - fi -} - - -## Poly/ML executable and database - -ML_DBASE_PREFIX="" - -POLY="$ML_HOME/poly" -check_file "$POLY" - -if [ -z "$ML_DBASE" ]; then - if [ ! -e "$ML_HOME/ML_dbase" -a "$(basename "$ML_HOME")" = bin ]; then - ML_DBASE_HOME="$(cd "$ML_HOME"; cd "$(pwd -P)"; cd ../lib/poly; pwd)" - else - ML_DBASE_HOME="$ML_HOME" - fi - if [ -z "$COPYDB" ]; then - ML_DBASE_PREFIX="$ML_DBASE_HOME/" - ML_DBASE="ML_dbase" - else - ML_DBASE="$ML_DBASE_HOME/ML_dbase" - fi - export POLYPATH="$ML_DBASE_HOME" -else - export POLYPATH="$(dirname "$ML_DBASE")" -fi - -DISCGARB_OPTIONS="-d -c" - -EXIT="fun exit 0 = (OS.Process.exit OS.Process.success): unit | exit _ = OS.Process.exit OS.Process.failure;" - - -## prepare databases - -if [ -z "$INFILE" ]; then - check_file "$ML_DBASE_PREFIX$ML_DBASE" - INFILE="$ML_DBASE" - MLTEXT="val use = PolyML.use; $EXIT $MLTEXT" - DISCGARB_OPTIONS="$DISCGARB_OPTIONS -S max" -else - COPYDB=true -fi - -if [ -z "$OUTFILE" ]; then - DB="$INFILE" - ML_OPTIONS="-r $ML_OPTIONS" -elif [ "$INFILE" -ef "$OUTFILE" ]; then - DB="$INFILE" -elif [ -n "$COPYDB" ]; then - [ -f "$OUTFILE" ] && { rm -f "$OUTFILE" || fail_out; } - cp "$INFILE" "$OUTFILE" || fail_out - chmod +w "$OUTFILE" || fail_out - DB="$OUTFILE" -else - [ -f "$OUTFILE" ] && { rm -f "$OUTFILE" || fail_out; } - echo "PolyML.make_database \"$OUTFILE\"; PolyML.quit();" | "$POLY" -r "$INFILE" - [ -f "$OUTFILE" ] || fail_out - DB="$OUTFILE" -fi - - -## run it! - -if [ -z "$TERMINATE" ]; then - FEEDER_OPTS="" -else - FEEDER_OPTS="-q" -fi - -DB_INFO="$(ls -l "$DB" 2>/dev/null)" - -"$ISABELLE_HOME/lib/scripts/feeder" -p -h "$MLTEXT" $FEEDER_OPTS | { - read FPID; "$POLY" $ML_OPTIONS "$DB"; - RC="$?"; kill -HUP "$FPID"; exit "$RC"; } -RC="$?" - -NEW_DB_INFO="$(ls -l "$DB" 2>/dev/null)" -[ -n "$OUTFILE" -a -n "$COMPRESS" -a "$DB_INFO" != "$NEW_DB_INFO" ] && \ - "$POLY" $DISCGARB_OPTIONS "$OUTFILE" -[ -n "$OUTFILE" -a -f "$OUTFILE" -a -n "$NOWRITE" ] && chmod -w "$OUTFILE" - -exit "$RC" diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-polyml-5.0 --- a/lib/scripts/run-polyml-5.0 Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/scripts/run-polyml-5.0 Tue Jun 02 10:04:03 2009 +0200 @@ -4,7 +4,7 @@ # # Poly/ML 5.0 startup script. -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE +export -n INFILE OUTFILE MLTEXT TERMINATE NOWRITE ## diagnostics @@ -54,11 +54,7 @@ if [ -z "$OUTFILE" ]; then COMMIT='fun commit () = (TextIO.output (TextIO.stdErr, "Error - Database is not opened for writing.\n"); false);' else - if [ -z "$COMPRESS" ]; then - COMMIT="fun commit () = (TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.export (\"$OUTFILE\", PolyML.rootFunction); true);" - else - COMMIT="fun commit () = (PolyML.shareCommonData PolyML.rootFunction; TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.export (\"$OUTFILE\", PolyML.rootFunction); true);" - fi + COMMIT="fun commit () = (PolyML.shareCommonData PolyML.rootFunction; TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.export (\"$OUTFILE\", PolyML.rootFunction); true);" [ -f "$OUTFILE" ] && { chmod +w "$OUTFILE" || fail_out; } rm -f "${OUTFILE}.o" || fail_out fi diff -r 3e900a2acaed -r edf74583715a lib/scripts/run-smlnj --- a/lib/scripts/run-smlnj Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/scripts/run-smlnj Tue Jun 02 10:04:03 2009 +0200 @@ -4,7 +4,7 @@ # # SML/NJ startup script (for 110 or later). -export -n INFILE OUTFILE COPYDB COMPRESS MLTEXT TERMINATE NOWRITE +export -n INFILE OUTFILE MLTEXT TERMINATE NOWRITE ## diagnostics diff -r 3e900a2acaed -r edf74583715a lib/scripts/timestart.bash --- a/lib/scripts/timestart.bash Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/scripts/timestart.bash Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # # Author: Makarius # diff -r 3e900a2acaed -r edf74583715a lib/scripts/timestop.bash --- a/lib/scripts/timestop.bash Tue Jun 02 10:02:52 2009 +0200 +++ b/lib/scripts/timestop.bash Tue Jun 02 10:04:03 2009 +0200 @@ -1,4 +1,4 @@ -# -*- shell-script -*- +# -*- shell-script -*- :mode=shellscript: # # Author: Makarius # diff -r 3e900a2acaed -r edf74583715a src/FOL/IFOL.thy --- a/src/FOL/IFOL.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/FOL/IFOL.thy Tue Jun 02 10:04:03 2009 +0200 @@ -610,7 +610,7 @@ subsection {* Intuitionistic Reasoning *} -setup {* Intuitionistic.method_setup "iprover" *} +setup {* Intuitionistic.method_setup @{binding iprover} *} lemma impE': assumes 1: "P --> Q" diff -r 3e900a2acaed -r edf74583715a src/HOL/Decision_Procs/ferrack_tac.ML --- a/src/HOL/Decision_Procs/ferrack_tac.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML Tue Jun 02 10:04:03 2009 +0200 @@ -2,6 +2,13 @@ Author: Amine Chaieb, TU Muenchen *) +signature FERRACK_TAC = +sig + val trace: bool ref + val linr_tac: Proof.context -> bool -> int -> tactic + val setup: theory -> theory +end + structure Ferrack_Tac = struct @@ -98,12 +105,10 @@ THEN tac) st end handle Subscript => no_tac st); -fun linr_meth src = - Method.syntax (Args.mode "no_quantify") src - #> (fn (q, ctxt) => SIMPLE_METHOD' (linr_tac ctxt (not q))); - val setup = - Method.add_method ("rferrack", linr_meth, - "decision procedure for linear real arithmetic"); + Method.setup @{binding rferrack} + (Args.mode "no_quantify" >> (fn q => fn ctxt => + SIMPLE_METHOD' (linr_tac ctxt (not q)))) + "decision procedure for linear real arithmetic"; end diff -r 3e900a2acaed -r edf74583715a src/HOL/Deriv.thy --- a/src/HOL/Deriv.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Deriv.thy Tue Jun 02 10:04:03 2009 +0200 @@ -76,7 +76,7 @@ hence "(\h. f(x+h) - f(x)) -- 0 --> 0" by (simp cong: LIM_cong) thus "(\h. f(x+h)) -- 0 --> f(x)" - by (simp add: LIM_def) + by (simp add: LIM_def dist_norm) qed lemma DERIV_mult_lemma: @@ -125,6 +125,7 @@ text{*Alternative definition for differentiability*} lemma DERIV_LIM_iff: + fixes f :: "'a::{real_normed_vector,inverse} \ 'a" shows "((%h. (f(a + h) - f(a)) / h) -- 0 --> D) = ((%x. (f(x)-f(a)) / (x-a)) -- a --> D)" apply (rule iffI) @@ -577,7 +578,7 @@ apply (drule not_P_Bolzano_bisect', assumption+) apply (rename_tac "l") apply (drule_tac x = l in spec, clarify) -apply (simp add: LIMSEQ_def) +apply (simp add: LIMSEQ_iff) apply (drule_tac P = "%r. 0 ?Q r" and x = "d/2" in spec) apply (drule_tac P = "%r. 0 ?Q r" and x = "d/2" in spec) apply (drule real_less_half_sum, auto) @@ -614,7 +615,7 @@ apply (cut_tac P = "% (u,v) . a \ u & u \ v & v \ b --> ~ (f (u) \ y & y \ f (v))" in lemma_BOLZANO2) apply safe apply simp_all -apply (simp add: isCont_iff LIM_def) +apply (simp add: isCont_iff LIM_eq) apply (rule ccontr) apply (subgoal_tac "a \ x & x \ b") prefer 2 @@ -675,7 +676,7 @@ apply (case_tac "a \ x & x \ b") apply (rule_tac [2] x = 1 in exI) prefer 2 apply force -apply (simp add: LIM_def isCont_iff) +apply (simp add: LIM_eq isCont_iff) apply (drule_tac x = x in spec, auto) apply (erule_tac V = "\M. \x. a \ x & x \ b & ~ f x \ M" in thin_rl) apply (drule_tac x = 1 in spec, auto) @@ -1486,7 +1487,7 @@ lemma LIM_fun_gt_zero: "[| f -- c --> (l::real); 0 < l |] ==> \r. 0 < r & (\x::real. x \ c & \c - x\ < r --> 0 < f x)" -apply (auto simp add: LIM_def) +apply (auto simp add: LIM_eq) apply (drule_tac x = "l/2" in spec, safe, force) apply (rule_tac x = s in exI) apply (auto simp only: abs_less_iff) @@ -1495,7 +1496,7 @@ lemma LIM_fun_less_zero: "[| f -- c --> (l::real); l < 0 |] ==> \r. 0 < r & (\x::real. x \ c & \c - x\ < r --> f x < 0)" -apply (auto simp add: LIM_def) +apply (auto simp add: LIM_eq) apply (drule_tac x = "-l/2" in spec, safe, force) apply (rule_tac x = s in exI) apply (auto simp only: abs_less_iff) diff -r 3e900a2acaed -r edf74583715a src/HOL/HOL.thy --- a/src/HOL/HOL.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/HOL.thy Tue Jun 02 10:04:03 2009 +0200 @@ -31,7 +31,7 @@ ("Tools/recfun_codegen.ML") begin -setup {* Intuitionistic.method_setup "iprover" *} +setup {* Intuitionistic.method_setup @{binding iprover} *} subsection {* Primitive logic *} diff -r 3e900a2acaed -r edf74583715a src/HOL/Integration.thy --- a/src/HOL/Integration.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Integration.thy Tue Jun 02 10:04:03 2009 +0200 @@ -272,7 +272,7 @@ fix x :: real assume "a \ x" and "x \ b" with f' have "DERIV f x :> f'(x)" by simp then have "\r>0. \s>0. \z. z \ x \ \z - x\ < s \ \(f z - f x) / (z - x) - f' x\ < r" - by (simp add: DERIV_iff2 LIM_def) + by (simp add: DERIV_iff2 LIM_eq) with `0 < e` obtain s where "\z. z \ x \ \z - x\ < s \ \(f z - f x) / (z - x) - f' x\ < e/2" and "0 < s" by (drule_tac x="e/2" in spec, auto) @@ -430,7 +430,7 @@ lemma Cauchy_iff2: "Cauchy X = (\j. (\M. \m \ M. \n \ M. \X m - X n\ < inverse(real (Suc j))))" -apply (simp add: Cauchy_def, auto) +apply (simp add: Cauchy_iff, auto) apply (drule reals_Archimedean, safe) apply (drule_tac x = n in spec, auto) apply (rule_tac x = M in exI, auto) diff -r 3e900a2acaed -r edf74583715a src/HOL/IsaMakefile --- a/src/HOL/IsaMakefile Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/IsaMakefile Tue Jun 02 10:04:03 2009 +0200 @@ -280,6 +280,7 @@ Fact.thy \ Integration.thy \ Lim.thy \ + Limits.thy \ Ln.thy \ Log.thy \ MacLaurin.thy \ diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/BigO.thy --- a/src/HOL/Library/BigO.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/BigO.thy Tue Jun 02 10:04:03 2009 +0200 @@ -871,7 +871,7 @@ done lemma bigo_LIMSEQ1: "f =o O(g) ==> g ----> 0 ==> f ----> (0::real)" - apply (simp add: LIMSEQ_def bigo_alt_def) + apply (simp add: LIMSEQ_iff bigo_alt_def) apply clarify apply (drule_tac x = "r / c" in spec) apply (drule mp) diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/Convex_Euclidean_Space.thy --- a/src/HOL/Library/Convex_Euclidean_Space.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/Convex_Euclidean_Space.thy Tue Jun 02 10:04:03 2009 +0200 @@ -615,7 +615,7 @@ subsection {* One rather trivial consequence. *} -lemma connected_UNIV: "connected UNIV" +lemma connected_UNIV: "connected (UNIV :: (real ^ _) set)" by(simp add: convex_connected convex_UNIV) subsection {* Convex functions into the reals. *} @@ -763,10 +763,10 @@ thus "dist x (u *s y + v *s z) \ e" using real_convex_bound_le[OF yz uv] by auto qed -lemma connected_ball: "connected(ball x e)" +lemma connected_ball: "connected(ball (x::real^_) e)" (* FIXME: generalize *) using convex_connected convex_ball by auto -lemma connected_cball: "connected(cball x e)" +lemma connected_cball: "connected(cball (x::real^_) e)" (* FIXME: generalize *) using convex_connected convex_cball by auto subsection {* Convex hull. *} @@ -2186,7 +2186,9 @@ ultimately show "u *s x + v *s y \ s" apply- apply(rule assms[unfolded is_interval_def, rule_format, OF as(1,2)]) using as(3-) dimindex_ge_1 apply- by(auto simp add: vector_component) qed -lemma is_interval_connected: "is_interval s \ connected s" +lemma is_interval_connected: + fixes s :: "(real ^ _) set" + shows "is_interval s \ connected s" using is_interval_convex convex_connected by auto lemma convex_interval: "convex {a .. b}" "convex {a<..x. (1 - dest_vec1 x) *s a + dest_vec1 x *s b)" +definition + linepath :: "real ^ 'n::finite \ real ^ 'n \ real ^ 1 \ real ^ 'n" where + "linepath a b = (\x. (1 - dest_vec1 x) *s a + dest_vec1 x *s b)" lemma pathstart_linepath[simp]: "pathstart(linepath a b) = a" unfolding pathstart_def linepath_def by auto diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/Efficient_Nat.thy --- a/src/HOL/Library/Efficient_Nat.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/Efficient_Nat.thy Tue Jun 02 10:04:03 2009 +0200 @@ -317,7 +317,7 @@ setup {* fold (Numeral.add_code @{const_name number_nat_inst.number_of_nat} - true false) ["SML", "OCaml", "Haskell"] + false true) ["SML", "OCaml", "Haskell"] *} text {* diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/Euclidean_Space.thy --- a/src/HOL/Library/Euclidean_Space.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/Euclidean_Space.thy Tue Jun 02 10:04:03 2009 +0200 @@ -498,6 +498,30 @@ apply simp done +subsection {* Metric *} + +instantiation "^" :: (metric_space, finite) metric_space +begin + +definition dist_vector_def: + "dist (x::'a^'b) (y::'a^'b) = setL2 (\i. dist (x$i) (y$i)) UNIV" + +instance proof + fix x y :: "'a ^ 'b" + show "dist x y = 0 \ x = y" + unfolding dist_vector_def + by (simp add: setL2_eq_0_iff Cart_eq) +next + fix x y z :: "'a ^ 'b" + show "dist x y \ dist x z + dist y z" + unfolding dist_vector_def + apply (rule order_trans [OF _ setL2_triangle_ineq]) + apply (simp add: setL2_mono dist_triangle2) + done +qed + +end + subsection {* Norms *} instantiation "^" :: (real_normed_vector, finite) real_normed_vector @@ -509,9 +533,6 @@ definition vector_sgn_def: "sgn (x::'a^'b) = scaleR (inverse (norm x)) x" -definition dist_vector_def: - "dist (x::'a^'b) y = norm (x - y)" - instance proof fix a :: real and x y :: "'a ^ 'b" show "0 \ norm x" @@ -531,7 +552,8 @@ show "sgn x = scaleR (inverse (norm x)) x" by (rule vector_sgn_def) show "dist x y = norm (x - y)" - by (rule dist_vector_def) + unfolding dist_vector_def vector_norm_def + by (simp add: dist_norm) qed end @@ -697,7 +719,7 @@ qed lemma square_continuous: "0 < (e::real) ==> \d. 0 < d \ (\y. abs(y - x) < d \ abs(y * y - x * x) < e)" - using isCont_power[OF isCont_ident, of 2, unfolded isCont_def LIM_def, rule_format, of e x] apply (auto simp add: power2_eq_square) + using isCont_power[OF isCont_ident, of 2, unfolded isCont_def LIM_eq, rule_format, of e x] apply (auto simp add: power2_eq_square) apply (rule_tac x="s" in exI) apply auto apply (erule_tac x=y in allE) @@ -949,6 +971,11 @@ "x \ y \ \ (norm (x - y) \ 0)" using norm_ge_zero[of "x - y"] by auto +lemma vector_dist_norm: + fixes x y :: "real ^ _" + shows "dist x y = norm (x - y)" + by (rule dist_norm) + use "normarith.ML" method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac) @@ -2566,7 +2593,7 @@ qed lemma dist_fstcart: "dist(fstcart (x::real^_)) (fstcart y) <= dist x y" - by (metis dist_vector_def fstcart_sub[symmetric] norm_fstcart) + unfolding dist_norm by (metis fstcart_sub[symmetric] norm_fstcart) lemma norm_sndcart: "norm(sndcart x) <= norm (x::real ^('n::finite + 'm::finite))" proof- @@ -2581,7 +2608,7 @@ qed lemma dist_sndcart: "dist(sndcart (x::real^_)) (sndcart y) <= dist x y" - by (metis dist_vector_def sndcart_sub[symmetric] norm_sndcart) + unfolding dist_norm by (metis sndcart_sub[symmetric] norm_sndcart) lemma dot_pastecart: "(pastecart (x1::'a::{times,comm_monoid_add}^'n::finite) (x2::'a::{times,comm_monoid_add}^'m::finite)) \ (pastecart y1 y2) = x1 \ y1 + x2 \ y2" by (simp add: dot_def setsum_UNIV_sum pastecart_def) diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/Fundamental_Theorem_Algebra.thy --- a/src/HOL/Library/Fundamental_Theorem_Algebra.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/Fundamental_Theorem_Algebra.thy Tue Jun 02 10:04:03 2009 +0200 @@ -306,12 +306,12 @@ from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\n. Re (s (f n))) x" by blast hence x: "\r>0. \n0. \n\n0. \ Re (s (f n)) - x \ < r" - unfolding LIMSEQ_def real_norm_def . + unfolding LIMSEQ_iff real_norm_def . from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\n. Im (s (f (g n)))) y" by blast hence y: "\r>0. \n0. \n\n0. \ Im (s (f (g n))) - y \ < r" - unfolding LIMSEQ_def real_norm_def . + unfolding LIMSEQ_iff 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)" diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/Product_Vector.thy --- a/src/HOL/Library/Product_Vector.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/Product_Vector.thy Tue Jun 02 10:04:03 2009 +0200 @@ -39,6 +39,38 @@ end +subsection {* Product is a metric space *} + +instantiation + "*" :: (metric_space, metric_space) metric_space +begin + +definition dist_prod_def: + "dist (x::'a \ 'b) y = sqrt ((dist (fst x) (fst y))\ + (dist (snd x) (snd y))\)" + +lemma dist_Pair_Pair: "dist (a, b) (c, d) = sqrt ((dist a c)\ + (dist b d)\)" + unfolding dist_prod_def by simp + +instance proof + fix x y :: "'a \ 'b" + show "dist x y = 0 \ x = y" + unfolding dist_prod_def + by (simp add: expand_prod_eq) +next + fix x y z :: "'a \ 'b" + show "dist x y \ dist x z + dist y z" + unfolding dist_prod_def + apply (rule order_trans [OF _ real_sqrt_sum_squares_triangle_ineq]) + apply (rule real_sqrt_le_mono) + apply (rule order_trans [OF add_mono]) + apply (rule power_mono [OF dist_triangle2 [of _ _ "fst z"] zero_le_dist]) + apply (rule power_mono [OF dist_triangle2 [of _ _ "snd z"] zero_le_dist]) + apply (simp only: real_sum_squared_expand) + done +qed + +end + subsection {* Product is a normed vector space *} instantiation @@ -51,9 +83,6 @@ definition sgn_prod_def: "sgn (x::'a \ 'b) = scaleR (inverse (norm x)) x" -definition dist_prod_def: - "dist (x::'a \ 'b) y = norm (x - y)" - lemma norm_Pair: "norm (a, b) = sqrt ((norm a)\ + (norm b)\)" unfolding norm_prod_def by simp @@ -78,7 +107,8 @@ show "sgn x = scaleR (inverse (norm x)) x" by (rule sgn_prod_def) show "dist x y = norm (x - y)" - by (rule dist_prod_def) + unfolding dist_prod_def norm_prod_def + by (simp add: dist_norm) qed end @@ -179,53 +209,53 @@ lemma LIMSEQ_Pair: assumes "X ----> a" and "Y ----> b" shows "(\n. (X n, Y n)) ----> (a, b)" -proof (rule LIMSEQ_I) +proof (rule metric_LIMSEQ_I) fix r :: real assume "0 < r" then have "0 < r / sqrt 2" (is "0 < ?s") by (simp add: divide_pos_pos) - obtain M where M: "\n\M. norm (X n - a) < ?s" - using LIMSEQ_D [OF `X ----> a` `0 < ?s`] .. - obtain N where N: "\n\N. norm (Y n - b) < ?s" - using LIMSEQ_D [OF `Y ----> b` `0 < ?s`] .. - have "\n\max M N. norm ((X n, Y n) - (a, b)) < r" - using M N by (simp add: real_sqrt_sum_squares_less norm_Pair) - then show "\n0. \n\n0. norm ((X n, Y n) - (a, b)) < r" .. + obtain M where M: "\n\M. dist (X n) a < ?s" + using metric_LIMSEQ_D [OF `X ----> a` `0 < ?s`] .. + obtain N where N: "\n\N. dist (Y n) b < ?s" + using metric_LIMSEQ_D [OF `Y ----> b` `0 < ?s`] .. + have "\n\max M N. dist (X n, Y n) (a, b) < r" + using M N by (simp add: real_sqrt_sum_squares_less dist_Pair_Pair) + then show "\n0. \n\n0. dist (X n, Y n) (a, b) < r" .. qed lemma Cauchy_Pair: assumes "Cauchy X" and "Cauchy Y" shows "Cauchy (\n. (X n, Y n))" -proof (rule CauchyI) +proof (rule metric_CauchyI) fix r :: real assume "0 < r" then have "0 < r / sqrt 2" (is "0 < ?s") by (simp add: divide_pos_pos) - obtain M where M: "\m\M. \n\M. norm (X m - X n) < ?s" - using CauchyD [OF `Cauchy X` `0 < ?s`] .. - obtain N where N: "\m\N. \n\N. norm (Y m - Y n) < ?s" - using CauchyD [OF `Cauchy Y` `0 < ?s`] .. - have "\m\max M N. \n\max M N. norm ((X m, Y m) - (X n, Y n)) < r" - using M N by (simp add: real_sqrt_sum_squares_less norm_Pair) - then show "\n0. \m\n0. \n\n0. norm ((X m, Y m) - (X n, Y n)) < r" .. + obtain M where M: "\m\M. \n\M. dist (X m) (X n) < ?s" + using metric_CauchyD [OF `Cauchy X` `0 < ?s`] .. + obtain N where N: "\m\N. \n\N. dist (Y m) (Y n) < ?s" + using metric_CauchyD [OF `Cauchy Y` `0 < ?s`] .. + have "\m\max M N. \n\max M N. dist (X m, Y m) (X n, Y n) < r" + using M N by (simp add: real_sqrt_sum_squares_less dist_Pair_Pair) + then show "\n0. \m\n0. \n\n0. dist (X m, Y m) (X n, Y n) < r" .. qed lemma LIM_Pair: assumes "f -- x --> a" and "g -- x --> b" shows "(\x. (f x, g x)) -- x --> (a, b)" -proof (rule LIM_I) +proof (rule metric_LIM_I) fix r :: real assume "0 < r" then have "0 < r / sqrt 2" (is "0 < ?e") by (simp add: divide_pos_pos) obtain s where s: "0 < s" - "\z. z \ x \ norm (z - x) < s \ norm (f z - a) < ?e" - using LIM_D [OF `f -- x --> a` `0 < ?e`] by fast + "\z. z \ x \ dist z x < s \ dist (f z) a < ?e" + using metric_LIM_D [OF `f -- x --> a` `0 < ?e`] by fast obtain t where t: "0 < t" - "\z. z \ x \ norm (z - x) < t \ norm (g z - b) < ?e" - using LIM_D [OF `g -- x --> b` `0 < ?e`] by fast + "\z. z \ x \ dist z x < t \ dist (g z) b < ?e" + using metric_LIM_D [OF `g -- x --> b` `0 < ?e`] by fast have "0 < min s t \ - (\z. z \ x \ norm (z - x) < min s t \ norm ((f z, g z) - (a, b)) < r)" - using s t by (simp add: real_sqrt_sum_squares_less norm_Pair) + (\z. z \ x \ dist z x < min s t \ dist (f z, g z) (a, b) < r)" + using s t by (simp add: real_sqrt_sum_squares_less dist_Pair_Pair) then show - "\s>0. \z. z \ x \ norm (z - x) < s \ norm ((f z, g z) - (a, b)) < r" .. + "\s>0. \z. z \ x \ dist z x < s \ dist (f z, g z) (a, b) < r" .. qed lemma isCont_Pair [simp]: diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/Topology_Euclidean_Space.thy --- a/src/HOL/Library/Topology_Euclidean_Space.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/Topology_Euclidean_Space.thy Tue Jun 02 10:04:03 2009 +0200 @@ -195,7 +195,7 @@ subsection{* The universal Euclidean versions are what we use most of the time *} definition - "open" :: "(real ^ 'n::finite) set \ bool" where + "open" :: "'a::metric_space set \ bool" where "open S \ (\x \ S. \e >0. \x'. dist x' x < e \ x' \ S)" definition "closed S \ open(UNIV - S)" definition "euclidean = topology open" @@ -288,17 +288,26 @@ subsection{* Open and closed balls. *} definition - ball :: "real ^ 'n::finite \ real \ (real^'n) set" where + ball :: "'a::metric_space \ real \ 'a set" where "ball x e = {y. dist x y < e}" definition - cball :: "real ^ 'n::finite \ real \ (real^'n) set" where + cball :: "'a::metric_space \ real \ 'a set" where "cball x e = {y. dist x y \ e}" lemma mem_ball[simp]: "y \ ball x e \ dist x y < e" by (simp add: ball_def) lemma mem_cball[simp]: "y \ cball x e \ dist x y \ e" by (simp add: cball_def) -lemma mem_ball_0[simp]: "x \ ball 0 e \ norm x < e" by (simp add: dist_norm) -lemma mem_cball_0[simp]: "x \ cball 0 e \ norm x \ e" by (simp add: dist_norm) + +lemma mem_ball_0 [simp]: + fixes x :: "'a::real_normed_vector" + shows "x \ ball 0 e \ norm x < e" + by (simp add: dist_norm) + +lemma mem_cball_0 [simp]: + fixes x :: "'a::real_normed_vector" + shows "x \ cball 0 e \ norm x \ e" + by (simp add: dist_norm) + lemma centre_in_cball[simp]: "x \ cball x e \ 0\ e" by simp lemma ball_subset_cball[simp,intro]: "ball x e \ cball x e" by (simp add: subset_eq) lemma subset_ball[intro]: "d <= e ==> ball x d \ ball x e" by (simp add: subset_eq) @@ -494,8 +503,9 @@ subsection{* Limit points *} -definition islimpt:: "real ^'n::finite \ (real^'n) set \ bool" (infixr "islimpt" 60) where - islimpt_def: "x islimpt S \ (\T. x\T \ open T \ (\y\S. y\T \ y\x))" +definition + islimpt:: "'a::metric_space \ 'a set \ bool" (infixr "islimpt" 60) where + "x islimpt S \ (\T. x\T \ open T \ (\y\S. y\T \ y\x))" (* FIXME: Sure this form is OK????*) lemma islimptE: assumes "x islimpt S" and "x \ T" and "open T" @@ -519,17 +529,44 @@ using approachable_lt_le[where f="\x'. dist x' x" and P="\x'. \ (x'\S \ x'\x)"] by metis (* FIXME: VERY slow! *) -lemma islimpt_UNIV[simp, intro]: "(x:: real ^'n::finite) islimpt UNIV" -proof- +axclass perfect_space \ metric_space + islimpt_UNIV [simp, intro]: "x islimpt UNIV" + +lemma perfect_choose_dist: + fixes x :: "'a::perfect_space" + shows "0 < r \ \a. a \ x \ dist a x < r" +using islimpt_UNIV [of x] +by (simp add: islimpt_approachable) + +instance real :: perfect_space +apply default +apply (rule islimpt_approachable [THEN iffD2]) +apply (clarify, rule_tac x="x + e/2" in bexI) +apply (auto simp add: dist_norm) +done + +instance "^" :: (perfect_space, finite) perfect_space +proof + fix x :: "'a ^ 'b" { - fix e::real assume ep: "e>0" - from vector_choose_size[of "e/2"] ep have "\(c:: real ^'n). norm c = e/2" by auto - then obtain c ::"real^'n" where c: "norm c = e/2" by blast - let ?x = "x + c" - have "?x \ x" using c ep by (auto simp add: norm_eq_0_imp) - moreover have "dist ?x x < e" using c ep apply simp by norm - ultimately have "\x'. x' \ x\ dist x' x < e" by blast} - then show ?thesis unfolding islimpt_approachable by blast + fix e :: real assume "0 < e" + def a \ "x $ arbitrary" + have "a islimpt UNIV" by (rule islimpt_UNIV) + with `0 < e` obtain b where "b \ a" and "dist b a < e" + unfolding islimpt_approachable by auto + def y \ "Cart_lambda ((Cart_nth x)(arbitrary := b))" + from `b \ a` have "y \ x" + unfolding a_def y_def by (simp add: Cart_eq) + from `dist b a < e` have "dist y x < e" + unfolding dist_vector_def a_def y_def + apply simp + apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]]) + apply (subst setsum_diff1' [where a=arbitrary], simp, simp, simp) + done + from `y \ x` and `dist y x < e` + have "\y\UNIV. y \ x \ dist y x < e" by auto + } + then show "x islimpt UNIV" unfolding islimpt_approachable by blast qed lemma closed_limpt: "closed S \ (\x. x islimpt S \ x \ S)" @@ -562,7 +599,7 @@ qed lemma finite_set_avoid: - fixes a :: "real ^ 'n::finite" + fixes a :: "'a::metric_space" assumes fS: "finite S" shows "\d>0. \x\S. x \ a \ d <= dist a x" proof(induct rule: finite_induct[OF fS]) case 1 thus ?case apply auto by ferrack @@ -594,7 +631,7 @@ done lemma discrete_imp_closed: - assumes e: "0 < e" and d: "\x \ S. \y \ S. norm(y - x) < e \ y = x" + assumes e: "0 < e" and d: "\x \ S. \y \ S. dist y x < e \ y = x" shows "closed S" proof- {fix x assume C: "\e>0. \x'\S. x' \ x \ dist x' x < e" @@ -603,8 +640,7 @@ let ?m = "min (e/2) (dist x y) " from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym]) from C[rule_format, OF mp] obtain z where z: "z \ S" "z\x" "dist z x < ?m" by blast - have th: "norm (z - y) < e" using z y - unfolding dist_norm [symmetric] + have th: "dist z y < e" using z y by (intro dist_triangle_lt [where z=x], simp) from d[rule_format, OF y(1) z(1) th] y z have False by (auto simp add: dist_commute)} @@ -644,23 +680,28 @@ apply (metis Int_lower1 Int_lower2 subset_interior) by (metis Int_mono interior_subset open_inter open_interior open_subset_interior) -lemma interior_limit_point[intro]: assumes x: "x \ interior S" shows "x islimpt S" +lemma interior_limit_point [intro]: + fixes x :: "'a::perfect_space" + assumes x: "x \ interior S" shows "x islimpt S" proof- from x obtain e where e: "e>0" "\x'. dist x x' < e \ x' \ S" unfolding mem_interior subset_eq Ball_def mem_ball by blast - {fix d::real assume d: "d>0" - let ?m = "min d e / 2" - have mde2: "?m \ 0" using e(1) d(1) by arith - from vector_choose_dist[OF mde2, of x] - obtain y where y: "dist x y = ?m" by blast - have th: "dist x y < e" "dist x y < d" unfolding y using e(1) d(1) by arith+ + { + fix d::real assume d: "d>0" + let ?m = "min d e" + have mde2: "0 < ?m" using e(1) d(1) by simp + from perfect_choose_dist [OF mde2, of x] + obtain y where "y \ x" and "dist y x < ?m" by blast + then have "dist y x < e" "dist y x < d" by simp_all + from `dist y x < e` e(2) have "y \ S" by (simp add: dist_commute) have "\x'\S. x'\ x \ dist x' x < d" - apply (rule bexI[where x=y]) - using e th y by (auto simp add: dist_commute)} + using `y \ S` `y \ x` `dist y x < d` by fast + } then show ?thesis unfolding islimpt_approachable by blast qed lemma interior_closed_Un_empty_interior: + fixes S T :: "(real ^ 'n::finite) set" (* FIXME: generalize to perfect_space *) assumes cS: "closed S" and iT: "interior T = {}" shows "interior(S \ T) = interior S" proof- @@ -690,7 +731,7 @@ done then have "\z. z \ T \ z\ y \ dist z y < d \ dist x z < e" by blast then have "\x' \S. x'\y \ dist x' y < d" using e by auto} - then have "y\S" by (metis islimpt_approachable cS closed_limpt) } + then have "y\S" by (metis islimpt_approachable [where 'a="real^'n"] cS closed_limpt[where 'a="real^'n"]) } then have "x \ interior S" unfolding mem_interior using e(1) by blast} hence "interior (S\T) \ interior S" unfolding mem_interior Ball_def subset_eq by blast ultimately show ?thesis by blast @@ -766,7 +807,7 @@ with * have "closure S \ t" unfolding closure_def using closed_limpt[of t] - by blast + by auto } ultimately show ?thesis using hull_unique[of S, of "closure S", of closed] @@ -971,17 +1012,24 @@ subsection{* Common nets and The "within" modifier for nets. *} definition - at :: "real ^ 'n::finite \ (real ^ 'n) net" where + at :: "'a::perfect_space \ 'a net" where "at a = mknet(\x y. 0 < dist x a \ dist x a <= dist y a)" -definition "at_infinity = mknet(\x y. norm x \ norm y)" -definition "sequentially = mknet(\(m::nat) n. m >= n)" - -definition within :: "'a net \ 'a set \ 'a net" (infixr "within" 70) where - within_def: "net within S = mknet (\x y. netord net x y \ x \ S)" - -definition indirection :: "real ^'n::finite \ real ^'n \ (real ^'n) net" (infixr "indirection" 70) where - indirection_def: "a indirection v = (at a) within {b. \c\0. b - a = c*s v}" +definition + at_infinity :: "'a::real_normed_vector net" where + "at_infinity = mknet (\x y. norm x \ norm y)" + +definition + sequentially :: "nat net" where + "sequentially = mknet (\m n. n \ m)" + +definition + within :: "'a net \ 'a set \ 'a net" (infixr "within" 70) where + "net within S = mknet (\x y. netord net x y \ x \ S)" + +definition + indirection :: "real ^'n::finite \ real ^'n \ (real ^'n) net" (infixr "indirection" 70) where + "a indirection v = (at a) within {b. \c\0. b - a = c*s v}" text{* Prove That They are all nets. *} @@ -1024,19 +1072,22 @@ lemma in_direction: "netord (a indirection v) x y \ 0 < dist x a \ dist x a \ dist y a \ (\c \ 0. x - a = c *s v)" by (simp add: within at indirection_def) -lemma within_UNIV: "at x within UNIV = at x" - by (simp add: within_def at_def netord_inverse) +lemma within_UNIV: "net within UNIV = net" + by (simp add: within_def netord_inverse) subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *} - -definition "trivial_limit (net:: 'a net) \ - (\(a::'a) b. a = b) \ (\(a::'a) b. a \ b \ (\x. ~(netord (net) x a) \ ~(netord(net) x b)))" - - -lemma trivial_limit_within: "trivial_limit (at (a::real^'n::finite) within S) \ ~(a islimpt S)" +definition + trivial_limit :: "'a net \ bool" where + "trivial_limit (net:: 'a net) \ + (\(a::'a) b. a = b) \ + (\(a::'a) b. a \ b \ (\x. ~(netord (net) x a) \ ~(netord(net) x b)))" + +lemma trivial_limit_within: + fixes a :: "'a::perfect_space" + shows "trivial_limit (at a within S) \ \ a islimpt S" proof- - {assume "\(a::real^'n) b. a = b" hence "\ a islimpt S" + {assume "\(a::'a) b. a = b" hence "\ a islimpt S" apply (simp add: islimpt_approachable_le) by (rule exI[where x=1], auto)} moreover @@ -1051,30 +1102,35 @@ {assume "\ a islimpt S" then obtain e where e: "e > 0" "\x' \ S. x' \ a \ dist x' a > e" unfolding islimpt_approachable_le by (auto simp add: not_le) - from e vector_choose_dist[of e a] obtain b where b: "dist a b = e" by auto - from b e(1) have "a \ b" by (simp add: dist_nz) + from e perfect_choose_dist[of e a] obtain b where b: "b \ a" "dist b a < e" by auto + then have "a \ b" by auto moreover have "\x. \ ((0 < dist x a \ dist x a \ dist a a) \ x \ S) \ \ ((0 < dist x a \ dist x a \ dist b a) \ x \ S)" using e(2) b by (auto simp add: dist_commute) - ultimately have "trivial_limit (at a within S)" unfolding trivial_limit_def within at + ultimately have "trivial_limit (at a within S)" + unfolding trivial_limit_def within at by blast} ultimately show ?thesis unfolding trivial_limit_def by blast qed -lemma trivial_limit_at: "~(trivial_limit (at a))" - apply (subst within_UNIV[symmetric]) - by (simp add: trivial_limit_within islimpt_UNIV) - -lemma trivial_limit_at_infinity: "~(trivial_limit (at_infinity :: ('a::{norm,zero_neq_one}) net))" +lemma trivial_limit_at: "\ trivial_limit (at a)" + using trivial_limit_within [of a UNIV] + by (simp add: within_UNIV) + +lemma trivial_limit_at_infinity: + "\ trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)" apply (simp add: trivial_limit_def at_infinity) by (metis order_refl zero_neq_one) -lemma trivial_limit_sequentially: "~(trivial_limit sequentially)" +lemma trivial_limit_sequentially: "\ trivial_limit sequentially" by (auto simp add: trivial_limit_def sequentially) subsection{* Some property holds "sufficiently close" to the limit point. *} -definition "eventually P net \ trivial_limit net \ (\y. (\x. netord net x y) \ (\x. netord net x y \ P x))" +definition + eventually :: "('a \ bool) \ 'a net \ bool" where + "eventually P net \ trivial_limit net \ + (\y. (\x. netord net x y) \ (\x. netord net x y \ P x))" lemma eventually_happens: "eventually P net ==> trivial_limit net \ (\x. P x)" by (metis eventually_def) @@ -1100,7 +1156,7 @@ unfolding eventually_def trivial_limit_within islimpt_approachable_le within at unfolding dist_nz[THEN sym] by (clarsimp, rule_tac x=d in exI, auto) qed -lemma eventually_within: " eventually P (at a within S) \ +lemma eventually_within: "eventually P (at a within S) \ (\d>0. \x\S. 0 < dist x a \ dist x a < d \ P x)" proof- { fix d @@ -1134,9 +1190,17 @@ thus "?lhs" unfolding eventually_def at_infinity using b y by auto qed -lemma always_eventually: "(\(x::'a::zero_neq_one). P x) ==> eventually P net" - apply (auto simp add: eventually_def trivial_limit_def ) - by (rule exI[where x=0], rule exI[where x=1], rule zero_neq_one) +lemma always_eventually: "(\x. P x) ==> eventually P net" + unfolding eventually_def trivial_limit_def by (clarify, simp) + +lemma eventually_True [simp]: "eventually (\x. True) net" + by (simp add: always_eventually) + +lemma trivial_limit_eventually: "trivial_limit net \ eventually P net" + unfolding eventually_def by simp + +lemma trivial_limit_eq: "trivial_limit net \ (\P. eventually P net)" + unfolding eventually_def trivial_limit_def by auto text{* Combining theorems for "eventually" *} @@ -1159,9 +1223,24 @@ lemma not_eventually: "(\x. \ P x ) \ ~(trivial_limit net) ==> ~(eventually P net)" by (auto simp add: eventually_def) +lemma eventually_rev_mono: + "eventually P net \ (\x. P x \ Q x) \ eventually Q net" +using eventually_mono [of P Q] by fast + +lemma eventually_rev_mp: + assumes 1: "eventually (\x. P x) net" + assumes 2: "eventually (\x. P x \ Q x) net" + shows "eventually (\x. Q x) net" +using 2 1 by (rule eventually_mp) + +lemma eventually_conjI: + "\eventually (\x. P x) net; eventually (\x. Q x) net\ + \ eventually (\x. P x \ Q x) net" +by (simp add: eventually_and) + subsection{* Limits, defined as vacuously true when the limit is trivial. *} -definition tendsto:: "('a \ real ^'n::finite) \ real ^'n \ 'a net \ bool" (infixr "--->" 55) where +definition tendsto:: "('a \ 'b::metric_space) \ 'b \ 'a net \ bool" (infixr "--->" 55) where tendsto_def: "(f ---> l) net \ (\e>0. eventually (\x. dist (f x) l < e) net)" lemma tendstoD: "(f ---> l) net \ e>0 \ eventually (\x. dist (f x) l < e) net" @@ -1173,9 +1252,8 @@ lemma Lim: "(f ---> l) net \ trivial_limit net \ - (\e>0. \y. (\x. netord net x y) \ - (\x. netord(net) x y \ dist (f x) l < e))" - by (auto simp add: tendsto_def eventually_def) + (\e>0. eventually (\x. dist (f x) l < e) net)" + unfolding tendsto_def trivial_limit_eq by auto text{* Show that they yield usual definitions in the various cases. *} @@ -1192,6 +1270,9 @@ (\e >0. \d>0. \x. 0 < dist x a \ dist x a < d \ dist (f x) l < e)" by (auto simp add: tendsto_def eventually_at) +lemma Lim_at_iff_LIM: "(f ---> l) (at a) \ f -- a --> l" + unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff) + lemma Lim_at_infinity: "(f ---> l) at_infinity \ (\e>0. \b. \x::real^'n::finite. norm x >= b \ dist (f x) l < e)" by (auto simp add: tendsto_def eventually_at_infinity) @@ -1201,8 +1282,11 @@ (\e>0. \N. \n\N. dist (S n) l < e)" by (auto simp add: tendsto_def eventually_sequentially) +lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \ S ----> l" + unfolding Lim_sequentially LIMSEQ_def .. + lemma Lim_eventually: "eventually (\x. f x = l) net \ (f ---> l) net" - by (auto simp add: eventually_def Lim) + unfolding tendsto_def by (auto elim: eventually_rev_mono) text{* The expected monotonicity property. *} @@ -1226,7 +1310,7 @@ qed lemma Lim_Un_univ: - "(f ---> l) (at x within S) \ (f ---> l) (at x within T) \ S \ T = (UNIV::(real^'n::finite) set) + "(f ---> l) (at x within S) \ (f ---> l) (at x within T) \ S \ T = UNIV ==> (f ---> l) (at x)" by (metis Lim_Un within_UNIV) @@ -1280,7 +1364,7 @@ ultimately show ?rhs apply (rule_tac x="(\n::nat. f (inverse (real n + 1)))" in exI) by auto next assume ?rhs - then obtain f::"nat\real^'a" where f:"(\n. f n \ S - {x})" "(\e>0. \N. \n\N. dist (f n) x < e)" unfolding Lim_sequentially by auto + then obtain f::"nat\'a" where f:"(\n. f n \ S - {x})" "(\e>0. \N. \n\N. dist (f n) x < e)" unfolding Lim_sequentially by auto { fix e::real assume "e>0" then obtain N where "dist (f N) x < e" using f(2) by auto moreover have "f N\S" "f N \ x" using f(1) by auto @@ -1294,44 +1378,43 @@ lemma Lim_linear: fixes f :: "('a \ real^'n::finite)" and h :: "(real^'n \ real^'m::finite)" assumes "(f ---> l) net" "linear h" shows "((\x. h (f x)) ---> h l) net" -proof (cases "trivial_limit net") - case True - thus ?thesis unfolding tendsto_def unfolding eventually_def by auto -next - case False note cas = this - obtain b where b: "b>0" "\x. norm (h x) \ b * norm x" using assms(2) using linear_bounded_pos[of h] by auto +proof - + obtain b where b: "b>0" "\x. norm (h x) \ b * norm x" + using assms(2) using linear_bounded_pos[of h] by auto { fix e::real assume "e >0" hence "e/b > 0" using `b>0` by (metis divide_pos_pos) - then have "(\y. (\x. netord net x y) \ (\x. netord net x y \ dist (f x) l < e/b))" using assms `e>0` cas - unfolding tendsto_def unfolding eventually_def by auto - then obtain y where y: "\x. netord net x y" "\x. netord net x y \ dist (f x) l < e/b" by auto - { fix x - have "netord net x y \ dist (h (f x)) (h l) < e" - using y(2) b unfolding dist_norm using linear_sub[of h "f x" l] `linear h` - apply auto by (metis b(1) b(2) dist_vector_def dist_commute less_le_not_le linorder_not_le mult_imp_div_pos_le real_mult_commute xt1(7)) (* FIXME: VERY slow! *) - } - hence " (\y. (\x. netord net x y) \ (\x. netord net x y \ dist (h (f x)) (h l) < e))" using y - by(rule_tac x="y" in exI) auto + with `(f ---> l) net` have "eventually (\x. dist (f x) l < e/b) net" + by (rule tendstoD) + then have "eventually (\x. dist (h (f x)) (h l) < e) net" + apply (rule eventually_rev_mono [rule_format]) + apply (simp add: dist_norm linear_sub [OF `linear h`, symmetric]) + apply (rule le_less_trans [OF b(2) [rule_format]]) + apply (simp add: pos_less_divide_eq `0 < b` mult_commute) + done } - thus ?thesis unfolding tendsto_def eventually_def using `b>0` by auto + thus ?thesis unfolding tendsto_def by simp qed lemma Lim_const: "((\x. a) ---> a) net" by (auto simp add: Lim trivial_limit_def) -lemma Lim_cmul: "(f ---> l) net ==> ((\x. c *s f x) ---> c *s l) net" +lemma Lim_cmul: + fixes f :: "'a \ real ^ 'n::finite" + shows "(f ---> l) net ==> ((\x. c *s f x) ---> c *s l) net" apply (rule Lim_linear[where f = f]) apply simp apply (rule linear_compose_cmul) apply (rule linear_id[unfolded id_def]) done -lemma Lim_neg: "(f ---> l) net ==> ((\x. -(f x)) ---> -l) net" +lemma Lim_neg: + fixes f :: "'a \ 'b::real_normed_vector" + shows "(f ---> l) net ==> ((\x. -(f x)) ---> -l) net" apply (simp add: Lim dist_norm group_simps) apply (subst minus_diff_eq[symmetric]) unfolding norm_minus_cancel by simp -lemma Lim_add: fixes f :: "'a \ real^'n::finite" shows +lemma Lim_add: fixes f :: "'a \ 'b::real_normed_vector" shows "(f ---> l) net \ (g ---> m) net \ ((\x. f(x) + g(x)) ---> l + m) net" proof- assume as:"(f ---> l) net" "(g ---> m) net" @@ -1341,34 +1424,32 @@ "eventually (\x. dist (g x) m < e/2) net" using as by (auto intro: tendstoD simp del: less_divide_eq_number_of1) hence "eventually (\x. dist (f x + g x) (l + m) < e) net" - proof(cases "trivial_limit net") - case True - thus ?thesis unfolding eventually_def by auto - next - case False - hence fl:"(\y. (\x. netord net x y) \ (\x. netord net x y \ dist (f x) l < e / 2))" and - gl:"(\y. (\x. netord net x y) \ (\x. netord net x y \ dist (g x) m < e / 2))" - using * unfolding eventually_def by auto - obtain c where c:"(\x. netord net x c)" "(\x. netord net x c \ dist (f x) l < e / 2 \ dist (g x) m < e / 2)" - using net_dilemma[of net, OF fl gl] by auto - { fix x assume "netord net x c" - with c(2) have " dist (f x + g x) (l + m) < e" using dist_triangle_add[of "f x" "g x" l m] by auto - } - with c show ?thesis unfolding eventually_def by auto - qed + apply (elim eventually_rev_mp) + apply (rule always_eventually, clarify) + apply (rule le_less_trans [OF dist_triangle_add]) + apply simp + done } - thus ?thesis unfolding tendsto_def by auto -qed - -lemma Lim_sub: "(f ---> l) net \ (g ---> m) net \ ((\x. f(x) - g(x)) ---> l - m) net" + thus ?thesis unfolding tendsto_def by simp +qed + +lemma Lim_sub: + fixes f :: "'a \ 'b::real_normed_vector" + shows "(f ---> l) net \ (g ---> m) net \ ((\x. f(x) - g(x)) ---> l - m) net" unfolding diff_minus by (simp add: Lim_add Lim_neg) -lemma Lim_null: "(f ---> l) net \ ((\x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm) -lemma Lim_null_norm: "(f ---> 0) net \ ((\x. vec1(norm(f x))) ---> 0) net" +lemma Lim_null: + fixes f :: "'a \ 'b::real_normed_vector" + shows "(f ---> l) net \ ((\x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm) + +lemma Lim_null_norm: + fixes f :: "'a \ 'b::real_normed_vector" + shows "(f ---> 0) net \ ((\x. vec1(norm(f x))) ---> 0) net" by (simp add: Lim dist_norm norm_vec1) lemma Lim_null_comparison: + fixes f :: "'a \ 'b::real_normed_vector" assumes "eventually (\x. norm(f x) <= g x) net" "((\x. vec1(g x)) ---> 0) net" shows "(f ---> 0) net" proof(simp add: tendsto_def, rule+) @@ -1386,24 +1467,27 @@ lemma Lim_component: "(f ---> l) net ==> ((\a. vec1((f a :: real ^'n::finite)$i)) ---> vec1(l$i)) net" - apply (simp add: Lim dist_norm vec1_sub[symmetric] norm_vec1 vector_minus_component[symmetric] del: vector_minus_component) + unfolding tendsto_def + apply (simp add: dist_norm vec1_sub[symmetric] norm_vec1 vector_minus_component[symmetric] del: vector_minus_component) apply (auto simp del: vector_minus_component) apply (erule_tac x=e in allE) apply clarify - apply (rule_tac x=y in exI) + apply (erule eventually_rev_mono) apply (auto simp del: vector_minus_component) apply (rule order_le_less_trans) apply (rule component_le_norm) by auto lemma Lim_transform_bound: + fixes f :: "'a \ 'b::real_normed_vector" + fixes g :: "'a \ 'c::real_normed_vector" assumes "eventually (\n. norm(f n) <= norm(g n)) net" "(g ---> 0) net" shows "(f ---> 0) net" proof(simp add: tendsto_def, rule+) fix e::real assume "e>0" { fix x assume "norm (f x) \ norm (g x)" "dist (g x) 0 < e" - hence "dist (f x) 0 < e" by norm} + hence "dist (f x) 0 < e" by (simp add: dist_norm)} thus "eventually (\x. dist (f x) 0 < e) net" using eventually_and[of "\x. norm (f x) \ norm (g x)" "\x. dist (g x) 0 < e" net] using eventually_mono[of "\x. norm (f x) \ norm (g x) \ dist (g x) 0 < e" "\x. dist (f x) 0 < e" net] @@ -1415,52 +1499,57 @@ lemma Lim_in_closed_set: assumes "closed S" "eventually (\x. f(x) \ S) net" "\(trivial_limit net)" "(f ---> l) net" shows "l \ S" -proof- - { assume "l \ S" - obtain e where e:"e>0" "ball l e \ UNIV - S" using assms(1) `l \ S` unfolding closed_def open_contains_ball by auto - hence *:"\x. dist l x < e \ x \ S" by auto - obtain y where "(\x. netord net x y) \ (\x. netord net x y \ dist (f x) l < e)" - using assms(3,4) `e>0` unfolding tendsto_def eventually_def by blast - hence "(\x. netord net x y) \ (\x. netord net x y \ f x \ S)" using * by (auto simp add: dist_commute) - hence False using assms(2,3) - using eventually_and[of "(\x. f x \ S)" "(\x. f x \ S)"] not_eventually[of "(\x. f x \ S \ f x \ S)" net] - unfolding eventually_def by blast - } - thus ?thesis by blast +proof (rule ccontr) + assume "l \ S" + obtain e where e:"e>0" "ball l e \ UNIV - S" using assms(1) `l \ S` unfolding closed_def open_contains_ball by auto + hence *:"\x. dist l x < e \ x \ S" by auto + have "eventually (\x. dist (f x) l < e) net" + using assms(4) `e>0` by (rule tendstoD) + with assms(2) have "eventually (\x. f x \ S \ dist (f x) l < e) net" + by (rule eventually_conjI) + then obtain x where "f x \ S" "dist (f x) l < e" + using assms(3) eventually_happens by auto + with * show "False" by (simp add: dist_commute) qed text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *} lemma Lim_norm_ubound: + fixes f :: "'a \ 'b::real_normed_vector" assumes "\(trivial_limit net)" "(f ---> l) net" "eventually (\x. norm(f x) <= e) net" shows "norm(l) <= e" -proof- - obtain y where y: "\x. netord net x y" "\x. netord net x y \ norm (f x) \ e" using assms(1,3) unfolding eventually_def by auto - show ?thesis - proof(rule ccontr) - assume "\ norm l \ e" - then obtain z where z: "\x. netord net x z" "\x. netord net x z \ dist (f x) l < norm l - e" - using assms(2)[unfolded Lim] using assms(1) apply simp apply(erule_tac x="norm l - e" in allE) by auto - obtain w where w:"netord net w z" "netord net w y" using net[of net] using z(1) y(1) by blast - hence "dist (f w) l < norm l - e \ norm (f w) <= e" using z(2) y(2) by auto - thus False using `\ norm l \ e` by norm - qed +proof (rule ccontr) + assume "\ norm l \ e" + then have "0 < norm l - e" by simp + with assms(2) have "eventually (\x. dist (f x) l < norm l - e) net" + by (rule tendstoD) + with assms(3) have "eventually (\x. norm (f x) \ e \ dist (f x) l < norm l - e) net" + by (rule eventually_conjI) + then obtain w where "norm (f w) \ e" "dist (f w) l < norm l - e" + using assms(1) eventually_happens by auto + hence "norm (f w - l) < norm l - e" "norm (f w) \ e" by (simp_all add: dist_norm) + hence "norm (f w - l) + norm (f w) < norm l" by simp + hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4]) + thus False using `\ norm l \ e` by simp qed lemma Lim_norm_lbound: + fixes f :: "'a \ 'b::real_normed_vector" assumes "\ (trivial_limit net)" "(f ---> l) net" "eventually (\x. e <= norm(f x)) net" shows "e \ norm l" -proof- - obtain y where y: "\x. netord net x y" "\x. netord net x y \ e \ norm (f x)" using assms(1,3) unfolding eventually_def by auto - show ?thesis - proof(rule ccontr) - assume "\ e \ norm l" - then obtain z where z: "\x. netord net x z" "\x. netord net x z \ dist (f x) l < e - norm l" - using assms(2)[unfolded Lim] using assms(1) apply simp apply(erule_tac x="e - norm l" in allE) by auto - obtain w where w:"netord net w z" "netord net w y" using net[of net] using z(1) y(1) by blast - hence "dist (f w) l < e - norm l \ e \ norm (f w)" using z(2) y(2) by auto - thus False using `\ e \ norm l` by norm - qed +proof (rule ccontr) + assume "\ e \ norm l" + then have "0 < e - norm l" by simp + with assms(2) have "eventually (\x. dist (f x) l < e - norm l) net" + by (rule tendstoD) + with assms(3) have "eventually (\x. e \ norm (f x) \ dist (f x) l < e - norm l) net" + by (rule eventually_conjI) + then obtain w where "e \ norm (f w)" "dist (f w) l < e - norm l" + using assms(1) eventually_happens by auto + hence "norm (f w - l) + norm l < e" "e \ norm (f w)" by (simp_all add: dist_norm) + hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans) + hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq]) + thus False by simp qed text{* Uniqueness of the limit, when nontrivial. *} @@ -1482,7 +1571,8 @@ qed lemma tendsto_Lim: - "~(trivial_limit (net::('b::zero_neq_one net))) \ (f ---> l) net ==> Lim net f = l" + fixes f :: "'a::zero_neq_one \ real ^ 'n::finite" + shows "~(trivial_limit net) \ (f ---> l) net ==> Lim net f = l" unfolding Lim_def using Lim_unique[of net f] by auto text{* Limit under bilinear function (surprisingly tedious, but important) *} @@ -1521,10 +1611,7 @@ fixes net :: "'a net" and h:: "real ^'m::finite \ real ^'n::finite \ real ^'p::finite" assumes "(f ---> l) net" and "(g ---> m) net" and "bilinear h" shows "((\x. h (f x) (g x)) ---> (h l m)) net" -proof(cases "trivial_limit net") - case True thus "((\x. h (f x) (g x)) ---> h l m) net" unfolding Lim .. -next - case False note ntriv = this +proof - obtain B where "B>0" and B:"\x y. norm (h x y) \ B * norm x * norm y" using bilinear_bounded_pos[OF assms(3)] by auto { fix e::real assume "e>0" obtain d where "d>0" and d:"\x' y'. norm (x' - l) < d \ norm (y' - m) < d \ norm x' * norm (y' - m) + norm (x' - l) * norm m < e / B" using `B>0` `e>0` @@ -1534,6 +1621,15 @@ unfolding bilinear_rsub[OF assms(3)] unfolding bilinear_lsub[OF assms(3)] by auto + have "eventually (\x. dist (f x) l < d) net" + using assms(1) `d>0` by (rule tendstoD) + moreover + have "eventually (\x. dist (g x) m < d) net" + using assms(2) `d>0` by (rule tendstoD) + ultimately + have "eventually (\x. dist (f x) l < d \ dist (g x) m < d) net" + by (rule eventually_conjI) + moreover { fix x assume "dist (f x) l < d \ dist (g x) m < d" hence **:"norm (f x) * norm (g x - m) + norm (f x - l) * norm m < e / B" using d[THEN spec[where x="f x"], THEN spec[where x="g x"]] unfolding dist_norm by auto @@ -1543,11 +1639,11 @@ also have "\ < e" using ** and `B>0` by(auto simp add: field_simps) finally have "dist (h (f x) (g x)) (h l m) < e" unfolding dist_norm and * using norm_triangle_lt by auto } - moreover - obtain c where "(\x. netord net x c) \ (\x. netord net x c \ dist (f x) l < d \ dist (g x) m < d)" - using net_dilemma[of net "\x. dist (f x) l < d" "\x. dist (g x) m < d"] using assms(1,2) unfolding Lim using False and `d>0` by (auto elim!: allE[where x=d]) - ultimately have "\y. (\x. netord net x y) \ (\x. netord net x y \ dist (h (f x) (g x)) (h l m) < e)" by auto } - thus "((\x. h (f x) (g x)) ---> h l m) net" unfolding Lim by auto + ultimately have "eventually (\x. dist (h (f x) (g x)) (h l m) < e) net" + by (auto elim: eventually_rev_mono) + } + thus "((\x. h (f x) (g x)) ---> h l m) net" + unfolding tendsto_def by simp qed text{* These are special for limits out of the same vector space. *} @@ -1556,12 +1652,14 @@ lemma Lim_at_id: "(id ---> a) (at a)" apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id) -lemma Lim_at_zero: "(f ---> l) (at (a::real^'a::finite)) \ ((\x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs") +lemma Lim_at_zero: + fixes a :: "'a::{real_normed_vector, perfect_space}" + shows "(f ---> l) (at a) \ ((\x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs") proof assume "?lhs" { fix e::real assume "e>0" with `?lhs` obtain d where d:"d>0" "\x. 0 < dist x a \ dist x a < d \ dist (f x) l < e" unfolding Lim_at by auto - { fix x::"real^'a" assume "0 < dist x 0 \ dist x 0 < d" + { fix x::"'a" assume "0 < dist x 0 \ dist x 0 < d" hence "dist (f (a + x)) l < e" using d apply(erule_tac x="x+a" in allE) by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute) } @@ -1573,7 +1671,7 @@ { fix e::real assume "e>0" with `?rhs` obtain d where d:"d>0" "\x. 0 < dist x 0 \ dist x 0 < d \ dist (f (a + x)) l < e" unfolding Lim_at by auto - { fix x::"real^'a" assume "0 < dist x a \ dist x a < d" + { fix x::"'a" assume "0 < dist x a \ dist x a < d" hence "dist (f x) l < e" using d apply(erule_tac x="x-a" in allE) by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute) } @@ -1599,27 +1697,31 @@ ultimately show ?thesis unfolding netlimit_def using some_equality[of "\x. \y. \ netord (at a within S) y x"] by blast qed -lemma netlimit_at: - fixes a :: "real ^ 'n::finite" - shows "netlimit(at a) = a" +lemma netlimit_at: "netlimit (at a) = a" apply (subst within_UNIV[symmetric]) using netlimit_within[of a UNIV] by (simp add: trivial_limit_at within_UNIV) text{* Transformation of limit. *} -lemma Lim_transform: assumes "((\x. f x - g x) ---> 0) net" "(f ---> l) net" +lemma Lim_transform: + fixes f g :: "'a::type \ 'b::real_normed_vector" + assumes "((\x. f x - g x) ---> 0) net" "(f ---> l) net" shows "(g ---> l) net" proof- from assms have "((\x. f x - g x - f x) ---> 0 - l) net" using Lim_sub[of "\x. f x - g x" 0 net f l] by auto thus "?thesis" using Lim_neg [of "\ x. - g x" "-l" net] by auto qed -lemma Lim_transform_eventually: "eventually (\x. f x = g x) net \ (f ---> l) net ==> (g ---> l) net" +lemma Lim_transform_eventually: + fixes f g :: "'a::type \ 'b::real_normed_vector" + (* FIXME: generalize to metric_space *) + shows "eventually (\x. f x = g x) net \ (f ---> l) net ==> (g ---> l) net" using Lim_eventually[of "\x. f x - g x" 0 net] Lim_transform[of f g net l] by auto lemma Lim_transform_within: - fixes x :: "real ^ 'n::finite" + fixes f g :: "'a::perfect_space \ 'b::real_normed_vector" + (* FIXME: generalize to metric_space *) assumes "0 < d" "(\x'\S. 0 < dist x' x \ dist x' x < d \ f x' = g x')" "(f ---> l) (at x within S)" shows "(g ---> l) (at x within S)" @@ -1628,7 +1730,10 @@ thus ?thesis using Lim_transform[of f g "at x within S" l] using assms(3) by auto qed -lemma Lim_transform_at: "0 < d \ (\x'. 0 < dist x' x \ dist x' x < d \ f x' = g x') \ +lemma Lim_transform_at: + fixes f g :: "'a::perfect_space \ 'b::real_normed_vector" + (* FIXME: generalize to metric_space *) + shows "0 < d \ (\x'. 0 < dist x' x \ dist x' x < d \ f x' = g x') \ (f ---> l) (at x) ==> (g ---> l) (at x)" apply (subst within_UNIV[symmetric]) using Lim_transform_within[of d UNIV x f g l] @@ -1637,7 +1742,8 @@ text{* Common case assuming being away from some crucial point like 0. *} lemma Lim_transform_away_within: - fixes f:: "real ^'m::finite \ real ^'n::finite" + fixes f:: "'a::perfect_space \ 'b::real_normed_vector" + (* FIXME: generalize to metric_space *) assumes "a\b" "\x\ S. x \ a \ x \ b \ f x = g x" and "(f ---> l) (at a within S)" shows "(g ---> l) (at a within S)" @@ -1648,7 +1754,8 @@ qed lemma Lim_transform_away_at: - fixes f:: "real ^'m::finite \ real ^'n::finite" + fixes f:: "'a::perfect_space \ 'b::real_normed_vector" + (* FIXME: generalize to metric_space *) assumes ab: "a\b" and fg: "\x. x \ a \ x \ b \ f x = g x" and fl: "(f ---> l) (at a)" shows "(g ---> l) (at a)" @@ -1658,7 +1765,8 @@ text{* Alternatively, within an open set. *} lemma Lim_transform_within_open: - fixes f:: "real ^'m::finite \ real ^'n::finite" + fixes f:: "'a::perfect_space \ 'b::real_normed_vector" + (* FIXME: generalize to metric_space *) assumes "open S" "a \ S" "\x\S. x \ a \ f x = g x" "(f ---> l) (at a)" shows "(g ---> l) (at a)" proof- @@ -1737,9 +1845,11 @@ text{* More properties of closed balls. *} -lemma closed_cball: "closed(cball x e)" +lemma closed_cball: + fixes x :: "'a::real_normed_vector" (* FIXME: generalize to metric_space *) + shows "closed (cball x e)" proof- - { fix xa::"nat\real^'a" and l assume as: "\n. dist x (xa n) \ e" "(xa ---> l) sequentially" + { fix xa::"nat\'a" and l assume as: "\n. dist x (xa n) \ e" "(xa ---> l) sequentially" from as(2) have "((\n. x - xa n) ---> x - l) sequentially" using Lim_sub[of "\n. x" x sequentially xa l] Lim_const[of x sequentially] by auto moreover from as(1) have "eventually (\n. norm (x - xa n) \ e) sequentially" unfolding eventually_sequentially dist_norm by auto ultimately have "dist x l \ e" @@ -1764,10 +1874,16 @@ by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def) lemma mem_interior_cball: "x \ interior S \ (\e>0. cball x e \ S)" - apply (simp add: interior_def) - by (metis open_contains_cball subset_trans ball_subset_cball centre_in_ball open_ball) - -lemma islimpt_ball: "y islimpt ball x e \ 0 < e \ y \ cball x e" (is "?lhs = ?rhs") + apply (simp add: interior_def, safe) + apply (force simp add: open_contains_cball) + apply (rule_tac x="ball x e" in exI) + apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball]) + done + +lemma islimpt_ball: + fixes x y :: "'a::{real_normed_vector,perfect_space}" + (* FIXME: generalize to metric_space *) + shows "y islimpt ball x e \ 0 < e \ y \ cball x e" (is "?lhs = ?rhs") proof assume "?lhs" { assume "e \ 0" @@ -1790,38 +1906,41 @@ next case False - have "dist x (y - (d / (2 * dist y x)) *s (y - x)) - = norm (x - y + (d / (2 * norm (y - x))) *s (y - x))" + have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) + = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))" unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto also have "\ = \- 1 + d / (2 * norm (x - y))\ * norm (x - y)" - using vector_sadd_rdistrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"] - unfolding vector_smult_lneg vector_smult_lid - by (auto simp add: norm_minus_commute) + using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"] + unfolding scaleR_minus_left scaleR_one + by (auto simp add: norm_minus_commute norm_scaleR) also have "\ = \- norm (x - y) + d / 2\" unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]] unfolding real_add_mult_distrib using `x\y`[unfolded dist_nz, unfolded dist_norm] by auto also have "\ \ e - d/2" using `d \ dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm) - finally have "y - (d / (2 * dist y x)) *s (y - x) \ ball x e" using `d>0` by auto + finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \ ball x e" using `d>0` by auto moreover - have "(d / (2*dist y x)) *s (y - x) \ 0" - using `x\y`[unfolded dist_nz] `d>0` unfolding vector_mul_eq_0 by (auto simp add: dist_commute) + have "(d / (2*dist y x)) *\<^sub>R (y - x) \ 0" + using `x\y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute) moreover - have "dist (y - (d / (2 * dist y x)) *s (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel norm_mul + have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel norm_scaleR using `d>0` `x\y`[unfolded dist_nz] dist_commute[of x y] unfolding dist_norm by auto - ultimately show "\x'\ball x e. x' \ y \ dist x' y < d" by (rule_tac x="y - (d / (2*dist y x)) *s (y - x)" in bexI) auto + ultimately show "\x'\ball x e. x' \ y \ dist x' y < d" by (rule_tac x="y - (d / (2*dist y x)) *\<^sub>R (y - x)" in bexI) auto qed next case False hence "d > dist x y" by auto show "\x'\ball x e. x' \ y \ dist x' y < d" proof(cases "x=y") case True - obtain z where **:"dist y z = (min e d) / 2" using vector_choose_dist[of "(min e d) / 2" y] + obtain z where **: "z \ y" "dist z y < min e d" + using perfect_choose_dist[of "min e d" y] using `d > 0` `e>0` by auto show "\x'\ball x e. x' \ y \ dist x' y < d" - apply(rule_tac x=z in bexI) unfolding `x=y` dist_commute dist_nz using ** `d > 0` `e>0` by auto + unfolding `x = y` + using `z \ y` ** + by (rule_tac x=z in bexI, auto simp add: dist_commute) next case False thus "\x'\ball x e. x' \ y \ dist x' y < d" using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto) @@ -1830,11 +1949,16 @@ thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto qed -lemma closure_ball: "0 < e ==> (closure(ball x e) = cball x e)" +lemma closure_ball: + fixes x y :: "'a::{real_normed_vector,perfect_space}" + (* FIXME: generalize to metric_space *) + shows "0 < e ==> (closure(ball x e) = cball x e)" apply (simp add: closure_def islimpt_ball expand_set_eq) by arith -lemma interior_cball: "interior(cball x e) = ball x e" +lemma interior_cball: + fixes x :: "real ^ _" (* FIXME: generalize *) + shows "interior(cball x e) = ball x e" proof(cases "e\0") case False note cs = this from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover @@ -1880,12 +2004,16 @@ ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto qed -lemma frontier_ball: "0 < e ==> frontier(ball a e) = {x. dist a x = e}" +lemma frontier_ball: + fixes a :: "real ^ _" (* FIXME: generalize *) + shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}" apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le) apply (simp add: expand_set_eq) by arith -lemma frontier_cball: "frontier(cball a e) = {x. dist a x = e}" +lemma frontier_cball: + fixes a :: "real ^ _" (* FIXME: generalize *) + shows "frontier(cball a e) = {x. dist a x = e}" apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le) apply (simp add: expand_set_eq) by arith @@ -1895,7 +2023,9 @@ by (metis zero_le_dist dist_self order_less_le_trans) lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty) -lemma cball_eq_sing: "(cball x e = {x}) \ e = 0" +lemma cball_eq_sing: + fixes x :: "real ^ _" (* FIXME: generalize *) + shows "(cball x e = {x}) \ e = 0" proof- { assume as:"\xa. (dist x xa \ e) = (xa = x)" hence "e \ 0" apply (erule_tac x=x in allE) by auto @@ -1905,7 +2035,9 @@ thus ?thesis unfolding expand_set_eq mem_cball by (auto simp add: dist_nz) qed -lemma cball_sing: "e = 0 ==> cball x e = {x}" by (simp add: cball_eq_sing) +lemma cball_sing: + fixes x :: "real ^ _" (* FIXME: generalize *) + shows "e = 0 ==> cball x e = {x}" by (simp add: cball_eq_sing) text{* For points in the interior, localization of limits makes no difference. *} @@ -1924,7 +2056,10 @@ lemma lim_within_interior: "x \ interior S ==> ((f ---> l) (at x within S) \ (f ---> l) (at x))" by (simp add: tendsto_def eventually_within_interior) -lemma netlimit_within_interior: assumes "x \ interior S" +lemma netlimit_within_interior: + fixes x :: "'a::{perfect_space, real_normed_vector}" + (* FIXME: generalize to perfect_space *) + assumes "x \ interior S" shows "netlimit(at x within S) = x" (is "?lhs = ?rhs") proof- from assms obtain e::real where e:"e>0" "ball x e \ S" using open_interior[of S] unfolding open_contains_ball using interior_subset[of S] by auto @@ -1949,9 +2084,15 @@ from assms obtain a where a:"\x\S. norm x \ a" unfolding bounded_def by auto { fix x assume "x\closure S" then obtain xa where xa:"\n. xa n \ S" "(xa ---> x) sequentially" unfolding closure_sequential by auto - moreover have "\y. \x. netord sequentially x y" using trivial_limit_sequentially unfolding trivial_limit_def by blast - hence "\y. (\x. netord sequentially x y) \ (\x. netord sequentially x y \ norm (xa x) \ a)" unfolding sequentially_def using a xa(1) by auto - ultimately have "norm x \ a" using Lim_norm_ubound[of sequentially xa x a] trivial_limit_sequentially unfolding eventually_def by auto + have "\n. xa n \ S \ norm (xa n) \ a" using a by simp + hence "eventually (\n. norm (xa n) \ a) sequentially" + by (rule eventually_mono, simp add: xa(1)) + have "norm x \ a" + apply (rule Lim_norm_ubound[of sequentially xa x a]) + apply (rule trivial_limit_sequentially) + apply (rule xa(2)) + apply fact + done } thus ?thesis unfolding bounded_def by auto qed @@ -2270,16 +2411,14 @@ subsection{* Completeness. *} - (* FIXME: Unify this with Cauchy from SEQ!!!!!*) - -definition - cauchy :: "(nat \ real ^ 'n::finite) \ bool" where - "cauchy s \ (\e>0. \N. \m n. m \ N \ n \ N --> dist(s m)(s n) < e)" - -definition complete_def:"complete s \ (\f::(nat=>real^'a::finite). (\n. f n \ s) \ cauchy f +lemma cauchy_def: + "Cauchy s \ (\e>0. \N. \m n. m \ N \ n \ N --> dist(s m)(s n) < e)" +unfolding Cauchy_def by blast + +definition complete_def:"complete s \ (\f::(nat=>real^'a::finite). (\n. f n \ s) \ Cauchy f --> (\l \ s. (f ---> l) sequentially))" -lemma cauchy: "cauchy s \ (\e>0.\ N::nat. \n\N. dist(s n)(s N) < e)" (is "?lhs = ?rhs") +lemma cauchy: "Cauchy s \ (\e>0.\ N::nat. \n\N. dist(s n)(s N) < e)" (is "?lhs = ?rhs") proof- { assume ?rhs { fix e::real @@ -2306,20 +2445,20 @@ qed lemma convergent_imp_cauchy: - "(s ---> l) sequentially ==> cauchy s" + "(s ---> l) sequentially ==> Cauchy s" proof(simp only: cauchy_def, rule, rule) fix e::real assume "e>0" "(s ---> l) sequentially" then obtain N::nat where N:"\n\N. dist (s n) l < e/2" unfolding Lim_sequentially by(erule_tac x="e/2" in allE) auto thus "\N. \m n. N \ m \ N \ n \ dist (s m) (s n) < e" using dist_triangle_half_l[of _ l e _] by (rule_tac x=N in exI) auto qed -lemma cauchy_imp_bounded: assumes "cauchy s" shows "bounded {y. (\n::nat. y = s n)}" +lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\n::nat. y = s n)}" proof- from assms obtain N::nat where "\m n. N \ m \ N \ n \ dist (s m) (s n) < 1" unfolding cauchy_def apply(erule_tac x= 1 in allE) by auto hence N:"\n. N \ n \ dist (s N) (s n) < 1" by auto { fix n::nat assume "n\N" hence "norm (s n) \ norm (s N) + 1" using N apply(erule_tac x=n in allE) unfolding dist_norm - using norm_triangle_sub[of "s N" "s n"] by (auto, metis dist_vector_def dist_commute le_add_right_mono norm_triangle_sub real_less_def) + using norm_triangle_sub[of "s N" "s n"] by (auto, metis norm_minus_commute le_add_right_mono norm_triangle_sub real_less_def) } hence "\n\N. norm (s n) \ norm (s N) + 1" by auto moreover @@ -2332,7 +2471,7 @@ lemma compact_imp_complete: assumes "compact s" shows "complete s" proof- - { fix f assume as: "(\n::nat. f n \ s)" "cauchy f" + { fix f assume as: "(\n::nat. f n \ s)" "Cauchy f" from as(1) obtain l r where lr: "l\s" "(\m n. m < n \ r m < r n)" "((f \ r) ---> l) sequentially" using assms unfolding compact_def by blast { fix n :: nat have lr':"n \ r n" @@ -2358,11 +2497,11 @@ lemma complete_univ: "complete UNIV" proof(simp add: complete_def, rule, rule) - fix f::"nat \ real^'n::finite" assume "cauchy f" + fix f::"nat \ real^'n::finite" assume "Cauchy f" hence "bounded (f`UNIV)" using cauchy_imp_bounded[of f] unfolding image_def by auto hence "compact (closure (f`UNIV))" using bounded_closed_imp_compact[of "closure (range f)"] by auto hence "complete (closure (range f))" using compact_imp_complete by auto - thus "\l. (f ---> l) sequentially" unfolding complete_def[of "closure (range f)"] using `cauchy f` unfolding closure_def by auto + thus "\l. (f ---> l) sequentially" unfolding complete_def[of "closure (range f)"] using `Cauchy f` unfolding closure_def by auto qed lemma complete_eq_closed: "complete s \ closed s" (is "?lhs = ?rhs") @@ -2375,13 +2514,15 @@ thus ?rhs unfolding closed_limpt by auto next assume ?rhs - { fix f assume as:"\n::nat. f n \ s" "cauchy f" + { fix f assume as:"\n::nat. f n \ s" "Cauchy f" then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto hence "\l\s. (f ---> l) sequentially" using `?rhs`[unfolded closed_sequential_limits, THEN spec[where x=f], THEN spec[where x=l]] using as(1) by auto } thus ?lhs unfolding complete_def by auto qed -lemma convergent_eq_cauchy: "(\l. (s ---> l) sequentially) \ cauchy s" (is "?lhs = ?rhs") +lemma convergent_eq_cauchy: + fixes s :: "nat \ real ^ 'n::finite" + shows "(\l. (s ---> l) sequentially) \ Cauchy s" (is "?lhs = ?rhs") proof assume ?lhs then obtain l where "(s ---> l) sequentially" by auto thus ?rhs using convergent_imp_cauchy by auto @@ -2420,7 +2561,7 @@ qed } hence "\n::nat. x n \ s" and x:"\n. \m < n. \ (dist (x m) (x n) < e)" by blast+ then obtain l r where "l\s" and r:"\m n. m < n \ r m < r n" and "((x \ r) ---> l) sequentially" using assms(1)[unfolded compact_def, THEN spec[where x=x]] by auto - from this(3) have "cauchy (x \ r)" using convergent_imp_cauchy by auto + from this(3) have "Cauchy (x \ r)" using convergent_imp_cauchy by auto then obtain N::nat where N:"\m n. N \ m \ N \ n \ dist ((x \ r) m) ((x \ r) n) < e" unfolding cauchy_def using `e>0` by auto show False using N[THEN spec[where x=N], THEN spec[where x="N+1"]] @@ -2614,6 +2755,7 @@ qed lemma bolzano_weierstrass_imp_closed: + fixes s :: "(real ^ 'n::finite) set" assumes "\t. infinite t \ t \ s --> (\x \ s. x islimpt t)" shows "closed s" proof- @@ -2710,7 +2852,8 @@ qed lemma finite_imp_closed: - "finite s ==> closed s" + fixes s :: "(real ^ _) set" (* FIXME: generalize *) + shows "finite s ==> closed s" proof- assume "finite s" hence "\( \t. t \ s \ infinite t)" using finite_subset by auto thus ?thesis using bolzano_weierstrass_imp_closed[of s] by auto @@ -2728,7 +2871,8 @@ by blast lemma closed_sing[simp]: - "closed {a}" + fixes a :: "real ^ _" (* FIXME: generalize *) + shows "closed {a}" using compact_eq_bounded_closed compact_sing[of a] by blast @@ -2754,7 +2898,8 @@ by blast lemma open_delete: - "open s ==> open(s - {x})" + fixes s :: "(real ^ _) set" (* FIXME: generalize *) + shows "open s ==> open(s - {x})" using open_diff[of s "{x}"] closed_sing by blast @@ -2824,7 +2969,7 @@ } hence "\N. \m n. N \ m \ N \ n \ dist (t m) (t n) < e" by auto } - hence "cauchy t" unfolding cauchy_def by auto + hence "Cauchy t" unfolding cauchy_def by auto then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto { fix n::nat { fix e::real assume "e>0" @@ -2876,7 +3021,7 @@ thus ?rhs by auto next assume ?rhs - hence "\x. P x \ cauchy (\n. s n x)" unfolding cauchy_def apply auto by (erule_tac x=e in allE)auto + hence "\x. P x \ Cauchy (\n. s n x)" unfolding cauchy_def apply auto by (erule_tac x=e in allE)auto then obtain l where l:"\x. P x \ ((\n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym] using choice[of "\x l. P x \ ((\n. s n x) ---> l) sequentially"] by auto { fix e::real assume "e>0" @@ -2913,17 +3058,16 @@ lemma continuous_trivial_limit: "trivial_limit net ==> continuous net f" - unfolding continuous_def tendsto_def eventually_def by auto + unfolding continuous_def tendsto_def trivial_limit_eq by auto lemma continuous_within: "continuous (at x within s) f \ (f ---> f(x)) (at x within s)" unfolding continuous_def unfolding tendsto_def using netlimit_within[of x s] - unfolding eventually_def - by (cases "trivial_limit (at x within s)") auto - -lemma continuous_at: "continuous (at x) f \ (f ---> f(x)) (at x)" using within_UNIV[of x] - using continuous_within[of x UNIV f] by auto + by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually) + +lemma continuous_at: "continuous (at x) f \ (f ---> f(x)) (at x)" + using continuous_within [of x UNIV f] by (simp add: within_UNIV) lemma continuous_at_within: assumes "continuous (at x) f" shows "continuous (at x within s) f" @@ -2969,8 +3113,8 @@ apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto qed -lemma continuous_at_ball: fixes f::"real^'a::finite \ real^'a" - shows "continuous (at x) f \ (\e>0. \d>0. f ` (ball x d) \ ball (f x) e)" (is "?lhs = ?rhs") +lemma continuous_at_ball: + "continuous (at x) f \ (\e>0. \d>0. f ` (ball x d) \ ball (f x) e)" (is "?lhs = ?rhs") proof assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x=xa in allE) apply (auto simp add: dist_commute dist_nz) @@ -3072,7 +3216,7 @@ --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs") proof assume ?lhs - { fix x::"nat \ real^'a" assume x:"\n. x n \ s" "\e>0. \N. \n\N. dist (x n) a < e" + { fix x::"nat \ 'a" assume x:"\n. x n \ s" "\e>0. \N. \n\N. dist (x n) a < e" fix e::real assume "e>0" from `?lhs` obtain d where "d>0" and d:"\x\s. 0 < dist x a \ dist x a < d \ dist (f x) (f a) < e" unfolding continuous_within Lim_within using `e>0` by auto from x(2) `d>0` obtain N where N:"\n\N. dist (x n) a < d" by auto @@ -3166,6 +3310,7 @@ text{* The usual transformation theorems. *} lemma continuous_transform_within: + fixes f g :: "real ^ 'n::finite \ 'b::real_normed_vector" assumes "0 < d" "x \ s" "\x' \ s. dist x' x < d --> f x' = g x'" "continuous (at x within s) f" shows "continuous (at x within s) g" @@ -3181,6 +3326,7 @@ qed lemma continuous_transform_at: + fixes f g :: "real ^ 'n::finite \ 'b::real_normed_vector" assumes "0 < d" "\x'. dist x' x < d --> f x' = g x'" "continuous (at x) f" shows "continuous (at x) g" @@ -3200,25 +3346,27 @@ text{* Combination results for pointwise continuity. *} lemma continuous_const: "continuous net (\x::'a::zero_neq_one. c)" - by(auto simp add: continuous_def Lim_const) + by (auto simp add: continuous_def Lim_const) lemma continuous_cmul: - "continuous net f ==> continuous net (\x. c *s f x)" - by(auto simp add: continuous_def Lim_cmul) + fixes f :: "'a \ real ^ 'n::finite" + shows "continuous net f ==> continuous net (\x. c *s f x)" + by (auto simp add: continuous_def Lim_cmul) lemma continuous_neg: - "continuous net f ==> continuous net (\x. -(f x))" - by(auto simp add: continuous_def Lim_neg) + fixes f :: "'a \ 'b::real_normed_vector" + shows "continuous net f ==> continuous net (\x. -(f x))" + by (auto simp add: continuous_def Lim_neg) lemma continuous_add: - "continuous net f \ continuous net g - ==> continuous net (\x. f x + g x)" - by(auto simp add: continuous_def Lim_add) + fixes f g :: "'a \ 'b::real_normed_vector" + shows "continuous net f \ continuous net g \ continuous net (\x. f x + g x)" + by (auto simp add: continuous_def Lim_add) lemma continuous_sub: - "continuous net f \ continuous net g - ==> continuous net (\x. f(x) - g(x))" - by(auto simp add: continuous_def Lim_sub) + fixes f g :: "'a \ 'b::real_normed_vector" + shows "continuous net f \ continuous net g \ continuous net (\x. f x - g x)" + by (auto simp add: continuous_def Lim_sub) text{* Same thing for setwise continuity. *} @@ -3476,11 +3624,13 @@ qed lemma continuous_open_preimage_univ: - "\x. continuous (at x) f \ open s \ open {x. f x \ s}" + fixes f :: "real ^ _ \ real ^ _" (* FIXME: generalize *) + shows "\x. continuous (at x) f \ open s \ open {x. f x \ s}" using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto lemma continuous_closed_preimage_univ: - "(\x. continuous (at x) f) \ closed s ==> closed {x. f x \ s}" + fixes f :: "real ^ _ \ real ^ _" (* FIXME: generalize *) + shows "(\x. continuous (at x) f) \ closed s ==> closed {x. f x \ s}" using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto text{* Equality of continuous functions on closure and related results. *} @@ -3574,6 +3724,7 @@ text{* Some arithmetical combinations (more to prove). *} lemma open_scaling[intro]: + fixes s :: "(real ^ _) set" assumes "c \ 0" "open s" shows "open((\x. c *s x) ` s)" proof- @@ -3591,9 +3742,11 @@ qed lemma open_negations: - "open s ==> open ((\ x. -x) ` s)" unfolding pth_3 by auto + fixes s :: "(real ^ _) set" (* FIXME: generalize *) + shows "open s ==> open ((\ x. -x) ` s)" unfolding pth_3 by auto lemma open_translation: + fixes s :: "(real ^ _) set" (* FIXME: generalize *) assumes "open s" shows "open((\x. a + x) ` s)" proof- { fix x have "continuous (at x) (\x. x - a)" using continuous_sub[of "at x" "\x. x" "\x. a"] continuous_at_id[of x] continuous_const[of "at x" a] by auto } @@ -3602,6 +3755,7 @@ qed lemma open_affinity: + fixes s :: "(real ^ _) set" assumes "open s" "c \ 0" shows "open ((\x. a + c *s x) ` s)" proof- @@ -3610,7 +3764,9 @@ thus ?thesis using assms open_translation[of "op *s c ` s" a] unfolding * by auto qed -lemma interior_translation: "interior ((\x. a + x) ` s) = (\x. a + x) ` (interior s)" +lemma interior_translation: + fixes s :: "'a::real_normed_vector set" + shows "interior ((\x. a + x) ` s) = (\x. a + x) ` (interior s)" proof (rule set_ext, rule) fix x assume "x \ interior (op + a ` s)" then obtain e where "e>0" and e:"ball x e \ op + a ` s" unfolding mem_interior by auto @@ -3757,12 +3913,14 @@ qed lemma linear_continuous_at: + fixes f :: "real ^ _ \ real ^ _" assumes "linear f" shows "continuous (at a) f" unfolding continuous_at Lim_at_zero[of f "f a" a] using linear_lim_0[OF assms] unfolding Lim_null[of "\x. f (a + x)"] unfolding linear_sub[OF assms, THEN sym] by auto lemma linear_continuous_within: - "linear f ==> continuous (at x within s) f" + fixes f :: "real ^ _ \ real ^ _" + shows "linear f ==> continuous (at x within s) f" using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto lemma linear_continuous_on: @@ -3772,12 +3930,14 @@ text{* Also bilinear functions, in composition form. *} lemma bilinear_continuous_at_compose: - "continuous (at x) f \ continuous (at x) g \ bilinear h + fixes f :: "real ^ _ \ real ^ _" + shows "continuous (at x) f \ continuous (at x) g \ bilinear h ==> continuous (at x) (\x. h (f x) (g x))" unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto lemma bilinear_continuous_within_compose: - "continuous (at x within s) f \ continuous (at x within s) g \ bilinear h + fixes f :: "real ^ _ \ real ^ _" + shows "continuous (at x within s) f \ continuous (at x within s) g \ bilinear h ==> continuous (at x within s) (\x. h (f x) (g x))" unfolding continuous_within using Lim_bilinear[of f "f x"] by auto @@ -3791,16 +3951,19 @@ lemma open_vec1: + fixes s :: "real set" shows "open(vec1 ` s) \ (\x \ s. \e>0. \x'. abs(x' - x) < e --> x' \ s)" (is "?lhs = ?rhs") unfolding open_def apply simp unfolding forall_vec1 dist_vec1 vec1_in_image_vec1 by simp lemma islimpt_approachable_vec1: + fixes s :: "real set" shows "(vec1 x) islimpt (vec1 ` s) \ (\e>0. \x'\ s. x' \ x \ abs(x' - x) < e)" by (auto simp add: islimpt_approachable dist_vec1 vec1_eq) lemma closed_vec1: + fixes s :: "real set" shows "closed (vec1 ` s) \ (\x. (\e>0. \x' \ s. x' \ x \ abs(x' - x) < e) --> x \ s)" @@ -3808,7 +3971,8 @@ unfolding dist_vec1 vec1_in_image_vec1 abs_minus_commute by auto lemma continuous_at_vec1_range: - "continuous (at x) (vec1 o f) \ (\e>0. \d>0. + fixes f :: "real ^ _ \ real" + shows "continuous (at x) (vec1 o f) \ (\e>0. \d>0. \x'. norm(x' - x) < d --> abs(f x' - f x) < e)" unfolding continuous_at unfolding Lim_at apply simp unfolding dist_vec1 unfolding dist_nz[THEN sym] unfolding dist_norm apply auto apply(erule_tac x=e in allE) apply auto apply (rule_tac x=d in exI) apply auto apply (erule_tac x=x' in allE) apply auto @@ -3819,7 +3983,8 @@ unfolding continuous_on_def apply (simp del: dist_commute) unfolding dist_vec1 unfolding dist_norm .. lemma continuous_at_vec1_norm: - "continuous (at x) (vec1 o norm)" + fixes x :: "real ^ _" + shows "continuous (at x) (vec1 o norm)" unfolding continuous_at_vec1_range using real_abs_sub_norm order_le_less_trans by blast lemma continuous_on_vec1_norm: @@ -3909,6 +4074,7 @@ text{* For *minimal* distance, we only need closure, not compactness. *} lemma distance_attains_inf: + fixes a :: "real ^ _" (* FIXME: generalize *) assumes "closed s" "s \ {}" shows "\x \ s. \y \ s. dist a x \ dist a y" proof- @@ -3933,6 +4099,7 @@ subsection{* We can now extend limit compositions to consider the scalar multiplier. *} lemma Lim_mul: + fixes f :: "'a \ real ^ _" assumes "((vec1 o c) ---> vec1 d) net" "(f ---> l) net" shows "((\x. c(x) *s f x) ---> (d *s l)) net" proof- @@ -3943,15 +4110,18 @@ qed lemma Lim_vmul: - "((vec1 o c) ---> vec1 d) net ==> ((\x. c(x) *s v) ---> d *s v) net" + fixes c :: "'a \ real" + shows "((vec1 o c) ---> vec1 d) net ==> ((\x. c(x) *s v) ---> d *s v) net" using Lim_mul[of c d net "\x. v" v] using Lim_const[of v] by auto lemma continuous_vmul: - "continuous net (vec1 o c) ==> continuous net (\x. c(x) *s v)" + fixes c :: "'a \ real" + shows "continuous net (vec1 o c) ==> continuous net (\x. c(x) *s v)" unfolding continuous_def using Lim_vmul[of c] by auto lemma continuous_mul: - "continuous net (vec1 o c) \ continuous net f + fixes c :: "'a \ real" + shows "continuous net (vec1 o c) \ continuous net f ==> continuous net (\x. c(x) *s f x) " unfolding continuous_def using Lim_mul[of c] by auto @@ -3967,19 +4137,18 @@ text{* And so we have continuity of inverse. *} lemma Lim_inv: + fixes f :: "'a \ real" assumes "((vec1 o f) ---> vec1 l) (net::'a net)" "l \ 0" shows "((vec1 o inverse o f) ---> vec1(inverse l)) net" -proof(cases "trivial_limit net") - case True thus ?thesis unfolding tendsto_def unfolding eventually_def by auto -next - case False note ntriv = this +proof - { fix e::real assume "e>0" - hence "0 < min (\l\ / 2) (l\ * e / 2)" using `l\0` mult_pos_pos[of "l^2" "e/2"] by auto - then obtain y where y1:"\x. netord net x y" and - y:"\x. netord net x y \ dist ((vec1 \ f) x) (vec1 l) < min (\l\ / 2) (l\ * e / 2)" using ntriv - using assms(1)[unfolded tendsto_def eventually_def, THEN spec[where x="min (abs l / 2) (l ^ 2 * e / 2)"]] by auto - { fix x assume "netord net x y" - hence *:"\f x - l\ < min (\l\ / 2) (l\ * e / 2)" using y[THEN spec[where x=x]] unfolding o_def dist_vec1 by auto + let ?d = "min (\l\ / 2) (l\ * e / 2)" + have "0 < ?d" using `l\0` `e>0` mult_pos_pos[of "l^2" "e/2"] by auto + with assms(1) have "eventually (\x. dist ((vec1 o f) x) (vec1 l) < ?d) net" + by (rule tendstoD) + moreover + { fix x assume "dist ((vec1 o f) x) (vec1 l) < ?d" + hence *:"\f x - l\ < min (\l\ / 2) (l\ * e / 2)" unfolding o_def dist_vec1 by auto hence fx0:"f x \ 0" using `l \ 0` by auto hence fxl0: "(f x) * l \ 0" using `l \ 0` by auto from * have **:"\f x - l\ < l\ * e / 2" by auto @@ -3996,31 +4165,33 @@ unfolding divide_divide_eq_left unfolding nonzero_abs_divide[OF fxl0] using mult_less_le_imp_less[OF **, of "inverse \f x * l\", of "inverse (l^2 / 2)"] using *** using fx0 `l\0` - unfolding inverse_eq_divide using `e>0` by auto } - hence "(\y. (\x. netord net x y) \ (\x. netord net x y \ dist ((vec1 \ inverse \ f) x) (vec1 (inverse l)) < e))" - using y1 by auto } - thus ?thesis unfolding tendsto_def eventually_def by auto + unfolding inverse_eq_divide using `e>0` by auto + } + ultimately + have "eventually (\x. dist ((vec1 o inverse o f) x) (vec1(inverse l)) < e) net" + by (auto elim: eventually_rev_mono) + } + thus ?thesis unfolding tendsto_def by auto qed lemma continuous_inv: - "continuous net (vec1 o f) \ f(netlimit net) \ 0 + fixes f :: "'a \ real" + shows "continuous net (vec1 o f) \ f(netlimit net) \ 0 ==> continuous net (vec1 o inverse o f)" unfolding continuous_def using Lim_inv by auto lemma continuous_at_within_inv: + fixes f :: "real ^ _ \ real" assumes "continuous (at a within s) (vec1 o f)" "f a \ 0" shows "continuous (at a within s) (vec1 o inverse o f)" -proof(cases "trivial_limit (at a within s)") - case True thus ?thesis unfolding continuous_def tendsto_def eventually_def by auto -next - case False note cs = this - thus ?thesis using netlimit_within[OF cs] assms(2) continuous_inv[OF assms(1)] by auto -qed + using assms unfolding continuous_within o_apply + by (rule Lim_inv) lemma continuous_at_inv: - "continuous (at a) (vec1 o f) \ f a \ 0 + fixes f :: "real ^ _ \ real" + shows "continuous (at a) (vec1 o f) \ f a \ 0 ==> continuous (at a) (vec1 o inverse o f) " - using within_UNIV[THEN sym, of a] using continuous_at_within_inv[of a UNIV] by auto + using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto subsection{* Preservation properties for pasted sets. *} @@ -4036,6 +4207,7 @@ qed lemma closed_pastecart: + fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *) assumes "closed s" "closed t" shows "closed {pastecart x y | x y . x \ s \ y \ t}" proof- @@ -4178,6 +4350,7 @@ text{* Related results with closure as the conclusion. *} lemma closed_scaling: + fixes s :: "(real ^ _) set" assumes "closed s" shows "closed ((\x. c *s x) ` s)" proof(cases "s={}") case True thus ?thesis by auto @@ -4205,6 +4378,7 @@ qed lemma closed_negations: + fixes s :: "(real ^ _) set" (* FIXME: generalize *) assumes "closed s" shows "closed ((\x. -x) ` s)" using closed_scaling[OF assms, of "-1"] unfolding pth_3 by auto @@ -4255,6 +4429,7 @@ qed lemma closed_translation: + fixes s :: "(real ^ _) set" (* FIXME: generalize *) assumes "closed s" shows "closed ((\x. a + x) ` s)" proof- have "{a + y |y. y \ s} = (op + a ` s)" by auto @@ -4268,20 +4443,23 @@ lemma translation_diff: "(\x::real^'a. a + x) ` (s - t) = ((\x. a + x) ` s) - ((\x. a + x) ` t)" by auto lemma closure_translation: - "closure ((\x. a + x) ` s) = (\x. a + x) ` (closure s)" + fixes s :: "(real ^ _) set" (* FIXME: generalize *) + shows "closure ((\x. a + x) ` s) = (\x. a + x) ` (closure s)" proof- have *:"op + a ` (UNIV - s) = UNIV - op + a ` s" apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto show ?thesis unfolding closure_interior translation_diff translation_UNIV using interior_translation[of a "UNIV - s"] unfolding * by auto qed lemma frontier_translation: - "frontier((\x. a + x) ` s) = (\x. a + x) ` (frontier s)" + fixes s :: "(real ^ _) set" (* FIXME: generalize *) + shows "frontier((\x. a + x) ` s) = (\x. a + x) ` (frontier s)" unfolding frontier_def translation_diff interior_translation closure_translation by auto subsection{* Separation between points and sets. *} lemma separate_point_closed: - "closed s \ a \ s ==> (\d>0. \x\s. d \ dist a x)" + fixes s :: "(real ^ _) set" (* FIXME: generalize *) + shows "closed s \ a \ s ==> (\d>0. \x\s. d \ dist a x)" proof(cases "s = {}") case True thus ?thesis by(auto intro!: exI[where x=1]) @@ -4682,11 +4860,13 @@ using bounded_subset_closed_interval_symmetric[of s] by auto lemma frontier_closed_interval: - "frontier {a .. b} = {a .. b} - {a<.. {c .. d} = {} \ dest_vec1 b < dest_vec1 a \ dest_vec1 d < dest_vec1 c \ dest_vec1 b < dest_vec1 c \ dest_vec1 d < dest_vec1 a" @@ -4808,20 +4988,27 @@ next case False { fix e::real - assume "0 < e" "\e>0. \y. (\x. netord net x y) \ (\x. netord net x y \ dist l (f x) < e)" - then obtain x y where x:"netord net x y" and y:"\x. netord net x y \ dist l (f x) < e / norm a" apply(erule_tac x="e / norm a" in allE) apply auto using False using norm_ge_zero[of a] apply auto - using divide_pos_pos[of e "norm a"] by auto - { fix z assume "netord net z y" hence "dist l (f z) < e / norm a" using y by blast - hence "norm a * norm (l - f z) < e" unfolding dist_norm and + assume "0 < e" + with `a \ vec 0` have "0 < e / norm a" by (simp add: divide_pos_pos) + with assms(1) have "eventually (\x. dist (f x) l < e / norm a) net" + by (rule tendstoD) + moreover + { fix z assume "dist (f z) l < e / norm a" + hence "norm a * norm (f z - l) < e" unfolding dist_norm and pos_less_divide_eq[OF False[unfolded vec_0 zero_less_norm_iff[of a, THEN sym]]] and real_mult_commute by auto - hence "\a \ l - a \ f z\ < e" using order_le_less_trans[OF norm_cauchy_schwarz_abs[of a "l - f z"], of e] unfolding dot_rsub[symmetric] by auto } - hence "\y. (\x. netord net x y) \ (\x. netord net x y \ \a \ l - a \ f x\ < e)" using x by auto } - thus ?thesis using assms unfolding Lim apply (auto simp add: dist_commute) - unfolding dist_vec1 by auto + hence "\a \ f z - a \ l\ < e" + using order_le_less_trans[OF norm_cauchy_schwarz_abs[of a "f z - l"], of e] + unfolding dot_rsub[symmetric] by auto } + ultimately have "eventually (\x. \a \ f x - a \ l\ < e) net" + by (auto elim: eventually_rev_mono) + } + thus ?thesis unfolding tendsto_def + by (auto simp add: dist_vec1) qed lemma continuous_at_vec1_dot: - "continuous (at x) (vec1 o (\y. a \ y))" + fixes x :: "real ^ _" + shows "continuous (at x) (vec1 o (\y. a \ y))" proof- have "((\x. x) ---> x) (at x)" unfolding Lim_at by auto thus ?thesis unfolding continuous_at and o_def using Lim_vec1_dot[of "\x. x" x "at x" a] by auto @@ -4848,10 +5035,10 @@ thus ?thesis unfolding closed_closedin[THEN sym] and * by auto qed -lemma closed_halfspace_ge: "closed {x. a \ x \ b}" +lemma closed_halfspace_ge: "closed {x::real^_. a \ x \ b}" using closed_halfspace_le[of "-a" "-b"] unfolding dot_lneg by auto -lemma closed_hyperplane: "closed {x. a \ x = b}" +lemma closed_hyperplane: "closed {x::real^_. a \ x = b}" proof- have "{x. a \ x = b} = {x. a \ x \ b} \ {x. a \ x \ b}" by auto thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto @@ -4867,13 +5054,13 @@ text{* Openness of halfspaces. *} -lemma open_halfspace_lt: "open {x. a \ x < b}" +lemma open_halfspace_lt: "open {x::real^_. a \ x < b}" proof- have "UNIV - {x. b \ a \ x} = {x. a \ x < b}" by auto thus ?thesis using closed_halfspace_ge[unfolded closed_def, of b a] by auto qed -lemma open_halfspace_gt: "open {x. a \ x > b}" +lemma open_halfspace_gt: "open {x::real^_. a \ x > b}" proof- have "UNIV - {x. b \ a \ x} = {x. a \ x > b}" by auto thus ?thesis using closed_halfspace_le[unfolded closed_def, of a b] by auto @@ -5145,8 +5332,9 @@ text{* "Isometry" (up to constant bounds) of injective linear map etc. *} lemma cauchy_isometric: - assumes e:"0 < e" and s:"subspace s" and f:"linear f" and normf:"\x\s. norm(f x) \ e * norm(x)" and xs:"\n::nat. x n \ s" and cf:"cauchy(f o x)" - shows "cauchy x" + fixes x :: "nat \ real ^ 'n::finite" + assumes e:"0 < e" and s:"subspace s" and f:"linear f" and normf:"\x\s. norm(f x) \ e * norm(x)" and xs:"\n::nat. x n \ s" and cf:"Cauchy(f o x)" + shows "Cauchy x" proof- { fix d::real assume "d>0" then obtain N where N:"\n\N. norm (f (x n) - f (x N)) < e * d" @@ -5166,7 +5354,7 @@ assumes "0 < e" and s:"subspace s" and f:"linear f" and normf:"\x\s. norm(f x) \ e * norm(x)" and cs:"complete s" shows "complete(f ` s)" proof- - { fix g assume as:"\n::nat. g n \ f ` s" and cfg:"cauchy g" + { fix g assume as:"\n::nat. g n \ f ` s" and cfg:"Cauchy g" then obtain x where "\n. x n \ s \ g n = f (x n)" unfolding image_iff and Bex_def using choice[of "\ n xa. xa \ s \ g n = f xa"] by auto hence x:"\n. x n \ s" "\n. g n = f (x n)" by auto @@ -5236,6 +5424,7 @@ qed lemma closed_injective_image_subspace: + fixes s :: "(real ^ _) set" assumes "subspace s" "linear f" "\x\s. f x = 0 --> x = 0" "closed s" shows "closed(f ` s)" proof- @@ -5360,7 +5549,8 @@ by auto lemma dim_closure: - "dim(closure s) = dim s" (is "?dc = ?d") + fixes s :: "(real ^ _) set" + shows "dim(closure s) = dim s" (is "?dc = ?d") proof- have "?dc \ ?d" using closure_minimal[OF span_inc, of s] using closed_subspace[OF subspace_span, of s] @@ -5559,7 +5749,7 @@ thus ?thesis by auto qed } - hence "cauchy z" unfolding cauchy_def by auto + hence "Cauchy z" unfolding cauchy_def by auto then obtain x where "x\s" and x:"(z ---> x) sequentially" using s(1)[unfolded compact_def complete_def, THEN spec[where x=z]] and z_in_s by auto def e \ "dist (f x) x" diff -r 3e900a2acaed -r edf74583715a src/HOL/Library/normarith.ML --- a/src/HOL/Library/normarith.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Library/normarith.ML Tue Jun 02 10:04:03 2009 +0200 @@ -391,7 +391,7 @@ fun init_conv ctxt = Simplifier.rewrite (Simplifier.context ctxt - (HOL_basic_ss addsimps ([@{thm vec_0}, @{thm vec_1}, @{thm dist_vector_def}, @{thm diff_0_right}, @{thm right_minus}, @{thm diff_self}, @{thm norm_0}] @ @{thms arithmetic_simps} @ @{thms norm_pths}))) + (HOL_basic_ss addsimps ([@{thm vec_0}, @{thm vec_1}, @{thm vector_dist_norm}, @{thm diff_0_right}, @{thm right_minus}, @{thm diff_self}, @{thm norm_0}] @ @{thms arithmetic_simps} @ @{thms norm_pths}))) then_conv field_comp_conv then_conv nnf_conv diff -r 3e900a2acaed -r edf74583715a src/HOL/Lim.thy --- a/src/HOL/Lim.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Lim.thy Tue Jun 02 10:04:03 2009 +0200 @@ -13,90 +13,102 @@ text{*Standard Definitions*} definition - LIM :: "['a::real_normed_vector => 'b::real_normed_vector, 'a, 'b] => bool" + at :: "'a::metric_space \ 'a filter" where + [code del]: "at a = Abs_filter (\P. \r>0. \x. x \ a \ dist x a < r \ P x)" + +definition + LIM :: "['a::metric_space \ 'b::metric_space, 'a, 'b] \ bool" ("((_)/ -- (_)/ --> (_))" [60, 0, 60] 60) where [code del]: "f -- a --> L = - (\r > 0. \s > 0. \x. x \ a & norm (x - a) < s - --> norm (f x - L) < r)" + (\r > 0. \s > 0. \x. x \ a & dist x a < s + --> dist (f x) L < r)" definition - isCont :: "['a::real_normed_vector => 'b::real_normed_vector, 'a] => bool" where + isCont :: "['a::metric_space \ 'b::metric_space, 'a] \ bool" where "isCont f a = (f -- a --> (f a))" definition - isUCont :: "['a::real_normed_vector => 'b::real_normed_vector] => bool" where - [code del]: "isUCont f = (\r>0. \s>0. \x y. norm (x - y) < s \ norm (f x - f y) < r)" + isUCont :: "['a::metric_space \ 'b::metric_space] \ bool" where + [code del]: "isUCont f = (\r>0. \s>0. \x y. dist x y < s \ dist (f x) (f y) < r)" + +subsection {* Neighborhood Filter *} +lemma eventually_at: + "eventually P (at a) \ (\d>0. \x. x \ a \ dist x a < d \ P x)" +unfolding at_def +apply (rule eventually_Abs_filter) +apply (rule_tac x=1 in exI, simp) +apply (clarify, rule_tac x=r in exI, simp) +apply (clarify, rename_tac r s) +apply (rule_tac x="min r s" in exI, simp) +done + +lemma LIM_conv_tendsto: "(f -- a --> L) \ tendsto f L (at a)" +unfolding LIM_def tendsto_def eventually_at .. subsection {* Limits of Functions *} -subsubsection {* Purely standard proofs *} +lemma metric_LIM_I: + "(\r. 0 < r \ \s>0. \x. x \ a \ dist x a < s \ dist (f x) L < r) + \ f -- a --> L" +by (simp add: LIM_def) + +lemma metric_LIM_D: + "\f -- a --> L; 0 < r\ + \ \s>0. \x. x \ a \ dist x a < s \ dist (f x) L < r" +by (simp add: LIM_def) lemma LIM_eq: - "f -- a --> L = + fixes a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector" + shows "f -- a --> L = (\r>0.\s>0.\x. x \ a & norm (x-a) < s --> norm (f x - L) < r)" -by (simp add: LIM_def diff_minus) +by (simp add: LIM_def dist_norm) lemma LIM_I: - "(!!r. 0 \s>0.\x. x \ a & norm (x-a) < s --> norm (f x - L) < r) + fixes a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector" + shows "(!!r. 0 \s>0.\x. x \ a & norm (x-a) < s --> norm (f x - L) < r) ==> f -- a --> L" by (simp add: LIM_eq) lemma LIM_D: - "[| f -- a --> L; 0 L; 0 \s>0.\x. x \ a & norm (x-a) < s --> norm (f x - L) < r" by (simp add: LIM_eq) -lemma LIM_offset: "f -- a --> L \ (\x. f (x + k)) -- a - k --> L" -apply (rule LIM_I) -apply (drule_tac r="r" in LIM_D, safe) +lemma LIM_offset: + fixes a :: "'a::real_normed_vector" and L :: "'b::metric_space" + shows "f -- a --> L \ (\x. f (x + k)) -- a - k --> L" +unfolding LIM_def dist_norm +apply clarify +apply (drule_tac x="r" in spec, safe) apply (rule_tac x="s" in exI, safe) apply (drule_tac x="x + k" in spec) apply (simp add: algebra_simps) done -lemma LIM_offset_zero: "f -- a --> L \ (\h. f (a + h)) -- 0 --> L" +lemma LIM_offset_zero: + fixes a :: "'a::real_normed_vector" and L :: "'b::metric_space" + shows "f -- a --> L \ (\h. f (a + h)) -- 0 --> L" by (drule_tac k="a" in LIM_offset, simp add: add_commute) -lemma LIM_offset_zero_cancel: "(\h. f (a + h)) -- 0 --> L \ f -- a --> L" +lemma LIM_offset_zero_cancel: + fixes a :: "'a::real_normed_vector" and L :: "'b::metric_space" + shows "(\h. f (a + h)) -- 0 --> L \ f -- a --> L" by (drule_tac k="- a" in LIM_offset, simp) lemma LIM_const [simp]: "(%x. k) -- x --> k" by (simp add: LIM_def) lemma LIM_add: - fixes f g :: "'a::real_normed_vector \ 'b::real_normed_vector" + fixes f g :: "'a::metric_space \ 'b::real_normed_vector" assumes f: "f -- a --> L" and g: "g -- a --> M" - shows "(%x. f x + g(x)) -- a --> (L + M)" -proof (rule LIM_I) - fix r :: real - assume r: "0 < r" - from LIM_D [OF f half_gt_zero [OF r]] - obtain fs - where fs: "0 < fs" - and fs_lt: "\x. x \ a & norm (x-a) < fs --> norm (f x - L) < r/2" - by blast - from LIM_D [OF g half_gt_zero [OF r]] - obtain gs - where gs: "0 < gs" - and gs_lt: "\x. x \ a & norm (x-a) < gs --> norm (g x - M) < r/2" - by blast - show "\s>0.\x. x \ a \ norm (x-a) < s \ norm (f x + g x - (L + M)) < r" - proof (intro exI conjI strip) - show "0 < min fs gs" by (simp add: fs gs) - fix x :: 'a - assume "x \ a \ norm (x-a) < min fs gs" - hence "x \ a \ norm (x-a) < fs \ norm (x-a) < gs" by simp - with fs_lt gs_lt - have "norm (f x - L) < r/2" and "norm (g x - M) < r/2" by blast+ - hence "norm (f x - L) + norm (g x - M) < r" by arith - thus "norm (f x + g x - (L + M)) < r" - by (blast intro: norm_diff_triangle_ineq order_le_less_trans) - qed -qed + shows "(\x. f x + g x) -- a --> (L + M)" +using assms unfolding LIM_conv_tendsto by (rule tendsto_add) lemma LIM_add_zero: - "\f -- a --> 0; g -- a --> 0\ \ (\x. f x + g x) -- a --> 0" + fixes f g :: "'a::metric_space \ 'b::real_normed_vector" + shows "\f -- a --> 0; g -- a --> 0\ \ (\x. f x + g x) -- a --> 0" by (drule (1) LIM_add, simp) lemma minus_diff_minus: @@ -104,46 +116,75 @@ shows "(- a) - (- b) = - (a - b)" by simp -lemma LIM_minus: "f -- a --> L ==> (%x. -f(x)) -- a --> -L" -by (simp only: LIM_eq minus_diff_minus norm_minus_cancel) +lemma LIM_minus: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "f -- a --> L \ (\x. - f x) -- a --> - L" +unfolding LIM_conv_tendsto by (rule tendsto_minus) +(* TODO: delete *) lemma LIM_add_minus: - "[| f -- x --> l; g -- x --> m |] ==> (%x. f(x) + -g(x)) -- x --> (l + -m)" + fixes f g :: "'a::metric_space \ 'b::real_normed_vector" + shows "[| f -- x --> l; g -- x --> m |] ==> (%x. f(x) + -g(x)) -- x --> (l + -m)" by (intro LIM_add LIM_minus) lemma LIM_diff: - "[| f -- x --> l; g -- x --> m |] ==> (%x. f(x) - g(x)) -- x --> l-m" -by (simp only: diff_minus LIM_add LIM_minus) + fixes f g :: "'a::metric_space \ 'b::real_normed_vector" + shows "\f -- x --> l; g -- x --> m\ \ (\x. f x - g x) -- x --> l - m" +unfolding LIM_conv_tendsto by (rule tendsto_diff) -lemma LIM_zero: "f -- a --> l \ (\x. f x - l) -- a --> 0" -by (simp add: LIM_def) - -lemma LIM_zero_cancel: "(\x. f x - l) -- a --> 0 \ f -- a --> l" -by (simp add: LIM_def) +lemma LIM_zero: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "f -- a --> l \ (\x. f x - l) -- a --> 0" +by (simp add: LIM_def dist_norm) -lemma LIM_zero_iff: "(\x. f x - l) -- a --> 0 = f -- a --> l" -by (simp add: LIM_def) +lemma LIM_zero_cancel: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "(\x. f x - l) -- a --> 0 \ f -- a --> l" +by (simp add: LIM_def dist_norm) -lemma LIM_imp_LIM: +lemma LIM_zero_iff: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "(\x. f x - l) -- a --> 0 = f -- a --> l" +by (simp add: LIM_def dist_norm) + +lemma metric_LIM_imp_LIM: assumes f: "f -- a --> l" - assumes le: "\x. x \ a \ norm (g x - m) \ norm (f x - l)" + assumes le: "\x. x \ a \ dist (g x) m \ dist (f x) l" shows "g -- a --> m" -apply (rule LIM_I, drule LIM_D [OF f], safe) +apply (rule metric_LIM_I, drule metric_LIM_D [OF f], safe) apply (rule_tac x="s" in exI, safe) apply (drule_tac x="x" in spec, safe) apply (erule (1) order_le_less_trans [OF le]) done -lemma LIM_norm: "f -- a --> l \ (\x. norm (f x)) -- a --> norm l" -by (erule LIM_imp_LIM, simp add: norm_triangle_ineq3) +lemma LIM_imp_LIM: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + fixes g :: "'a::metric_space \ 'c::real_normed_vector" + assumes f: "f -- a --> l" + assumes le: "\x. x \ a \ norm (g x - m) \ norm (f x - l)" + shows "g -- a --> m" +apply (rule metric_LIM_imp_LIM [OF f]) +apply (simp add: dist_norm le) +done -lemma LIM_norm_zero: "f -- a --> 0 \ (\x. norm (f x)) -- a --> 0" +lemma LIM_norm: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "f -- a --> l \ (\x. norm (f x)) -- a --> norm l" +unfolding LIM_conv_tendsto by (rule tendsto_norm) + +lemma LIM_norm_zero: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "f -- a --> 0 \ (\x. norm (f x)) -- a --> 0" by (drule LIM_norm, simp) -lemma LIM_norm_zero_cancel: "(\x. norm (f x)) -- a --> 0 \ f -- a --> 0" +lemma LIM_norm_zero_cancel: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "(\x. norm (f x)) -- a --> 0 \ f -- a --> 0" by (erule LIM_imp_LIM, simp) -lemma LIM_norm_zero_iff: "(\x. norm (f x)) -- a --> 0 = f -- a --> 0" +lemma LIM_norm_zero_iff: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "(\x. norm (f x)) -- a --> 0 = f -- a --> 0" by (rule iffI [OF LIM_norm_zero_cancel LIM_norm_zero]) lemma LIM_rabs: "f -- a --> (l::real) \ (\x. \f x\) -- a --> \l\" @@ -161,9 +202,9 @@ lemma LIM_const_not_eq: fixes a :: "'a::real_normed_algebra_1" shows "k \ L \ \ (\x. k) -- a --> L" -apply (simp add: LIM_eq) -apply (rule_tac x="norm (k - L)" in exI, simp, safe) -apply (rule_tac x="a + of_real (s/2)" in exI, simp add: norm_of_real) +apply (simp add: LIM_def) +apply (rule_tac x="dist k L" in exI, simp add: zero_less_dist_iff, safe) +apply (rule_tac x="a + of_real (s/2)" in exI, simp add: dist_norm) done lemmas LIM_not_zero = LIM_const_not_eq [where L = 0] @@ -176,10 +217,21 @@ done lemma LIM_unique: - fixes a :: "'a::real_normed_algebra_1" + fixes a :: "'a::real_normed_algebra_1" -- {* TODO: find a more appropriate class *} shows "\f -- a --> L; f -- a --> M\ \ L = M" -apply (drule (1) LIM_diff) -apply (auto dest!: LIM_const_eq) +apply (rule ccontr) +apply (drule_tac r="dist L M / 2" in metric_LIM_D, simp add: zero_less_dist_iff) +apply (drule_tac r="dist L M / 2" in metric_LIM_D, simp add: zero_less_dist_iff) +apply (clarify, rename_tac r s) +apply (subgoal_tac "min r s \ 0") +apply (subgoal_tac "dist L M < dist L M / 2 + dist L M / 2", simp) +apply (subgoal_tac "dist L M \ dist (f (a + of_real (min r s / 2))) L + + dist (f (a + of_real (min r s / 2))) M") +apply (erule le_less_trans, rule add_strict_mono) +apply (drule spec, erule mp, simp add: dist_norm) +apply (drule spec, erule mp, simp add: dist_norm) +apply (subst dist_commute, rule dist_triangle) +apply simp done lemma LIM_ident [simp]: "(\x. x) -- a --> a" @@ -195,9 +247,9 @@ \ ((\x. f x) -- a --> l) = ((\x. g x) -- b --> m)" by (simp add: LIM_def) -lemma LIM_equal2: +lemma metric_LIM_equal2: assumes 1: "0 < R" - assumes 2: "\x. \x \ a; norm (x - a) < R\ \ f x = g x" + assumes 2: "\x. \x \ a; dist x a < R\ \ f x = g x" shows "g -- a --> l \ f -- a --> l" apply (unfold LIM_def, safe) apply (drule_tac x="r" in spec, safe) @@ -206,9 +258,22 @@ apply (simp add: 2) done -text{*Two uses in Hyperreal/Transcendental.ML*} +lemma LIM_equal2: + fixes f g :: "'a::real_normed_vector \ 'b::metric_space" + assumes 1: "0 < R" + assumes 2: "\x. \x \ a; norm (x - a) < R\ \ f x = g x" + shows "g -- a --> l \ f -- a --> l" +apply (unfold LIM_def dist_norm, safe) +apply (drule_tac x="r" in spec, safe) +apply (rule_tac x="min s R" in exI, safe) +apply (simp add: 1) +apply (simp add: 2) +done + +text{*Two uses in Transcendental.ML*} lemma LIM_trans: - "[| (%x. f(x) + -g(x)) -- a --> 0; g -- a --> l |] ==> f -- a --> l" + fixes f g :: "'a::metric_space \ 'b::real_normed_vector" + shows "[| (%x. f(x) + -g(x)) -- a --> 0; g -- a --> l |] ==> f -- a --> l" apply (drule LIM_add, assumption) apply (auto simp add: add_assoc) done @@ -217,62 +282,70 @@ assumes g: "g -- l --> g l" assumes f: "f -- a --> l" shows "(\x. g (f x)) -- a --> g l" -proof (rule LIM_I) +proof (rule metric_LIM_I) fix r::real assume r: "0 < r" obtain s where s: "0 < s" - and less_r: "\y. \y \ l; norm (y - l) < s\ \ norm (g y - g l) < r" - using LIM_D [OF g r] by fast + and less_r: "\y. \y \ l; dist y l < s\ \ dist (g y) (g l) < r" + using metric_LIM_D [OF g r] by fast obtain t where t: "0 < t" - and less_s: "\x. \x \ a; norm (x - a) < t\ \ norm (f x - l) < s" - using LIM_D [OF f s] by fast + and less_s: "\x. \x \ a; dist x a < t\ \ dist (f x) l < s" + using metric_LIM_D [OF f s] by fast - show "\t>0. \x. x \ a \ norm (x - a) < t \ norm (g (f x) - g l) < r" + show "\t>0. \x. x \ a \ dist x a < t \ dist (g (f x)) (g l) < r" proof (rule exI, safe) show "0 < t" using t . next - fix x assume "x \ a" and "norm (x - a) < t" - hence "norm (f x - l) < s" by (rule less_s) - thus "norm (g (f x) - g l) < r" + fix x assume "x \ a" and "dist x a < t" + hence "dist (f x) l < s" by (rule less_s) + thus "dist (g (f x)) (g l) < r" using r less_r by (case_tac "f x = l", simp_all) qed qed +lemma metric_LIM_compose2: + assumes f: "f -- a --> b" + assumes g: "g -- b --> c" + assumes inj: "\d>0. \x. x \ a \ dist x a < d \ f x \ b" + shows "(\x. g (f x)) -- a --> c" +proof (rule metric_LIM_I) + fix r :: real + assume r: "0 < r" + obtain s where s: "0 < s" + and less_r: "\y. \y \ b; dist y b < s\ \ dist (g y) c < r" + using metric_LIM_D [OF g r] by fast + obtain t where t: "0 < t" + and less_s: "\x. \x \ a; dist x a < t\ \ dist (f x) b < s" + using metric_LIM_D [OF f s] by fast + obtain d where d: "0 < d" + and neq_b: "\x. \x \ a; dist x a < d\ \ f x \ b" + using inj by fast + + show "\t>0. \x. x \ a \ dist x a < t \ dist (g (f x)) c < r" + proof (safe intro!: exI) + show "0 < min d t" using d t by simp + next + fix x + assume "x \ a" and "dist x a < min d t" + hence "f x \ b" and "dist (f x) b < s" + using neq_b less_s by simp_all + thus "dist (g (f x)) c < r" + by (rule less_r) + qed +qed + lemma LIM_compose2: + fixes a :: "'a::real_normed_vector" assumes f: "f -- a --> b" assumes g: "g -- b --> c" assumes inj: "\d>0. \x. x \ a \ norm (x - a) < d \ f x \ b" shows "(\x. g (f x)) -- a --> c" -proof (rule LIM_I) - fix r :: real - assume r: "0 < r" - obtain s where s: "0 < s" - and less_r: "\y. \y \ b; norm (y - b) < s\ \ norm (g y - c) < r" - using LIM_D [OF g r] by fast - obtain t where t: "0 < t" - and less_s: "\x. \x \ a; norm (x - a) < t\ \ norm (f x - b) < s" - using LIM_D [OF f s] by fast - obtain d where d: "0 < d" - and neq_b: "\x. \x \ a; norm (x - a) < d\ \ f x \ b" - using inj by fast - - show "\t>0. \x. x \ a \ norm (x - a) < t \ norm (g (f x) - c) < r" - proof (safe intro!: exI) - show "0 < min d t" using d t by simp - next - fix x - assume "x \ a" and "norm (x - a) < min d t" - hence "f x \ b" and "norm (f x - b) < s" - using neq_b less_s by simp_all - thus "norm (g (f x) - c) < r" - by (rule less_r) - qed -qed +by (rule metric_LIM_compose2 [OF f g inj [folded dist_norm]]) lemma LIM_o: "\g -- l --> g l; f -- a --> l\ \ (g \ f) -- a --> g l" unfolding o_def by (rule LIM_compose) lemma real_LIM_sandwich_zero: - fixes f g :: "'a::real_normed_vector \ real" + fixes f g :: "'a::metric_space \ real" assumes f: "f -- a --> 0" assumes 1: "\x. x \ a \ 0 \ g x" assumes 2: "\x. x \ a \ g x \ f x" @@ -288,26 +361,12 @@ text {* Bounded Linear Operators *} -lemma (in bounded_linear) cont: "f -- a --> f a" -proof (rule LIM_I) - fix r::real assume r: "0 < r" - obtain K where K: "0 < K" and norm_le: "\x. norm (f x) \ norm x * K" - using pos_bounded by fast - show "\s>0. \x. x \ a \ norm (x - a) < s \ norm (f x - f a) < r" - proof (rule exI, safe) - from r K show "0 < r / K" by (rule divide_pos_pos) - next - fix x assume x: "norm (x - a) < r / K" - have "norm (f x - f a) = norm (f (x - a))" by (simp only: diff) - also have "\ \ norm (x - a) * K" by (rule norm_le) - also from K x have "\ < r" by (simp only: pos_less_divide_eq) - finally show "norm (f x - f a) < r" . - qed -qed - lemma (in bounded_linear) LIM: "g -- a --> l \ (\x. f (g x)) -- a --> f l" -by (rule LIM_compose [OF cont]) +unfolding LIM_conv_tendsto by (rule tendsto) + +lemma (in bounded_linear) cont: "f -- a --> f a" +by (rule LIM [OF LIM_ident]) lemma (in bounded_linear) LIM_zero: "g -- a --> 0 \ (\x. f (g x)) -- a --> 0" @@ -315,39 +374,16 @@ text {* Bounded Bilinear Operators *} +lemma (in bounded_bilinear) LIM: + "\f -- a --> L; g -- a --> M\ \ (\x. f x ** g x) -- a --> L ** M" +unfolding LIM_conv_tendsto by (rule tendsto) + lemma (in bounded_bilinear) LIM_prod_zero: + fixes a :: "'d::metric_space" assumes f: "f -- a --> 0" assumes g: "g -- a --> 0" shows "(\x. f x ** g x) -- a --> 0" -proof (rule LIM_I) - fix r::real assume r: "0 < r" - obtain K where K: "0 < K" - and norm_le: "\x y. norm (x ** y) \ norm x * norm y * K" - using pos_bounded by fast - from K have K': "0 < inverse K" - by (rule positive_imp_inverse_positive) - obtain s where s: "0 < s" - and norm_f: "\x. \x \ a; norm (x - a) < s\ \ norm (f x) < r" - using LIM_D [OF f r] by auto - obtain t where t: "0 < t" - and norm_g: "\x. \x \ a; norm (x - a) < t\ \ norm (g x) < inverse K" - using LIM_D [OF g K'] by auto - show "\s>0. \x. x \ a \ norm (x - a) < s \ norm (f x ** g x - 0) < r" - proof (rule exI, safe) - from s t show "0 < min s t" by simp - next - fix x assume x: "x \ a" - assume "norm (x - a) < min s t" - hence xs: "norm (x - a) < s" and xt: "norm (x - a) < t" by simp_all - from x xs have 1: "norm (f x) < r" by (rule norm_f) - from x xt have 2: "norm (g x) < inverse K" by (rule norm_g) - have "norm (f x ** g x) \ norm (f x) * norm (g x) * K" by (rule norm_le) - also from 1 2 K have "\ < r * inverse K * K" - by (intro mult_strict_right_mono mult_strict_mono' norm_ge_zero) - also from K have "r * inverse K * K = r" by simp - finally show "norm (f x ** g x - 0) < r" by simp - qed -qed +using LIM [OF f g] by (simp add: zero_left) lemma (in bounded_bilinear) LIM_left_zero: "f -- a --> 0 \ (\x. f x ** c) -- a --> 0" @@ -357,19 +393,6 @@ "f -- a --> 0 \ (\x. c ** f x) -- a --> 0" by (rule bounded_linear.LIM_zero [OF bounded_linear_right]) -lemma (in bounded_bilinear) LIM: - "\f -- a --> L; g -- a --> M\ \ (\x. f x ** g x) -- a --> L ** M" -apply (drule LIM_zero) -apply (drule LIM_zero) -apply (rule LIM_zero_cancel) -apply (subst prod_diff_prod) -apply (rule LIM_add_zero) -apply (rule LIM_add_zero) -apply (erule (1) LIM_prod_zero) -apply (erule LIM_left_zero) -apply (erule LIM_right_zero) -done - lemmas LIM_mult = mult.LIM lemmas LIM_mult_zero = mult.LIM_prod_zero @@ -383,89 +406,41 @@ lemmas LIM_of_real = of_real.LIM lemma LIM_power: - fixes f :: "'a::real_normed_vector \ 'b::{power,real_normed_algebra}" + fixes f :: "'a::metric_space \ 'b::{power,real_normed_algebra}" assumes f: "f -- a --> l" shows "(\x. f x ^ n) -- a --> l ^ n" by (induct n, simp, simp add: LIM_mult f) subsubsection {* Derived theorems about @{term LIM} *} -lemma LIM_inverse_lemma: - fixes x :: "'a::real_normed_div_algebra" - assumes r: "0 < r" - assumes x: "norm (x - 1) < min (1/2) (r/2)" - shows "norm (inverse x - 1) < r" -proof - - from r have r2: "0 < r/2" by simp - from x have 0: "x \ 0" by clarsimp - from x have x': "norm (1 - x) < min (1/2) (r/2)" - by (simp only: norm_minus_commute) - hence less1: "norm (1 - x) < r/2" by simp - have "norm (1::'a) - norm x \ norm (1 - x)" by (rule norm_triangle_ineq2) - also from x' have "norm (1 - x) < 1/2" by simp - finally have "1/2 < norm x" by simp - hence "inverse (norm x) < inverse (1/2)" - by (rule less_imp_inverse_less, simp) - hence less2: "norm (inverse x) < 2" - by (simp add: nonzero_norm_inverse 0) - from less1 less2 r2 norm_ge_zero - have "norm (1 - x) * norm (inverse x) < (r/2) * 2" - by (rule mult_strict_mono) - thus "norm (inverse x - 1) < r" - by (simp only: norm_mult [symmetric] left_diff_distrib, simp add: 0) -qed +lemma LIM_inverse: + fixes L :: "'a::real_normed_div_algebra" + shows "\f -- a --> L; L \ 0\ \ (\x. inverse (f x)) -- a --> inverse L" +unfolding LIM_conv_tendsto +by (rule tendsto_inverse) lemma LIM_inverse_fun: assumes a: "a \ (0::'a::real_normed_div_algebra)" shows "inverse -- a --> inverse a" -proof (rule LIM_equal2) - from a show "0 < norm a" by simp -next - fix x assume "norm (x - a) < norm a" - hence "x \ 0" by auto - with a show "inverse x = inverse (inverse a * x) * inverse a" - by (simp add: nonzero_inverse_mult_distrib - nonzero_imp_inverse_nonzero - nonzero_inverse_inverse_eq mult_assoc) -next - have 1: "inverse -- 1 --> inverse (1::'a)" - apply (rule LIM_I) - apply (rule_tac x="min (1/2) (r/2)" in exI) - apply (simp add: LIM_inverse_lemma) - done - have "(\x. inverse a * x) -- a --> inverse a * a" - by (intro LIM_mult LIM_ident LIM_const) - hence "(\x. inverse a * x) -- a --> 1" - by (simp add: a) - with 1 have "(\x. inverse (inverse a * x)) -- a --> inverse 1" - by (rule LIM_compose) - hence "(\x. inverse (inverse a * x)) -- a --> 1" - by simp - hence "(\x. inverse (inverse a * x) * inverse a) -- a --> 1 * inverse a" - by (intro LIM_mult LIM_const) - thus "(\x. inverse (inverse a * x) * inverse a) -- a --> inverse a" - by simp -qed - -lemma LIM_inverse: - fixes L :: "'a::real_normed_div_algebra" - shows "\f -- a --> L; L \ 0\ \ (\x. inverse (f x)) -- a --> inverse L" -by (rule LIM_inverse_fun [THEN LIM_compose]) +by (rule LIM_inverse [OF LIM_ident a]) lemma LIM_sgn: - "\f -- a --> l; l \ 0\ \ (\x. sgn (f x)) -- a --> sgn l" + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "\f -- a --> l; l \ 0\ \ (\x. sgn (f x)) -- a --> sgn l" unfolding sgn_div_norm by (simp add: LIM_scaleR LIM_inverse LIM_norm) subsection {* Continuity *} -subsubsection {* Purely standard proofs *} - -lemma LIM_isCont_iff: "(f -- a --> f a) = ((\h. f (a + h)) -- 0 --> f a)" +lemma LIM_isCont_iff: + fixes f :: "'a::real_normed_vector \ 'b::metric_space" + shows "(f -- a --> f a) = ((\h. f (a + h)) -- 0 --> f a)" by (rule iffI [OF LIM_offset_zero LIM_offset_zero_cancel]) -lemma isCont_iff: "isCont f x = (\h. f (x + h)) -- 0 --> f x" +lemma isCont_iff: + fixes f :: "'a::real_normed_vector \ 'b::metric_space" + shows "isCont f x = (\h. f (x + h)) -- 0 --> f x" by (simp add: isCont_def LIM_isCont_iff) lemma isCont_ident [simp]: "isCont (\x. x) a" @@ -474,28 +449,36 @@ lemma isCont_const [simp]: "isCont (\x. k) a" unfolding isCont_def by (rule LIM_const) -lemma isCont_norm: "isCont f a \ isCont (\x. norm (f x)) a" +lemma isCont_norm: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "isCont f a \ isCont (\x. norm (f x)) a" unfolding isCont_def by (rule LIM_norm) lemma isCont_rabs: "isCont f a \ isCont (\x. \f x :: real\) a" unfolding isCont_def by (rule LIM_rabs) -lemma isCont_add: "\isCont f a; isCont g a\ \ isCont (\x. f x + g x) a" +lemma isCont_add: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "\isCont f a; isCont g a\ \ isCont (\x. f x + g x) a" unfolding isCont_def by (rule LIM_add) -lemma isCont_minus: "isCont f a \ isCont (\x. - f x) a" +lemma isCont_minus: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "isCont f a \ isCont (\x. - f x) a" unfolding isCont_def by (rule LIM_minus) -lemma isCont_diff: "\isCont f a; isCont g a\ \ isCont (\x. f x - g x) a" +lemma isCont_diff: + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "\isCont f a; isCont g a\ \ isCont (\x. f x - g x) a" unfolding isCont_def by (rule LIM_diff) lemma isCont_mult: - fixes f g :: "'a::real_normed_vector \ 'b::real_normed_algebra" + fixes f g :: "'a::metric_space \ 'b::real_normed_algebra" shows "\isCont f a; isCont g a\ \ isCont (\x. f x * g x) a" unfolding isCont_def by (rule LIM_mult) lemma isCont_inverse: - fixes f :: "'a::real_normed_vector \ 'b::real_normed_div_algebra" + fixes f :: "'a::metric_space \ 'b::real_normed_div_algebra" shows "\isCont f a; f a \ 0\ \ isCont (\x. inverse (f x)) a" unfolding isCont_def by (rule LIM_inverse) @@ -503,7 +486,15 @@ "\isCont g l; f -- a --> l\ \ (\x. g (f x)) -- a --> g l" unfolding isCont_def by (rule LIM_compose) +lemma metric_isCont_LIM_compose2: + assumes f [unfolded isCont_def]: "isCont f a" + assumes g: "g -- f a --> l" + assumes inj: "\d>0. \x. x \ a \ dist x a < d \ f x \ f a" + shows "(\x. g (f x)) -- a --> l" +by (rule metric_LIM_compose2 [OF f g inj]) + lemma isCont_LIM_compose2: + fixes a :: "'a::real_normed_vector" assumes f [unfolded isCont_def]: "isCont f a" assumes g: "g -- f a --> l" assumes inj: "\d>0. \x. x \ a \ norm (x - a) < d \ f x \ f a" @@ -526,22 +517,25 @@ lemmas isCont_scaleR = scaleR.isCont lemma isCont_of_real: - "isCont f a \ isCont (\x. of_real (f x)) a" + "isCont f a \ isCont (\x. of_real (f x)::'b::real_normed_algebra_1) a" unfolding isCont_def by (rule LIM_of_real) lemma isCont_power: - fixes f :: "'a::real_normed_vector \ 'b::{power,real_normed_algebra}" + fixes f :: "'a::metric_space \ 'b::{power,real_normed_algebra}" shows "isCont f a \ isCont (\x. f x ^ n) a" unfolding isCont_def by (rule LIM_power) lemma isCont_sgn: - "\isCont f a; f a \ 0\ \ isCont (\x. sgn (f x)) a" + fixes f :: "'a::metric_space \ 'b::real_normed_vector" + shows "\isCont f a; f a \ 0\ \ isCont (\x. sgn (f x)) a" unfolding isCont_def by (rule LIM_sgn) lemma isCont_abs [simp]: "isCont abs (a::real)" by (rule isCont_rabs [OF isCont_ident]) -lemma isCont_setsum: fixes A :: "nat set" assumes "finite A" +lemma isCont_setsum: + fixes f :: "'a \ 'b::metric_space \ 'c::real_normed_vector" + fixes A :: "'a set" assumes "finite A" shows "\ i \ A. isCont (f i) x \ isCont (\ x. \ i \ A. f i x) x" using `finite A` proof induct @@ -578,7 +572,7 @@ hence "f ?x < 0" using `f x < 0` by auto thus False using `0 \ f ?x` by auto qed - + subsection {* Uniform Continuity *} @@ -588,14 +582,14 @@ lemma isUCont_Cauchy: "\isUCont f; Cauchy X\ \ Cauchy (\n. f (X n))" unfolding isUCont_def -apply (rule CauchyI) +apply (rule metric_CauchyI) apply (drule_tac x=e in spec, safe) -apply (drule_tac e=s in CauchyD, safe) +apply (drule_tac e=s in metric_CauchyD, safe) apply (rule_tac x=M in exI, simp) done lemma (in bounded_linear) isUCont: "isUCont f" -unfolding isUCont_def +unfolding isUCont_def dist_norm proof (intro allI impI) fix r::real assume r: "0 < r" obtain K where K: "0 < K" and norm_le: "\x. norm (f x) \ norm x * K" @@ -620,44 +614,46 @@ subsection {* Relation of LIM and LIMSEQ *} lemma LIMSEQ_SEQ_conv1: - fixes a :: "'a::real_normed_vector" + fixes a :: "'a::metric_space" assumes X: "X -- a --> L" shows "\S. (\n. S n \ a) \ S ----> a \ (\n. X (S n)) ----> L" -proof (safe intro!: LIMSEQ_I) +proof (safe intro!: metric_LIMSEQ_I) fix S :: "nat \ 'a" fix r :: real assume rgz: "0 < r" assume as: "\n. S n \ a" assume S: "S ----> a" - from LIM_D [OF X rgz] obtain s + from metric_LIM_D [OF X rgz] obtain s where sgz: "0 < s" - and aux: "\x. \x \ a; norm (x - a) < s\ \ norm (X x - L) < r" + and aux: "\x. \x \ a; dist x a < s\ \ dist (X x) L < r" by fast - from LIMSEQ_D [OF S sgz] - obtain no where "\n\no. norm (S n - a) < s" by blast - hence "\n\no. norm (X (S n) - L) < r" by (simp add: aux as) - thus "\no. \n\no. norm (X (S n) - L) < r" .. + from metric_LIMSEQ_D [OF S sgz] + obtain no where "\n\no. dist (S n) a < s" by blast + hence "\n\no. dist (X (S n)) L < r" by (simp add: aux as) + thus "\no. \n\no. dist (X (S n)) L < r" .. qed + lemma LIMSEQ_SEQ_conv2: fixes a :: real assumes "\S. (\n. S n \ a) \ S ----> a \ (\n. X (S n)) ----> L" shows "X -- a --> L" proof (rule ccontr) assume "\ (X -- a --> L)" - hence "\ (\r > 0. \s > 0. \x. x \ a & norm (x - a) < s --> norm (X x - L) < r)" by (unfold LIM_def) - hence "\r > 0. \s > 0. \x. \(x \ a \ \x - a\ < s --> norm (X x - L) < r)" by simp - hence "\r > 0. \s > 0. \x. (x \ a \ \x - a\ < s \ norm (X x - L) \ r)" by (simp add: linorder_not_less) - then obtain r where rdef: "r > 0 \ (\s > 0. \x. (x \ a \ \x - a\ < s \ norm (X x - L) \ r))" by auto + hence "\ (\r > 0. \s > 0. \x. x \ a & norm (x - a) < s --> dist (X x) L < r)" + unfolding LIM_def dist_norm . + hence "\r > 0. \s > 0. \x. \(x \ a \ \x - a\ < s --> dist (X x) L < r)" by simp + hence "\r > 0. \s > 0. \x. (x \ a \ \x - a\ < s \ dist (X x) L \ r)" by (simp add: not_less) + then obtain r where rdef: "r > 0 \ (\s > 0. \x. (x \ a \ \x - a\ < s \ dist (X x) L \ r))" by auto - let ?F = "\n::nat. SOME x. x\a \ \x - a\ < inverse (real (Suc n)) \ norm (X x - L) \ r" - have "\n. \x. x\a \ \x - a\ < inverse (real (Suc n)) \ norm (X x - L) \ r" + let ?F = "\n::nat. SOME x. x\a \ \x - a\ < inverse (real (Suc n)) \ dist (X x) L \ r" + have "\n. \x. x\a \ \x - a\ < inverse (real (Suc n)) \ dist (X x) L \ r" using rdef by simp - hence F: "\n. ?F n \ a \ \?F n - a\ < inverse (real (Suc n)) \ norm (X (?F n) - L) \ r" + hence F: "\n. ?F n \ a \ \?F n - a\ < inverse (real (Suc n)) \ dist (X (?F n)) L \ r" by (rule someI_ex) hence F1: "\n. ?F n \ a" and F2: "\n. \?F n - a\ < inverse (real (Suc n))" - and F3: "\n. norm (X (?F n) - L) \ r" + and F3: "\n. dist (X (?F n)) L \ r" by fast+ have "?F ----> a" @@ -694,13 +690,13 @@ obtain n where "n = no + 1" by simp then have nolen: "no \ n" by simp (* We prove this by showing that for any m there is an n\m such that |X (?F n) - L| \ r *) - have "norm (X (?F n) - L) \ r" + have "dist (X (?F n)) L \ r" by (rule F3) - with nolen have "\n. no \ n \ norm (X (?F n) - L) \ r" by fast + with nolen have "\n. no \ n \ dist (X (?F n)) L \ r" by fast } - then have "(\no. \n. no \ n \ norm (X (?F n) - L) \ r)" by simp - with rdef have "\e>0. (\no. \n. no \ n \ norm (X (?F n) - L) \ e)" by auto - thus ?thesis by (unfold LIMSEQ_def, auto simp add: linorder_not_less) + then have "(\no. \n. no \ n \ dist (X (?F n)) L \ r)" by simp + with rdef have "\e>0. (\no. \n. no \ n \ dist (X (?F n)) L \ e)" by auto + thus ?thesis by (unfold LIMSEQ_def, auto simp add: not_less) qed ultimately show False by simp qed diff -r 3e900a2acaed -r edf74583715a src/HOL/Limits.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Limits.thy Tue Jun 02 10:04:03 2009 +0200 @@ -0,0 +1,462 @@ +(* Title : Limits.thy + Author : Brian Huffman +*) + +header {* Filters and Limits *} + +theory Limits +imports RealVector RComplete +begin + +subsection {* Filters *} + +typedef (open) 'a filter = + "{f :: ('a \ bool) \ bool. f (\x. True) + \ (\P Q. (\x. P x \ Q x) \ f P \ f Q) + \ (\P Q. f P \ f Q \ f (\x. P x \ Q x))}" +proof + show "(\P. True) \ ?filter" by simp +qed + +definition + eventually :: "('a \ bool) \ 'a filter \ bool" where + [code del]: "eventually P F \ Rep_filter F P" + +lemma eventually_True [simp]: "eventually (\x. True) F" +unfolding eventually_def using Rep_filter [of F] by blast + +lemma eventually_mono: + "(\x. P x \ Q x) \ eventually P F \ eventually Q F" +unfolding eventually_def using Rep_filter [of F] by blast + +lemma eventually_conj: + "\eventually (\x. P x) F; eventually (\x. Q x) F\ + \ eventually (\x. P x \ Q x) F" +unfolding eventually_def using Rep_filter [of F] by blast + +lemma eventually_mp: + assumes "eventually (\x. P x \ Q x) F" + assumes "eventually (\x. P x) F" + shows "eventually (\x. Q x) F" +proof (rule eventually_mono) + show "\x. (P x \ Q x) \ P x \ Q x" by simp + show "eventually (\x. (P x \ Q x) \ P x) F" + using assms by (rule eventually_conj) +qed + +lemma eventually_rev_mp: + assumes "eventually (\x. P x) F" + assumes "eventually (\x. P x \ Q x) F" + shows "eventually (\x. Q x) F" +using assms(2) assms(1) by (rule eventually_mp) + +lemma eventually_conj_iff: + "eventually (\x. P x \ Q x) net \ eventually P net \ eventually Q net" +by (auto intro: eventually_conj elim: eventually_rev_mp) + +lemma eventually_Abs_filter: + assumes "f (\x. True)" + assumes "\P Q. (\x. P x \ Q x) \ f P \ f Q" + assumes "\P Q. f P \ f Q \ f (\x. P x \ Q x)" + shows "eventually P (Abs_filter f) \ f P" +unfolding eventually_def using assms +by (subst Abs_filter_inverse, auto) + +lemma filter_ext: + "(\P. eventually P F \ eventually P F') \ F = F'" +unfolding eventually_def +by (simp add: Rep_filter_inject [THEN iffD1] ext) + +lemma eventually_elim1: + assumes "eventually (\i. P i) F" + assumes "\i. P i \ Q i" + shows "eventually (\i. Q i) F" +using assms by (auto elim!: eventually_rev_mp) + +lemma eventually_elim2: + assumes "eventually (\i. P i) F" + assumes "eventually (\i. Q i) F" + assumes "\i. P i \ Q i \ R i" + shows "eventually (\i. R i) F" +using assms by (auto elim!: eventually_rev_mp) + + +subsection {* Boundedness *} + +definition + Bfun :: "('a \ 'b::real_normed_vector) \ 'a filter \ bool" where + [code del]: "Bfun S F = (\K>0. eventually (\i. norm (S i) \ K) F)" + +lemma BfunI: assumes K: "eventually (\i. norm (X i) \ K) F" shows "Bfun X F" +unfolding Bfun_def +proof (intro exI conjI allI) + show "0 < max K 1" by simp +next + show "eventually (\i. norm (X i) \ max K 1) F" + using K by (rule eventually_elim1, simp) +qed + +lemma BfunE: + assumes "Bfun S F" + obtains B where "0 < B" and "eventually (\i. norm (S i) \ B) F" +using assms unfolding Bfun_def by fast + + +subsection {* Convergence to Zero *} + +definition + Zfun :: "('a \ 'b::real_normed_vector) \ 'a filter \ bool" where + [code del]: "Zfun S F = (\r>0. eventually (\i. norm (S i) < r) F)" + +lemma ZfunI: + "(\r. 0 < r \ eventually (\i. norm (S i) < r) F) \ Zfun S F" +unfolding Zfun_def by simp + +lemma ZfunD: + "\Zfun S F; 0 < r\ \ eventually (\i. norm (S i) < r) F" +unfolding Zfun_def by simp + +lemma Zfun_ssubst: + "eventually (\i. X i = Y i) F \ Zfun Y F \ Zfun X F" +unfolding Zfun_def by (auto elim!: eventually_rev_mp) + +lemma Zfun_zero: "Zfun (\i. 0) F" +unfolding Zfun_def by simp + +lemma Zfun_norm_iff: "Zfun (\i. norm (S i)) F = Zfun (\i. S i) F" +unfolding Zfun_def by simp + +lemma Zfun_imp_Zfun: + assumes X: "Zfun X F" + assumes Y: "eventually (\i. norm (Y i) \ norm (X i) * K) F" + shows "Zfun (\n. Y n) F" +proof (cases) + assume K: "0 < K" + show ?thesis + proof (rule ZfunI) + fix r::real assume "0 < r" + hence "0 < r / K" + using K by (rule divide_pos_pos) + then have "eventually (\i. norm (X i) < r / K) F" + using ZfunD [OF X] by fast + with Y show "eventually (\i. norm (Y i) < r) F" + proof (rule eventually_elim2) + fix i + assume *: "norm (Y i) \ norm (X i) * K" + assume "norm (X i) < r / K" + hence "norm (X i) * K < r" + by (simp add: pos_less_divide_eq K) + thus "norm (Y i) < r" + by (simp add: order_le_less_trans [OF *]) + qed + qed +next + assume "\ 0 < K" + hence K: "K \ 0" by (simp only: not_less) + show ?thesis + proof (rule ZfunI) + fix r :: real + assume "0 < r" + from Y show "eventually (\i. norm (Y i) < r) F" + proof (rule eventually_elim1) + fix i + assume "norm (Y i) \ norm (X i) * K" + also have "\ \ norm (X i) * 0" + using K norm_ge_zero by (rule mult_left_mono) + finally show "norm (Y i) < r" + using `0 < r` by simp + qed + qed +qed + +lemma Zfun_le: "\Zfun Y F; \n. norm (X n) \ norm (Y n)\ \ Zfun X F" +by (erule_tac K="1" in Zfun_imp_Zfun, simp) + +lemma Zfun_add: + assumes X: "Zfun X F" and Y: "Zfun Y F" + shows "Zfun (\n. X n + Y n) F" +proof (rule ZfunI) + fix r::real assume "0 < r" + hence r: "0 < r / 2" by simp + have "eventually (\i. norm (X i) < r/2) F" + using X r by (rule ZfunD) + moreover + have "eventually (\i. norm (Y i) < r/2) F" + using Y r by (rule ZfunD) + ultimately + show "eventually (\i. norm (X i + Y i) < r) F" + proof (rule eventually_elim2) + fix i + assume *: "norm (X i) < r/2" "norm (Y i) < r/2" + have "norm (X i + Y i) \ norm (X i) + norm (Y i)" + by (rule norm_triangle_ineq) + also have "\ < r/2 + r/2" + using * by (rule add_strict_mono) + finally show "norm (X i + Y i) < r" + by simp + qed +qed + +lemma Zfun_minus: "Zfun X F \ Zfun (\i. - X i) F" +unfolding Zfun_def by simp + +lemma Zfun_diff: "\Zfun X F; Zfun Y F\ \ Zfun (\i. X i - Y i) F" +by (simp only: diff_minus Zfun_add Zfun_minus) + +lemma (in bounded_linear) Zfun: + assumes X: "Zfun X F" + shows "Zfun (\n. f (X n)) F" +proof - + obtain K where "\x. norm (f x) \ norm x * K" + using bounded by fast + then have "eventually (\i. norm (f (X i)) \ norm (X i) * K) F" + by simp + with X show ?thesis + by (rule Zfun_imp_Zfun) +qed + +lemma (in bounded_bilinear) Zfun: + assumes X: "Zfun X F" + assumes Y: "Zfun Y F" + shows "Zfun (\n. X n ** Y n) F" +proof (rule ZfunI) + fix r::real assume r: "0 < r" + obtain K where K: "0 < K" + and norm_le: "\x y. norm (x ** y) \ norm x * norm y * K" + using pos_bounded by fast + from K have K': "0 < inverse K" + by (rule positive_imp_inverse_positive) + have "eventually (\i. norm (X i) < r) F" + using X r by (rule ZfunD) + moreover + have "eventually (\i. norm (Y i) < inverse K) F" + using Y K' by (rule ZfunD) + ultimately + show "eventually (\i. norm (X i ** Y i) < r) F" + proof (rule eventually_elim2) + fix i + assume *: "norm (X i) < r" "norm (Y i) < inverse K" + have "norm (X i ** Y i) \ norm (X i) * norm (Y i) * K" + by (rule norm_le) + also have "norm (X i) * norm (Y i) * K < r * inverse K * K" + by (intro mult_strict_right_mono mult_strict_mono' norm_ge_zero * K) + also from K have "r * inverse K * K = r" + by simp + finally show "norm (X i ** Y i) < r" . + qed +qed + +lemma (in bounded_bilinear) Zfun_left: + "Zfun X F \ Zfun (\n. X n ** a) F" +by (rule bounded_linear_left [THEN bounded_linear.Zfun]) + +lemma (in bounded_bilinear) Zfun_right: + "Zfun X F \ Zfun (\n. a ** X n) F" +by (rule bounded_linear_right [THEN bounded_linear.Zfun]) + +lemmas Zfun_mult = mult.Zfun +lemmas Zfun_mult_right = mult.Zfun_right +lemmas Zfun_mult_left = mult.Zfun_left + + +subsection{* Limits *} + +definition + tendsto :: "('a \ 'b::metric_space) \ 'b \ 'a filter \ bool" where + [code del]: "tendsto f l net \ (\e>0. eventually (\x. dist (f x) l < e) net)" + +lemma tendstoI: + "(\e. 0 < e \ eventually (\x. dist (f x) l < e) net) + \ tendsto f l net" + unfolding tendsto_def by auto + +lemma tendstoD: + "tendsto f l net \ 0 < e \ eventually (\x. dist (f x) l < e) net" + unfolding tendsto_def by auto + +lemma tendsto_Zfun_iff: "tendsto (\n. X n) L F = Zfun (\n. X n - L) F" +by (simp only: tendsto_def Zfun_def dist_norm) + +lemma tendsto_const: "tendsto (\n. k) k F" +by (simp add: tendsto_def) + +lemma tendsto_norm: + fixes a :: "'a::real_normed_vector" + shows "tendsto X a F \ tendsto (\n. norm (X n)) (norm a) F" +apply (simp add: tendsto_def dist_norm, safe) +apply (drule_tac x="e" in spec, safe) +apply (erule eventually_elim1) +apply (erule order_le_less_trans [OF norm_triangle_ineq3]) +done + +lemma add_diff_add: + fixes a b c d :: "'a::ab_group_add" + shows "(a + c) - (b + d) = (a - b) + (c - d)" +by simp + +lemma minus_diff_minus: + fixes a b :: "'a::ab_group_add" + shows "(- a) - (- b) = - (a - b)" +by simp + +lemma tendsto_add: + fixes a b :: "'a::real_normed_vector" + shows "\tendsto X a F; tendsto Y b F\ \ tendsto (\n. X n + Y n) (a + b) F" +by (simp only: tendsto_Zfun_iff add_diff_add Zfun_add) + +lemma tendsto_minus: + fixes a :: "'a::real_normed_vector" + shows "tendsto X a F \ tendsto (\n. - X n) (- a) F" +by (simp only: tendsto_Zfun_iff minus_diff_minus Zfun_minus) + +lemma tendsto_minus_cancel: + fixes a :: "'a::real_normed_vector" + shows "tendsto (\n. - X n) (- a) F \ tendsto X a F" +by (drule tendsto_minus, simp) + +lemma tendsto_diff: + fixes a b :: "'a::real_normed_vector" + shows "\tendsto X a F; tendsto Y b F\ \ tendsto (\n. X n - Y n) (a - b) F" +by (simp add: diff_minus tendsto_add tendsto_minus) + +lemma (in bounded_linear) tendsto: + "tendsto X a F \ tendsto (\n. f (X n)) (f a) F" +by (simp only: tendsto_Zfun_iff diff [symmetric] Zfun) + +lemma (in bounded_bilinear) tendsto: + "\tendsto X a F; tendsto Y b F\ \ tendsto (\n. X n ** Y n) (a ** b) F" +by (simp only: tendsto_Zfun_iff prod_diff_prod + Zfun_add Zfun Zfun_left Zfun_right) + + +subsection {* Continuity of Inverse *} + +lemma (in bounded_bilinear) Zfun_prod_Bfun: + assumes X: "Zfun X F" + assumes Y: "Bfun Y F" + shows "Zfun (\n. X n ** Y n) F" +proof - + obtain K where K: "0 \ K" + and norm_le: "\x y. norm (x ** y) \ norm x * norm y * K" + using nonneg_bounded by fast + obtain B where B: "0 < B" + and norm_Y: "eventually (\i. norm (Y i) \ B) F" + using Y by (rule BfunE) + have "eventually (\i. norm (X i ** Y i) \ norm (X i) * (B * K)) F" + using norm_Y proof (rule eventually_elim1) + fix i + assume *: "norm (Y i) \ B" + have "norm (X i ** Y i) \ norm (X i) * norm (Y i) * K" + by (rule norm_le) + also have "\ \ norm (X i) * B * K" + by (intro mult_mono' order_refl norm_Y norm_ge_zero + mult_nonneg_nonneg K *) + also have "\ = norm (X i) * (B * K)" + by (rule mult_assoc) + finally show "norm (X i ** Y i) \ norm (X i) * (B * K)" . + qed + with X show ?thesis + by (rule Zfun_imp_Zfun) +qed + +lemma (in bounded_bilinear) flip: + "bounded_bilinear (\x y. y ** x)" +apply default +apply (rule add_right) +apply (rule add_left) +apply (rule scaleR_right) +apply (rule scaleR_left) +apply (subst mult_commute) +using bounded by fast + +lemma (in bounded_bilinear) Bfun_prod_Zfun: + assumes X: "Bfun X F" + assumes Y: "Zfun Y F" + shows "Zfun (\n. X n ** Y n) F" +using flip Y X by (rule bounded_bilinear.Zfun_prod_Bfun) + +lemma inverse_diff_inverse: + "\(a::'a::division_ring) \ 0; b \ 0\ + \ inverse a - inverse b = - (inverse a * (a - b) * inverse b)" +by (simp add: algebra_simps) + +lemma Bfun_inverse_lemma: + fixes x :: "'a::real_normed_div_algebra" + shows "\r \ norm x; 0 < r\ \ norm (inverse x) \ inverse r" +apply (subst nonzero_norm_inverse, clarsimp) +apply (erule (1) le_imp_inverse_le) +done + +lemma Bfun_inverse: + fixes a :: "'a::real_normed_div_algebra" + assumes X: "tendsto X a F" + assumes a: "a \ 0" + shows "Bfun (\n. inverse (X n)) F" +proof - + from a have "0 < norm a" by simp + hence "\r>0. r < norm a" by (rule dense) + then obtain r where r1: "0 < r" and r2: "r < norm a" by fast + have "eventually (\i. dist (X i) a < r) F" + using tendstoD [OF X r1] by fast + hence "eventually (\i. norm (inverse (X i)) \ inverse (norm a - r)) F" + proof (rule eventually_elim1) + fix i + assume "dist (X i) a < r" + hence 1: "norm (X i - a) < r" + by (simp add: dist_norm) + hence 2: "X i \ 0" using r2 by auto + hence "norm (inverse (X i)) = inverse (norm (X i))" + by (rule nonzero_norm_inverse) + also have "\ \ inverse (norm a - r)" + proof (rule le_imp_inverse_le) + show "0 < norm a - r" using r2 by simp + next + have "norm a - norm (X i) \ norm (a - X i)" + by (rule norm_triangle_ineq2) + also have "\ = norm (X i - a)" + by (rule norm_minus_commute) + also have "\ < r" using 1 . + finally show "norm a - r \ norm (X i)" by simp + qed + finally show "norm (inverse (X i)) \ inverse (norm a - r)" . + qed + thus ?thesis by (rule BfunI) +qed + +lemma tendsto_inverse_lemma: + fixes a :: "'a::real_normed_div_algebra" + shows "\tendsto X a F; a \ 0; eventually (\i. X i \ 0) F\ + \ tendsto (\i. inverse (X i)) (inverse a) F" +apply (subst tendsto_Zfun_iff) +apply (rule Zfun_ssubst) +apply (erule eventually_elim1) +apply (erule (1) inverse_diff_inverse) +apply (rule Zfun_minus) +apply (rule Zfun_mult_left) +apply (rule mult.Bfun_prod_Zfun) +apply (erule (1) Bfun_inverse) +apply (simp add: tendsto_Zfun_iff) +done + +lemma tendsto_inverse: + fixes a :: "'a::real_normed_div_algebra" + assumes X: "tendsto X a F" + assumes a: "a \ 0" + shows "tendsto (\i. inverse (X i)) (inverse a) F" +proof - + from a have "0 < norm a" by simp + with X have "eventually (\i. dist (X i) a < norm a) F" + by (rule tendstoD) + then have "eventually (\i. X i \ 0) F" + unfolding dist_norm by (auto elim!: eventually_elim1) + with X a show ?thesis + by (rule tendsto_inverse_lemma) +qed + +lemma tendsto_divide: + fixes a b :: "'a::real_normed_field" + shows "\tendsto X a F; tendsto Y b F; b \ 0\ + \ tendsto (\n. X n / Y n) (a / b) F" +by (simp add: mult.tendsto tendsto_inverse divide_inverse) + +end diff -r 3e900a2acaed -r edf74583715a src/HOL/Ln.thy --- a/src/HOL/Ln.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Ln.thy Tue Jun 02 10:04:03 2009 +0200 @@ -343,7 +343,7 @@ done lemma DERIV_ln: "0 < x ==> DERIV ln x :> 1 / x" - apply (unfold deriv_def, unfold LIM_def, clarsimp) + apply (unfold deriv_def, unfold LIM_eq, clarsimp) apply (rule exI) apply (rule conjI) prefer 2 diff -r 3e900a2acaed -r edf74583715a src/HOL/Log.thy --- a/src/HOL/Log.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Log.thy Tue Jun 02 10:04:03 2009 +0200 @@ -248,7 +248,7 @@ qed lemma LIMSEQ_neg_powr: "0 < s ==> (%x. (real x) powr - s) ----> 0" - apply (unfold LIMSEQ_def) + apply (unfold LIMSEQ_iff) apply clarsimp apply (rule_tac x = "natfloor(r powr (1 / - s)) + 1" in exI) apply clarify diff -r 3e900a2acaed -r edf74583715a src/HOL/NSA/CLim.thy --- a/src/HOL/NSA/CLim.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/NSA/CLim.thy Tue Jun 02 10:04:03 2009 +0200 @@ -45,17 +45,25 @@ hIm_hcomplex_of_complex) (** get this result easily now **) -lemma LIM_Re: "f -- a --> L ==> (%x. Re(f x)) -- a --> Re(L)" +lemma LIM_Re: + fixes f :: "'a::real_normed_vector \ complex" + shows "f -- a --> L ==> (%x. Re(f x)) -- a --> Re(L)" by (simp add: LIM_NSLIM_iff NSLIM_Re) -lemma LIM_Im: "f -- a --> L ==> (%x. Im(f x)) -- a --> Im(L)" +lemma LIM_Im: + fixes f :: "'a::real_normed_vector \ complex" + shows "f -- a --> L ==> (%x. Im(f x)) -- a --> Im(L)" by (simp add: LIM_NSLIM_iff NSLIM_Im) -lemma LIM_cnj: "f -- a --> L ==> (%x. cnj (f x)) -- a --> cnj L" -by (simp add: LIM_def complex_cnj_diff [symmetric]) +lemma LIM_cnj: + fixes f :: "'a::real_normed_vector \ complex" + shows "f -- a --> L ==> (%x. cnj (f x)) -- a --> cnj L" +by (simp add: LIM_eq complex_cnj_diff [symmetric]) -lemma LIM_cnj_iff: "((%x. cnj (f x)) -- a --> cnj L) = (f -- a --> L)" -by (simp add: LIM_def complex_cnj_diff [symmetric]) +lemma LIM_cnj_iff: + fixes f :: "'a::real_normed_vector \ complex" + shows "((%x. cnj (f x)) -- a --> cnj L) = (f -- a --> L)" +by (simp add: LIM_eq complex_cnj_diff [symmetric]) lemma starfun_norm: "( *f* (\x. norm (f x))) = (\x. hnorm (( *f* f) x))" by transfer (rule refl) @@ -74,8 +82,10 @@ approx_approx_zero_iff [symmetric] approx_minus_iff [symmetric]) (** much, much easier standard proof **) -lemma CLIM_CRLIM_iff: "(f -- x --> L) = ((%y. cmod(f y - L)) -- x --> 0)" -by (simp add: LIM_def) +lemma CLIM_CRLIM_iff: + fixes f :: "'a::real_normed_vector \ complex" + shows "(f -- x --> L) = ((%y. cmod(f y - L)) -- x --> 0)" +by (simp add: LIM_eq) (* so this is nicer nonstandard proof *) lemma NSCLIM_NSCRLIM_iff2: @@ -92,7 +102,8 @@ done lemma LIM_CRLIM_Re_Im_iff: - "(f -- a --> L) = ((%x. Re(f x)) -- a --> Re(L) & + fixes f :: "'a::real_normed_vector \ complex" + shows "(f -- a --> L) = ((%x. Re(f x)) -- a --> Re(L) & (%x. Im(f x)) -- a --> Im(L))" by (simp add: LIM_NSLIM_iff NSLIM_NSCRLIM_Re_Im_iff) @@ -113,10 +124,14 @@ lemma isContCR_cmod [simp]: "isCont cmod (a)" by (simp add: isNSCont_isCont_iff [symmetric]) -lemma isCont_Re: "isCont f a ==> isCont (%x. Re (f x)) a" +lemma isCont_Re: + fixes f :: "'a::real_normed_vector \ complex" + shows "isCont f a ==> isCont (%x. Re (f x)) a" by (simp add: isCont_def LIM_Re) -lemma isCont_Im: "isCont f a ==> isCont (%x. Im (f x)) a" +lemma isCont_Im: + fixes f :: "'a::real_normed_vector \ complex" + shows "isCont f a ==> isCont (%x. Im (f x)) a" by (simp add: isCont_def LIM_Im) subsection{* Differentiation of Natural Number Powers*} diff -r 3e900a2acaed -r edf74583715a src/HOL/NSA/HLim.thy --- a/src/HOL/NSA/HLim.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/NSA/HLim.thy Tue Jun 02 10:04:03 2009 +0200 @@ -287,7 +287,7 @@ fix r::real assume r: "0 < r" with f obtain s where s: "0 < s" and less_r: "\x y. norm (x - y) < s \ norm (f x - f y) < r" - by (auto simp add: isUCont_def) + by (auto simp add: isUCont_def dist_norm) from less_r have less_r': "\x y. hnorm (x - y) < star_of s \ hnorm (starfun f x - starfun f y) < star_of r" @@ -306,7 +306,7 @@ lemma isNSUCont_isUCont: fixes f :: "'a::real_normed_vector \ 'b::real_normed_vector" assumes f: "isNSUCont f" shows "isUCont f" -proof (unfold isUCont_def, safe) +proof (unfold isUCont_def dist_norm, safe) fix r::real assume r: "0 < r" have "\s>0. \x y. hnorm (x - y) < s \ hnorm (starfun f x - starfun f y) < star_of r" diff -r 3e900a2acaed -r edf74583715a src/HOL/Relation_Power.thy --- a/src/HOL/Relation_Power.thy Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -(* Title: HOL/Relation_Power.thy - Author: Tobias Nipkow - Copyright 1996 TU Muenchen -*) - -header{*Powers of Relations and Functions*} - -theory Relation_Power -imports Power Transitive_Closure Plain -begin - -consts funpower :: "('a \ 'b) \ nat \ 'a \ 'b" (infixr "^^" 80) - -overloading - relpow \ "funpower \ ('a \ 'a) set \ nat \ ('a \ 'a) set" -begin - -text {* @{text "R ^^ n = R O ... O R"}, the n-fold composition of @{text R} *} - -primrec relpow where - "(R \ ('a \ 'a) set) ^^ 0 = Id" - | "(R \ ('a \ 'a) set) ^^ Suc n = R O (R ^^ n)" - -end - -overloading - funpow \ "funpower \ ('a \ 'a) \ nat \ 'a \ 'a" -begin - -text {* @{text "f ^^ n = f o ... o f"}, the n-fold composition of @{text f} *} - -primrec funpow where - "(f \ 'a \ 'a) ^^ 0 = id" - | "(f \ 'a \ 'a) ^^ Suc n = f o (f ^^ n)" - -end - -primrec fun_pow :: "nat \ ('a \ 'a) \ 'a \ 'a" where - "fun_pow 0 f = id" - | "fun_pow (Suc n) f = f o fun_pow n f" - -lemma funpow_fun_pow [code unfold]: - "f ^^ n = fun_pow n f" - unfolding funpow_def fun_pow_def .. - -lemma funpow_add: - "f ^^ (m + n) = f ^^ m o f ^^ n" - by (induct m) simp_all - -lemma funpow_swap1: - "f ((f ^^ n) x) = (f ^^ n) (f x)" -proof - - have "f ((f ^^ n) x) = (f ^^ (n+1)) x" unfolding One_nat_def by simp - also have "\ = (f ^^ n o f ^^ 1) x" by (simp only: funpow_add) - also have "\ = (f ^^ n) (f x)" unfolding One_nat_def by simp - finally show ?thesis . -qed - -lemma rel_pow_1 [simp]: - fixes R :: "('a * 'a) set" - shows "R ^^ 1 = R" - by simp - -lemma rel_pow_0_I: - "(x, x) \ R ^^ 0" - by simp - -lemma rel_pow_Suc_I: - "(x, y) \ R ^^ n \ (y, z) \ R \ (x, z) \ R ^^ Suc n" - by auto - -lemma rel_pow_Suc_I2: - "(x, y) \ R \ (y, z) \ R ^^ n \ (x, z) \ R ^^ Suc n" - by (induct n arbitrary: z) (simp, fastsimp) - -lemma rel_pow_0_E: - "(x, y) \ R ^^ 0 \ (x = y \ P) \ P" - by simp - -lemma rel_pow_Suc_E: - "(x, z) \ R ^^ Suc n \ (\y. (x, y) \ R ^^ n \ (y, z) \ R \ P) \ P" - by auto - -lemma rel_pow_E: - "(x, z) \ R ^^ n \ (n = 0 \ x = z \ P) - \ (\y m. n = Suc m \ (x, y) \ R ^^ m \ (y, z) \ R \ P) - \ P" - by (cases n) auto - -lemma rel_pow_Suc_D2: - "(x, z) \ R ^^ Suc n \ (\y. (x, y) \ R \ (y, z) \ R ^^ n)" - apply (induct n arbitrary: x z) - apply (blast intro: rel_pow_0_I elim: rel_pow_0_E rel_pow_Suc_E) - apply (blast intro: rel_pow_Suc_I elim: rel_pow_0_E rel_pow_Suc_E) - done - -lemma rel_pow_Suc_D2': - "\x y z. (x, y) \ R ^^ n \ (y, z) \ R \ (\w. (x, w) \ R \ (w, z) \ R ^^ n)" - by (induct n) (simp_all, blast) - -lemma rel_pow_E2: - "(x, z) \ R ^^ n \ (n = 0 \ x = z \ P) - \ (\y m. n = Suc m \ (x, y) \ R \ (y, z) \ R ^^ m \ P) - \ P" - apply (cases n, simp) - apply (cut_tac n=nat and R=R in rel_pow_Suc_D2', simp, blast) - done - -lemma rtrancl_imp_UN_rel_pow: - "p \ R^* \ p \ (\n. R ^^ n)" - apply (cases p) apply (simp only:) - apply (erule rtrancl_induct) - apply (blast intro: rel_pow_0_I rel_pow_Suc_I)+ - done - -lemma rel_pow_imp_rtrancl: - "p \ R ^^ n \ p \ R^*" - apply (induct n arbitrary: p) - apply (simp_all only: split_tupled_all) - apply (blast intro: rtrancl_refl elim: rel_pow_0_E) - apply (blast elim: rel_pow_Suc_E intro: rtrancl_into_rtrancl) - done - -lemma rtrancl_is_UN_rel_pow: - "R^* = (UN n. R ^^ n)" - by (blast intro: rtrancl_imp_UN_rel_pow rel_pow_imp_rtrancl) - -lemma trancl_power: - "x \ r^+ = (\n > 0. x \ r ^^ n)" - apply (cases x) - apply simp - apply (rule iffI) - apply (drule tranclD2) - apply (clarsimp simp: rtrancl_is_UN_rel_pow) - apply (rule_tac x="Suc x" in exI) - apply (clarsimp simp: rel_comp_def) - apply fastsimp - apply clarsimp - apply (case_tac n, simp) - apply clarsimp - apply (drule rel_pow_imp_rtrancl) - apply fastsimp - done - -lemma single_valued_rel_pow: - fixes R :: "('a * 'a) set" - shows "single_valued R \ single_valued (R ^^ n)" - apply (induct n arbitrary: R) - apply simp_all - apply (rule single_valuedI) - apply (fast dest: single_valuedD elim: rel_pow_Suc_E) - done - -end diff -r 3e900a2acaed -r edf74583715a src/HOL/SEQ.thy --- a/src/HOL/SEQ.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/SEQ.thy Tue Jun 02 10:04:03 2009 +0200 @@ -9,27 +9,31 @@ header {* Sequences and Convergence *} theory SEQ -imports RealVector RComplete +imports Limits begin definition + sequentially :: "nat filter" where + [code del]: "sequentially = Abs_filter (\P. \N. \n\N. P n)" + +definition Zseq :: "[nat \ 'a::real_normed_vector] \ bool" where --{*Standard definition of sequence converging to zero*} [code del]: "Zseq X = (\r>0. \no. \n\no. norm (X n) < r)" definition - LIMSEQ :: "[nat => 'a::real_normed_vector, 'a] => bool" + LIMSEQ :: "[nat \ 'a::metric_space, 'a] \ bool" ("((_)/ ----> (_))" [60, 60] 60) where --{*Standard definition of convergence of sequence*} - [code del]: "X ----> L = (\r. 0 < r --> (\no. \n. no \ n --> norm (X n - L) < r))" + [code del]: "X ----> L = (\r>0. \no. \n\no. dist (X n) L < r)" definition - lim :: "(nat => 'a::real_normed_vector) => 'a" where + lim :: "(nat \ 'a::real_normed_vector) \ 'a" where --{*Standard definition of limit using choice operator*} "lim X = (THE L. X ----> L)" definition - convergent :: "(nat => 'a::real_normed_vector) => bool" where + convergent :: "(nat \ 'a::metric_space) \ bool" where --{*Standard definition of convergence*} "convergent X = (\L. X ----> L)" @@ -62,10 +66,28 @@ [code del]: "subseq f = (\m. \n>m. (f m) < (f n))" definition - Cauchy :: "(nat => 'a::real_normed_vector) => bool" where + Cauchy :: "(nat \ 'a::metric_space) \ bool" where --{*Standard definition of the Cauchy condition*} - [code del]: "Cauchy X = (\e>0. \M. \m \ M. \n \ M. norm (X m - X n) < e)" + [code del]: "Cauchy X = (\e>0. \M. \m \ M. \n \ M. dist (X m) (X n) < e)" + + +subsection {* Sequentially *} +lemma eventually_sequentially: + "eventually P sequentially \ (\N. \n\N. P n)" +unfolding sequentially_def +apply (rule eventually_Abs_filter) +apply simp +apply (clarify, rule_tac x=N in exI, simp) +apply (clarify, rename_tac M N) +apply (rule_tac x="max M N" in exI, simp) +done + +lemma Zseq_conv_Zfun: "Zseq X \ Zfun X sequentially" +unfolding Zseq_def Zfun_def eventually_sequentially .. + +lemma LIMSEQ_conv_tendsto: "(X ----> L) \ tendsto X L sequentially" +unfolding LIMSEQ_def tendsto_def eventually_sequentially .. subsection {* Bounded Sequences *} @@ -110,6 +132,13 @@ apply (drule_tac x="n - k" in spec, simp) done +lemma Bseq_conv_Bfun: "Bseq X \ Bfun X sequentially" +unfolding Bfun_def eventually_sequentially +apply (rule iffI) +apply (simp add: Bseq_def, fast) +apply (fast intro: BseqI2') +done + subsection {* Sequences That Converge to Zero *} @@ -134,61 +163,15 @@ assumes X: "Zseq X" assumes Y: "\n. norm (Y n) \ norm (X n) * K" shows "Zseq (\n. Y n)" -proof (cases) - assume K: "0 < K" - show ?thesis - proof (rule ZseqI) - fix r::real assume "0 < r" - hence "0 < r / K" - using K by (rule divide_pos_pos) - then obtain N where "\n\N. norm (X n) < r / K" - using ZseqD [OF X] by fast - hence "\n\N. norm (X n) * K < r" - by (simp add: pos_less_divide_eq K) - hence "\n\N. norm (Y n) < r" - by (simp add: order_le_less_trans [OF Y]) - thus "\N. \n\N. norm (Y n) < r" .. - qed -next - assume "\ 0 < K" - hence K: "K \ 0" by (simp only: linorder_not_less) - { - fix n::nat - have "norm (Y n) \ norm (X n) * K" by (rule Y) - also have "\ \ norm (X n) * 0" - using K norm_ge_zero by (rule mult_left_mono) - finally have "norm (Y n) = 0" by simp - } - thus ?thesis by (simp add: Zseq_zero) -qed +using X Y Zfun_imp_Zfun [of X sequentially Y K] +unfolding Zseq_conv_Zfun by simp lemma Zseq_le: "\Zseq Y; \n. norm (X n) \ norm (Y n)\ \ Zseq X" by (erule_tac K="1" in Zseq_imp_Zseq, simp) lemma Zseq_add: - assumes X: "Zseq X" - assumes Y: "Zseq Y" - shows "Zseq (\n. X n + Y n)" -proof (rule ZseqI) - fix r::real assume "0 < r" - hence r: "0 < r / 2" by simp - obtain M where M: "\n\M. norm (X n) < r/2" - using ZseqD [OF X r] by fast - obtain N where N: "\n\N. norm (Y n) < r/2" - using ZseqD [OF Y r] by fast - show "\N. \n\N. norm (X n + Y n) < r" - proof (intro exI allI impI) - fix n assume n: "max M N \ n" - have "norm (X n + Y n) \ norm (X n) + norm (Y n)" - by (rule norm_triangle_ineq) - also have "\ < r/2 + r/2" - proof (rule add_strict_mono) - from M n show "norm (X n) < r/2" by simp - from N n show "norm (Y n) < r/2" by simp - qed - finally show "norm (X n + Y n) < r" by simp - qed -qed + "Zseq X \ Zseq Y \ Zseq (\n. X n + Y n)" +unfolding Zseq_conv_Zfun by (rule Zfun_add) lemma Zseq_minus: "Zseq X \ Zseq (\n. - X n)" unfolding Zseq_def by simp @@ -197,94 +180,22 @@ by (simp only: diff_minus Zseq_add Zseq_minus) lemma (in bounded_linear) Zseq: - assumes X: "Zseq X" - shows "Zseq (\n. f (X n))" -proof - - obtain K where "\x. norm (f x) \ norm x * K" - using bounded by fast - with X show ?thesis - by (rule Zseq_imp_Zseq) -qed + "Zseq X \ Zseq (\n. f (X n))" +unfolding Zseq_conv_Zfun by (rule Zfun) lemma (in bounded_bilinear) Zseq: - assumes X: "Zseq X" - assumes Y: "Zseq Y" - shows "Zseq (\n. X n ** Y n)" -proof (rule ZseqI) - fix r::real assume r: "0 < r" - obtain K where K: "0 < K" - and norm_le: "\x y. norm (x ** y) \ norm x * norm y * K" - using pos_bounded by fast - from K have K': "0 < inverse K" - by (rule positive_imp_inverse_positive) - obtain M where M: "\n\M. norm (X n) < r" - using ZseqD [OF X r] by fast - obtain N where N: "\n\N. norm (Y n) < inverse K" - using ZseqD [OF Y K'] by fast - show "\N. \n\N. norm (X n ** Y n) < r" - proof (intro exI allI impI) - fix n assume n: "max M N \ n" - have "norm (X n ** Y n) \ norm (X n) * norm (Y n) * K" - by (rule norm_le) - also have "norm (X n) * norm (Y n) * K < r * inverse K * K" - proof (intro mult_strict_right_mono mult_strict_mono' norm_ge_zero K) - from M n show Xn: "norm (X n) < r" by simp - from N n show Yn: "norm (Y n) < inverse K" by simp - qed - also from K have "r * inverse K * K = r" by simp - finally show "norm (X n ** Y n) < r" . - qed -qed + "Zseq X \ Zseq Y \ Zseq (\n. X n ** Y n)" +unfolding Zseq_conv_Zfun by (rule Zfun) lemma (in bounded_bilinear) Zseq_prod_Bseq: - assumes X: "Zseq X" - assumes Y: "Bseq Y" - shows "Zseq (\n. X n ** Y n)" -proof - - obtain K where K: "0 \ K" - and norm_le: "\x y. norm (x ** y) \ norm x * norm y * K" - using nonneg_bounded by fast - obtain B where B: "0 < B" - and norm_Y: "\n. norm (Y n) \ B" - using Y [unfolded Bseq_def] by fast - from X show ?thesis - proof (rule Zseq_imp_Zseq) - fix n::nat - have "norm (X n ** Y n) \ norm (X n) * norm (Y n) * K" - by (rule norm_le) - also have "\ \ norm (X n) * B * K" - by (intro mult_mono' order_refl norm_Y norm_ge_zero - mult_nonneg_nonneg K) - also have "\ = norm (X n) * (B * K)" - by (rule mult_assoc) - finally show "norm (X n ** Y n) \ norm (X n) * (B * K)" . - qed -qed + "Zseq X \ Bseq Y \ Zseq (\n. X n ** Y n)" +unfolding Zseq_conv_Zfun Bseq_conv_Bfun +by (rule Zfun_prod_Bfun) lemma (in bounded_bilinear) Bseq_prod_Zseq: - assumes X: "Bseq X" - assumes Y: "Zseq Y" - shows "Zseq (\n. X n ** Y n)" -proof - - obtain K where K: "0 \ K" - and norm_le: "\x y. norm (x ** y) \ norm x * norm y * K" - using nonneg_bounded by fast - obtain B where B: "0 < B" - and norm_X: "\n. norm (X n) \ B" - using X [unfolded Bseq_def] by fast - from Y show ?thesis - proof (rule Zseq_imp_Zseq) - fix n::nat - have "norm (X n ** Y n) \ norm (X n) * norm (Y n) * K" - by (rule norm_le) - also have "\ \ B * norm (Y n) * K" - by (intro mult_mono' order_refl norm_X norm_ge_zero - mult_nonneg_nonneg K) - also have "\ = norm (Y n) * (B * K)" - by (simp only: mult_ac) - finally show "norm (X n ** Y n) \ norm (Y n) * (B * K)" . - qed -qed + "Bseq X \ Zseq Y \ Zseq (\n. X n ** Y n)" +unfolding Zseq_conv_Zfun Bseq_conv_Bfun +by (rule Bfun_prod_Zfun) lemma (in bounded_bilinear) Zseq_left: "Zseq X \ Zseq (\n. X n ** a)" @@ -302,38 +213,51 @@ subsection {* Limits of Sequences *} lemma LIMSEQ_iff: - "(X ----> L) = (\r>0. \no. \n \ no. norm (X n - L) < r)" -by (rule LIMSEQ_def) + fixes L :: "'a::real_normed_vector" + shows "(X ----> L) = (\r>0. \no. \n \ no. norm (X n - L) < r)" +unfolding LIMSEQ_def dist_norm .. lemma LIMSEQ_Zseq_iff: "((\n. X n) ----> L) = Zseq (\n. X n - L)" -by (simp only: LIMSEQ_def Zseq_def) +by (simp only: LIMSEQ_iff Zseq_def) + +lemma metric_LIMSEQ_I: + "(\r. 0 < r \ \no. \n\no. dist (X n) L < r) \ X ----> L" +by (simp add: LIMSEQ_def) + +lemma metric_LIMSEQ_D: + "\X ----> L; 0 < r\ \ \no. \n\no. dist (X n) L < r" +by (simp add: LIMSEQ_def) lemma LIMSEQ_I: - "(\r. 0 < r \ \no. \n\no. norm (X n - L) < r) \ X ----> L" -by (simp add: LIMSEQ_def) + fixes L :: "'a::real_normed_vector" + shows "(\r. 0 < r \ \no. \n\no. norm (X n - L) < r) \ X ----> L" +by (simp add: LIMSEQ_iff) lemma LIMSEQ_D: - "\X ----> L; 0 < r\ \ \no. \n\no. norm (X n - L) < r" -by (simp add: LIMSEQ_def) + fixes L :: "'a::real_normed_vector" + shows "\X ----> L; 0 < r\ \ \no. \n\no. norm (X n - L) < r" +by (simp add: LIMSEQ_iff) lemma LIMSEQ_const: "(\n. k) ----> k" by (simp add: LIMSEQ_def) -lemma LIMSEQ_const_iff: "(\n. k) ----> l = (k = l)" -by (simp add: LIMSEQ_Zseq_iff Zseq_const_iff) +lemma LIMSEQ_const_iff: "(\n. k) ----> l \ k = l" +apply (safe intro!: LIMSEQ_const) +apply (rule ccontr) +apply (drule_tac r="dist k l" in metric_LIMSEQ_D) +apply (simp add: zero_less_dist_iff) +apply auto +done -lemma LIMSEQ_norm: "X ----> a \ (\n. norm (X n)) ----> norm a" -apply (simp add: LIMSEQ_def, safe) -apply (drule_tac x="r" in spec, safe) -apply (rule_tac x="no" in exI, safe) -apply (drule_tac x="n" in spec, safe) -apply (erule order_le_less_trans [OF norm_triangle_ineq3]) -done +lemma LIMSEQ_norm: + fixes a :: "'a::real_normed_vector" + shows "X ----> a \ (\n. norm (X n)) ----> norm a" +unfolding LIMSEQ_conv_tendsto by (rule tendsto_norm) lemma LIMSEQ_ignore_initial_segment: "f ----> a \ (\n. f (n + k)) ----> a" -apply (rule LIMSEQ_I) -apply (drule (1) LIMSEQ_D) +apply (rule metric_LIMSEQ_I) +apply (drule (1) metric_LIMSEQ_D) apply (erule exE, rename_tac N) apply (rule_tac x=N in exI) apply simp @@ -341,8 +265,8 @@ lemma LIMSEQ_offset: "(\n. f (n + k)) ----> a \ f ----> a" -apply (rule LIMSEQ_I) -apply (drule (1) LIMSEQ_D) +apply (rule metric_LIMSEQ_I) +apply (drule (1) metric_LIMSEQ_D) apply (erule exE, rename_tac N) apply (rule_tac x="N + k" in exI) apply clarify @@ -363,51 +287,50 @@ unfolding LIMSEQ_def by (metis div_le_dividend div_mult_self1_is_m le_trans nat_mult_commute) - -lemma add_diff_add: - fixes a b c d :: "'a::ab_group_add" - shows "(a + c) - (b + d) = (a - b) + (c - d)" -by simp +lemma LIMSEQ_add: + fixes a b :: "'a::real_normed_vector" + shows "\X ----> a; Y ----> b\ \ (\n. X n + Y n) ----> a + b" +unfolding LIMSEQ_conv_tendsto by (rule tendsto_add) -lemma minus_diff_minus: - fixes a b :: "'a::ab_group_add" - shows "(- a) - (- b) = - (a - b)" -by simp +lemma LIMSEQ_minus: + fixes a :: "'a::real_normed_vector" + shows "X ----> a \ (\n. - X n) ----> - a" +unfolding LIMSEQ_conv_tendsto by (rule tendsto_minus) -lemma LIMSEQ_add: "\X ----> a; Y ----> b\ \ (\n. X n + Y n) ----> a + b" -by (simp only: LIMSEQ_Zseq_iff add_diff_add Zseq_add) - -lemma LIMSEQ_minus: "X ----> a \ (\n. - X n) ----> - a" -by (simp only: LIMSEQ_Zseq_iff minus_diff_minus Zseq_minus) - -lemma LIMSEQ_minus_cancel: "(\n. - X n) ----> - a \ X ----> a" +lemma LIMSEQ_minus_cancel: + fixes a :: "'a::real_normed_vector" + shows "(\n. - X n) ----> - a \ X ----> a" by (drule LIMSEQ_minus, simp) -lemma LIMSEQ_diff: "\X ----> a; Y ----> b\ \ (\n. X n - Y n) ----> a - b" -by (simp add: diff_minus LIMSEQ_add LIMSEQ_minus) +lemma LIMSEQ_diff: + fixes a b :: "'a::real_normed_vector" + shows "\X ----> a; Y ----> b\ \ (\n. X n - Y n) ----> a - b" +unfolding LIMSEQ_conv_tendsto by (rule tendsto_diff) lemma LIMSEQ_unique: "\X ----> a; X ----> b\ \ a = b" -by (drule (1) LIMSEQ_diff, simp add: LIMSEQ_const_iff) +apply (rule ccontr) +apply (drule_tac r="dist a b / 2" in metric_LIMSEQ_D, simp add: zero_less_dist_iff) +apply (drule_tac r="dist a b / 2" in metric_LIMSEQ_D, simp add: zero_less_dist_iff) +apply (clarify, rename_tac M N) +apply (subgoal_tac "dist a b < dist a b / 2 + dist a b / 2", simp) +apply (subgoal_tac "dist a b \ dist (X (max M N)) a + dist (X (max M N)) b") +apply (erule le_less_trans, rule add_strict_mono, simp, simp) +apply (subst dist_commute, rule dist_triangle) +done lemma (in bounded_linear) LIMSEQ: "X ----> a \ (\n. f (X n)) ----> f a" -by (simp only: LIMSEQ_Zseq_iff diff [symmetric] Zseq) +unfolding LIMSEQ_conv_tendsto by (rule tendsto) lemma (in bounded_bilinear) LIMSEQ: "\X ----> a; Y ----> b\ \ (\n. X n ** Y n) ----> a ** b" -by (simp only: LIMSEQ_Zseq_iff prod_diff_prod - Zseq_add Zseq Zseq_left Zseq_right) +unfolding LIMSEQ_conv_tendsto by (rule tendsto) lemma LIMSEQ_mult: fixes a b :: "'a::real_normed_algebra" shows "[| X ----> a; Y ----> b |] ==> (%n. X n * Y n) ----> a * b" by (rule mult.LIMSEQ) -lemma inverse_diff_inverse: - "\(a::'a::division_ring) \ 0; b \ 0\ - \ inverse a - inverse b = - (inverse a * (a - b) * inverse b)" -by (simp add: algebra_simps) - lemma Bseq_inverse_lemma: fixes x :: "'a::real_normed_div_algebra" shows "\r \ norm x; 0 < r\ \ norm (inverse x) \ inverse r" @@ -417,69 +340,15 @@ lemma Bseq_inverse: fixes a :: "'a::real_normed_div_algebra" - assumes X: "X ----> a" - assumes a: "a \ 0" - shows "Bseq (\n. inverse (X n))" -proof - - from a have "0 < norm a" by simp - hence "\r>0. r < norm a" by (rule dense) - then obtain r where r1: "0 < r" and r2: "r < norm a" by fast - obtain N where N: "\n. N \ n \ norm (X n - a) < r" - using LIMSEQ_D [OF X r1] by fast - show ?thesis - proof (rule BseqI2' [rule_format]) - fix n assume n: "N \ n" - hence 1: "norm (X n - a) < r" by (rule N) - hence 2: "X n \ 0" using r2 by auto - hence "norm (inverse (X n)) = inverse (norm (X n))" - by (rule nonzero_norm_inverse) - also have "\ \ inverse (norm a - r)" - proof (rule le_imp_inverse_le) - show "0 < norm a - r" using r2 by simp - next - have "norm a - norm (X n) \ norm (a - X n)" - by (rule norm_triangle_ineq2) - also have "\ = norm (X n - a)" - by (rule norm_minus_commute) - also have "\ < r" using 1 . - finally show "norm a - r \ norm (X n)" by simp - qed - finally show "norm (inverse (X n)) \ inverse (norm a - r)" . - qed -qed - -lemma LIMSEQ_inverse_lemma: - fixes a :: "'a::real_normed_div_algebra" - shows "\X ----> a; a \ 0; \n. X n \ 0\ - \ (\n. inverse (X n)) ----> inverse a" -apply (subst LIMSEQ_Zseq_iff) -apply (simp add: inverse_diff_inverse nonzero_imp_inverse_nonzero) -apply (rule Zseq_minus) -apply (rule Zseq_mult_left) -apply (rule mult.Bseq_prod_Zseq) -apply (erule (1) Bseq_inverse) -apply (simp add: LIMSEQ_Zseq_iff) -done + shows "\X ----> a; a \ 0\ \ Bseq (\n. inverse (X n))" +unfolding LIMSEQ_conv_tendsto Bseq_conv_Bfun +by (rule Bfun_inverse) lemma LIMSEQ_inverse: fixes a :: "'a::real_normed_div_algebra" - assumes X: "X ----> a" - assumes a: "a \ 0" - shows "(\n. inverse (X n)) ----> inverse a" -proof - - from a have "0 < norm a" by simp - then obtain k where "\n\k. norm (X n - a) < norm a" - using LIMSEQ_D [OF X] by fast - hence "\n\k. X n \ 0" by auto - hence k: "\n. X (n + k) \ 0" by simp - - from X have "(\n. X (n + k)) ----> a" - by (rule LIMSEQ_ignore_initial_segment) - hence "(\n. inverse (X (n + k))) ----> inverse a" - using a k by (rule LIMSEQ_inverse_lemma) - thus "(\n. inverse (X n)) ----> inverse a" - by (rule LIMSEQ_offset) -qed + shows "\X ----> a; a \ 0\ \ (\n. inverse (X n)) ----> inverse a" +unfolding LIMSEQ_conv_tendsto +by (rule tendsto_inverse) lemma LIMSEQ_divide: fixes a b :: "'a::real_normed_field" @@ -492,6 +361,7 @@ by (induct m) (simp_all add: LIMSEQ_const LIMSEQ_mult) lemma LIMSEQ_setsum: + fixes L :: "'a \ 'b::real_normed_vector" assumes n: "\n. n \ S \ X n ----> L n" shows "(\m. \n\S. X n m) ----> (\n\S. L n)" proof (cases "finite S") @@ -534,39 +404,40 @@ by (simp add: setprod_def LIMSEQ_const) qed -lemma LIMSEQ_add_const: "f ----> a ==> (%n.(f n + b)) ----> a + b" +lemma LIMSEQ_add_const: + fixes a :: "'a::real_normed_vector" + shows "f ----> a ==> (%n.(f n + b)) ----> a + b" by (simp add: LIMSEQ_add LIMSEQ_const) (* FIXME: delete *) lemma LIMSEQ_add_minus: - "[| X ----> a; Y ----> b |] ==> (%n. X n + -Y n) ----> a + -b" + fixes a b :: "'a::real_normed_vector" + shows "[| X ----> a; Y ----> b |] ==> (%n. X n + -Y n) ----> a + -b" by (simp only: LIMSEQ_add LIMSEQ_minus) -lemma LIMSEQ_diff_const: "f ----> a ==> (%n.(f n - b)) ----> a - b" +lemma LIMSEQ_diff_const: + fixes a b :: "'a::real_normed_vector" + shows "f ----> a ==> (%n.(f n - b)) ----> a - b" by (simp add: LIMSEQ_diff LIMSEQ_const) -lemma LIMSEQ_diff_approach_zero: - "g ----> L ==> (%x. f x - g x) ----> 0 ==> - f ----> L" - apply (drule LIMSEQ_add) - apply assumption - apply simp -done +lemma LIMSEQ_diff_approach_zero: + fixes L :: "'a::real_normed_vector" + shows "g ----> L ==> (%x. f x - g x) ----> 0 ==> f ----> L" +by (drule (1) LIMSEQ_add, simp) -lemma LIMSEQ_diff_approach_zero2: - "f ----> L ==> (%x. f x - g x) ----> 0 ==> - g ----> L"; - apply (drule LIMSEQ_diff) - apply assumption - apply simp -done +lemma LIMSEQ_diff_approach_zero2: + fixes L :: "'a::real_normed_vector" + shows "f ----> L ==> (%x. f x - g x) ----> 0 ==> g ----> L"; +by (drule (1) LIMSEQ_diff, simp) text{*A sequence tends to zero iff its abs does*} -lemma LIMSEQ_norm_zero: "((\n. norm (X n)) ----> 0) = (X ----> 0)" -by (simp add: LIMSEQ_def) +lemma LIMSEQ_norm_zero: + fixes X :: "nat \ 'a::real_normed_vector" + shows "((\n. norm (X n)) ----> 0) \ (X ----> 0)" +by (simp add: LIMSEQ_iff) lemma LIMSEQ_rabs_zero: "((%n. \f n\) ----> 0) = (f ----> (0::real))" -by (simp add: LIMSEQ_def) +by (simp add: LIMSEQ_iff) lemma LIMSEQ_imp_rabs: "f ----> (l::real) ==> (%n. \f n\) ----> \l\" by (drule LIMSEQ_norm, simp) @@ -653,7 +524,9 @@ lemma convergent_LIMSEQ_iff: "convergent X = (X ----> lim X)" by (auto intro: theI LIMSEQ_unique simp add: convergent_def lim_def) -lemma convergent_minus_iff: "(convergent X) = (convergent (%n. -(X n)))" +lemma convergent_minus_iff: + fixes X :: "nat \ 'a::real_normed_vector" + shows "convergent X \ convergent (\n. - X n)" apply (simp add: convergent_def) apply (auto dest: LIMSEQ_minus) apply (drule LIMSEQ_minus, auto) @@ -1119,20 +992,35 @@ subsection {* Cauchy Sequences *} -lemma CauchyI: - "(\e. 0 < e \ \M. \m\M. \n\M. norm (X m - X n) < e) \ Cauchy X" +lemma metric_CauchyI: + "(\e. 0 < e \ \M. \m\M. \n\M. dist (X m) (X n) < e) \ Cauchy X" +by (simp add: Cauchy_def) + +lemma metric_CauchyD: + "\Cauchy X; 0 < e\ \ \M. \m\M. \n\M. dist (X m) (X n) < e" by (simp add: Cauchy_def) +lemma Cauchy_iff: + fixes X :: "nat \ 'a::real_normed_vector" + shows "Cauchy X \ (\e>0. \M. \m\M. \n\M. norm (X m - X n) < e)" +unfolding Cauchy_def dist_norm .. + +lemma CauchyI: + fixes X :: "nat \ 'a::real_normed_vector" + shows "(\e. 0 < e \ \M. \m\M. \n\M. norm (X m - X n) < e) \ Cauchy X" +by (simp add: Cauchy_iff) + lemma CauchyD: - "\Cauchy X; 0 < e\ \ \M. \m\M. \n\M. norm (X m - X n) < e" -by (simp add: Cauchy_def) + fixes X :: "nat \ 'a::real_normed_vector" + shows "\Cauchy X; 0 < e\ \ \M. \m\M. \n\M. norm (X m - X n) < e" +by (simp add: Cauchy_iff) lemma Cauchy_subseq_Cauchy: "\ Cauchy X; subseq f \ \ Cauchy (X o f)" -apply (auto simp add: Cauchy_def) -apply (drule_tac x=e in spec, clarify) -apply (rule_tac x=M in exI, clarify) -apply (blast intro: seq_suble le_trans dest!: spec) +apply (auto simp add: Cauchy_def) +apply (drule_tac x=e in spec, clarify) +apply (rule_tac x=M in exI, clarify) +apply (blast intro: le_trans [OF _ seq_suble] dest!: spec) done subsubsection {* Cauchy Sequences are Bounded *} @@ -1149,7 +1037,7 @@ done lemma Cauchy_Bseq: "Cauchy X ==> Bseq X" -apply (simp add: Cauchy_def) +apply (simp add: Cauchy_iff) apply (drule spec, drule mp, rule zero_less_one, safe) apply (drule_tac x="M" in spec, simp) apply (drule lemmaCauchy) @@ -1167,22 +1055,21 @@ theorem LIMSEQ_imp_Cauchy: assumes X: "X ----> a" shows "Cauchy X" -proof (rule CauchyI) +proof (rule metric_CauchyI) fix e::real assume "0 < e" hence "0 < e/2" by simp - with X have "\N. \n\N. norm (X n - a) < e/2" by (rule LIMSEQ_D) - then obtain N where N: "\n\N. norm (X n - a) < e/2" .. - show "\N. \m\N. \n\N. norm (X m - X n) < e" + with X have "\N. \n\N. dist (X n) a < e/2" by (rule metric_LIMSEQ_D) + then obtain N where N: "\n\N. dist (X n) a < e/2" .. + show "\N. \m\N. \n\N. dist (X m) (X n) < e" proof (intro exI allI impI) fix m assume "N \ m" - hence m: "norm (X m - a) < e/2" using N by fast + hence m: "dist (X m) a < e/2" using N by fast fix n assume "N \ n" - hence n: "norm (X n - a) < e/2" using N by fast - have "norm (X m - X n) = norm ((X m - a) - (X n - a))" by simp - also have "\ \ norm (X m - a) + norm (X n - a)" - by (rule norm_triangle_ineq4) - also from m n have "\ < e" by(simp add:field_simps) - finally show "norm (X m - X n) < e" . + hence n: "dist (X n) a < e/2" using N by fast + have "dist (X m) (X n) \ dist (X m) a + dist (X n) a" + by (rule dist_triangle2) + also from m n have "\ < e" by simp + finally show "dist (X m) (X n) < e" . qed qed @@ -1311,7 +1198,7 @@ lemma convergent_subseq_convergent: fixes X :: "nat \ 'a::banach" shows "\ convergent X; subseq f \ \ convergent (X o f)" - by (simp add: Cauchy_subseq_Cauchy Cauchy_convergent_iff [symmetric]) + by (simp add: Cauchy_subseq_Cauchy Cauchy_convergent_iff [symmetric]) subsection {* Power Sequences *} diff -r 3e900a2acaed -r edf74583715a src/HOL/Series.thy --- a/src/HOL/Series.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Series.thy Tue Jun 02 10:04:03 2009 +0200 @@ -160,7 +160,7 @@ lemma series_zero: "(\m. n \ m --> f(m) = 0) ==> f sums (setsum f {0.. (%n. setsum f {n*k.. f ----> 0" apply (drule summable_convergent_sumr_iff [THEN iffD1]) apply (drule convergent_Cauchy) -apply (simp only: Cauchy_def LIMSEQ_def, safe) +apply (simp only: Cauchy_iff LIMSEQ_iff, safe) apply (drule_tac x="r" in spec, safe) apply (rule_tac x="M" in exI, safe) apply (drule_tac x="Suc n" in spec, simp) @@ -371,7 +371,7 @@ lemma summable_Cauchy: "summable (f::nat \ 'a::banach) = (\e > 0. \N. \m \ N. \n. norm (setsum f {m.. (Binding.qualify false prefix b, Code.add_default_eqn_attrib :: attrs)) spec; - fun simp_attr_binding prefix = (Binding.qualify false prefix (Binding.name "simps"), + fun simp_attr_binding prefix = (Binding.qualify true prefix (Binding.name "simps"), map (Attrib.internal o K) [Simplifier.simp_add, Nitpick_Const_Simp_Thms.add, Quickcheck_RecFun_Simp_Thms.add]); in diff -r 3e900a2acaed -r edf74583715a src/HOL/Transcendental.thy --- a/src/HOL/Transcendental.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Transcendental.thy Tue Jun 02 10:04:03 2009 +0200 @@ -438,7 +438,7 @@ assumes k: "0 < (k::real)" assumes le: "\h. \h \ 0; norm h < k\ \ norm (f h) \ K * norm h" shows "f -- 0 --> 0" -unfolding LIM_def diff_0_right +unfolding LIM_eq diff_0_right proof (safe) let ?h = "of_real (k / 2)::'a" have "?h \ 0" and "norm ?h < k" using k by simp_all @@ -2145,7 +2145,7 @@ lemma lemma_tan_total: "0 < y ==> \x. 0 < x & x < pi/2 & y < tan x" apply (cut_tac LIM_cos_div_sin) -apply (simp only: LIM_def) +apply (simp only: LIM_eq) apply (drule_tac x = "inverse y" in spec, safe, force) apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero], safe) apply (rule_tac x = "(pi/2) - e" in exI) diff -r 3e900a2acaed -r edf74583715a src/HOL/Transitive_Closure.thy --- a/src/HOL/Transitive_Closure.thy Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/Transitive_Closure.thy Tue Jun 02 10:04:03 2009 +0200 @@ -698,6 +698,9 @@ apply (cut_tac n=nat and R=R in rel_pow_Suc_D2', simp, blast) done +lemma rel_pow_add: "R ^^ (m+n) = R^^n O R^^m" +by(induct n) auto + lemma rtrancl_imp_UN_rel_pow: assumes "p \ R^*" shows "p \ (\n. R ^^ n)" diff -r 3e900a2acaed -r edf74583715a src/HOL/ex/predicate_compile.ML --- a/src/HOL/ex/predicate_compile.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/HOL/ex/predicate_compile.ML Tue Jun 02 10:04:03 2009 +0200 @@ -31,6 +31,8 @@ (* debug stuff *) +fun makestring _ = "?"; (* FIXME dummy *) + fun tracing s = (if ! Toplevel.debug then Output.tracing s else ()); fun print_tac s = (if ! Toplevel.debug then Tactical.print_tac s else Seq.single); diff -r 3e900a2acaed -r edf74583715a src/Pure/IsaMakefile --- a/src/Pure/IsaMakefile Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/IsaMakefile Tue Jun 02 10:04:03 2009 +0200 @@ -19,16 +19,15 @@ ## Pure -BOOTSTRAP_FILES = ML-Systems/exn.ML ML-Systems/ml_name_space.ML \ +BOOTSTRAP_FILES = ML-Systems/compiler_polyml-5.0.ML \ + ML-Systems/compiler_polyml-5.2.ML ML-Systems/compiler_polyml-5.3.ML \ + ML-Systems/exn.ML ML-Systems/ml_name_space.ML \ ML-Systems/ml_pretty.ML ML-Systems/mosml.ML \ ML-Systems/multithreading.ML ML-Systems/multithreading_polyml.ML \ - ML-Systems/overloading_smlnj.ML ML-Systems/polyml-4.1.3.ML \ - ML-Systems/polyml-4.1.4.ML ML-Systems/polyml-4.2.0.ML \ - ML-Systems/polyml-5.0.ML ML-Systems/polyml-5.1.ML \ - ML-Systems/polyml-experimental.ML ML-Systems/polyml.ML \ - ML-Systems/polyml_common.ML ML-Systems/polyml_old_compiler4.ML \ - ML-Systems/polyml_old_compiler5.ML ML-Systems/polyml_pp.ML \ - ML-Systems/proper_int.ML ML-Systems/smlnj.ML \ + ML-Systems/overloading_smlnj.ML ML-Systems/polyml-5.0.ML \ + ML-Systems/polyml-5.1.ML ML-Systems/polyml-experimental.ML \ + ML-Systems/polyml.ML ML-Systems/polyml_common.ML \ + ML-Systems/pp_polyml.ML ML-Systems/proper_int.ML ML-Systems/smlnj.ML \ ML-Systems/system_shell.ML ML-Systems/thread_dummy.ML \ ML-Systems/time_limit.ML ML-Systems/universal.ML diff -r 3e900a2acaed -r edf74583715a src/Pure/Isar/attrib.ML --- a/src/Pure/Isar/attrib.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/Isar/attrib.ML Tue Jun 02 10:04:03 2009 +0200 @@ -26,14 +26,10 @@ (('c * 'a list) * ('b * 'a list) list) list -> (('c * 'att list) * ('fact * 'att list) list) list val crude_closure: Proof.context -> src -> src - val add_attributes: (bstring * (src -> attribute) * string) list -> theory -> theory - val syntax: attribute context_parser -> src -> attribute val setup: Binding.binding -> attribute context_parser -> string -> theory -> theory val attribute_setup: bstring * Position.T -> Symbol_Pos.text * Position.T -> string -> theory -> theory - val no_args: attribute -> src -> attribute val add_del: attribute -> attribute -> attribute context_parser - val add_del_args: attribute -> attribute -> src -> attribute val thm_sel: Facts.interval list parser val thm: thm context_parser val thms: thm list context_parser @@ -89,6 +85,10 @@ |> Pretty.chunks |> Pretty.writeln end; +fun add_attribute name att comment thy = thy |> Attributes.map (fn atts => + #2 (NameSpace.define (Sign.naming_of thy) (name, ((att, comment), stamp ())) atts) + handle Symtab.DUP dup => error ("Duplicate declaration of attribute " ^ quote dup)); + (* name space *) @@ -149,24 +149,13 @@ Args.closure src); -(* add_attributes *) - -fun add_attributes raw_attrs thy = - let - val new_attrs = - raw_attrs |> map (fn (name, att, comment) => (Binding.name name, ((att, comment), stamp ()))); - fun add attrs = fold (snd oo NameSpace.define (Sign.naming_of thy)) new_attrs attrs - handle Symtab.DUP dup => error ("Duplicate declaration of attributes " ^ quote dup); - in Attributes.map add thy end; - - (* attribute setup *) -fun syntax scan src (context, th) = - let val (f: attribute, context') = Args.syntax "attribute" scan src context - in f (context', th) end; +fun syntax scan = Args.syntax "attribute" scan; -fun setup name scan comment = add_attributes [(Binding.name_of name, syntax scan, comment)]; +fun setup name scan = + add_attribute name + (fn src => fn (ctxt, th) => let val (a, ctxt') = syntax scan src ctxt in a (ctxt', th) end); fun attribute_setup name (txt, pos) cmt = Context.theory_map (ML_Context.expression pos @@ -175,12 +164,9 @@ ("(" ^ ML_Syntax.make_binding name ^ ", " ^ txt ^ ", " ^ ML_Syntax.print_string cmt ^ ")")); -(* basic syntax *) +(* add/del syntax *) -fun no_args x = syntax (Scan.succeed x); - -fun add_del add del = (Scan.lift (Args.add >> K add || Args.del >> K del || Scan.succeed add)); -fun add_del_args add del = syntax (add_del add del); +fun add_del add del = Scan.lift (Args.add >> K add || Args.del >> K del || Scan.succeed add); @@ -237,113 +223,100 @@ fun internal att = Args.src (("Pure.attribute", [T.mk_attribute att]), Position.none); -val internal_att = - syntax (Scan.lift Args.internal_attribute >> Morphism.form); - - -(* tags *) - -val tagged = syntax (Scan.lift (Args.name -- Args.name) >> Thm.tag); -val untagged = syntax (Scan.lift Args.name >> Thm.untag); - -val kind = syntax (Scan.lift Args.name >> Thm.kind); - (* rule composition *) val COMP_att = - syntax (Scan.lift (Scan.optional (Args.bracks P.nat) 1) -- thm - >> (fn (i, B) => Thm.rule_attribute (fn _ => fn A => Drule.compose_single (A, i, B)))); + Scan.lift (Scan.optional (Args.bracks P.nat) 1) -- thm + >> (fn (i, B) => Thm.rule_attribute (fn _ => fn A => Drule.compose_single (A, i, B))); val THEN_att = - syntax (Scan.lift (Scan.optional (Args.bracks P.nat) 1) -- thm - >> (fn (i, B) => Thm.rule_attribute (fn _ => fn A => A RSN (i, B)))); + Scan.lift (Scan.optional (Args.bracks P.nat) 1) -- thm + >> (fn (i, B) => Thm.rule_attribute (fn _ => fn A => A RSN (i, B))); val OF_att = - syntax (thms >> (fn Bs => Thm.rule_attribute (fn _ => fn A => Bs MRS A))); + thms >> (fn Bs => Thm.rule_attribute (fn _ => fn A => Bs MRS A)); (* rename_abs *) -val rename_abs = syntax - (Scan.lift (Scan.repeat (Args.maybe Args.name) >> (apsnd o Drule.rename_bvars'))); +val rename_abs : (Context.generic * thm -> Context.generic * thm) parser = + Scan.repeat (Args.maybe Args.name) >> (apsnd o Drule.rename_bvars'); (* unfold / fold definitions *) fun unfolded_syntax rule = - syntax (thms >> - (fn ths => Thm.rule_attribute (fn context => rule (Context.proof_of context) ths))); + thms >> (fn ths => Thm.rule_attribute (fn context => rule (Context.proof_of context) ths)); val unfolded = unfolded_syntax LocalDefs.unfold; val folded = unfolded_syntax LocalDefs.fold; -(* rule cases *) - -val consumes = syntax (Scan.lift (Scan.optional P.nat 1) >> RuleCases.consumes); -val case_names = syntax (Scan.lift (Scan.repeat1 Args.name) >> RuleCases.case_names); -val case_conclusion = - syntax (Scan.lift (Args.name -- Scan.repeat Args.name) >> RuleCases.case_conclusion); -val params = syntax (Scan.lift (P.and_list1 (Scan.repeat Args.name)) >> RuleCases.params); - - (* rule format *) -val rule_format = syntax (Args.mode "no_asm" - >> (fn true => ObjectLogic.rule_format_no_asm | false => ObjectLogic.rule_format)); +val rule_format = Args.mode "no_asm" + >> (fn true => ObjectLogic.rule_format_no_asm | false => ObjectLogic.rule_format); -val elim_format = no_args (Thm.rule_attribute (K Tactic.make_elim)); +val elim_format = Thm.rule_attribute (K Tactic.make_elim); (* misc rules *) -val standard = no_args (Thm.rule_attribute (K Drule.standard)); - -val no_vars = no_args (Thm.rule_attribute (fn context => fn th => +val no_vars = Thm.rule_attribute (fn context => fn th => let val ctxt = Variable.set_body false (Context.proof_of context); val ((_, [th']), _) = Variable.import_thms true [th] ctxt; - in th' end)); + in th' end); val eta_long = - no_args (Thm.rule_attribute (K (Conv.fconv_rule Drule.eta_long_conversion))); + Thm.rule_attribute (K (Conv.fconv_rule Drule.eta_long_conversion)); -val rotated = syntax - (Scan.lift (Scan.optional P.int 1) >> (fn n => Thm.rule_attribute (K (rotate_prems n)))); - -val abs_def = no_args (Thm.rule_attribute (K Drule.abs_def)); +val rotated = Scan.optional P.int 1 >> (fn n => Thm.rule_attribute (K (rotate_prems n))); (* theory setup *) val _ = Context.>> (Context.map_theory - (add_attributes - [("attribute", internal_att, "internal attribute"), - ("tagged", tagged, "tagged theorem"), - ("untagged", untagged, "untagged theorem"), - ("kind", kind, "theorem kind"), - ("COMP", COMP_att, "direct composition with rules (no lifting)"), - ("THEN", THEN_att, "resolution with rule"), - ("OF", OF_att, "rule applied to facts"), - ("rename_abs", rename_abs, "rename bound variables in abstractions"), - ("unfolded", unfolded, "unfolded definitions"), - ("folded", folded, "folded definitions"), - ("standard", standard, "result put into standard form"), - ("elim_format", elim_format, "destruct rule turned into elimination rule format"), - ("no_vars", no_vars, "frozen schematic vars"), - ("eta_long", eta_long, "put theorem into eta long beta normal form"), - ("consumes", consumes, "number of consumed facts"), - ("case_names", case_names, "named rule cases"), - ("case_conclusion", case_conclusion, "named conclusion of rule cases"), - ("params", params, "named rule parameters"), - ("atomize", no_args ObjectLogic.declare_atomize, "declaration of atomize rule"), - ("rulify", no_args ObjectLogic.declare_rulify, "declaration of rulify rule"), - ("rule_format", rule_format, "result put into standard rule format"), - ("rotated", rotated, "rotated theorem premises"), - ("defn", add_del_args LocalDefs.defn_add LocalDefs.defn_del, - "declaration of definitional transformations"), - ("abs_def", abs_def, "abstract over free variables of a definition")])); + (setup (Binding.name "attribute") (Scan.lift Args.internal_attribute >> Morphism.form) + "internal attribute" #> + setup (Binding.name "tagged") (Scan.lift (Args.name -- Args.name) >> Thm.tag) "tagged theorem" #> + setup (Binding.name "untagged") (Scan.lift Args.name >> Thm.untag) "untagged theorem" #> + setup (Binding.name "kind") (Scan.lift Args.name >> Thm.kind) "theorem kind" #> + setup (Binding.name "COMP") COMP_att "direct composition with rules (no lifting)" #> + setup (Binding.name "THEN") THEN_att "resolution with rule" #> + setup (Binding.name "OF") OF_att "rule applied to facts" #> + setup (Binding.name "rename_abs") (Scan.lift rename_abs) + "rename bound variables in abstractions" #> + setup (Binding.name "unfolded") unfolded "unfolded definitions" #> + setup (Binding.name "folded") folded "folded definitions" #> + setup (Binding.name "consumes") (Scan.lift (Scan.optional P.nat 1) >> RuleCases.consumes) + "number of consumed facts" #> + setup (Binding.name "case_names") (Scan.lift (Scan.repeat1 Args.name) >> RuleCases.case_names) + "named rule cases" #> + setup (Binding.name "case_conclusion") + (Scan.lift (Args.name -- Scan.repeat Args.name) >> RuleCases.case_conclusion) + "named conclusion of rule cases" #> + setup (Binding.name "params") + (Scan.lift (P.and_list1 (Scan.repeat Args.name)) >> RuleCases.params) + "named rule parameters" #> + setup (Binding.name "standard") (Scan.succeed (Thm.rule_attribute (K Drule.standard))) + "result put into standard form (legacy)" #> + setup (Binding.name "rule_format") rule_format "result put into canonical rule format" #> + setup (Binding.name "elim_format") (Scan.succeed elim_format) + "destruct rule turned into elimination rule format" #> + setup (Binding.name "no_vars") (Scan.succeed no_vars) "frozen schematic vars" #> + setup (Binding.name "eta_long") (Scan.succeed eta_long) + "put theorem into eta long beta normal form" #> + setup (Binding.name "atomize") (Scan.succeed ObjectLogic.declare_atomize) + "declaration of atomize rule" #> + setup (Binding.name "rulify") (Scan.succeed ObjectLogic.declare_rulify) + "declaration of rulify rule" #> + setup (Binding.name "rotated") (Scan.lift rotated) "rotated theorem premises" #> + setup (Binding.name "defn") (add_del LocalDefs.defn_add LocalDefs.defn_del) + "declaration of definitional transformations" #> + setup (Binding.name "abs_def") (Scan.succeed (Thm.rule_attribute (K Drule.abs_def))) + "abstract over free variables of a definition")); @@ -397,8 +370,8 @@ val name = Sign.full_bname thy bname; in thy - |> add_attributes [(bname, syntax (Scan.lift (scan_config thy config) >> Morphism.form), - "configuration option")] + |> setup (Binding.name bname) (Scan.lift (scan_config thy config) >> Morphism.form) + "configuration option" |> Configs.map (Symtab.update (name, config)) end; diff -r 3e900a2acaed -r edf74583715a src/Pure/Isar/method.ML --- a/src/Pure/Isar/method.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/Isar/method.ML Tue Jun 02 10:04:03 2009 +0200 @@ -75,30 +75,13 @@ val defined: theory -> string -> bool val method: theory -> src -> Proof.context -> method val method_i: theory -> src -> Proof.context -> method - val add_methods: (bstring * (src -> Proof.context -> method) * string) list - -> theory -> theory - val add_method: bstring * (src -> Proof.context -> method) * string - -> theory -> theory val syntax: 'a context_parser -> src -> Proof.context -> 'a * Proof.context val setup: binding -> (Proof.context -> method) context_parser -> string -> theory -> theory val method_setup: bstring * Position.T -> Symbol_Pos.text * Position.T -> string -> theory -> theory - val simple_args: 'a parser -> ('a -> Proof.context -> method) -> src -> Proof.context -> method - val ctxt_args: (Proof.context -> method) -> src -> Proof.context -> method type modifier = (Proof.context -> Proof.context) * attribute val section: modifier parser list -> thm list context_parser val sections: modifier parser list -> thm list list context_parser - val sectioned_args: 'a context_parser -> modifier parser list -> - ('a -> Proof.context -> 'b) -> src -> Proof.context -> 'b - val bang_sectioned_args: modifier parser list -> - (thm list -> Proof.context -> 'a) -> src -> Proof.context -> 'a - val bang_sectioned_args': modifier parser list -> 'a context_parser -> - ('a -> thm list -> Proof.context -> 'b) -> src -> Proof.context -> 'b - val only_sectioned_args: modifier parser list -> (Proof.context -> 'a) -> src -> - Proof.context -> 'a - val thms_ctxt_args: (thm list -> Proof.context -> 'a) -> src -> Proof.context -> 'a - val thms_args: (thm list -> 'a) -> src -> Proof.context -> 'a - val thm_args: (thm -> 'a) -> src -> Proof.context -> 'a val parse: text parser end; @@ -356,6 +339,10 @@ |> Pretty.chunks |> Pretty.writeln end; +fun add_method name meth comment thy = thy |> Methods.map (fn meths => + #2 (NameSpace.define (Sign.naming_of thy) (name, ((meth, comment), stamp ())) meths) + handle Symtab.DUP dup => error ("Duplicate declaration of method " ^ quote dup)); + (* get methods *) @@ -376,27 +363,13 @@ fun method thy = method_i thy o Args.map_name (NameSpace.intern (#1 (Methods.get thy))); -(* add method *) - -fun add_methods raw_meths thy = - let - val new_meths = raw_meths |> map (fn (name, f, comment) => - (Binding.name name, ((f, comment), stamp ()))); - - fun add meths = fold (snd oo NameSpace.define (Sign.naming_of thy)) new_meths meths - handle Symtab.DUP dup => error ("Duplicate declaration of method " ^ quote dup); - in Methods.map add thy end; - -val add_method = add_methods o Library.single; - - (* method setup *) fun syntax scan = Args.context_syntax "method" scan; -fun setup name scan comment = - add_methods [(Binding.name_of name, - fn src => fn ctxt => let val (m, ctxt') = syntax scan src ctxt in m ctxt' end, comment)]; +fun setup name scan = + add_method name + (fn src => fn ctxt => let val (m, ctxt') = syntax scan src ctxt in m ctxt' end); fun method_setup name (txt, pos) cmt = Context.theory_map (ML_Context.expression pos @@ -411,15 +384,6 @@ structure P = OuterParse; -(* basic *) - -fun simple_args scan f src ctxt : method = - fst (syntax (Scan.lift (scan >> (fn x => f x ctxt))) src ctxt); - -fun ctxt_args (f: Proof.context -> method) src ctxt = - fst (syntax (Scan.succeed (f ctxt)) src ctxt); - - (* sections *) type modifier = (Proof.context -> Proof.context) * attribute; @@ -436,19 +400,6 @@ fun sections ss = Scan.repeat (section ss); -fun sectioned_args args ss f src ctxt = - let val ((x, _), ctxt') = syntax (args -- sections ss) src ctxt - in f x ctxt' end; - -fun bang_sectioned_args ss f = sectioned_args Args.bang_facts ss f; -fun bang_sectioned_args' ss scan f = - sectioned_args (Args.bang_facts -- scan >> swap) ss (uncurry f); -fun only_sectioned_args ss f = sectioned_args (Scan.succeed ()) ss (fn () => f); - -fun thms_ctxt_args f = sectioned_args (thms []) [] f; -fun thms_args f = thms_ctxt_args (K o f); -fun thm_args f = thms_args (fn [thm] => f thm | _ => error "Single theorem expected"); - end; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/compiler_polyml-5.0.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Pure/ML-Systems/compiler_polyml-5.0.ML Tue Jun 02 10:04:03 2009 +0200 @@ -0,0 +1,32 @@ +(* Title: Pure/ML-Systems/compiler_polyml-5.0.ML + +Runtime compilation -- for PolyML.compilerEx in version 5.0 and 5.1. +*) + +fun use_text ({tune_source, print, error, ...}: use_context) (line, name) verbose txt = + let + val in_buffer = ref (explode (tune_source txt)); + val out_buffer = ref ([]: string list); + fun output () = implode (rev (case ! out_buffer of "\n" :: cs => cs | cs => cs)); + + val current_line = ref line; + fun get () = + (case ! in_buffer of + [] => "" + | c :: cs => (in_buffer := cs; if c = "\n" then current_line := ! current_line + 1 else (); c)); + fun put s = out_buffer := s :: ! out_buffer; + + fun exec () = + (case ! in_buffer of + [] => () + | _ => (PolyML.compilerEx (get, put, fn () => ! current_line, name) (); exec ())); + in + exec () handle exn => (error (output ()); raise exn); + if verbose then print (output ()) else () + end; + +fun use_file context verbose name = + let + val instream = TextIO.openIn name; + val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); + in use_text context (1, name) verbose txt end; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/compiler_polyml-5.2.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Pure/ML-Systems/compiler_polyml-5.2.ML Tue Jun 02 10:04:03 2009 +0200 @@ -0,0 +1,51 @@ +(* Title: Pure/ML-Systems/compiler_polyml-5.2.ML + +Runtime compilation for Poly/ML 5.2 and 5.2.1. +*) + +local + +fun drop_newline s = + if String.isSuffix "\n" s then String.substring (s, 0, size s - 1) + else s; + +in + +fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context) + (start_line, name) verbose txt = + let + val current_line = ref start_line; + val in_buffer = ref (String.explode (tune_source txt)); + val out_buffer = ref ([]: string list); + fun output () = drop_newline (implode (rev (! out_buffer))); + + fun get () = + (case ! in_buffer of + [] => NONE + | c :: cs => + (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c)); + fun put s = out_buffer := s :: ! out_buffer; + fun message (msg, is_err, line) = + (if is_err then "Error: " else "Warning: ") ^ drop_newline msg ^ str_of_pos line name ^ "\n"; + + val parameters = + [PolyML.Compiler.CPOutStream put, + PolyML.Compiler.CPLineNo (fn () => ! current_line), + PolyML.Compiler.CPErrorMessageProc (put o message), + PolyML.Compiler.CPNameSpace name_space]; + val _ = + (while not (List.null (! in_buffer)) do + PolyML.compiler (get, parameters) ()) + handle exn => + (put ("Exception- " ^ General.exnMessage exn ^ " raised"); + error (output ()); raise exn); + in if verbose then print (output ()) else () end; + +fun use_file context verbose name = + let + val instream = TextIO.openIn name; + val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); + in use_text context (1, name) verbose txt end; + +end; + diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/compiler_polyml-5.3.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Pure/ML-Systems/compiler_polyml-5.3.ML Tue Jun 02 10:04:03 2009 +0200 @@ -0,0 +1,55 @@ +(* Title: Pure/ML-Systems/compiler_polyml-5.3.ML + +Runtime compilation for Poly/ML 5.3 (SVN experimental). +*) + +local + +fun drop_newline s = + if String.isSuffix "\n" s then String.substring (s, 0, size s - 1) + else s; + +in + +fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context) + (start_line, name) verbose txt = + let + val current_line = ref start_line; + val in_buffer = ref (String.explode (tune_source txt)); + val out_buffer = ref ([]: string list); + fun output () = drop_newline (implode (rev (! out_buffer))); + + fun get () = + (case ! in_buffer of + [] => NONE + | c :: cs => + (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c)); + fun put s = out_buffer := s :: ! out_buffer; + fun put_message {message = msg1, hard, location = {startLine = line, ...}, context} = + (put (if hard then "Error: " else "Warning: "); + PolyML.prettyPrint (put, 76) msg1; + (case context of NONE => () | SOME msg2 => PolyML.prettyPrint (put, 76) msg2); + put ("At" ^ str_of_pos line name ^ "\n")); + + val parameters = + [PolyML.Compiler.CPOutStream put, + PolyML.Compiler.CPLineNo (fn () => ! current_line), + PolyML.Compiler.CPErrorMessageProc put_message, + PolyML.Compiler.CPNameSpace name_space, + PolyML.Compiler.CPPrintInAlphabeticalOrder false]; + val _ = + (while not (List.null (! in_buffer)) do + PolyML.compiler (get, parameters) ()) + handle exn => + (put ("Exception- " ^ General.exnMessage exn ^ " raised"); + error (output ()); raise exn); + in if verbose then print (output ()) else () end; + +fun use_file context verbose name = + let + val instream = TextIO.openIn name; + val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); + in use_text context (1, name) verbose txt end; + +end; + diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/install_pp_polyml-experimental.ML --- a/src/Pure/ML-Systems/install_pp_polyml-experimental.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/install_pp_polyml-experimental.ML Tue Jun 02 10:04:03 2009 +0200 @@ -1,18 +1,17 @@ (* Title: Pure/ML-Systems/install_pp_polyml-experimental.ML -Extra toplevel pretty-printing for Poly/ML; experimental version for -Poly/ML 5.3. +Extra toplevel pretty-printing for Poly/ML 5.3 (SVN experimental). *) -addPrettyPrinter (fn depth => fn pretty => fn x => +PolyML.addPrettyPrinter (fn depth => fn pretty => fn x => (case Future.peek x of - NONE => PrettyString "" - | SOME (Exn.Exn _) => PrettyString "" + NONE => PolyML.PrettyString "" + | SOME (Exn.Exn _) => PolyML.PrettyString "" | SOME (Exn.Result y) => pretty (y, depth))); -addPrettyPrinter (fn depth => fn pretty => fn x => +PolyML.addPrettyPrinter (fn depth => fn pretty => fn x => (case Lazy.peek x of - NONE => PrettyString "" - | SOME (Exn.Exn _) => PrettyString "" + NONE => PolyML.PrettyString "" + | SOME (Exn.Exn _) => PolyML.PrettyString "" | SOME (Exn.Result y) => pretty (y, depth))); diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/install_pp_polyml.ML --- a/src/Pure/ML-Systems/install_pp_polyml.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/install_pp_polyml.ML Tue Jun 02 10:04:03 2009 +0200 @@ -3,15 +3,17 @@ Extra toplevel pretty-printing for Poly/ML. *) -install_pp (fn (str, _, _, _) => fn depth => fn (print: 'a * int -> unit) => fn (x: 'a future) => - (case Future.peek x of - NONE => str "" - | SOME (Exn.Exn _) => str "" - | SOME (Exn.Result y) => print (y, depth))); +PolyML.install_pp + (fn (str, _, _, _) => fn depth => fn (print: 'a * int -> unit) => fn (x: 'a future) => + (case Future.peek x of + NONE => str "" + | SOME (Exn.Exn _) => str "" + | SOME (Exn.Result y) => print (y, depth))); -install_pp (fn (str, _, _, _) => fn depth => fn (print: 'a * int -> unit) => fn (x: 'a lazy) => - (case Lazy.peek x of - NONE => str "" - | SOME (Exn.Exn _) => str "" - | SOME (Exn.Result y) => print (y, depth))); +PolyML.install_pp + (fn (str, _, _, _) => fn depth => fn (print: 'a * int -> unit) => fn (x: 'a lazy) => + (case Lazy.peek x of + NONE => str "" + | SOME (Exn.Exn _) => str "" + | SOME (Exn.Result y) => print (y, depth))); diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/mosml.ML --- a/src/Pure/ML-Systems/mosml.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/mosml.ML Tue Jun 02 10:04:03 2009 +0200 @@ -132,8 +132,6 @@ (*dummy implementation*) fun exception_trace f = f (); -(*dummy implementation*) -fun print x = x; (** Compiler-independent timing functions **) diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/multithreading_polyml.ML --- a/src/Pure/ML-Systems/multithreading_polyml.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/multithreading_polyml.ML Tue Jun 02 10:04:03 2009 +0200 @@ -1,7 +1,7 @@ (* Title: Pure/ML-Systems/multithreading_polyml.ML Author: Makarius -Multithreading in Poly/ML 5.2 or later (cf. polyml/basis/Thread.sml). +Multithreading in Poly/ML 5.2.1 or later (cf. polyml/basis/Thread.sml). *) signature MULTITHREADING_POLYML = diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml-4.1.3.ML --- a/src/Pure/ML-Systems/polyml-4.1.3.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -(* Title: Pure/ML-Systems/polyml-4.1.3.ML - -Compatibility wrapper for Poly/ML 4.1.3. -*) - -use "ML-Systems/polyml_old_basis.ML"; -use "ML-Systems/universal.ML"; -use "ML-Systems/thread_dummy.ML"; -use "ML-Systems/ml_name_space.ML"; -use "ML-Systems/polyml_common.ML"; -use "ML-Systems/polyml_old_compiler4.ML"; -use "ML-Systems/polyml_pp.ML"; - -val pointer_eq = Address.wordEq; - diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml-4.1.4.ML --- a/src/Pure/ML-Systems/polyml-4.1.4.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -(* Title: Pure/ML-Systems/polyml-4.1.4.ML - -Compatibility wrapper for Poly/ML 4.1.4. -*) - -use "ML-Systems/polyml_old_basis.ML"; -use "ML-Systems/universal.ML"; -use "ML-Systems/thread_dummy.ML"; -use "ML-Systems/ml_name_space.ML"; -use "ML-Systems/polyml_common.ML"; -use "ML-Systems/polyml_old_compiler4.ML"; -use "ML-Systems/polyml_pp.ML"; - -val pointer_eq = Address.wordEq; - diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml-4.2.0.ML --- a/src/Pure/ML-Systems/polyml-4.2.0.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -(* Title: Pure/ML-Systems/polyml-4.2.0.ML - -Compatibility wrapper for Poly/ML 4.2.0. -*) - -use "ML-Systems/universal.ML"; -use "ML-Systems/thread_dummy.ML"; -use "ML-Systems/ml_name_space.ML"; -use "ML-Systems/polyml_common.ML"; -use "ML-Systems/polyml_old_compiler4.ML"; -use "ML-Systems/polyml_pp.ML"; - -val pointer_eq = Address.wordEq; - diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml-5.0.ML --- a/src/Pure/ML-Systems/polyml-5.0.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/polyml-5.0.ML Tue Jun 02 10:04:03 2009 +0200 @@ -7,8 +7,8 @@ use "ML-Systems/thread_dummy.ML"; use "ML-Systems/ml_name_space.ML"; use "ML-Systems/polyml_common.ML"; -use "ML-Systems/polyml_old_compiler5.ML"; -use "ML-Systems/polyml_pp.ML"; +use "ML-Systems/compiler_polyml-5.0.ML"; +use "ML-Systems/pp_polyml.ML"; val pointer_eq = PolyML.pointerEq; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml-5.1.ML --- a/src/Pure/ML-Systems/polyml-5.1.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/polyml-5.1.ML Tue Jun 02 10:04:03 2009 +0200 @@ -6,8 +6,8 @@ use "ML-Systems/thread_dummy.ML"; use "ML-Systems/ml_name_space.ML"; use "ML-Systems/polyml_common.ML"; -use "ML-Systems/polyml_old_compiler5.ML"; -use "ML-Systems/polyml_pp.ML"; +use "ML-Systems/compiler_polyml-5.0.ML"; +use "ML-Systems/pp_polyml.ML"; val pointer_eq = PolyML.pointerEq; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml-experimental.ML --- a/src/Pure/ML-Systems/polyml-experimental.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/polyml-experimental.ML Tue Jun 02 10:04:03 2009 +0200 @@ -1,6 +1,6 @@ -(* Title: Pure/ML-Systems/polyml.ML +(* Title: Pure/ML-Systems/polyml-experimental.ML -Compatibility wrapper for experimental versions of Poly/ML after 5.2.1. +Compatibility wrapper for Poly/ML 5.3 (SVN experimental). *) open Thread; @@ -19,92 +19,42 @@ fun share_common_data () = PolyML.shareCommonData PolyML.rootFunction; - -(* runtime compilation *) - -local - -fun drop_newline s = - if String.isSuffix "\n" s then String.substring (s, 0, size s - 1) - else s; - -in - -fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context) - (start_line, name) verbose txt = - let - val current_line = ref start_line; - val in_buffer = ref (String.explode (tune_source txt)); - val out_buffer = ref ([]: string list); - fun output () = drop_newline (implode (rev (! out_buffer))); - - fun get () = - (case ! in_buffer of - [] => NONE - | c :: cs => - (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c)); - fun put s = out_buffer := s :: ! out_buffer; - fun put_message {message = msg1, hard, location = {startLine = line, ...}, context} = - (put (if hard then "Error: " else "Warning: "); - PolyML.prettyPrint (put, 76) msg1; - (case context of NONE => () | SOME msg2 => PolyML.prettyPrint (put, 76) msg2); - put ("At" ^ str_of_pos line name ^ "\n")); - - val parameters = - [PolyML.Compiler.CPOutStream put, - PolyML.Compiler.CPLineNo (fn () => ! current_line), - PolyML.Compiler.CPErrorMessageProc put_message, - PolyML.Compiler.CPNameSpace name_space, - PolyML.Compiler.CPPrintInAlphabeticalOrder false]; - val _ = - (while not (List.null (! in_buffer)) do - PolyML.compiler (get, parameters) ()) - handle exn => - (put ("Exception- " ^ General.exnMessage exn ^ " raised"); - error (output ()); raise exn); - in if verbose then print (output ()) else () end; - -fun use_file context verbose name = - let - val instream = TextIO.openIn name; - val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); - in use_text context (1, name) verbose txt end; - -end; +use "ML-Systems/compiler_polyml-5.3.ML"; (* toplevel pretty printing *) val pretty_ml = let - fun convert len (PrettyBlock (ind, _, context, prts)) = + fun convert len (PolyML.PrettyBlock (ind, _, context, prts)) = let fun property name default = - (case List.find (fn ContextProperty (a, _) => name = a | _ => false) context of - SOME (ContextProperty (_, b)) => b + (case List.find (fn PolyML.ContextProperty (a, _) => name = a | _ => false) context of + SOME (PolyML.ContextProperty (_, b)) => b | NONE => default); val bg = property "begin" ""; val en = property "end" ""; val len' = property "length" len; in ML_Pretty.Block ((bg, en), map (convert len') prts, ind) end - | convert len (PrettyString s) = + | convert len (PolyML.PrettyString s) = ML_Pretty.String (s, case Int.fromString len of SOME i => i | NONE => size s) - | convert _ (PrettyBreak (wd, _)) = + | convert _ (PolyML.PrettyBreak (wd, _)) = ML_Pretty.Break (if wd < 99999 then (false, wd) else (true, 2)); in convert "" end; fun ml_pretty (ML_Pretty.Block ((bg, en), prts, ind)) = let val context = - (if bg = "" then [] else [ContextProperty ("begin", bg)]) @ - (if en = "" then [] else [ContextProperty ("end", en)]) - in PrettyBlock (ind, false, context, map ml_pretty prts) end + (if bg = "" then [] else [PolyML.ContextProperty ("begin", bg)]) @ + (if en = "" then [] else [PolyML.ContextProperty ("end", en)]) + in PolyML.PrettyBlock (ind, false, context, map ml_pretty prts) end | ml_pretty (ML_Pretty.String (s, len)) = - if len = size s then PrettyString s - else PrettyBlock (0, false, [ContextProperty ("length", Int.toString len)], [PrettyString s]) - | ml_pretty (ML_Pretty.Break (false, wd)) = PrettyBreak (wd, 0) - | ml_pretty (ML_Pretty.Break (true, _)) = PrettyBreak (99999, 0); + if len = size s then PolyML.PrettyString s + else PolyML.PrettyBlock + (0, false, [PolyML.ContextProperty ("length", Int.toString len)], [PolyML.PrettyString s]) + | ml_pretty (ML_Pretty.Break (false, wd)) = PolyML.PrettyBreak (wd, 0) + | ml_pretty (ML_Pretty.Break (true, _)) = PolyML.PrettyBreak (99999, 0); fun toplevel_pp context (_: string list) pp = use_text context (1, "pp") false - ("addPrettyPrinter (fn _ => fn _ => ml_pretty o Pretty.to_ML o (" ^ pp ^ "))"); + ("PolyML.addPrettyPrinter (fn _ => fn _ => ml_pretty o Pretty.to_ML o (" ^ pp ^ "))"); diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml.ML --- a/src/Pure/ML-Systems/polyml.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/polyml.ML Tue Jun 02 10:04:03 2009 +0200 @@ -1,6 +1,6 @@ (* Title: Pure/ML-Systems/polyml.ML -Compatibility wrapper for Poly/ML 5.2 or later. +Compatibility wrapper for Poly/ML 5.2 and 5.2.1. *) open Thread; @@ -22,54 +22,6 @@ fun share_common_data () = PolyML.shareCommonData PolyML.rootFunction; - -(* runtime compilation *) - -local - -fun drop_newline s = - if String.isSuffix "\n" s then String.substring (s, 0, size s - 1) - else s; - -in - -fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context) - (start_line, name) verbose txt = - let - val current_line = ref start_line; - val in_buffer = ref (String.explode (tune_source txt)); - val out_buffer = ref ([]: string list); - fun output () = drop_newline (implode (rev (! out_buffer))); +use "ML-Systems/compiler_polyml-5.2.ML"; +use "ML-Systems/pp_polyml.ML"; - fun get () = - (case ! in_buffer of - [] => NONE - | c :: cs => - (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c)); - fun put s = out_buffer := s :: ! out_buffer; - fun message (msg, is_err, line) = - (if is_err then "Error: " else "Warning: ") ^ drop_newline msg ^ str_of_pos line name ^ "\n"; - - val parameters = - [PolyML.Compiler.CPOutStream put, - PolyML.Compiler.CPLineNo (fn () => ! current_line), - PolyML.Compiler.CPErrorMessageProc (put o message), - PolyML.Compiler.CPNameSpace name_space]; - val _ = - (while not (List.null (! in_buffer)) do - PolyML.compiler (get, parameters) ()) - handle exn => - (put ("Exception- " ^ General.exnMessage exn ^ " raised"); - error (output ()); raise exn); - in if verbose then print (output ()) else () end; - -fun use_file context verbose name = - let - val instream = TextIO.openIn name; - val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); - in use_text context (1, name) verbose txt end; - -end; - -use "ML-Systems/polyml_pp.ML"; - diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml_common.ML --- a/src/Pure/ML-Systems/polyml_common.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/polyml_common.ML Tue Jun 02 10:04:03 2009 +0200 @@ -1,6 +1,6 @@ (* Title: Pure/ML-Systems/polyml_common.ML -Compatibility file for Poly/ML -- common part for 4.x and 5.x. +Compatibility file for Poly/ML -- common part for 5.x. *) exception Interrupt = SML90.Interrupt; @@ -28,13 +28,7 @@ (* old Poly/ML emulation *) -local - val orig_exit = exit; -in - open PolyML; - val exit = orig_exit; - fun quit () = exit 0; -end; +fun quit () = exit 0; (* restore old-style character / string functions *) @@ -83,6 +77,8 @@ fun print_depth n = (depth := n; PolyML.print_depth n); end; +val error_depth = PolyML.error_depth; + (** interrupts **) @@ -134,7 +130,12 @@ | SOME txt => txt); -(* profile execution *) + +(** Runtime system **) + +val exception_trace = PolyML.exception_trace; +val timing = PolyML.timing; +val profiling = PolyML.profiling; fun profile 0 f x = f x | profile n f x = diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml_old_basis.ML --- a/src/Pure/ML-Systems/polyml_old_basis.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,29 +0,0 @@ -(* Title: Pure/ML-Systems/polyml_old_basis.ML - -Fixes for the old SML basis library (before Poly/ML 4.2.0). -*) - -structure String = -struct - fun isSuffix s1 s2 = - let val n1 = size s1 and n2 = size s2 - in if n1 = n2 then s1 = s2 else n1 <= n2 andalso String.substring (s2, n2 - n1, n1) = s1 end; - fun isSubstring s1 s2 = - String.isPrefix s1 s2 orelse - size s1 < size s2 andalso isSubstring s1 (String.extract (s2, 1, NONE)); - open String; -end; - -structure Substring = -struct - open Substring; - val full = all; -end; - -structure TextIO = -struct - open TextIO; - fun inputLine is = - let val s = TextIO.inputLine is - in if s = "" then NONE else SOME s end; -end; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml_old_compiler4.ML --- a/src/Pure/ML-Systems/polyml_old_compiler4.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -(* Title: Pure/ML-Systems/polyml_old_compiler4.ML - -Runtime compilation -- for old PolyML.compiler (version 4.x). -*) - -fun use_text ({tune_source, print, error, ...}: use_context) (line: int, name) verbose txt = - let - val in_buffer = ref (explode (tune_source txt)); - val out_buffer = ref ([]: string list); - fun output () = implode (rev (case ! out_buffer of "\n" :: cs => cs | cs => cs)); - - fun get () = - (case ! in_buffer of - [] => "" - | c :: cs => (in_buffer := cs; c)); - fun put s = out_buffer := s :: ! out_buffer; - - fun exec () = - (case ! in_buffer of - [] => () - | _ => (PolyML.compiler (get, put) (); exec ())); - in - exec () handle exn => - (error ((if name = "" then "" else "Error in " ^ name ^ "\n") ^ output ()); raise exn); - if verbose then print (output ()) else () - end; - -fun use_file context verbose name = - let - val instream = TextIO.openIn name; - val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); - in use_text context (1, name) verbose txt end; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml_old_compiler5.ML --- a/src/Pure/ML-Systems/polyml_old_compiler5.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -(* Title: Pure/ML-Systems/polyml_old_compiler5.ML - -Runtime compilation -- for old PolyML.compilerEx (version 5.0, 5.1). -*) - -fun use_text ({tune_source, print, error, ...}: use_context) (line, name) verbose txt = - let - val in_buffer = ref (explode (tune_source txt)); - val out_buffer = ref ([]: string list); - fun output () = implode (rev (case ! out_buffer of "\n" :: cs => cs | cs => cs)); - - val current_line = ref line; - fun get () = - (case ! in_buffer of - [] => "" - | c :: cs => (in_buffer := cs; if c = "\n" then current_line := ! current_line + 1 else (); c)); - fun put s = out_buffer := s :: ! out_buffer; - - fun exec () = - (case ! in_buffer of - [] => () - | _ => (PolyML.compilerEx (get, put, fn () => ! current_line, name) (); exec ())); - in - exec () handle exn => (error (output ()); raise exn); - if verbose then print (output ()) else () - end; - -fun use_file context verbose name = - let - val instream = TextIO.openIn name; - val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); - in use_text context (1, name) verbose txt end; diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/polyml_pp.ML --- a/src/Pure/ML-Systems/polyml_pp.ML Tue Jun 02 10:02:52 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -(* Title: Pure/ML-Systems/polyml_pp.ML - -Toplevel pretty printing for Poly/ML before 5.3. -*) - -fun ml_pprint (print, begin_blk, brk, end_blk) = - let - fun str "" = () - | str s = print s; - fun pprint (ML_Pretty.Block ((bg, en), prts, ind)) = - (str bg; begin_blk (ind, false); List.app pprint prts; end_blk (); str en) - | pprint (ML_Pretty.String (s, _)) = str s - | pprint (ML_Pretty.Break (false, wd)) = brk (wd, 0) - | pprint (ML_Pretty.Break (true, _)) = brk (99999, 0); - in pprint end; - -fun toplevel_pp context (_: string list) pp = - use_text context (1, "pp") false - ("install_pp (fn args => fn _ => fn _ => ml_pprint args o Pretty.to_ML o (" ^ pp ^ "))"); - diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/pp_polyml.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Pure/ML-Systems/pp_polyml.ML Tue Jun 02 10:04:03 2009 +0200 @@ -0,0 +1,20 @@ +(* Title: Pure/ML-Systems/pp_polyml.ML + +Toplevel pretty printing for Poly/ML before 5.3. +*) + +fun ml_pprint (print, begin_blk, brk, end_blk) = + let + fun str "" = () + | str s = print s; + fun pprint (ML_Pretty.Block ((bg, en), prts, ind)) = + (str bg; begin_blk (ind, false); List.app pprint prts; end_blk (); str en) + | pprint (ML_Pretty.String (s, _)) = str s + | pprint (ML_Pretty.Break (false, wd)) = brk (wd, 0) + | pprint (ML_Pretty.Break (true, _)) = brk (99999, 0); + in pprint end; + +fun toplevel_pp context (_: string list) pp = + use_text context (1, "pp") false + ("PolyML.install_pp (fn args => fn _ => fn _ => ml_pprint args o Pretty.to_ML o (" ^ pp ^ "))"); + diff -r 3e900a2acaed -r edf74583715a src/Pure/ML-Systems/smlnj.ML --- a/src/Pure/ML-Systems/smlnj.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML-Systems/smlnj.ML Tue Jun 02 10:04:03 2009 +0200 @@ -92,12 +92,6 @@ (*dummy implementation*) fun exception_trace f = f (); -(*dummy implementation*) -fun print x = x; - -(*dummy implementation*) -fun makestring x = "dummy string for SML New Jersey"; - (* ML command execution *) diff -r 3e900a2acaed -r edf74583715a src/Pure/ML/ml_test.ML --- a/src/Pure/ML/ml_test.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/ML/ml_test.ML Tue Jun 02 10:04:03 2009 +0200 @@ -35,7 +35,7 @@ in (regs, context') end; fun position_of ctxt - ({file, startLine = line, startPosition = i, endPosition = j, ...}: location) = + ({file, startLine = line, startPosition = i, endPosition = j, ...}: PolyML.location) = (case pairself (Inttab.lookup (Extra_Env.get (Context.Proof ctxt))) (i, j) of (SOME pos1, SOME pos2) => Position.encode_range (pos1, pos2) | (SOME pos, NONE) => pos @@ -47,15 +47,15 @@ fun report_parse_tree context depth space = let val pos_of = position_of (Context.proof_of context); - fun report loc (PTtype types) = + fun report loc (PolyML.PTtype types) = PolyML.NameSpace.displayTypeExpression (types, depth, space) |> pretty_ml |> Pretty.from_ML |> Pretty.string_of |> Position.report_text Markup.ML_typing (pos_of loc) - | report loc (PTdeclaredAt decl) = + | report loc (PolyML.PTdeclaredAt decl) = Markup.markup (Markup.properties (Position.properties_of (pos_of decl)) Markup.ML_def) "" |> Position.report_text Markup.ML_ref (pos_of loc) - | report _ (PTnextSibling tree) = report_tree (tree ()) - | report _ (PTfirstChild tree) = report_tree (tree ()) + | report _ (PolyML.PTnextSibling tree) = report_tree (tree ()) + | report _ (PolyML.PTfirstChild tree) = report_tree (tree ()) | report _ _ = () and report_tree (loc, props) = List.app (report loc) props; in report_tree end; diff -r 3e900a2acaed -r edf74583715a src/Pure/meta_simplifier.ML --- a/src/Pure/meta_simplifier.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/meta_simplifier.ML Tue Jun 02 10:04:03 2009 +0200 @@ -158,11 +158,6 @@ Thm.eq_thm_prop (thm1, thm2); -(* congruences *) - -val eq_cong = Thm.eq_thm_prop - - (* simplification sets, procedures, and solvers *) (*A simpset contains data required during conversion: @@ -785,7 +780,7 @@ val prems' = merge Thm.eq_thm_prop (prems1, prems2); val bounds' = if #1 bounds1 < #1 bounds2 then bounds2 else bounds1; val depth' = if #1 depth1 < #1 depth2 then depth2 else depth1; - val congs' = merge (eq_cong o pairself #2) (congs1, congs2); + val congs' = merge (Thm.eq_thm_prop o pairself #2) (congs1, congs2); val weak' = merge (op =) (weak1, weak2); val procs' = Net.merge eq_proc (procs1, procs2); val loop_tacs' = AList.merge (op =) (K true) (loop_tacs1, loop_tacs2); diff -r 3e900a2acaed -r edf74583715a src/Pure/mk --- a/src/Pure/mk Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/mk Tue Jun 02 10:04:03 2009 +0200 @@ -114,7 +114,7 @@ -e "val ml_platform = \"$ML_PLATFORM\";" \ -e "(use\"$COMPAT\"; use\"ROOT.ML\") handle _ => exit 1;" \ -e "ml_prompts \"ML> \" \"ML# \";" \ - -f -c -q -w RAW_ML_SYSTEM Pure > "$LOG" 2>&1 + -f -q -w RAW_ML_SYSTEM Pure > "$LOG" 2>&1 RC="$?" fi diff -r 3e900a2acaed -r edf74583715a src/Pure/simplifier.ML --- a/src/Pure/simplifier.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Pure/simplifier.ML Tue Jun 02 10:04:03 2009 +0200 @@ -348,16 +348,7 @@ -(** proof methods **) - -(* simplification *) - -val simp_options = - (Args.parens (Args.$$$ no_asmN) >> K simp_tac || - Args.parens (Args.$$$ no_asm_simpN) >> K asm_simp_tac || - Args.parens (Args.$$$ no_asm_useN) >> K full_simp_tac || - Args.parens (Args.$$$ asm_lrN) >> K asm_lr_simp_tac || - Scan.succeed asm_full_simp_tac); +(** method syntax **) val cong_modifiers = [Args.$$$ congN -- Args.colon >> K ((I, cong_add): Method.modifier), @@ -379,25 +370,33 @@ >> K (Context.proof_map (map_ss MetaSimplifier.clear_ss), simp_add)] @ cong_modifiers; -fun simp_args more_mods = - Method.sectioned_args (Args.bang_facts -- Scan.lift simp_options) - (more_mods @ simp_modifiers'); +val simp_options = + (Args.parens (Args.$$$ no_asmN) >> K simp_tac || + Args.parens (Args.$$$ no_asm_simpN) >> K asm_simp_tac || + Args.parens (Args.$$$ no_asm_useN) >> K full_simp_tac || + Args.parens (Args.$$$ asm_lrN) >> K asm_lr_simp_tac || + Scan.succeed asm_full_simp_tac); -fun simp_method (prems, tac) ctxt = METHOD (fn facts => - ALLGOALS (Method.insert_tac (prems @ facts)) THEN - (CHANGED_PROP o ALLGOALS o tac) (local_simpset_of ctxt)); - -fun simp_method' (prems, tac) ctxt = METHOD (fn facts => - HEADGOAL (Method.insert_tac (prems @ facts) THEN' - ((CHANGED_PROP) oo tac) (local_simpset_of ctxt))); +fun simp_method more_mods meth = + Args.bang_facts -- Scan.lift simp_options --| + Method.sections (more_mods @ simp_modifiers') >> + (fn (prems, tac) => fn ctxt => METHOD (fn facts => meth ctxt tac (prems @ facts))); (** setup **) -fun method_setup more_mods = Method.add_methods - [(simpN, simp_args more_mods simp_method', "simplification"), - ("simp_all", simp_args more_mods simp_method, "simplification (all goals)")]; +fun method_setup more_mods = + Method.setup (Binding.name simpN) + (simp_method more_mods (fn ctxt => fn tac => fn facts => + HEADGOAL (Method.insert_tac facts THEN' + (CHANGED_PROP oo tac) (local_simpset_of ctxt)))) + "simplification" #> + Method.setup (Binding.name "simp_all") + (simp_method more_mods (fn ctxt => fn tac => fn facts => + ALLGOALS (Method.insert_tac facts) THEN + (CHANGED_PROP o ALLGOALS o tac) (local_simpset_of ctxt))) + "simplification (all goals)"; fun easy_setup reflect trivs = method_setup [] #> Context.theory_map (map_ss (fn _ => let diff -r 3e900a2acaed -r edf74583715a src/Tools/Compute_Oracle/am_sml.ML --- a/src/Tools/Compute_Oracle/am_sml.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Tools/Compute_Oracle/am_sml.ML Tue Jun 02 10:04:03 2009 +0200 @@ -320,7 +320,7 @@ val strict_args = (case toplevel_arity_of c of NONE => the (arity_of c) | SOME sa => sa) val xs = map (fn n => if n < strict_args then "x"^(str n) else "x"^(str n)^"()") rightargs val right = (indexed "C" c)^" "^(string_of_tuple xs) - val message = "(\"unresolved lazy call: "^(string_of_int c)^", \"^(makestring x"^(string_of_int (strict_args - 1))^"))" + val message = "(\"unresolved lazy call: " ^ string_of_int c ^ "\")" val right = if strict_args < the (arity_of c) then "raise AM_SML.Run "^message else right in (indexed "c" c)^(if gnum > 0 then "_"^(str gnum) else "")^leftargs^" = "^right diff -r 3e900a2acaed -r edf74583715a src/Tools/Compute_Oracle/compute.ML --- a/src/Tools/Compute_Oracle/compute.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Tools/Compute_Oracle/compute.ML Tue Jun 02 10:04:03 2009 +0200 @@ -379,7 +379,11 @@ fun has_witness s = not (null (Sign.witness_sorts thy [] [s])) val shyptab = fold Sorttab.delete (filter has_witness (Sorttab.keys (shyptab))) shyptab val shyps = if Sorttab.is_empty shyptab then [] else Sorttab.keys (fold delete_term (prop::hyps) shyptab) - val _ = if not (null shyps) then raise Compute ("dangling sort hypotheses: "^(makestring shyps)) else () + val _ = + if not (null shyps) then + raise Compute ("dangling sort hypotheses: " ^ + commas (map (Syntax.string_of_sort_global thy) shyps)) + else () in Thm.cterm_of thy (fold_rev (fn hyp => fn p => Logic.mk_implies (hyp, p)) hyps prop) end))); @@ -610,7 +614,8 @@ case match_aterms varsubst b' a' of NONE => let - fun mk s = makestring (infer_types (naming_of computer) (encoding_of computer) ty s) + fun mk s = Syntax.string_of_term_global Pure.thy + (infer_types (naming_of computer) (encoding_of computer) ty s) val left = "computed left side: "^(mk a') val right = "computed right side: "^(mk b') in diff -r 3e900a2acaed -r edf74583715a src/Tools/eqsubst.ML --- a/src/Tools/eqsubst.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Tools/eqsubst.ML Tue Jun 02 10:04:03 2009 +0200 @@ -20,25 +20,25 @@ * Zipper.T (* focusterm to search under *) exception eqsubst_occL_exp of - string * int list * Thm.thm list * int * Thm.thm + string * int list * thm list * int * thm (* low level substitution functions *) val apply_subst_in_asm : int -> - Thm.thm -> - Thm.thm -> - (Thm.cterm list * int * 'a * Thm.thm) * match -> Thm.thm Seq.seq + thm -> + thm -> + (cterm list * int * 'a * thm) * match -> thm Seq.seq val apply_subst_in_concl : int -> - Thm.thm -> - Thm.cterm list * Thm.thm -> - Thm.thm -> match -> Thm.thm Seq.seq + thm -> + cterm list * thm -> + thm -> match -> thm Seq.seq (* matching/unification within zippers *) val clean_match_z : - Context.theory -> Term.term -> Zipper.T -> match option + theory -> term -> Zipper.T -> match option val clean_unify_z : - Context.theory -> int -> Term.term -> Zipper.T -> match Seq.seq + theory -> int -> term -> Zipper.T -> match Seq.seq (* skipping things in seq seq's *) @@ -57,65 +57,64 @@ (* tactics *) val eqsubst_asm_tac : Proof.context -> - int list -> Thm.thm list -> int -> Thm.thm -> Thm.thm Seq.seq + int list -> thm list -> int -> tactic val eqsubst_asm_tac' : Proof.context -> - (searchinfo -> int -> Term.term -> match skipseq) -> - int -> Thm.thm -> int -> Thm.thm -> Thm.thm Seq.seq + (searchinfo -> int -> term -> match skipseq) -> + int -> thm -> int -> tactic val eqsubst_tac : Proof.context -> int list -> (* list of occurences to rewrite, use [0] for any *) - Thm.thm list -> int -> Thm.thm -> Thm.thm Seq.seq + thm list -> int -> tactic val eqsubst_tac' : Proof.context -> (* proof context *) - (searchinfo -> Term.term -> match Seq.seq) (* search function *) - -> Thm.thm (* equation theorem to rewrite with *) + (searchinfo -> term -> match Seq.seq) (* search function *) + -> thm (* equation theorem to rewrite with *) -> int (* subgoal number in goal theorem *) - -> Thm.thm (* goal theorem *) - -> Thm.thm Seq.seq (* rewritten goal theorem *) + -> thm (* goal theorem *) + -> thm Seq.seq (* rewritten goal theorem *) val fakefree_badbounds : - (string * Term.typ) list -> - Term.term -> - (string * Term.typ) list * (string * Term.typ) list * Term.term + (string * typ) list -> + term -> + (string * typ) list * (string * typ) list * term val mk_foo_match : - (Term.term -> Term.term) -> - ('a * Term.typ) list -> Term.term -> Term.term + (term -> term) -> + ('a * typ) list -> term -> term (* preparing substitution *) - val prep_meta_eq : Proof.context -> Thm.thm -> Thm.thm list + val prep_meta_eq : Proof.context -> thm -> thm list val prep_concl_subst : - int -> Thm.thm -> (Thm.cterm list * Thm.thm) * searchinfo + int -> thm -> (cterm list * thm) * searchinfo val prep_subst_in_asm : - int -> Thm.thm -> int -> - (Thm.cterm list * int * int * Thm.thm) * searchinfo + int -> thm -> int -> + (cterm list * int * int * thm) * searchinfo val prep_subst_in_asms : - int -> Thm.thm -> - ((Thm.cterm list * int * int * Thm.thm) * searchinfo) list + int -> thm -> + ((cterm list * int * int * thm) * searchinfo) list val prep_zipper_match : - Zipper.T -> Term.term * ((string * Term.typ) list * (string * Term.typ) list * Term.term) + Zipper.T -> term * ((string * typ) list * (string * typ) list * term) (* search for substitutions *) val valid_match_start : Zipper.T -> bool val search_lr_all : Zipper.T -> Zipper.T Seq.seq val search_lr_valid : (Zipper.T -> bool) -> Zipper.T -> Zipper.T Seq.seq val searchf_lr_unify_all : - searchinfo -> Term.term -> match Seq.seq Seq.seq + searchinfo -> term -> match Seq.seq Seq.seq val searchf_lr_unify_valid : - searchinfo -> Term.term -> match Seq.seq Seq.seq + searchinfo -> term -> match Seq.seq Seq.seq val searchf_bt_unify_valid : - searchinfo -> Term.term -> match Seq.seq Seq.seq + searchinfo -> term -> match Seq.seq Seq.seq (* syntax tools *) val ith_syntax : int list parser val options_syntax : bool parser (* Isar level hooks *) - val eqsubst_asm_meth : Proof.context -> int list -> Thm.thm list -> Proof.method - val eqsubst_meth : Proof.context -> int list -> Thm.thm list -> Proof.method - val subst_meth : Method.src -> Proof.context -> Proof.method + val eqsubst_asm_meth : Proof.context -> int list -> thm list -> Proof.method + val eqsubst_meth : Proof.context -> int list -> thm list -> Proof.method val setup : theory -> theory end; @@ -560,15 +559,13 @@ Scan.optional (Args.parens (Scan.repeat OuterParse.nat)) [0]; (* combination method that takes a flag (true indicates that subst -should be done to an assumption, false = apply to the conclusion of -the goal) as well as the theorems to use *) -fun subst_meth src = - Method.syntax ((Scan.lift options_syntax) -- (Scan.lift ith_syntax) -- Attrib.thms) src - #> (fn (((asmflag, occL), inthms), ctxt) => - (if asmflag then eqsubst_asm_meth else eqsubst_meth) ctxt occL inthms); - - + should be done to an assumption, false = apply to the conclusion of + the goal) as well as the theorems to use *) val setup = - Method.add_method ("subst", subst_meth, "single-step substitution"); + Method.setup @{binding subst} + (Scan.lift (options_syntax -- ith_syntax) -- Attrib.thms >> + (fn ((asmflag, occL), inthms) => fn ctxt => + (if asmflag then eqsubst_asm_meth else eqsubst_meth) ctxt occL inthms)) + "single-step substitution"; end; diff -r 3e900a2acaed -r edf74583715a src/Tools/intuitionistic.ML --- a/src/Tools/intuitionistic.ML Tue Jun 02 10:02:52 2009 +0200 +++ b/src/Tools/intuitionistic.ML Tue Jun 02 10:04:03 2009 +0200 @@ -7,7 +7,7 @@ signature INTUITIONISTIC = sig val prover_tac: Proof.context -> int option -> int -> tactic - val method_setup: bstring -> theory -> theory + val method_setup: binding -> theory -> theory end; structure Intuitionistic: INTUITIONISTIC = @@ -84,15 +84,16 @@ modifier introN Args.colon (Scan.succeed ()) ContextRules.intro, Args.del -- Args.colon >> K (I, ContextRules.rule_del)]; -val method = - Method.bang_sectioned_args' modifiers (Scan.lift (Scan.option OuterParse.nat)) - (fn n => fn prems => fn ctxt => METHOD (fn facts => - HEADGOAL (Method.insert_tac (prems @ facts) THEN' - ObjectLogic.atomize_prems_tac THEN' prover_tac ctxt n))); - in -fun method_setup name = Method.add_method (name, method, "intuitionistic proof search"); +fun method_setup name = + Method.setup name + (Args.bang_facts -- Scan.lift (Scan.option OuterParse.nat) --| + Method.sections modifiers >> + (fn (prems, n) => fn ctxt => METHOD (fn facts => + HEADGOAL (Method.insert_tac (prems @ facts) THEN' + ObjectLogic.atomize_prems_tac THEN' prover_tac ctxt n)))) + "intuitionistic proof search"; end;