--- a/Admin/Linux/Isabelle.run Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/Linux/Isabelle.run Fri Sep 18 16:42:19 2015 +0100
@@ -17,15 +17,28 @@
source "$ISABELLE_HOME/lib/scripts/isabelle-platform"
+# Java runtime options
+
+ISABELLE_NAME="$(basename "$0" .run)"
+if [ -z "$ISABELLE_PLATFORM64" ]; then
+ declare -a JAVA_OPTIONS=($(perl -p -e 's,#.*$,,g;' "$ISABELLE_HOME/${ISABELLE_NAME}.options32"))
+else
+ declare -a JAVA_OPTIONS=($(perl -p -e 's,#.*$,,g;' "$ISABELLE_HOME/${ISABELLE_NAME}.options64"))
+fi
+
+
# main
#paranoia setting -- avoid problems of Java/Swing versus XIM/IBus etc.
unset XMODIFIERS
-exec "$ISABELLE_HOME/contrib/jdk/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}/jre/bin/java" \
- "-Disabelle.home=$ISABELLE_HOME" \
- {JAVA_ARGS} \
- -classpath "{CLASSPATH}" \
- "-splash:$ISABELLE_HOME/lib/logo/isabelle.gif" \
- isabelle.Main "$@"
-
+if "$ISABELLE_HOME/bin/isabelle" jedit_client -c
+then
+ "$ISABELLE_HOME/bin/isabelle" jedit_client "$@"
+else
+ exec "$ISABELLE_HOME/contrib/jdk/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}/jre/bin/java" \
+ "-Disabelle.home=$ISABELLE_HOME" "${JAVA_OPTIONS[@]}" \
+ -classpath "{CLASSPATH}" \
+ "-splash:$ISABELLE_HOME/lib/logo/isabelle.gif" \
+ isabelle.Main -server="$("$ISABELLE_HOME/bin/isabelle" jedit_client -n)" "$@"
+fi
--- a/Admin/MacOS/Info.plist-part1 Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/MacOS/Info.plist-part1 Fri Sep 18 16:42:19 2015 +0100
@@ -9,7 +9,7 @@
<key>CFBundleIconFile</key>
<string>isabelle.icns</string>
<key>CFBundleIdentifier</key>
-<string>de.tum.in.isabelle</string>
+<string>de.tum.in.isabelle.{ISABELLE_NAME}</string>
<key>CFBundleDisplayName</key>
<string>{ISABELLE_NAME}</string>
<key>CFBundleInfoDictionaryVersion</key>
@@ -26,13 +26,34 @@
<string>1</string>
<key>NSHumanReadableCopyright</key>
<string></string>
+<key>LSMinimumSystemVersion</key>
+<string>10.7</string>
<key>LSApplicationCategoryType</key>
<string>public.app-category.developer-tools</string>
<key>NSHighResolutionCapable</key>
<string>true</string>
+<key>NSSupportsAutomaticGraphicsSwitching</key>
+<string>true</string>
<key>JVMRuntime</key>
-<string>jdk</string>
+<string>bundled.jdk</string>
<key>JVMMainClassName</key>
<string>isabelle.Main</string>
+<key>CFBundleDocumentTypes</key>
+<array>
+<dict>
+<key>CFBundleTypeExtensions</key>
+<array>
+<string>thy</string>
+</array>
+<key>CFBundleTypeIconFile</key>
+<string>theory.icns</string>
+<key>CFBundleTypeName</key>
+<string>Isabelle theory file</string>
+<key>CFBundleTypeRole</key>
+<string>Editor</string>
+<key>LSTypeIsPackage</key>
+<false/>
+</dict>
+</array>
<key>JVMOptions</key>
<array>
--- a/Admin/Windows/launch4j/isabelle.xml Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/Windows/launch4j/isabelle.xml Fri Sep 18 16:42:19 2015 +0100
@@ -18,6 +18,10 @@
<mainClass>isabelle.Main</mainClass>
{CLASSPATH}
</classPath>
+ <singleInstance>
+ <mutexName>{ISABELLE_NAME}</mutexName>
+ <windowTitle>{ISABELLE_NAME}</windowTitle>
+ </singleInstance>
<jre>
<path>%EXEDIR%\contrib\jdk\{PLATFORM}\jre</path>
<bundledJre64Bit>{PLATFORM_IS_64}</bundledJre64Bit>
--- a/Admin/components/bundled-macos Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/components/bundled-macos Fri Sep 18 16:42:19 2015 +0100
@@ -1,2 +1,2 @@
#additional components to be bundled for release
-macos_app-20130716
+macos_app-20150916
--- a/Admin/components/components.sha1 Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/components/components.sha1 Fri Sep 18 16:42:19 2015 +0100
@@ -81,6 +81,7 @@
5f95c96bb99927f3a026050f85bd056f37a9189e kodkodi-1.5.2.tar.gz
377e36efb8608e6c828c7718d890e97fde2006a4 linux_app-20131007.tar.gz
0aab4f73ff7f5e36f33276547e10897e1e56fb1d macos_app-20130716.tar.gz
+ad5d0e640ce3609a885cecab645389a2204e03bb macos_app-20150916.tar.gz
1c8cb6a8f4cbeaedce2d6d1ba8fc7e2ab3663aeb polyml-5.4.1.tar.gz
a3f9c159a0ee9a63b7a5d0c835ed9c2c908f8b56 polyml-5.5.0-1.tar.gz
7d604a99355efbfc1459d80db3279ffa7ade3e39 polyml-5.5.0-2.tar.gz
@@ -93,6 +94,9 @@
5b31ad8556e41dfd6d5e85f407818be399aa3d2a polyml-5.5.2-3.tar.gz
532f6e8814752aeb406c62fabcfd2cc05f8a7ca8 polyml-5.5.2.tar.gz
1c53f699d35c0db6c7cf4ea51f2310adbd1d0dc5 polyml-5.5.3-20150820.tar.gz
+b4b624fb5f34d1dc814fb4fb469fafd7d7ea018a polyml-5.5.3-20150908.tar.gz
+b668e1f43a41608a8eb365c5e19db6c54c72748a polyml-5.5.3-20150911.tar.gz
+1f5cd9b1390dab13861f90dfc06d4180cc107587 polyml-5.5.3-20150916.tar.gz
8ee375cfc38972f080dbc78f07b68dac03efe968 ProofGeneral-3.7.1.1.tar.gz
847b52c0676b5eb0fbf0476f64fc08c2d72afd0c ProofGeneral-4.1.tar.gz
8e0b2b432755ef11d964e20637d1bc567d1c0477 ProofGeneral-4.2-1.tar.gz
--- a/Admin/components/main Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/components/main Fri Sep 18 16:42:19 2015 +0100
@@ -9,7 +9,7 @@
jfreechart-1.0.14-1
jortho-1.0-2
kodkodi-1.5.2
-polyml-5.5.3-20150820
+polyml-5.5.3-20150916
scala-2.11.7
spass-3.8ds
xz-java-1.2-1
--- a/Admin/lib/Tools/build_doc Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/lib/Tools/build_doc Fri Sep 18 16:42:19 2015 +0100
@@ -4,6 +4,17 @@
#
# DESCRIPTION: build Isabelle documentation
+## settings
+
+case "$ISABELLE_JAVA_PLATFORM" in
+ x86-*)
+ ISABELLE_BUILD_JAVA_OPTIONS="$ISABELLE_BUILD_JAVA_OPTIONS32"
+ ;;
+ x86_64-*)
+ ISABELLE_BUILD_JAVA_OPTIONS="$ISABELLE_BUILD_JAVA_OPTIONS64"
+ ;;
+esac
+
## diagnostics
--- a/Admin/lib/Tools/makedist_bundle Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/lib/Tools/makedist_bundle Fri Sep 18 16:42:19 2015 +0100
@@ -187,6 +187,23 @@
purge_jdk "x86-linux"
purge_jdk "x86_64-linux"
+ for PLATFORM in 32 64
+ do
+ (
+ echo "# Java runtime options for ${PLATFORM}bit platform"
+ declare -a JAVA_ARGS
+ if [ "$PLATFORM" = 32 ]; then
+ eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS32)"
+ else
+ eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS64)"
+ fi
+ for ARG in "${JAVA_ARGS[@]}"
+ do
+ echo "$ARG"
+ done
+ ) > "$ISABELLE_TARGET/${ISABELLE_NAME}.options${PLATFORM}"
+ done
+
LINUX_CLASSPATH=""
for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
do
@@ -196,9 +213,9 @@
LINUX_CLASSPATH="$LINUX_CLASSPATH:\\\$ISABELLE_HOME/$ENTRY"
fi
done
+
cat "$ISABELLE_HOME/Admin/Linux/Isabelle.run" | \
- perl -p > "$ISABELLE_TARGET/${ISABELLE_NAME}.run" \
- -e "s,{JAVA_ARGS},$JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS,g; s,{CLASSPATH},$LINUX_CLASSPATH,;"
+ perl -p > "$ISABELLE_TARGET/${ISABELLE_NAME}.run" -e "s,{CLASSPATH},$LINUX_CLASSPATH,;"
chmod +x "$ISABELLE_TARGET/${ISABELLE_NAME}.run"
mv "$ISABELLE_TARGET/contrib/linux_app" "$TMP/."
@@ -240,9 +257,14 @@
"$ISABELLE_TARGET/src/Tools/jEdit/dist/properties/jEdit.props"
(
- echo -e "# Java runtime options\r"
declare -a JAVA_ARGS=()
- eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS)"
+ if [ "$PLATFORM_FAMILY" = windows ]; then
+ echo -e "# Java runtime options for 32bit platform\r"
+ eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS32)"
+ else
+ echo -e "# Java runtime options for 64bit platform\r"
+ eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS64)"
+ fi
for ARG in "${JAVA_ARGS[@]}"
do
echo -e "$ARG\r"
@@ -268,6 +290,7 @@
-e "s,{ICON},$APP_TEMPLATE/isabelle_transparent.ico,g;" \
-e "s,{SPLASH},$APP_TEMPLATE/isabelle.bmp,g;" \
-e "s,{CLASSPATH},$EXE_CLASSPATH,g;" \
+ -e "s,{ISABELLE_NAME},$ISABELLE_NAME,g;" \
-e "s,{PLATFORM},$PLATFORM,g;" \
-e "s,{PLATFORM_IS_64},$PLATFORM_IS_64,g;" \
-e "s,{PLATFORM_BITS},$PLATFORM_BITS,g;" \
@@ -335,7 +358,7 @@
cat "$APP_TEMPLATE/Info.plist-part1"
declare -a OPTIONS=()
- eval "OPTIONS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS)"
+ eval "OPTIONS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS64)"
for OPT in "${OPTIONS[@]}"
do
echo "<string>$OPT</string>"
@@ -353,12 +376,13 @@
cp -R "$APP_TEMPLATE/Resources/." "$APP/Contents/Resources/."
ln -sf "../Resources/${ISABELLE_NAME}/contrib/jdk/x86_64-darwin" \
- "$APP/Contents/PlugIns/jdk"
+ "$APP/Contents/PlugIns/bundled.jdk"
cp macos_app/JavaAppLauncher "$APP/Contents/MacOS/." && \
chmod +x "$APP/Contents/MacOS/JavaAppLauncher"
mv "$ISABELLE_NAME" "$APP/Contents/Resources/."
+ ln -sf "../../Info.plist" "$APP/Contents/Resources/$ISABELLE_NAME/${ISABELLE_NAME}.plist"
ln -sf "Contents/Resources/$ISABELLE_NAME" "$APP/Isabelle"
rm -f "${ARCHIVE_DIR}/${ISABELLE_NAME}.dmg"
--- a/Admin/polyml/build Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/polyml/build Fri Sep 18 16:42:19 2015 +0100
@@ -64,11 +64,11 @@
OPTIONS=()
;;
x86-windows)
- OPTIONS=(--host=i686-w32-mingw32 CPPFLAGS='-I/mingw32/include')
+ OPTIONS=(--host=i686-w32-mingw32 CPPFLAGS='-I/mingw32/include' --disable-windows-gui)
PATH="/mingw32/bin:$PATH"
;;
x86_64-windows)
- OPTIONS=(--host=x86_64-w64-mingw32 CPPFLAGS='-I/mingw64/include')
+ OPTIONS=(--host=x86_64-w64-mingw32 CPPFLAGS='-I/mingw64/include' --disable-windows-gui)
PATH="/mingw64/bin:$PATH"
;;
*)
--- a/Admin/polyml/settings Fri Sep 18 16:27:37 2015 +0100
+++ b/Admin/polyml/settings Fri Sep 18 16:42:19 2015 +0100
@@ -3,50 +3,67 @@
POLYML_HOME="$COMPONENT"
-# simple settings (example)
+# platform preference
-#ML_SYSTEM=polyml-5.5.3
-#ML_PLATFORM="$ISABELLE_PLATFORM32"
-#ML_HOME="$POLYML_HOME/$ML_PLATFORM"
-#ML_OPTIONS="-H 500"
-#ML_SOURCES="$POLYML_HOME/src"
-
-
-# smart settings
-
-ML_SYSTEM=polyml-5.5.3
+if grep "ML_system_64.*=.*true" "$ISABELLE_HOME_USER/etc/preferences" >/dev/null 2>/dev/null
+then
+ ML_SYSTEM_64="true"
+else
+ ML_SYSTEM_64="false"
+fi
-case "$ISABELLE_PLATFORM" in
- *-linux)
- if env LD_LIBRARY_PATH="$POLYML_HOME/$ISABELLE_PLATFORM32:$LD_LIBRARY_PATH" \
- "$POLYML_HOME/$ISABELLE_PLATFORM32/poly" -v >/dev/null 2>/dev/null
- then
- ML_PLATFORM="$ISABELLE_PLATFORM32"
- else
- ML_PLATFORM="$ISABELLE_PLATFORM64"
- if [ -z "$ML_PLATFORM_FALLBACK" ]; then
- echo >&2 "### Cannot execute Poly/ML in 32bit mode (missing shared libraries for C/C++)"
- echo >&2 "### Using bulky 64bit version of Poly/ML instead"
- ML_PLATFORM_FALLBACK="true"
- fi
- fi
+case "${ISABELLE_PLATFORM}:${ML_SYSTEM_64}" in
+ x86-cygwin:true)
+ PLATFORMS="x86_64-windows x86-windows"
;;
- x86-cygwin)
- ML_PLATFORM="x86-windows"
+ x86-cygwin:*)
+ PLATFORMS="x86-windows x86_64-windows"
+ ;;
+ *:true)
+ PLATFORMS="$ISABELLE_PLATFORM64 $ISABELLE_PLATFORM32"
;;
*)
- ML_PLATFORM="$ISABELLE_PLATFORM32"
+ PLATFORMS="$ISABELLE_PLATFORM32 $ISABELLE_PLATFORM64"
;;
esac
-case "$ML_PLATFORM" in
- x86_64-*)
- ML_OPTIONS="-H 1000"
- ;;
- *)
- ML_OPTIONS="-H 500"
- ;;
-esac
+
+# check executable
+
+unset ML_HOME
+
+for PLATFORM in $PLATFORMS
+do
+ if [ -z "$ML_HOME" ]
+ then
+ if "$POLYML_HOME/$PLATFORM/polyml" -v </dev/null >/dev/null 2>/dev/null
+ then
+
+ # ML settings
+
+ ML_SYSTEM=polyml-5.5.3
+ ML_PLATFORM="$PLATFORM"
+ ML_HOME="$POLYML_HOME/$ML_PLATFORM"
+ ML_SOURCES="$POLYML_HOME/src"
-ML_HOME="$POLYML_HOME/$ML_PLATFORM"
-ML_SOURCES="$POLYML_HOME/src"
+ case "$ML_PLATFORM" in
+ x86_64-windows)
+ ML_OPTIONS="-H 1000 --codepage utf8"
+ ;;
+ x86-windows)
+ ML_OPTIONS="-H 500 --codepage utf8"
+ ;;
+ x86_64-*)
+ ML_OPTIONS="-H 1000"
+ ;;
+ *)
+ ML_OPTIONS="-H 500"
+ ;;
+ esac
+
+ fi
+ fi
+done
+
+unset PLATFORM
+unset PLATFORMS
--- a/NEWS Fri Sep 18 16:27:37 2015 +0100
+++ b/NEWS Fri Sep 18 16:42:19 2015 +0100
@@ -21,6 +21,9 @@
At least one Debugger view needs to be active to have any effect on the
running ML program.
+* The main Isabelle executable is managed as single-instance Desktop
+application uniformly on all platforms: Linux, Windows, Mac OS X.
+
*** Isar ***
@@ -116,13 +119,13 @@
sequences. Further explanations and examples are given in the isar-ref
manual.
-* Proof method "goals" turns the current subgoals into cases within the
-context; the conclusion is bound to variable ?case in each case.
-For example:
+* Proof method "goal_cases" turns the current subgoals into cases within
+the context; the conclusion is bound to variable ?case in each case. For
+example:
lemma "\<And>x. A x \<Longrightarrow> B x \<Longrightarrow> C x"
and "\<And>y z. U y \<Longrightarrow> V z \<Longrightarrow> W y z"
-proof goals
+proof goal_cases
case (1 x)
then show ?case using \<open>A x\<close> \<open>B x\<close> sorry
next
@@ -132,7 +135,7 @@
lemma "\<And>x. A x \<Longrightarrow> B x \<Longrightarrow> C x"
and "\<And>y z. U y \<Longrightarrow> V z \<Longrightarrow> W y z"
-proof goals
+proof goal_cases
case prems: 1
then show ?case using prems sorry
next
@@ -181,6 +184,26 @@
*** HOL ***
+* Qualification of various formal entities in the libraries is done more
+uniformly via "context begin qualified definition ... end" instead of
+old-style "hide_const (open) ...". Consequently, both the defined
+constant and its defining fact become qualified, e.g. Option.is_none and
+Option.is_none_def. Occasional INCOMPATIBILITY in applications.
+
+* Combinator to represent case distinction on products is named "uncurry",
+with "split" and "prod_case" retained as input abbreviations.
+Partially applied occurences of "uncurry" with eta-contracted body
+terms are not printed with special syntax, to provide a compact
+notation and getting rid of a special-case print translation.
+Hence, the "uncurry"-expressions are printed the following way:
+a) fully applied "uncurry f p": explicit case-expression;
+b) partially applied with explicit double lambda abstraction in
+the body term "uncurry (%a b. t [a, b])": explicit paired abstraction;
+c) partially applied with eta-contracted body term "uncurry f":
+no special syntax, plain "uncurry" combinator.
+This aims for maximum readability in a given subterm.
+INCOMPATIBILITY.
+
* Some old and rarely used ASCII replacement syntax has been removed.
INCOMPATIBILITY, standard syntax with symbols should be used instead.
The subsequent commands help to reproduce the old forms, e.g. to
@@ -189,6 +212,10 @@
type_notation Map.map (infixr "~=>" 0)
notation Map.map_comp (infixl "o'_m" 55)
+* The alternative notation "\<Colon>" for type and sort constraints has been
+removed: in LaTeX document output it looks the same as "::".
+INCOMPATIBILITY, use plain "::" instead.
+
* Theory Map: lemma map_of_is_SomeD was a clone of map_of_SomeD and has
been removed. INCOMPATIBILITY.
@@ -276,9 +303,24 @@
* Theory Library/Old_Recdef: discontinued obsolete 'defer_recdef'
command. Minor INCOMPATIBILITY, use 'function' instead.
+* Recursive function definitions ('fun', 'function', 'partial_function')
+no longer expose the low-level "_def" facts of the internal
+construction. INCOMPATIBILITY, enable option "function_defs" in the
+context for rare situations where these facts are really needed.
+
+* Imperative_HOL: obsolete theory Legacy_Mrec has been removed.
+
+* Library/Omega_Words_Fun: Infinite words modeled as functions nat => 'a.
+
*** ML ***
+* Simproc programming interfaces have been simplified:
+Simplifier.make_simproc and Simplifier.define_simproc supersede various
+forms of Simplifier.mk_simproc, Simplifier.simproc_global etc. Note that
+term patterns for the left-hand sides are specified with implicitly
+fixed variables, like top-level theorem statements. INCOMPATIBILITY.
+
* Instantiation rules have been re-organized as follows:
Thm.instantiate (*low-level instantiation with named arguments*)
@@ -307,12 +349,38 @@
*** System ***
+* Property values in etc/symbols may contain spaces, if written with the
+replacement character "␣" (Unicode point 0x2324). For example:
+
+ \<star> code: 0x0022c6 group: operator font: Deja␣Vu␣Sans␣Mono
+
+* Command-line tool "isabelle jedit_client" allows to connect to already
+running Isabelle/jEdit process. This achieves the effect of
+single-instance applications seen on common GUI desktops.
+
+* Poly/ML default platform architecture may be changed from 32bit to
+64bit via system option ML_system_64. A system restart (and rebuild)
+is required after change.
+
* Poly/ML 5.5.3 runs natively on x86-windows and x86_64-windows,
which both allow larger heap space than former x86-cygwin.
* Java runtime environment for x86_64-windows allows to use larger heap
space.
+* Java runtime options are determined separately for 32bit vs. 64bit
+platforms as follows.
+
+ - Isabelle desktop application: platform-specific files that are
+ associated with the main app bundle
+
+ - isabelle jedit: settings
+ JEDIT_JAVA_SYSTEM_OPTIONS
+ JEDIT_JAVA_OPTIONS32 vs. JEDIT_JAVA_OPTIONS64
+
+ - isabelle build: settings
+ ISABELLE_BUILD_JAVA_OPTIONS32 vs. ISABELLE_BUILD_JAVA_OPTIONS64
+
New in Isabelle2015 (May 2015)
--- a/etc/options Fri Sep 18 16:27:37 2015 +0100
+++ b/etc/options Fri Sep 18 16:42:19 2015 +0100
@@ -107,6 +107,9 @@
public option ML_statistics : bool = true
-- "ML run-time system statistics"
+public option ML_system_64 : bool = false
+ -- "ML system for 64bit platform is used if possible (change requires restart)"
+
section "Editor Reactivity"
--- a/etc/settings Fri Sep 18 16:27:37 2015 +0100
+++ b/etc/settings Fri Sep 18 16:42:19 2015 +0100
@@ -38,7 +38,9 @@
###
ISABELLE_BUILD_OPTIONS=""
-ISABELLE_BUILD_JAVA_OPTIONS="-Djava.awt.headless=true -Xmx1024m -Xss1m"
+
+ISABELLE_BUILD_JAVA_OPTIONS32="-Djava.awt.headless=true -Xms128m -Xmx1024m -Xss1m"
+ISABELLE_BUILD_JAVA_OPTIONS64="-Djava.awt.headless=true -Xms512m -Xmx2560m -Xss4m"
###
--- a/lib/Tools/build Fri Sep 18 16:27:37 2015 +0100
+++ b/lib/Tools/build Fri Sep 18 16:42:19 2015 +0100
@@ -4,6 +4,17 @@
#
# DESCRIPTION: build and manage Isabelle sessions
+## settings
+
+case "$ISABELLE_JAVA_PLATFORM" in
+ x86-*)
+ ISABELLE_BUILD_JAVA_OPTIONS="$ISABELLE_BUILD_JAVA_OPTIONS32"
+ ;;
+ x86_64-*)
+ ISABELLE_BUILD_JAVA_OPTIONS="$ISABELLE_BUILD_JAVA_OPTIONS64"
+ ;;
+esac
+
## diagnostics
@@ -14,6 +25,8 @@
local PREFIX="$1"
echo "${PREFIX}ISABELLE_BUILD_OPTIONS=\"$ISABELLE_BUILD_OPTIONS\""
echo
+ echo "${PREFIX}ISABELLE_BUILD_JAVA_OPTIONS=\"$ISABELLE_BUILD_JAVA_OPTIONS\""
+ echo
echo "${PREFIX}ML_PLATFORM=\"$ML_PLATFORM\""
echo "${PREFIX}ML_HOME=\"$ML_HOME\""
echo "${PREFIX}ML_SYSTEM=\"$ML_SYSTEM\""
--- a/lib/Tools/console Fri Sep 18 16:27:37 2015 +0100
+++ b/lib/Tools/console Fri Sep 18 16:42:19 2015 +0100
@@ -4,6 +4,20 @@
#
# DESCRIPTION: run Isabelle process with raw ML console and line editor
+## settings
+
+case "$ISABELLE_JAVA_PLATFORM" in
+ x86-*)
+ ISABELLE_BUILD_JAVA_OPTIONS="$ISABELLE_BUILD_JAVA_OPTIONS32"
+ ;;
+ x86_64-*)
+ ISABELLE_BUILD_JAVA_OPTIONS="$ISABELLE_BUILD_JAVA_OPTIONS64"
+ ;;
+esac
+
+
+## diagnostics
+
PRG="$(basename "$0")"
function usage()
--- a/lib/scripts/feeder.pl Fri Sep 18 16:27:37 2015 +0100
+++ b/lib/scripts/feeder.pl Fri Sep 18 16:42:19 2015 +0100
@@ -19,14 +19,18 @@
#buffer lines
$| = 1;
+sub emit {
+ my ($text) = @_;
+ if ($text) {
+ utf8::upgrade($text);
+ $text =~ s/([\x80-\xff])/\\${\(ord($1))}/g;
+ print $text, "\n";
+ }
+}
$emitpid && (print $$, "\n");
-if ($head) {
- utf8::upgrade($head);
- $head =~ s/([\x80-\xff])/\\${\(ord($1))}/g;
- print $head, "\n";
-}
+emit("$head");
if (!$quit) {
while (<STDIN>) {
@@ -34,7 +38,7 @@
}
}
-$tail && (print "$tail", "\n");
+emit("$tail");
# wait forever
--- a/lib/scripts/getsettings Fri Sep 18 16:27:37 2015 +0100
+++ b/lib/scripts/getsettings Fri Sep 18 16:42:19 2015 +0100
@@ -240,21 +240,29 @@
{
local BASE="$1"
local CATALOG="$2"
+ local COMPONENT=""
+ local -a COMPONENTS=()
if [ ! -f "$CATALOG" ]; then
echo >&2 "Bad component catalog file: \"$CATALOG\""
exit 2
fi
+
{
while { unset REPLY; read -r; test "$?" = 0 -o -n "$REPLY"; }
do
case "$REPLY" in
\#* | "") ;;
- /*) init_component "$REPLY" ;;
- *) init_component "$BASE/$REPLY" ;;
+ /*) COMPONENTS["${#COMPONENTS[@]}"]="$REPLY" ;;
+ *) COMPONENTS["${#COMPONENTS[@]}"]="$BASE/$REPLY" ;;
esac
done
} < "$CATALOG"
+
+ for COMPONENT in "${COMPONENTS[@]}"
+ do
+ init_component "$COMPONENT"
+ done
}
#main components
--- a/src/Doc/Codegen/Adaptation.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Doc/Codegen/Adaptation.thy Fri Sep 18 16:42:19 2015 +0100
@@ -346,7 +346,7 @@
definition %quote "HOL.equal (x::bar) y \<longleftrightarrow> x = y"
-instance %quote by default (simp add: equal_bar_def)
+instance %quote by standard (simp add: equal_bar_def)
end %quote (*<*)
--- a/src/Doc/Codegen/Setup.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Doc/Codegen/Setup.thy Fri Sep 18 16:42:19 2015 +0100
@@ -11,18 +11,13 @@
ML_file "../antiquote_setup.ML"
ML_file "../more_antiquote.ML"
-setup \<open>
-let
- val typ = Simple_Syntax.read_typ;
-in
- Sign.del_syntax (Symbol.xsymbolsN, false)
- [("_constrain", typ "logic => type => logic", Mixfix ("_\<Colon>_", [4, 0], 3)),
- ("_constrain", typ "prop' => type => prop'", Mixfix ("_\<Colon>_", [4, 0], 3))] #>
- Sign.add_syntax (Symbol.xsymbolsN, false)
- [("_constrain", typ "logic => type => logic", Mixfix ("_ \<Colon> _", [4, 0], 3)),
- ("_constrain", typ "prop' => type => prop'", Mixfix ("_ \<Colon> _", [4, 0], 3))]
-end
-\<close>
+no_syntax (output)
+ "_constrain" :: "logic => type => logic" ("_::_" [4, 0] 3)
+ "_constrain" :: "prop' => type => prop'" ("_::_" [4, 0] 3)
+
+syntax (output)
+ "_constrain" :: "logic => type => logic" ("_ :: _" [4, 0] 3)
+ "_constrain" :: "prop' => type => prop'" ("_ :: _" [4, 0] 3)
declare [[default_code_width = 74]]
--- a/src/Doc/Isar_Ref/Inner_Syntax.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Doc/Isar_Ref/Inner_Syntax.thy Fri Sep 18 16:42:19 2015 +0100
@@ -839,10 +839,6 @@
input is likely to be ambiguous. The correct form is @{text "x < (y
:: nat)"}.
- \item Constraints may be either written with two literal colons
- ``@{verbatim "::"}'' or the double-colon symbol @{verbatim "\<Colon>"},
- which actually looks exactly the same in some {\LaTeX} styles.
-
\item Dummy variables (written as underscore) may occur in different
roles.
--- a/src/Doc/Isar_Ref/Proof.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Doc/Isar_Ref/Proof.thy Fri Sep 18 16:42:19 2015 +0100
@@ -832,7 +832,7 @@
\begin{matharray}{rcl}
@{command_def "print_rules"}@{text "\<^sup>*"} & : & @{text "context \<rightarrow>"} \\[0.5ex]
@{method_def "-"} & : & @{text method} \\
- @{method_def "goals"} & : & @{text method} \\
+ @{method_def "goal_cases"} & : & @{text method} \\
@{method_def "fact"} & : & @{text method} \\
@{method_def "assumption"} & : & @{text method} \\
@{method_def "this"} & : & @{text method} \\
@@ -847,7 +847,7 @@
\end{matharray}
@{rail \<open>
- @@{method goals} (@{syntax name}*)
+ @@{method goal_cases} (@{syntax name}*)
;
@@{method fact} @{syntax thmrefs}?
;
@@ -886,10 +886,10 @@
method; thus a plain \emph{do-nothing} proof step would be ``@{command
"proof"}~@{text "-"}'' rather than @{command "proof"} alone.
- \item @{method "goals"}~@{text "a\<^sub>1 \<dots> a\<^sub>n"} is like ``@{method "-"}'', but
- the current subgoals are turned into cases within the context (see also
- \secref{sec:cases-induct}). The specified case names are used if present;
- otherwise cases are numbered starting from 1.
+ \item @{method "goal_cases"}~@{text "a\<^sub>1 \<dots> a\<^sub>n"} turns the current subgoals
+ into cases within the context (see also \secref{sec:cases-induct}). The
+ specified case names are used if present; otherwise cases are numbered
+ starting from 1.
Invoking cases in the subsequent proof body via the @{command_ref case}
command will @{command fix} goal parameters, @{command assume} goal
--- a/src/Doc/JEdit/JEdit.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Doc/JEdit/JEdit.thy Fri Sep 18 16:42:19 2015 +0100
@@ -226,12 +226,12 @@
Usage: isabelle jedit [OPTIONS] [FILES ...]
Options are:
- -J OPTION add JVM runtime option (default JEDIT_JAVA_OPTIONS)
+ -J OPTION add JVM runtime option
-b build only
-d DIR include session directory
-f fresh build
- -j OPTION add jEdit runtime option (default JEDIT_OPTIONS)
- -l NAME logic image name (default ISABELLE_LOGIC)
+ -j OPTION add jEdit runtime option
+ -l NAME logic image name
-m MODE add print mode for output
-n no build of session image on startup
-s system build mode for session image
--- a/src/HOL/Algebra/AbelCoset.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/AbelCoset.thy Fri Sep 18 16:42:19 2015 +0100
@@ -236,7 +236,7 @@
by (rule a_normal)
show "abelian_subgroup H G"
- by default (simp add: a_comm)
+ by standard (simp add: a_comm)
qed
lemma abelian_subgroupI2:
--- a/src/HOL/Algebra/Divisibility.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/Divisibility.thy Fri Sep 18 16:42:19 2015 +0100
@@ -25,14 +25,14 @@
and r_cancel:
"\<And>a b c. \<lbrakk>a \<otimes> c = b \<otimes> c; a \<in> carrier G; b \<in> carrier G; c \<in> carrier G\<rbrakk> \<Longrightarrow> a = b"
shows "monoid_cancel G"
- by default fact+
+ by standard fact+
lemma (in monoid_cancel) is_monoid_cancel:
"monoid_cancel G"
..
sublocale group \<subseteq> monoid_cancel
- by default simp_all
+ by standard simp_all
locale comm_monoid_cancel = monoid_cancel + comm_monoid
@@ -3640,7 +3640,7 @@
done
sublocale factorial_monoid \<subseteq> primeness_condition_monoid
- by default (rule irreducible_is_prime)
+ by standard (rule irreducible_is_prime)
lemma (in factorial_monoid) primeness_condition:
@@ -3649,10 +3649,10 @@
lemma (in factorial_monoid) gcd_condition [simp]:
shows "gcd_condition_monoid G"
- by default (rule gcdof_exists)
+ by standard (rule gcdof_exists)
sublocale factorial_monoid \<subseteq> gcd_condition_monoid
- by default (rule gcdof_exists)
+ by standard (rule gcdof_exists)
lemma (in factorial_monoid) division_weak_lattice [simp]:
shows "weak_lattice (division_rel G)"
--- a/src/HOL/Algebra/Group.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/Group.thy Fri Sep 18 16:42:19 2015 +0100
@@ -286,7 +286,8 @@
qed
then have carrier_subset_Units: "carrier G <= Units G"
by (unfold Units_def) fast
- show ?thesis by default (auto simp: r_one m_assoc carrier_subset_Units)
+ show ?thesis
+ by standard (auto simp: r_one m_assoc carrier_subset_Units)
qed
lemma (in monoid) group_l_invI:
@@ -730,7 +731,7 @@
assumes m_comm: "!!x y. [| x \<in> carrier G; y \<in> carrier G |] ==>
x \<otimes> y = y \<otimes> x"
shows "comm_group G"
- by default (simp_all add: m_comm)
+ by standard (simp_all add: m_comm)
lemma comm_groupI:
fixes G (structure)
@@ -758,7 +759,7 @@
theorem (in group) subgroups_partial_order:
"partial_order \<lparr>carrier = {H. subgroup H G}, eq = op =, le = op \<subseteq>\<rparr>"
- by default simp_all
+ by standard simp_all
lemma (in group) subgroup_self:
"subgroup (carrier G) G"
--- a/src/HOL/Algebra/IntRing.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/IntRing.thy Fri Sep 18 16:42:19 2015 +0100
@@ -60,7 +60,7 @@
and "pow \<Z> x n = x^n"
proof -
-- "Specification"
- show "monoid \<Z>" by default auto
+ show "monoid \<Z>" by standard auto
then interpret int: monoid \<Z> .
-- "Carrier"
@@ -76,7 +76,7 @@
where "finprod \<Z> f A = setprod f A"
proof -
-- "Specification"
- show "comm_monoid \<Z>" by default auto
+ show "comm_monoid \<Z>" by standard auto
then interpret int: comm_monoid \<Z> .
-- "Operations"
@@ -94,7 +94,7 @@
and int_finsum_eq: "finsum \<Z> f A = setsum f A"
proof -
-- "Specification"
- show "abelian_monoid \<Z>" by default auto
+ show "abelian_monoid \<Z>" by standard auto
then interpret int: abelian_monoid \<Z> .
-- "Carrier"
@@ -178,7 +178,7 @@
and "lless \<lparr>carrier = UNIV::int set, eq = op =, le = op \<le>\<rparr> x y = (x < y)"
proof -
show "partial_order \<lparr>carrier = UNIV::int set, eq = op =, le = op \<le>\<rparr>"
- by default simp_all
+ by standard simp_all
show "carrier \<lparr>carrier = UNIV::int set, eq = op =, le = op \<le>\<rparr> = UNIV"
by simp
show "le \<lparr>carrier = UNIV::int set, eq = op =, le = op \<le>\<rparr> x y = (x \<le> y)"
@@ -215,7 +215,7 @@
interpretation int (* [unfolded UNIV] *) :
total_order "\<lparr>carrier = UNIV::int set, eq = op =, le = op \<le>\<rparr>"
- by default clarsimp
+ by standard clarsimp
subsection {* Generated Ideals of @{text "\<Z>"} *}
--- a/src/HOL/Algebra/Lattice.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/Lattice.thy Fri Sep 18 16:42:19 2015 +0100
@@ -921,7 +921,7 @@
lemma (in weak_partial_order) weak_total_orderI:
assumes total: "!!x y. [| x \<in> carrier L; y \<in> carrier L |] ==> x \<sqsubseteq> y | y \<sqsubseteq> x"
shows "weak_total_order L"
- by default (rule total)
+ by standard (rule total)
text {* Total orders are lattices. *}
@@ -985,7 +985,7 @@
and inf_exists:
"!!A. [| A \<subseteq> carrier L |] ==> EX i. greatest L i (Lower L A)"
shows "weak_complete_lattice L"
- by default (auto intro: sup_exists inf_exists)
+ by standard (auto intro: sup_exists inf_exists)
definition
top :: "_ => 'a" ("\<top>\<index>")
@@ -1133,14 +1133,14 @@
"[| x \<in> carrier L; y \<in> carrier L |] ==> EX s. least L s (Upper L {x, y})"
sublocale upper_semilattice < weak: weak_upper_semilattice
- by default (rule sup_of_two_exists)
+ by standard (rule sup_of_two_exists)
locale lower_semilattice = partial_order +
assumes inf_of_two_exists:
"[| x \<in> carrier L; y \<in> carrier L |] ==> EX s. greatest L s (Lower L {x, y})"
sublocale lower_semilattice < weak: weak_lower_semilattice
- by default (rule inf_of_two_exists)
+ by standard (rule inf_of_two_exists)
locale lattice = upper_semilattice + lower_semilattice
@@ -1191,19 +1191,19 @@
assumes total_order_total: "[| x \<in> carrier L; y \<in> carrier L |] ==> x \<sqsubseteq> y | y \<sqsubseteq> x"
sublocale total_order < weak: weak_total_order
- by default (rule total_order_total)
+ by standard (rule total_order_total)
text {* Introduction rule: the usual definition of total order *}
lemma (in partial_order) total_orderI:
assumes total: "!!x y. [| x \<in> carrier L; y \<in> carrier L |] ==> x \<sqsubseteq> y | y \<sqsubseteq> x"
shows "total_order L"
- by default (rule total)
+ by standard (rule total)
text {* Total orders are lattices. *}
sublocale total_order < weak: lattice
- by default (auto intro: sup_of_two_exists inf_of_two_exists)
+ by standard (auto intro: sup_of_two_exists inf_of_two_exists)
text {* Complete lattices *}
@@ -1215,7 +1215,7 @@
"[| A \<subseteq> carrier L |] ==> EX i. greatest L i (Lower L A)"
sublocale complete_lattice < weak: weak_complete_lattice
- by default (auto intro: sup_exists inf_exists)
+ by standard (auto intro: sup_exists inf_exists)
text {* Introduction rule: the usual definition of complete lattice *}
@@ -1225,7 +1225,7 @@
and inf_exists:
"!!A. [| A \<subseteq> carrier L |] ==> EX i. greatest L i (Lower L A)"
shows "complete_lattice L"
- by default (auto intro: sup_exists inf_exists)
+ by standard (auto intro: sup_exists inf_exists)
theorem (in partial_order) complete_lattice_criterion1:
assumes top_exists: "EX g. greatest L g (carrier L)"
@@ -1282,7 +1282,7 @@
(is "complete_lattice ?L")
proof (rule partial_order.complete_latticeI)
show "partial_order ?L"
- by default auto
+ by standard auto
next
fix B
assume "B \<subseteq> carrier ?L"
--- a/src/HOL/Algebra/RingHom.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/RingHom.thy Fri Sep 18 16:42:19 2015 +0100
@@ -17,7 +17,7 @@
and hom_one [simp] = ring_hom_one [OF homh]
sublocale ring_hom_cring \<subseteq> ring: ring_hom_ring
- by default (rule homh)
+ by standard (rule homh)
sublocale ring_hom_ring \<subseteq> abelian_group: abelian_group_hom R S
apply (rule abelian_group_homI)
--- a/src/HOL/Algebra/UnivPoly.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Algebra/UnivPoly.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1760,7 +1760,7 @@
and deg_r_0: "deg R r = 0"
shows "r = monom P (eval R R id a f) 0"
proof -
- interpret UP_pre_univ_prop R R id P by default simp
+ interpret UP_pre_univ_prop R R id P by standard simp
have eval_ring_hom: "eval R R id a \<in> ring_hom P R"
using eval_ring_hom [OF a] by simp
have "eval R R id a f = eval R R id a ?gq \<oplus>\<^bsub>R\<^esub> eval R R id a r"
--- a/src/HOL/BNF_Fixpoint_Base.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/BNF_Fixpoint_Base.thy Fri Sep 18 16:42:19 2015 +0100
@@ -15,10 +15,10 @@
begin
lemma False_imp_eq_True: "(False \<Longrightarrow> Q) \<equiv> Trueprop True"
- by default simp_all
+ by standard simp_all
lemma conj_imp_eq_imp_imp: "(P \<and> Q \<Longrightarrow> PROP R) \<equiv> (P \<Longrightarrow> Q \<Longrightarrow> PROP R)"
- by default simp_all
+ by standard simp_all
lemma mp_conj: "(P \<longrightarrow> Q) \<and> R \<Longrightarrow> P \<Longrightarrow> R \<and> Q"
by auto
--- a/src/HOL/Basic_BNF_LFPs.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Basic_BNF_LFPs.thy Fri Sep 18 16:42:19 2015 +0100
@@ -30,7 +30,7 @@
lemmas xtor_inject = xtor_rel[of "op ="]
lemma xtor_rel_induct: "(\<And>x y. vimage2p id_bnf id_bnf R x y \<Longrightarrow> IR (xtor x) (xtor y)) \<Longrightarrow> R \<le> IR"
- unfolding xtor_def vimage2p_def id_bnf_def by default
+ unfolding xtor_def vimage2p_def id_bnf_def ..
lemma Inl_def_alt: "Inl \<equiv> (\<lambda>a. xtor (id_bnf (Inl a)))"
unfolding xtor_def id_bnf_def by (rule reflexive)
@@ -60,10 +60,10 @@
by (cases p) auto
lemma ex_neg_all_pos: "((\<exists>x. P x) \<Longrightarrow> Q) \<equiv> (\<And>x. P x \<Longrightarrow> Q)"
- by default blast+
+ by standard blast+
lemma hypsubst_in_prems: "(\<And>x. y = x \<Longrightarrow> z = f x \<Longrightarrow> P) \<equiv> (z = f y \<Longrightarrow> P)"
- by default blast+
+ by standard blast+
lemma isl_map_sum:
"isl (map_sum f g s) = isl s"
--- a/src/HOL/Codegenerator_Test/Candidates.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Codegenerator_Test/Candidates.thy Fri Sep 18 16:42:19 2015 +0100
@@ -12,6 +12,8 @@
"~~/src/HOL/ex/Records"
begin
+text \<open>Drop technical stuff from @{theory Quickcheck_Narrowing} which is tailored towards Haskell\<close>
+
setup \<open>
fn thy =>
let
@@ -19,7 +21,9 @@
val consts = map_filter (try (curry (Axclass.param_of_inst thy)
@{const_name "Quickcheck_Narrowing.partial_term_of"})) tycos;
in fold Code.del_eqns consts thy end
-\<close> -- \<open>drop technical stuff from @{text Quickcheck_Narrowing} which is tailored towards Haskell\<close>
+\<close>
+
+text \<open>Simple example for the predicate compiler.\<close>
inductive sublist :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool"
where
@@ -29,6 +33,32 @@
code_pred sublist .
-code_reserved SML upto -- {* avoid popular infix *}
+text \<open>Avoid popular infix.\<close>
+
+code_reserved SML upto
+
+text \<open>Explicit check in @{text OCaml} for correct precedence of let expressions in list expressions\<close>
+
+definition funny_list :: "bool list"
+where
+ "funny_list = [let b = True in b, False]"
+
+definition funny_list' :: "bool list"
+where
+ "funny_list' = funny_list"
+
+lemma [code]:
+ "funny_list' = [True, False]"
+ by (simp add: funny_list_def funny_list'_def)
+
+definition check_list :: unit
+where
+ "check_list = (if funny_list = funny_list' then () else undefined)"
+
+text \<open>Explicit check in @{text Scala} for correct bracketing of abstractions\<close>
+
+definition funny_funs :: "(bool \<Rightarrow> bool) list \<Rightarrow> (bool \<Rightarrow> bool) list"
+where
+ "funny_funs fs = (\<lambda>x. x \<or> True) # (\<lambda>x. x \<or> False) # fs"
end
--- a/src/HOL/Complete_Partial_Order.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Complete_Partial_Order.thy Fri Sep 18 16:42:19 2015 +0100
@@ -293,7 +293,7 @@
end
instance complete_lattice \<subseteq> ccpo
- by default (fast intro: Sup_upper Sup_least)+
+ by standard (fast intro: Sup_upper Sup_least)+
lemma lfp_eq_fixp:
assumes f: "mono f" shows "lfp f = fixp f"
--- a/src/HOL/Conditionally_Complete_Lattices.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Conditionally_Complete_Lattices.thy Fri Sep 18 16:42:19 2015 +0100
@@ -371,7 +371,7 @@
end
instance complete_lattice \<subseteq> conditionally_complete_lattice
- by default (auto intro: Sup_upper Sup_least Inf_lower Inf_greatest)
+ by standard (auto intro: Sup_upper Sup_least Inf_lower Inf_greatest)
lemma cSup_eq:
fixes a :: "'a :: {conditionally_complete_lattice, no_bot}"
--- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy Fri Sep 18 16:42:19 2015 +0100
@@ -578,7 +578,7 @@
begin
sublocale dlo: unbounded_dense_linorder
-proof (unfold_locales, goals)
+proof (unfold_locales, goal_cases)
case (1 x y)
then show ?case
using between_less [of x y] by auto
--- a/src/HOL/Decision_Procs/Reflected_Multivariate_Polynomial.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Decision_Procs/Reflected_Multivariate_Polynomial.thy Fri Sep 18 16:42:19 2015 +0100
@@ -891,7 +891,7 @@
subsection \<open>Miscellaneous lemmas about indexes, decrementation, substitution etc ...\<close>
lemma isnpolyh_polybound0: "isnpolyh p (Suc n) \<Longrightarrow> polybound0 p"
-proof (induct p arbitrary: n rule: poly.induct, auto, goals)
+proof (induct p arbitrary: n rule: poly.induct, auto, goal_cases)
case prems: (1 c n p n')
then have "n = Suc (n - 1)"
by simp
--- a/src/HOL/Decision_Procs/langford.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Decision_Procs/langford.ML Fri Sep 18 16:42:19 2015 +0100
@@ -170,11 +170,8 @@
in
val reduce_ex_simproc =
- Simplifier.make_simproc
- {lhss = [@{cpat "\<exists>x. ?P x"}],
- name = "reduce_ex_simproc",
- proc = K proc,
- identifier = []};
+ Simplifier.make_simproc @{context} "reduce_ex_simproc"
+ {lhss = [@{term "\<exists>x. P x"}], proc = K proc, identifier = []};
end;
--- a/src/HOL/Enum.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Enum.thy Fri Sep 18 16:42:19 2015 +0100
@@ -446,9 +446,10 @@
"enum_ex P = enum_ex (%x. enum_ex (%y. P (x, y)))"
-instance by default
- (simp_all add: enum_prod_def distinct_product
- enum_UNIV enum_distinct enum_all_prod_def enum_ex_prod_def)
+instance
+ by standard
+ (simp_all add: enum_prod_def distinct_product
+ enum_UNIV enum_distinct enum_all_prod_def enum_ex_prod_def)
end
--- a/src/HOL/Finite_Set.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Finite_Set.thy Fri Sep 18 16:42:19 2015 +0100
@@ -573,7 +573,7 @@
end
instance prod :: (finite, finite) finite
- by default (simp only: UNIV_Times_UNIV [symmetric] finite_cartesian_product finite)
+ by standard (simp only: UNIV_Times_UNIV [symmetric] finite_cartesian_product finite)
lemma inj_graph: "inj (%f. {(x, y). y = f x})"
by (rule inj_onI, auto simp add: set_eq_iff fun_eq_iff)
@@ -593,16 +593,16 @@
qed
instance bool :: finite
- by default (simp add: UNIV_bool)
+ by standard (simp add: UNIV_bool)
instance set :: (finite) finite
- by default (simp only: Pow_UNIV [symmetric] finite_Pow_iff finite)
+ by standard (simp only: Pow_UNIV [symmetric] finite_Pow_iff finite)
instance unit :: finite
- by default (simp add: UNIV_unit)
+ by standard (simp add: UNIV_unit)
instance sum :: (finite, finite) finite
- by default (simp only: UNIV_Plus_UNIV [symmetric] finite_Plus finite)
+ by standard (simp only: UNIV_Plus_UNIV [symmetric] finite_Plus finite)
subsection \<open>A basic fold functional for finite sets\<close>
@@ -967,7 +967,7 @@
"comp_fun_commute (\<lambda>x A'. if P x then Set.insert x A' else A')"
proof -
interpret comp_fun_idem Set.insert by (fact comp_fun_idem_insert)
- show ?thesis by default (auto simp: fun_eq_iff)
+ show ?thesis by standard (auto simp: fun_eq_iff)
qed
lemma Set_filter_fold:
@@ -988,7 +988,7 @@
shows "image f A = fold (\<lambda>k A. Set.insert (f k) A) {} A"
using assms
proof -
- interpret comp_fun_commute "\<lambda>k A. Set.insert (f k) A" by default auto
+ interpret comp_fun_commute "\<lambda>k A. Set.insert (f k) A" by standard auto
show ?thesis using assms by (induct A) auto
qed
@@ -997,7 +997,7 @@
shows "Ball A P = fold (\<lambda>k s. s \<and> P k) True A"
using assms
proof -
- interpret comp_fun_commute "\<lambda>k s. s \<and> P k" by default auto
+ interpret comp_fun_commute "\<lambda>k s. s \<and> P k" by standard auto
show ?thesis using assms by (induct A) auto
qed
@@ -1006,7 +1006,7 @@
shows "Bex A P = fold (\<lambda>k s. s \<or> P k) False A"
using assms
proof -
- interpret comp_fun_commute "\<lambda>k s. s \<or> P k" by default auto
+ interpret comp_fun_commute "\<lambda>k s. s \<or> P k" by standard auto
show ?thesis using assms by (induct A) auto
qed
@@ -1027,14 +1027,14 @@
assumes "finite B"
shows "(\<Union>y\<in>B. {(x, y)}) \<union> A = fold (\<lambda>y. Set.insert (x, y)) A B"
proof -
- interpret comp_fun_commute "\<lambda>y. Set.insert (x, y)" by default auto
+ interpret comp_fun_commute "\<lambda>y. Set.insert (x, y)" by standard auto
show ?thesis using assms by (induct B arbitrary: A) simp_all
qed
lemma comp_fun_commute_product_fold:
assumes "finite B"
shows "comp_fun_commute (\<lambda>x z. fold (\<lambda>y. Set.insert (x, y)) z B)"
-by default (auto simp: fold_union_pair[symmetric] assms)
+ by standard (auto simp: fold_union_pair[symmetric] assms)
lemma product_fold:
assumes "finite A"
@@ -1122,18 +1122,16 @@
begin
interpretation fold?: comp_fun_commute f
- by default (insert comp_fun_commute, simp add: fun_eq_iff)
+ by standard (insert comp_fun_commute, simp add: fun_eq_iff)
definition F :: "'a set \<Rightarrow> 'b"
where
eq_fold: "F A = fold f z A"
-lemma empty [simp]:
- "F {} = z"
+lemma empty [simp]:"F {} = z"
by (simp add: eq_fold)
-lemma infinite [simp]:
- "\<not> finite A \<Longrightarrow> F A = z"
+lemma infinite [simp]: "\<not> finite A \<Longrightarrow> F A = z"
by (simp add: eq_fold)
lemma insert [simp]:
@@ -1172,7 +1170,7 @@
declare insert [simp del]
interpretation fold?: comp_fun_idem f
- by default (insert comp_fun_commute comp_fun_idem, simp add: fun_eq_iff)
+ by standard (insert comp_fun_commute comp_fun_idem, simp add: fun_eq_iff)
lemma insert_idem [simp]:
assumes "finite A"
@@ -1202,7 +1200,7 @@
where
"folding.F (\<lambda>_. Suc) 0 = card"
proof -
- show "folding (\<lambda>_. Suc)" by default rule
+ show "folding (\<lambda>_. Suc)" by standard rule
then interpret card!: folding "\<lambda>_. Suc" 0 .
from card_def show "folding.F (\<lambda>_. Suc) 0 = card" by rule
qed
--- a/src/HOL/GCD.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/GCD.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1975,7 +1975,7 @@
and "Sup.SUPREMUM Lcm A f = Lcm (f ` A)"
proof -
show "class.complete_lattice Gcd Lcm gcd Rings.dvd (\<lambda>m n. m dvd n \<and> \<not> n dvd m) lcm 1 (0::nat)"
- by default (auto simp add: Gcd_nat_def Lcm_nat_empty Lcm_nat_infinite)
+ by standard (auto simp add: Gcd_nat_def Lcm_nat_empty Lcm_nat_infinite)
then interpret gcd_lcm_complete_lattice_nat:
complete_lattice Gcd Lcm gcd Rings.dvd "\<lambda>m n. m dvd n \<and> \<not> n dvd m" lcm 1 "0::nat" .
from gcd_lcm_complete_lattice_nat.INF_def show "Inf.INFIMUM Gcd A f = Gcd (f ` A)" .
--- a/src/HOL/Groups.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Groups.thy Fri Sep 18 16:42:19 2015 +0100
@@ -71,7 +71,7 @@
begin
sublocale monoid
- by default (simp_all add: commute comm_neutral)
+ by standard (simp_all add: commute comm_neutral)
end
@@ -132,7 +132,7 @@
begin
sublocale add!: semigroup plus
- by default (fact add_assoc)
+ by standard (fact add_assoc)
end
@@ -143,7 +143,7 @@
begin
sublocale add!: abel_semigroup plus
- by default (fact add_commute)
+ by standard (fact add_commute)
declare add.left_commute [algebra_simps, field_simps]
@@ -160,7 +160,7 @@
begin
sublocale mult!: semigroup times
- by default (fact mult_assoc)
+ by standard (fact mult_assoc)
end
@@ -171,7 +171,7 @@
begin
sublocale mult!: abel_semigroup times
- by default (fact mult_commute)
+ by standard (fact mult_commute)
declare mult.left_commute [algebra_simps, field_simps]
@@ -189,7 +189,7 @@
begin
sublocale add!: monoid plus 0
- by default (fact add_0_left add_0_right)+
+ by standard (fact add_0_left add_0_right)+
end
@@ -201,10 +201,10 @@
begin
subclass monoid_add
- by default (simp_all add: add_0 add.commute [of _ 0])
+ by standard (simp_all add: add_0 add.commute [of _ 0])
sublocale add!: comm_monoid plus 0
- by default (simp add: ac_simps)
+ by standard (simp add: ac_simps)
end
@@ -214,7 +214,7 @@
begin
sublocale mult!: monoid times 1
- by default (fact mult_1_left mult_1_right)+
+ by standard (fact mult_1_left mult_1_right)+
end
@@ -226,10 +226,10 @@
begin
subclass monoid_mult
- by default (simp_all add: mult_1 mult.commute [of _ 1])
+ by standard (simp_all add: mult_1 mult.commute [of _ 1])
sublocale mult!: comm_monoid times 1
- by default (simp add: ac_simps)
+ by standard (simp add: ac_simps)
end
--- a/src/HOL/Groups_Big.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Groups_Big.thy Fri Sep 18 16:42:19 2015 +0100
@@ -18,7 +18,7 @@
begin
interpretation comp_fun_commute f
- by default (simp add: fun_eq_iff left_commute)
+ by standard (simp add: fun_eq_iff left_commute)
interpretation comp?: comp_fun_commute "f \<circ> g"
by (fact comp_comp_fun_commute)
--- a/src/HOL/HOL.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOL.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1254,10 +1254,10 @@
qed
lemma implies_True_equals: "(PROP P \<Longrightarrow> True) \<equiv> Trueprop True"
-by default (intro TrueI)
+ by standard (intro TrueI)
lemma False_implies_equals: "(False \<Longrightarrow> P) \<equiv> Trueprop True"
-by default simp_all
+ by standard simp_all
(* This is not made a simp rule because it does not improve any proofs
but slows some AFP entries down by 5% (cpu time). May 2015 *)
@@ -1446,25 +1446,29 @@
declaration \<open>
fn _ => Induct.map_simpset (fn ss => ss
addsimprocs
- [Simplifier.simproc_global @{theory} "swap_induct_false"
- ["induct_false \<Longrightarrow> PROP P \<Longrightarrow> PROP Q"]
- (fn _ =>
- (fn _ $ (P as _ $ @{const induct_false}) $ (_ $ Q $ _) =>
- if P <> Q then SOME Drule.swap_prems_eq else NONE
- | _ => NONE)),
- Simplifier.simproc_global @{theory} "induct_equal_conj_curry"
- ["induct_conj P Q \<Longrightarrow> PROP R"]
- (fn _ =>
- (fn _ $ (_ $ P) $ _ =>
- let
- fun is_conj (@{const induct_conj} $ P $ Q) =
- is_conj P andalso is_conj Q
- | is_conj (Const (@{const_name induct_equal}, _) $ _ $ _) = true
- | is_conj @{const induct_true} = true
- | is_conj @{const induct_false} = true
- | is_conj _ = false
- in if is_conj P then SOME @{thm induct_conj_curry} else NONE end
- | _ => NONE))]
+ [Simplifier.make_simproc @{context} "swap_induct_false"
+ {lhss = [@{term "induct_false \<Longrightarrow> PROP P \<Longrightarrow> PROP Q"}],
+ proc = fn _ => fn _ => fn ct =>
+ (case Thm.term_of ct of
+ _ $ (P as _ $ @{const induct_false}) $ (_ $ Q $ _) =>
+ if P <> Q then SOME Drule.swap_prems_eq else NONE
+ | _ => NONE),
+ identifier = []},
+ Simplifier.make_simproc @{context} "induct_equal_conj_curry"
+ {lhss = [@{term "induct_conj P Q \<Longrightarrow> PROP R"}],
+ proc = fn _ => fn _ => fn ct =>
+ (case Thm.term_of ct of
+ _ $ (_ $ P) $ _ =>
+ let
+ fun is_conj (@{const induct_conj} $ P $ Q) =
+ is_conj P andalso is_conj Q
+ | is_conj (Const (@{const_name induct_equal}, _) $ _ $ _) = true
+ | is_conj @{const induct_true} = true
+ | is_conj @{const induct_false} = true
+ | is_conj _ = false
+ in if is_conj P then SOME @{thm induct_conj_curry} else NONE end
+ | _ => NONE),
+ identifier = []}]
|> Simplifier.set_mksimps (fn ctxt =>
Simpdata.mksimps Simpdata.mksimps_pairs ctxt #>
map (rewrite_rule ctxt (map Thm.symmetric @{thms induct_rulify_fallback}))))
@@ -1731,8 +1735,14 @@
setup \<open>
Code_Preproc.map_pre (fn ctxt =>
- ctxt addsimprocs [Simplifier.simproc_global_i @{theory} "equal" [@{term HOL.eq}]
- (fn _ => fn Const (_, Type ("fun", [Type _, _])) => SOME @{thm eq_equal} | _ => NONE)])
+ ctxt addsimprocs
+ [Simplifier.make_simproc @{context} "equal"
+ {lhss = [@{term HOL.eq}],
+ proc = fn _ => fn _ => fn ct =>
+ (case Thm.term_of ct of
+ Const (_, Type (@{type_name fun}, [Type _, _])) => SOME @{thm eq_equal}
+ | _ => NONE),
+ identifier = []}])
\<close>
--- a/src/HOL/HOLCF/Bifinite.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Bifinite.thy Fri Sep 18 16:42:19 2015 +0100
@@ -162,7 +162,7 @@
qed
instance u :: (profinite) bifinite
- by default (rule profinite)
+ by standard (rule profinite)
text {*
Types @{typ "'a \<rightarrow> 'b"} and @{typ "'a u \<rightarrow>! 'b"} are isomorphic.
@@ -256,10 +256,10 @@
by (simp add: approx_chain_def cfun_eq_iff finite_deflation_bottom)
instance unit :: bifinite
- by default (fast intro!: approx_chain_unit)
+ by standard (fast intro!: approx_chain_unit)
instance discr :: (countable) profinite
- by default (fast intro!: discr_approx)
+ by standard (fast intro!: discr_approx)
instance lift :: (countable) bifinite
proof
--- a/src/HOL/HOLCF/Completion.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Completion.thy Fri Sep 18 16:42:19 2015 +0100
@@ -116,7 +116,7 @@
assumes type: "type_definition Rep Abs {S. ideal S}"
assumes below: "\<And>x y. x \<sqsubseteq> y \<longleftrightarrow> Rep x \<subseteq> Rep y"
shows "OFCLASS('b, cpo_class)"
-by (default, rule exI, erule typedef_ideal_lub [OF type below])
+ by standard (rule exI, erule typedef_ideal_lub [OF type below])
end
--- a/src/HOL/HOLCF/ConvexPD.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/ConvexPD.thy Fri Sep 18 16:42:19 2015 +0100
@@ -414,14 +414,14 @@
by (simp add: convex_map_def convex_bind_bind)
lemma ep_pair_convex_map: "ep_pair e p \<Longrightarrow> ep_pair (convex_map\<cdot>e) (convex_map\<cdot>p)"
-apply default
+apply standard
apply (induct_tac x rule: convex_pd_induct, simp_all add: ep_pair.e_inverse)
apply (induct_tac y rule: convex_pd_induct)
apply (simp_all add: ep_pair.e_p_below monofun_cfun)
done
lemma deflation_convex_map: "deflation d \<Longrightarrow> deflation (convex_map\<cdot>d)"
-apply default
+apply standard
apply (induct_tac x rule: convex_pd_induct, simp_all add: deflation.idem)
apply (induct_tac x rule: convex_pd_induct)
apply (simp_all add: deflation.below monofun_cfun)
--- a/src/HOL/HOLCF/Deflation.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Deflation.thy Fri Sep 18 16:42:19 2015 +0100
@@ -161,7 +161,7 @@
unfolding finite_deflation_def by simp
lemma finite_deflation_bottom: "finite_deflation \<bottom>"
-by default simp_all
+by standard simp_all
subsection {* Continuous embedding-projection pairs *}
@@ -358,7 +358,7 @@
subsection {* Composing ep-pairs *}
lemma ep_pair_ID_ID: "ep_pair ID ID"
-by default simp_all
+by standard simp_all
lemma ep_pair_comp:
assumes "ep_pair e1 p1" and "ep_pair e2 p2"
--- a/src/HOL/HOLCF/Discrete.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Discrete.thy Fri Sep 18 16:42:19 2015 +0100
@@ -19,7 +19,7 @@
"(op \<sqsubseteq> :: 'a discr \<Rightarrow> 'a discr \<Rightarrow> bool) = (op =)"
instance
-by default (simp add: below_discr_def)
+ by standard (simp add: below_discr_def)
end
--- a/src/HOL/HOLCF/Domain.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Domain.thy Fri Sep 18 16:42:19 2015 +0100
@@ -125,7 +125,7 @@
unfolding prj_beta emb_beta
by (simp add: type_definition.Abs_inverse [OF type])
show "ep_pair (emb :: 'a \<rightarrow> udom) prj"
- apply default
+ apply standard
apply (simp add: prj_emb)
apply (simp add: emb_prj cast.below)
done
--- a/src/HOL/HOLCF/Fun_Cpo.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Fun_Cpo.thy Fri Sep 18 16:42:19 2015 +0100
@@ -93,7 +93,7 @@
by (simp add: below_fun_def)
instance "fun" :: (type, pcpo) pcpo
-by default (fast intro: minimal_fun)
+by standard (fast intro: minimal_fun)
lemma inst_fun_pcpo: "\<bottom> = (\<lambda>x. \<bottom>)"
by (rule minimal_fun [THEN bottomI, symmetric])
--- a/src/HOL/HOLCF/Library/Defl_Bifinite.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Library/Defl_Bifinite.thy Fri Sep 18 16:42:19 2015 +0100
@@ -490,7 +490,7 @@
by (fast intro: below_antisym meet_defl_below2 meet_defl_greatest)
interpretation meet_defl: semilattice "\<lambda>a b. meet_defl\<cdot>a\<cdot>b"
-by default
+by standard
(fast intro: below_antisym meet_defl_greatest
meet_defl_below1 [THEN below_trans] meet_defl_below2 [THEN below_trans])+
--- a/src/HOL/HOLCF/Library/List_Predomain.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Library/List_Predomain.thy Fri Sep 18 16:42:19 2015 +0100
@@ -143,7 +143,7 @@
lemma deflation_list_map [domain_deflation]:
"deflation d \<Longrightarrow> deflation (list_map d)"
-apply default
+apply standard
apply (induct_tac x, simp_all add: deflation.idem)
apply (induct_tac x, simp_all add: deflation.below)
done
--- a/src/HOL/HOLCF/Library/Option_Cpo.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Library/Option_Cpo.thy Fri Sep 18 16:42:19 2015 +0100
@@ -269,7 +269,7 @@
lemma deflation_option_map [domain_deflation]:
"deflation d \<Longrightarrow> deflation (option_map d)"
-apply default
+apply standard
apply (induct_tac x, simp_all add: deflation.idem)
apply (induct_tac x, simp_all add: deflation.below)
done
--- a/src/HOL/HOLCF/Library/Sum_Cpo.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Library/Sum_Cpo.thy Fri Sep 18 16:42:19 2015 +0100
@@ -342,7 +342,7 @@
lemma deflation_map_sum [domain_deflation]:
"\<lbrakk>deflation d1; deflation d2\<rbrakk> \<Longrightarrow> deflation (map_sum' d1 d2)"
-apply default
+apply standard
apply (induct_tac x, simp_all add: deflation.idem)
apply (induct_tac x, simp_all add: deflation.below)
done
--- a/src/HOL/HOLCF/LowerPD.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/LowerPD.thy Fri Sep 18 16:42:19 2015 +0100
@@ -407,14 +407,14 @@
by (simp add: lower_map_def lower_bind_bind)
lemma ep_pair_lower_map: "ep_pair e p \<Longrightarrow> ep_pair (lower_map\<cdot>e) (lower_map\<cdot>p)"
-apply default
+apply standard
apply (induct_tac x rule: lower_pd_induct, simp_all add: ep_pair.e_inverse)
apply (induct_tac y rule: lower_pd_induct)
apply (simp_all add: ep_pair.e_p_below monofun_cfun del: lower_plus_below_iff)
done
lemma deflation_lower_map: "deflation d \<Longrightarrow> deflation (lower_map\<cdot>d)"
-apply default
+apply standard
apply (induct_tac x rule: lower_pd_induct, simp_all add: deflation.idem)
apply (induct_tac x rule: lower_pd_induct)
apply (simp_all add: deflation.below monofun_cfun del: lower_plus_below_iff)
--- a/src/HOL/HOLCF/Map_Functions.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Map_Functions.thy Fri Sep 18 16:42:19 2015 +0100
@@ -195,13 +195,13 @@
by (simp add: cfcomp1 u_map_map eta_cfun)
lemma ep_pair_u_map: "ep_pair e p \<Longrightarrow> ep_pair (u_map\<cdot>e) (u_map\<cdot>p)"
-apply default
+apply standard
apply (case_tac x, simp, simp add: ep_pair.e_inverse)
apply (case_tac y, simp, simp add: ep_pair.e_p_below)
done
lemma deflation_u_map: "deflation d \<Longrightarrow> deflation (u_map\<cdot>d)"
-apply default
+apply standard
apply (case_tac x, simp, simp add: deflation.idem)
apply (case_tac x, simp, simp add: deflation.below)
done
--- a/src/HOL/HOLCF/Pcpo.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Pcpo.thy Fri Sep 18 16:42:19 2015 +0100
@@ -198,7 +198,7 @@
begin
subclass cpo
-apply default
+apply standard
apply (frule chfin)
apply (blast intro: lub_finch1)
done
@@ -213,7 +213,7 @@
begin
subclass chfin
-apply default
+apply standard
apply (unfold max_in_chain_def)
apply (case_tac "\<forall>i. Y i = \<bottom>")
apply simp
--- a/src/HOL/HOLCF/Representable.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Representable.thy Fri Sep 18 16:42:19 2015 +0100
@@ -119,10 +119,10 @@
qed
instance "domain" \<subseteq> bifinite
-by default (rule approx_chain_ep_cast [OF ep_pair_emb_prj cast_DEFL])
+by standard (rule approx_chain_ep_cast [OF ep_pair_emb_prj cast_DEFL])
instance predomain \<subseteq> profinite
-by default (rule approx_chain_ep_cast [OF predomain_ep cast_liftdefl])
+by standard (rule approx_chain_ep_cast [OF predomain_ep cast_liftdefl])
subsection {* Universal domain ep-pairs *}
--- a/src/HOL/HOLCF/Tools/cont_proc.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Tools/cont_proc.ML Fri Sep 18 16:42:19 2015 +0100
@@ -8,7 +8,7 @@
val cont_thms: term -> thm list
val all_cont_thms: term -> thm list
val cont_tac: Proof.context -> int -> tactic
- val cont_proc: theory -> simproc
+ val cont_proc: simproc
val setup: theory -> theory
end
@@ -119,15 +119,17 @@
end
local
- fun solve_cont ctxt t =
+ fun solve_cont ctxt ct =
let
+ val t = Thm.term_of ct
val tr = Thm.instantiate' [] [SOME (Thm.cterm_of ctxt t)] @{thm Eq_TrueI}
in Option.map fst (Seq.pull (cont_tac ctxt 1 tr)) end
in
- fun cont_proc thy =
- Simplifier.simproc_global thy "cont_proc" ["cont f"] solve_cont
+ val cont_proc =
+ Simplifier.make_simproc @{context} "cont_proc"
+ {lhss = [@{term "cont f"}], proc = K solve_cont, identifier = []}
end
-fun setup thy = map_theory_simpset (fn ctxt => ctxt addsimprocs [cont_proc thy]) thy
+val setup = map_theory_simpset (fn ctxt => ctxt addsimprocs [cont_proc])
end
--- a/src/HOL/HOLCF/Tools/cpodef.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Tools/cpodef.ML Fri Sep 18 16:42:19 2015 +0100
@@ -15,27 +15,27 @@
Rep_bottom_iff: thm, Abs_bottom_iff: thm }
val add_podef: binding * (string * sort) list * mixfix ->
- term -> (binding * binding) option -> (Proof.context -> tactic) -> theory ->
+ term -> Typedef.bindings option -> (Proof.context -> tactic) -> theory ->
(Typedef.info * thm) * theory
val add_cpodef: binding * (string * sort) list * mixfix ->
- term -> (binding * binding) option -> (Proof.context -> tactic) * (Proof.context -> tactic) ->
+ term -> Typedef.bindings option -> (Proof.context -> tactic) * (Proof.context -> tactic) ->
theory -> (Typedef.info * cpo_info) * theory
val add_pcpodef: binding * (string * sort) list * mixfix ->
- term -> (binding * binding) option -> (Proof.context -> tactic) * (Proof.context -> tactic) ->
+ term -> Typedef.bindings option -> (Proof.context -> tactic) * (Proof.context -> tactic) ->
theory -> (Typedef.info * cpo_info * pcpo_info) * theory
val cpodef_proof:
(binding * (string * sort) list * mixfix) * term
- * (binding * binding) option -> theory -> Proof.state
+ * Typedef.bindings option -> theory -> Proof.state
val cpodef_proof_cmd:
(binding * (string * string option) list * mixfix) * string
- * (binding * binding) option -> theory -> Proof.state
+ * Typedef.bindings option -> theory -> Proof.state
val pcpodef_proof:
(binding * (string * sort) list * mixfix) * term
- * (binding * binding) option -> theory -> Proof.state
+ * Typedef.bindings option -> theory -> Proof.state
val pcpodef_proof_cmd:
(binding * (string * string option) list * mixfix) * string
- * (binding * binding) option -> theory -> Proof.state
+ * Typedef.bindings option -> theory -> Proof.state
end
structure Cpodef : CPODEF =
@@ -63,13 +63,14 @@
fun prove_cpo
(name: binding)
(newT: typ)
- (Rep_name: binding, Abs_name: binding)
+ opt_bindings
(type_definition: thm) (* type_definition Rep Abs A *)
(below_def: thm) (* op << == %x y. Rep x << Rep y *)
(admissible: thm) (* adm (%x. x : set) *)
(thy: theory)
=
let
+ val {Rep_name, Abs_name, ...} = Typedef.make_bindings name opt_bindings;
val cpo_thms = map (Thm.transfer thy) [type_definition, below_def, admissible]
val (full_tname, Ts) = dest_Type newT
val lhs_sorts = map (snd o dest_TFree) Ts
@@ -102,13 +103,14 @@
fun prove_pcpo
(name: binding)
(newT: typ)
- (Rep_name: binding, Abs_name: binding)
+ opt_bindings
(type_definition: thm) (* type_definition Rep Abs A *)
(below_def: thm) (* op << == %x y. Rep x << Rep y *)
(bottom_mem: thm) (* bottom : set *)
(thy: theory)
=
let
+ val {Rep_name, Abs_name, ...} = Typedef.make_bindings name opt_bindings;
val pcpo_thms = map (Thm.transfer thy) [type_definition, below_def, bottom_mem]
val (full_tname, Ts) = dest_Type newT
val lhs_sorts = map (snd o dest_TFree) Ts
@@ -138,7 +140,7 @@
(* prepare_cpodef *)
-fun prepare prep_term name (tname, raw_args, _) raw_set opt_morphs thy =
+fun prepare prep_term name (tname, raw_args, _) raw_set thy =
let
(*rhs*)
val tmp_ctxt =
@@ -155,18 +157,15 @@
val lhs_tfrees = map (Proof_Context.check_tfree tmp_ctxt') raw_args
val full_tname = Sign.full_name thy tname
val newT = Type (full_tname, map TFree lhs_tfrees)
-
- val morphs = opt_morphs
- |> the_default (Binding.prefix_name "Rep_" name, Binding.prefix_name "Abs_" name)
in
- (newT, oldT, set, morphs)
+ (newT, oldT, set)
end
-fun add_podef typ set opt_morphs tac thy =
+fun add_podef typ set opt_bindings tac thy =
let
val name = #1 typ
val ((full_tname, info as ({Rep_name, ...}, {type_definition, ...})), thy) = thy
- |> Typedef.add_typedef_global false typ set opt_morphs tac
+ |> Typedef.add_typedef_global typ set opt_bindings tac
val oldT = #rep_type (#1 info)
val newT = #abs_type (#1 info)
val lhs_tfrees = map dest_TFree (snd (dest_Type newT))
@@ -189,13 +188,12 @@
(prep_term: Proof.context -> 'a -> term)
(typ: binding * (string * sort) list * mixfix)
(raw_set: 'a)
- (opt_morphs: (binding * binding) option)
+ opt_bindings
(thy: theory)
: term * term * (thm -> thm -> theory -> (Typedef.info * cpo_info) * theory) =
let
val name = #1 typ
- val (newT, oldT, set, morphs) =
- prepare prep_term name typ raw_set opt_morphs thy
+ val (newT, oldT, set) = prepare prep_term name typ raw_set thy
val goal_nonempty =
HOLogic.mk_Trueprop (HOLogic.mk_exists ("x", oldT, HOLogic.mk_mem (Free ("x", oldT), set)))
@@ -205,9 +203,9 @@
fun cpodef_result nonempty admissible thy =
let
val ((info as (_, {type_definition, ...}), below_def), thy) = thy
- |> add_podef typ set opt_morphs (fn ctxt => resolve_tac ctxt [nonempty] 1)
+ |> add_podef typ set opt_bindings (fn ctxt => resolve_tac ctxt [nonempty] 1)
val (cpo_info, thy) = thy
- |> prove_cpo name newT morphs type_definition below_def admissible
+ |> prove_cpo name newT opt_bindings type_definition below_def admissible
in
((info, cpo_info), thy)
end
@@ -221,13 +219,12 @@
(prep_term: Proof.context -> 'a -> term)
(typ: binding * (string * sort) list * mixfix)
(raw_set: 'a)
- (opt_morphs: (binding * binding) option)
+ opt_bindings
(thy: theory)
: term * term * (thm -> thm -> theory -> (Typedef.info * cpo_info * pcpo_info) * theory) =
let
val name = #1 typ
- val (newT, oldT, set, morphs) =
- prepare prep_term name typ raw_set opt_morphs thy
+ val (newT, oldT, set) = prepare prep_term name typ raw_set thy
val goal_bottom_mem =
HOLogic.mk_Trueprop (HOLogic.mk_mem (Const (@{const_name bottom}, oldT), set))
@@ -239,11 +236,11 @@
let
fun tac ctxt = resolve_tac ctxt [exI] 1 THEN resolve_tac ctxt [bottom_mem] 1
val ((info as (_, {type_definition, ...}), below_def), thy) = thy
- |> add_podef typ set opt_morphs tac
+ |> add_podef typ set opt_bindings tac
val (cpo_info, thy) = thy
- |> prove_cpo name newT morphs type_definition below_def admissible
+ |> prove_cpo name newT opt_bindings type_definition below_def admissible
val (pcpo_info, thy) = thy
- |> prove_pcpo name newT morphs type_definition below_def bottom_mem
+ |> prove_pcpo name newT opt_bindings type_definition below_def bottom_mem
in
((info, cpo_info, pcpo_info), thy)
end
@@ -256,10 +253,10 @@
(* tactic interface *)
-fun add_cpodef typ set opt_morphs (tac1, tac2) thy =
+fun add_cpodef typ set opt_bindings (tac1, tac2) thy =
let
val (goal1, goal2, cpodef_result) =
- prepare_cpodef Syntax.check_term typ set opt_morphs thy
+ prepare_cpodef Syntax.check_term typ set opt_bindings thy
val thm1 = Goal.prove_global thy [] [] goal1 (tac1 o #context)
handle ERROR msg => cat_error msg
("Failed to prove non-emptiness of " ^ quote (Syntax.string_of_term_global thy set))
@@ -268,10 +265,10 @@
("Failed to prove admissibility of " ^ quote (Syntax.string_of_term_global thy set))
in cpodef_result thm1 thm2 thy end
-fun add_pcpodef typ set opt_morphs (tac1, tac2) thy =
+fun add_pcpodef typ set opt_bindings (tac1, tac2) thy =
let
val (goal1, goal2, pcpodef_result) =
- prepare_pcpodef Syntax.check_term typ set opt_morphs thy
+ prepare_pcpodef Syntax.check_term typ set opt_bindings thy
val thm1 = Goal.prove_global thy [] [] goal1 (tac1 o #context)
handle ERROR msg => cat_error msg
("Failed to prove non-emptiness of " ^ quote (Syntax.string_of_term_global thy set))
@@ -286,23 +283,23 @@
local
fun gen_cpodef_proof prep_term prep_constraint
- ((b, raw_args, mx), set, opt_morphs) thy =
+ ((b, raw_args, mx), set, opt_bindings) thy =
let
val ctxt = Proof_Context.init_global thy
val args = map (apsnd (prep_constraint ctxt)) raw_args
val (goal1, goal2, make_result) =
- prepare_cpodef prep_term (b, args, mx) set opt_morphs thy
+ prepare_cpodef prep_term (b, args, mx) set opt_bindings thy
fun after_qed [[th1, th2]] = Proof_Context.background_theory (snd o make_result th1 th2)
| after_qed _ = raise Fail "cpodef_proof"
in Proof.theorem NONE after_qed [[(goal1, []), (goal2, [])]] ctxt end
fun gen_pcpodef_proof prep_term prep_constraint
- ((b, raw_args, mx), set, opt_morphs) thy =
+ ((b, raw_args, mx), set, opt_bindings) thy =
let
val ctxt = Proof_Context.init_global thy
val args = map (apsnd (prep_constraint ctxt)) raw_args
val (goal1, goal2, make_result) =
- prepare_pcpodef prep_term (b, args, mx) set opt_morphs thy
+ prepare_pcpodef prep_term (b, args, mx) set opt_bindings thy
fun after_qed [[th1, th2]] = Proof_Context.background_theory (snd o make_result th1 th2)
| after_qed _ = raise Fail "pcpodef_proof"
in Proof.theorem NONE after_qed [[(goal1, []), (goal2, [])]] ctxt end
@@ -321,24 +318,30 @@
(** outer syntax **)
-val typedef_proof_decl =
+local
+
+fun cpodef pcpo =
(Parse.type_args_constrained -- Parse.binding) -- Parse.opt_mixfix --
(@{keyword "="} |-- Parse.term) --
Scan.option
(@{keyword "morphisms"} |-- Parse.!!! (Parse.binding -- Parse.binding))
+ >> (fn ((((args, t), mx), A), morphs) =>
+ Toplevel.theory_to_proof
+ ((if pcpo then pcpodef_proof_cmd else cpodef_proof_cmd)
+ ((t, args, mx), A, SOME (Typedef.make_morphisms t morphs))))
-fun mk_pcpodef_proof pcpo ((((args, t), mx), A), morphs) =
- (if pcpo then pcpodef_proof_cmd else cpodef_proof_cmd)
- ((t, args, mx), A, morphs)
+in
val _ =
Outer_Syntax.command @{command_keyword pcpodef}
"HOLCF type definition (requires admissibility proof)"
- (typedef_proof_decl >> (Toplevel.theory_to_proof o mk_pcpodef_proof true))
+ (cpodef true)
val _ =
Outer_Syntax.command @{command_keyword cpodef}
"HOLCF type definition (requires admissibility proof)"
- (typedef_proof_decl >> (Toplevel.theory_to_proof o mk_pcpodef_proof false))
+ (cpodef false)
end
+
+end
--- a/src/HOL/HOLCF/Tools/domaindef.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Tools/domaindef.ML Fri Sep 18 16:42:19 2015 +0100
@@ -18,11 +18,11 @@
}
val add_domaindef: binding * (string * sort) list * mixfix ->
- term -> (binding * binding) option -> theory ->
+ term -> Typedef.bindings option -> theory ->
(Typedef.info * Cpodef.cpo_info * Cpodef.pcpo_info * rep_info) * theory
val domaindef_cmd: (binding * (string * string option) list * mixfix) * string
- * (binding * binding) option -> theory -> theory
+ * Typedef.bindings option -> theory -> theory
end
structure Domaindef : DOMAINDEF =
@@ -80,7 +80,7 @@
(prep_term: Proof.context -> 'a -> term)
(typ as (tname, raw_args, _) : binding * (string * sort) list * mixfix)
(raw_defl: 'a)
- (opt_morphs: (binding * binding) option)
+ (opt_bindings: Typedef.bindings option)
(thy: theory)
: (Typedef.info * Cpodef.cpo_info * Cpodef.pcpo_info * rep_info) * theory =
let
@@ -100,10 +100,6 @@
val full_tname = Sign.full_name thy tname
val newT = Type (full_tname, map TFree lhs_tfrees)
- (*morphisms*)
- val morphs = opt_morphs
- |> the_default (Binding.prefix_name "Rep_" tname, Binding.prefix_name "Abs_" tname)
-
(*set*)
val set = @{term "defl_set :: udom defl => udom set"} $ defl
@@ -111,7 +107,7 @@
fun tac1 ctxt = resolve_tac ctxt @{thms defl_set_bottom} 1
fun tac2 ctxt = resolve_tac ctxt @{thms adm_defl_set} 1
val ((info, cpo_info, pcpo_info), thy) = thy
- |> Cpodef.add_pcpodef typ set (SOME morphs) (tac1, tac2)
+ |> Cpodef.add_pcpodef typ set opt_bindings (tac1, tac2)
(*definitions*)
val Rep_const = Const (#Rep_name (#1 info), newT --> udomT)
@@ -187,8 +183,8 @@
handle ERROR msg =>
cat_error msg ("The error(s) above occurred in domaindef " ^ Binding.print tname)
-fun add_domaindef typ defl opt_morphs thy =
- gen_add_domaindef Syntax.check_term typ defl opt_morphs thy
+fun add_domaindef typ defl opt_bindings thy =
+ gen_add_domaindef Syntax.check_term typ defl opt_bindings thy
fun domaindef_cmd ((b, raw_args, mx), A, morphs) thy =
let
@@ -199,17 +195,13 @@
(** outer syntax **)
-val domaindef_decl =
- (Parse.type_args_constrained -- Parse.binding) --
- Parse.opt_mixfix -- (@{keyword "="} |-- Parse.term) --
- Scan.option
- (@{keyword "morphisms"} |-- Parse.!!! (Parse.binding -- Parse.binding))
-
-fun mk_domaindef (((((args, t)), mx), A), morphs) =
- domaindef_cmd ((t, args, mx), A, morphs)
-
val _ =
Outer_Syntax.command @{command_keyword domaindef} "HOLCF definition of domains from deflations"
- (domaindef_decl >> (Toplevel.theory o mk_domaindef))
+ ((Parse.type_args_constrained -- Parse.binding) --
+ Parse.opt_mixfix -- (@{keyword "="} |-- Parse.term) --
+ Scan.option
+ (@{keyword "morphisms"} |-- Parse.!!! (Parse.binding -- Parse.binding)) >>
+ (fn (((((args, t)), mx), A), morphs) =>
+ Toplevel.theory (domaindef_cmd ((t, args, mx), A, SOME (Typedef.make_morphisms t morphs)))));
end
--- a/src/HOL/HOLCF/Universal.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/Universal.thy Fri Sep 18 16:42:19 2015 +0100
@@ -98,7 +98,7 @@
done
interpretation udom: preorder ubasis_le
-apply default
+apply standard
apply (rule ubasis_le_refl)
apply (erule (1) ubasis_le_trans)
done
@@ -879,7 +879,7 @@
done
lemma ep_pair_udom: "ep_pair udom_emb udom_prj"
- apply default
+ apply standard
apply (rule compact_basis.principal_induct, simp)
apply (simp add: udom_emb_principal udom_prj_principal)
apply (simp add: basis_prj_basis_emb)
@@ -986,7 +986,7 @@
qed
instance udom :: bifinite
- by default (fast intro: udom_approx)
+ by standard (fast intro: udom_approx)
hide_const (open) node
--- a/src/HOL/HOLCF/UpperPD.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/HOLCF/UpperPD.thy Fri Sep 18 16:42:19 2015 +0100
@@ -400,14 +400,14 @@
by (simp add: upper_map_def upper_bind_bind)
lemma ep_pair_upper_map: "ep_pair e p \<Longrightarrow> ep_pair (upper_map\<cdot>e) (upper_map\<cdot>p)"
-apply default
+apply standard
apply (induct_tac x rule: upper_pd_induct, simp_all add: ep_pair.e_inverse)
apply (induct_tac y rule: upper_pd_induct)
apply (simp_all add: ep_pair.e_p_below monofun_cfun del: upper_below_plus_iff)
done
lemma deflation_upper_map: "deflation d \<Longrightarrow> deflation (upper_map\<cdot>d)"
-apply default
+apply standard
apply (induct_tac x rule: upper_pd_induct, simp_all add: deflation.idem)
apply (induct_tac x rule: upper_pd_induct)
apply (simp_all add: deflation.below monofun_cfun del: upper_below_plus_iff)
--- a/src/HOL/Hoare/hoare_syntax.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Hoare/hoare_syntax.ML Fri Sep 18 16:42:19 2015 +0100
@@ -28,7 +28,7 @@
fun mk_abstuple [x] body = Syntax_Trans.abs_tr [x, body]
| mk_abstuple (x :: xs) body =
- Syntax.const @{const_syntax case_prod} $ Syntax_Trans.abs_tr [x, mk_abstuple xs body];
+ Syntax.const @{const_syntax uncurry} $ Syntax_Trans.abs_tr [x, mk_abstuple xs body];
fun mk_fbody x e [y] = if eq_idt (x, y) then e else y
| mk_fbody x e (y :: xs) =
@@ -82,21 +82,21 @@
local
fun dest_abstuple
- (Const (@{const_syntax case_prod}, _) $ Abs (v, _, body)) =
+ (Const (@{const_syntax uncurry}, _) $ Abs (v, _, body)) =
subst_bound (Syntax.free v, dest_abstuple body)
| dest_abstuple (Abs (v,_, body)) = subst_bound (Syntax.free v, body)
| dest_abstuple tm = tm;
-fun abs2list (Const (@{const_syntax case_prod}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
+fun abs2list (Const (@{const_syntax uncurry}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
| abs2list (Abs (x, T, _)) = [Free (x, T)]
| abs2list _ = [];
-fun mk_ts (Const (@{const_syntax case_prod}, _) $ Abs (_, _, t)) = mk_ts t
+fun mk_ts (Const (@{const_syntax uncurry}, _) $ Abs (_, _, t)) = mk_ts t
| mk_ts (Abs (_, _, t)) = mk_ts t
| mk_ts (Const (@{const_syntax Pair}, _) $ a $ b) = a :: mk_ts b
| mk_ts t = [t];
-fun mk_vts (Const (@{const_syntax case_prod},_) $ Abs (x, _, t)) =
+fun mk_vts (Const (@{const_syntax uncurry},_) $ Abs (x, _, t)) =
(Syntax.free x :: abs2list t, mk_ts t)
| mk_vts (Abs (x, _, t)) = ([Syntax.free x], [t])
| mk_vts _ = raise Match;
@@ -106,7 +106,7 @@
if t = Bound i then find_ch vts (i - 1) xs
else (true, (v, subst_bounds (xs, t)));
-fun is_f (Const (@{const_syntax case_prod}, _) $ Abs _) = true
+fun is_f (Const (@{const_syntax uncurry}, _) $ Abs _) = true
| is_f (Abs _) = true
| is_f _ = false;
--- a/src/HOL/Hoare/hoare_tac.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Hoare/hoare_tac.ML Fri Sep 18 16:42:19 2015 +0100
@@ -26,7 +26,7 @@
local
(** maps (%x1 ... xn. t) to [x1,...,xn] **)
-fun abs2list (Const (@{const_name case_prod}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
+fun abs2list (Const (@{const_name uncurry}, _) $ Abs (x, T, t)) = Free (x, T) :: abs2list t
| abs2list (Abs (x, T, _)) = [Free (x, T)]
| abs2list _ = [];
@@ -47,7 +47,7 @@
Abs (_, T, _) => T
| Const (_, Type (_, [_, Type (_, [T, _])])) $ _ => T);
in
- Const (@{const_name case_prod},
+ Const (@{const_name uncurry},
(T --> T2 --> HOLogic.boolT) --> HOLogic.mk_prodT (T, T2) --> HOLogic.boolT) $
absfree (x, T) z
end;
--- a/src/HOL/IMP/Abs_Int0.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_Int0.thy Fri Sep 18 16:42:19 2015 +0100
@@ -31,14 +31,15 @@
lemma Some_le[simp]: "(Some x \<le> u) = (\<exists>y. u = Some y \<and> x \<le> y)"
by (cases u) auto
-instance proof
- case goal1 show ?case by(rule less_option_def)
+instance
+proof (standard, goal_cases)
+ case 1 show ?case by(rule less_option_def)
next
- case goal2 show ?case by(cases x, simp_all)
+ case (2 x) show ?case by(cases x, simp_all)
next
- case goal3 thus ?case by(cases z, simp, cases y, simp, cases x, auto)
+ case (3 x y z) thus ?case by(cases z, simp, cases y, simp, cases x, auto)
next
- case goal4 thus ?case by(cases y, simp, cases x, auto)
+ case (4 x y) thus ?case by(cases y, simp, cases x, auto)
qed
end
@@ -63,14 +64,15 @@
definition top_option where "\<top> = Some \<top>"
-instance proof
- case goal4 show ?case by(cases a, simp_all add: top_option_def)
+instance
+proof (standard, goal_cases)
+ case (4 a) show ?case by(cases a, simp_all add: top_option_def)
next
- case goal1 thus ?case by(cases x, simp, cases y, simp_all)
+ case (1 x y) thus ?case by(cases x, simp, cases y, simp_all)
next
- case goal2 thus ?case by(cases y, simp, cases x, simp_all)
+ case (2 x y) thus ?case by(cases y, simp, cases x, simp_all)
next
- case goal3 thus ?case by(cases z, simp, cases y, simp, cases x, simp_all)
+ case (3 x y z) thus ?case by(cases z, simp, cases y, simp, cases x, simp_all)
qed
end
@@ -85,8 +87,8 @@
"\<bottom> = None"
instance
-proof
- case goal1 thus ?case by(auto simp: bot_option_def)
+proof (standard, goal_cases)
+ case 1 thus ?case by(auto simp: bot_option_def)
qed
end
--- a/src/HOL/IMP/Abs_Int1_const.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_Int1_const.thy Fri Sep 18 16:42:19 2015 +0100
@@ -32,22 +32,22 @@
definition "\<top> = Any"
instance
-proof
- case goal1 thus ?case by (rule less_const_def)
+proof (standard, goal_cases)
+ case 1 thus ?case by (rule less_const_def)
next
- case goal2 show ?case by (cases x) simp_all
+ case (2 x) show ?case by (cases x) simp_all
next
- case goal3 thus ?case by(cases z, cases y, cases x, simp_all)
+ case (3 x y z) thus ?case by(cases z, cases y, cases x, simp_all)
next
- case goal4 thus ?case by(cases x, cases y, simp_all, cases y, simp_all)
+ case (4 x y) thus ?case by(cases x, cases y, simp_all, cases y, simp_all)
next
- case goal6 thus ?case by(cases x, cases y, simp_all)
+ case (6 x y) thus ?case by(cases x, cases y, simp_all)
next
- case goal5 thus ?case by(cases y, cases x, simp_all)
+ case (5 x y) thus ?case by(cases y, cases x, simp_all)
next
- case goal7 thus ?case by(cases z, cases y, cases x, simp_all)
+ case (7 x y z) thus ?case by(cases z, cases y, cases x, simp_all)
next
- case goal8 thus ?case by(simp add: top_const_def)
+ case 8 thus ?case by(simp add: top_const_def)
qed
end
@@ -55,16 +55,15 @@
permanent_interpretation Val_semilattice
where \<gamma> = \<gamma>_const and num' = Const and plus' = plus_const
-proof
- case goal1 thus ?case
+proof (standard, goal_cases)
+ case (1 a b) thus ?case
by(cases a, cases b, simp, simp, cases b, simp, simp)
next
- case goal2 show ?case by(simp add: top_const_def)
+ case 2 show ?case by(simp add: top_const_def)
next
- case goal3 show ?case by simp
+ case 3 show ?case by simp
next
- case goal4 thus ?case
- by(auto simp: plus_const_cases split: const.split)
+ case 4 thus ?case by(auto simp: plus_const_cases split: const.split)
qed
permanent_interpretation Abs_Int
@@ -123,9 +122,8 @@
permanent_interpretation Abs_Int_mono
where \<gamma> = \<gamma>_const and num' = Const and plus' = plus_const
-proof
- case goal1 thus ?case
- by(auto simp: plus_const_cases split: const.split)
+proof (standard, goal_cases)
+ case 1 thus ?case by(auto simp: plus_const_cases split: const.split)
qed
text{* Termination: *}
@@ -136,10 +134,10 @@
permanent_interpretation Abs_Int_measure
where \<gamma> = \<gamma>_const and num' = Const and plus' = plus_const
and m = m_const and h = "1"
-proof
- case goal1 thus ?case by(auto simp: m_const_def split: const.splits)
+proof (standard, goal_cases)
+ case 1 thus ?case by(auto simp: m_const_def split: const.splits)
next
- case goal2 thus ?case by(auto simp: m_const_def less_const_def split: const.splits)
+ case 2 thus ?case by(auto simp: m_const_def less_const_def split: const.splits)
qed
thm AI_Some_measure
--- a/src/HOL/IMP/Abs_Int1_parity.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_Int1_parity.thy Fri Sep 18 16:42:19 2015 +0100
@@ -58,21 +58,21 @@
definition top_parity where
"\<top> = Either"
-text{* Now the instance proof. This time we take a lazy shortcut: we do not
-write out the proof obligations but use the @{text goali} primitive to refer
-to the assumptions of subgoal i and @{text "case?"} to refer to the
-conclusion of subgoal i. The class axioms are presented in the same order as
-in the class definition. Warning: this is brittle! *}
+text{* Now the instance proof. This time we take a shortcut with the help of
+proof method @{text goal_cases}: it creates cases 1 ... n for the subgoals
+1 ... n; in case i, i is also the name of the assumptions of subgoal i and
+@{text "case?"} refers to the conclusion of subgoal i.
+The class axioms are presented in the same order as in the class definition. *}
instance
-proof
- case goal1 (*sup1*) show ?case by(auto simp: less_eq_parity_def sup_parity_def)
+proof (standard, goal_cases)
+ case 1 (*sup1*) show ?case by(auto simp: less_eq_parity_def sup_parity_def)
next
- case goal2 (*sup2*) show ?case by(auto simp: less_eq_parity_def sup_parity_def)
+ case 2 (*sup2*) show ?case by(auto simp: less_eq_parity_def sup_parity_def)
next
- case goal3 (*sup least*) thus ?case by(auto simp: less_eq_parity_def sup_parity_def)
+ case 3 (*sup least*) thus ?case by(auto simp: less_eq_parity_def sup_parity_def)
next
- case goal4 (*top*) show ?case by(auto simp: less_eq_parity_def top_parity_def)
+ case 4 (*top*) show ?case by(auto simp: less_eq_parity_def top_parity_def)
qed
end
@@ -104,21 +104,22 @@
permanent_interpretation Val_semilattice
where \<gamma> = \<gamma>_parity and num' = num_parity and plus' = plus_parity
-proof txt{* of the locale axioms *}
- fix a b :: parity
- assume "a \<le> b" thus "\<gamma>_parity a \<subseteq> \<gamma>_parity b"
- by(auto simp: less_eq_parity_def)
-next txt{* The rest in the lazy, implicit way *}
- case goal2 show ?case by(auto simp: top_parity_def)
+proof (standard, goal_cases) txt{* subgoals are the locale axioms *}
+ case 1 thus ?case by(auto simp: less_eq_parity_def)
next
- case goal3 show ?case by auto
+ case 2 show ?case by(auto simp: top_parity_def)
next
- txt{* Warning: this subproof refers to the names @{text a1} and @{text a2}
- from the statement of the axiom. *}
- case goal4 thus ?case
+ case 3 show ?case by auto
+next
+ case (4 _ a1 _ a2) thus ?case
by (induction a1 a2 rule: plus_parity.induct) (auto simp add:mod_add_eq)
qed
+text{* In case 4 we needed to refer to particular variables.
+Writing (i x y z) fixes the names of the variables in case i to be x, y and z
+in the left-to-right order in which the variables occur in the subgoal.
+Underscores are anonymous placeholders for variable names we don't care to fix. *}
+
text{* Instantiating the abstract interpretation locale requires no more
proofs (they happened in the instatiation above) but delivers the
instantiated abstract interpreter which we call @{text AI_parity}: *}
@@ -156,8 +157,8 @@
permanent_interpretation Abs_Int_mono
where \<gamma> = \<gamma>_parity and num' = num_parity and plus' = plus_parity
-proof
- case goal1 thus ?case
+proof (standard, goal_cases)
+ case (1 _ a1 _ a2) thus ?case
by(induction a1 a2 rule: plus_parity.induct)
(auto simp add:less_eq_parity_def)
qed
@@ -168,10 +169,10 @@
permanent_interpretation Abs_Int_measure
where \<gamma> = \<gamma>_parity and num' = num_parity and plus' = plus_parity
and m = m_parity and h = "1"
-proof
- case goal1 thus ?case by(auto simp add: m_parity_def less_eq_parity_def)
+proof (standard, goal_cases)
+ case 1 thus ?case by(auto simp add: m_parity_def less_eq_parity_def)
next
- case goal2 thus ?case by(auto simp add: m_parity_def less_eq_parity_def less_parity_def)
+ case 2 thus ?case by(auto simp add: m_parity_def less_eq_parity_def less_parity_def)
qed
thm AI_Some_measure
--- a/src/HOL/IMP/Abs_Int2.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_Int2.thy Fri Sep 18 16:42:19 2015 +0100
@@ -11,14 +11,14 @@
definition "less_prod p1 p2 = (p1 \<le> p2 \<and> \<not> p2 \<le> (p1::'a*'b))"
instance
-proof
- case goal1 show ?case by(rule less_prod_def)
+proof (standard, goal_cases)
+ case 1 show ?case by(rule less_prod_def)
next
- case goal2 show ?case by(simp add: less_eq_prod_def)
+ case 2 show ?case by(simp add: less_eq_prod_def)
next
- case goal3 thus ?case unfolding less_eq_prod_def by(metis order_trans)
+ case 3 thus ?case unfolding less_eq_prod_def by(metis order_trans)
next
- case goal4 thus ?case by(simp add: less_eq_prod_def)(metis eq_iff surjective_pairing)
+ case 4 thus ?case by(simp add: less_eq_prod_def)(metis eq_iff surjective_pairing)
qed
end
--- a/src/HOL/IMP/Abs_Int2_ivl.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_Int2_ivl.thy Fri Sep 18 16:42:19 2015 +0100
@@ -104,22 +104,22 @@
by(auto simp add: is_empty_rep_def max_def min_def split: if_splits)
instance
-proof
- case goal1 show ?case by (rule less_ivl_def)
+proof (standard, goal_cases)
+ case 1 show ?case by (rule less_ivl_def)
next
- case goal2 show ?case by transfer (simp add: le_rep_def split: prod.splits)
+ case 2 show ?case by transfer (simp add: le_rep_def split: prod.splits)
next
- case goal3 thus ?case by transfer (auto simp: le_rep_def split: if_splits)
+ case 3 thus ?case by transfer (auto simp: le_rep_def split: if_splits)
next
- case goal4 thus ?case by transfer (auto simp: le_rep_def eq_ivl_iff split: if_splits)
+ case 4 thus ?case by transfer (auto simp: le_rep_def eq_ivl_iff split: if_splits)
next
- case goal5 thus ?case by transfer (auto simp add: le_rep_def sup_rep_def is_empty_min_max)
+ case 5 thus ?case by transfer (auto simp add: le_rep_def sup_rep_def is_empty_min_max)
next
- case goal6 thus ?case by transfer (auto simp add: le_rep_def sup_rep_def is_empty_min_max)
+ case 6 thus ?case by transfer (auto simp add: le_rep_def sup_rep_def is_empty_min_max)
next
- case goal7 thus ?case by transfer (auto simp add: le_rep_def sup_rep_def)
+ case 7 thus ?case by transfer (auto simp add: le_rep_def sup_rep_def)
next
- case goal8 show ?case by transfer (simp add: le_rep_def is_empty_rep_def)
+ case 8 show ?case by transfer (simp add: le_rep_def is_empty_rep_def)
qed
end
@@ -132,8 +132,8 @@
"equal_ivl i1 (i2::ivl) = (i1\<le>i2 \<and> i2 \<le> i1)"
instance
-proof
- case goal1 show ?case by(simp add: equal_ivl_def eq_iff)
+proof (standard, goal_cases)
+ case 1 show ?case by(simp add: equal_ivl_def eq_iff)
qed
end
@@ -161,14 +161,14 @@
definition "\<bottom> = empty_ivl"
instance
-proof
- case goal1 thus ?case by (simp add: \<gamma>_inf le_ivl_iff_subset)
+proof (standard, goal_cases)
+ case 1 thus ?case by (simp add: \<gamma>_inf le_ivl_iff_subset)
next
- case goal2 thus ?case by (simp add: \<gamma>_inf le_ivl_iff_subset)
+ case 2 thus ?case by (simp add: \<gamma>_inf le_ivl_iff_subset)
next
- case goal3 thus ?case by (simp add: \<gamma>_inf le_ivl_iff_subset)
+ case 3 thus ?case by (simp add: \<gamma>_inf le_ivl_iff_subset)
next
- case goal4 show ?case
+ case 4 show ?case
unfolding bot_ivl_def by transfer (auto simp: le_iff_subset)
qed
@@ -304,14 +304,14 @@
permanent_interpretation Val_semilattice
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = "op +"
-proof
- case goal1 thus ?case by transfer (simp add: le_iff_subset)
+proof (standard, goal_cases)
+ case 1 thus ?case by transfer (simp add: le_iff_subset)
next
- case goal2 show ?case by transfer (simp add: \<gamma>_rep_def)
+ case 2 show ?case by transfer (simp add: \<gamma>_rep_def)
next
- case goal3 show ?case by transfer (simp add: \<gamma>_rep_def)
+ case 3 show ?case by transfer (simp add: \<gamma>_rep_def)
next
- case goal4 thus ?case
+ case 4 thus ?case
apply transfer
apply(auto simp: \<gamma>_rep_def plus_rep_def add_mono_le_Fin add_mono_Fin_le)
by(auto simp: empty_rep_def is_empty_rep_def)
@@ -321,26 +321,26 @@
permanent_interpretation Val_lattice_gamma
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = "op +"
defining aval_ivl = aval'
-proof
- case goal1 show ?case by(simp add: \<gamma>_inf)
+proof (standard, goal_cases)
+ case 1 show ?case by(simp add: \<gamma>_inf)
next
- case goal2 show ?case unfolding bot_ivl_def by transfer simp
+ case 2 show ?case unfolding bot_ivl_def by transfer simp
qed
permanent_interpretation Val_inv
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = "op +"
and test_num' = in_ivl
and inv_plus' = inv_plus_ivl and inv_less' = inv_less_ivl
-proof
- case goal1 thus ?case by transfer (auto simp: \<gamma>_rep_def)
+proof (standard, goal_cases)
+ case 1 thus ?case by transfer (auto simp: \<gamma>_rep_def)
next
- case goal2 thus ?case
+ case (2 _ _ _ _ _ i1 i2) thus ?case
unfolding inv_plus_ivl_def minus_ivl_def
apply(clarsimp simp add: \<gamma>_inf)
using gamma_plus'[of "i1+i2" _ "-i1"] gamma_plus'[of "i1+i2" _ "-i2"]
by(simp add: \<gamma>_uminus)
next
- case goal3 thus ?case
+ case (3 i1 i2) thus ?case
unfolding inv_less_ivl_def minus_ivl_def one_extended_def
apply(clarsimp simp add: \<gamma>_inf split: if_splits)
using gamma_plus'[of "i1+1" _ "-1"] gamma_plus'[of "i2 - 1" _ "1"]
@@ -388,14 +388,14 @@
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = "op +"
and test_num' = in_ivl
and inv_plus' = inv_plus_ivl and inv_less' = inv_less_ivl
-proof
- case goal1 thus ?case by (rule mono_plus_ivl)
+proof (standard, goal_cases)
+ case 1 thus ?case by (rule mono_plus_ivl)
next
- case goal2 thus ?case
+ case 2 thus ?case
unfolding inv_plus_ivl_def minus_ivl_def less_eq_prod_def
by (auto simp: le_infI1 le_infI2 mono_plus_ivl mono_minus_ivl)
next
- case goal3 thus ?case
+ case 3 thus ?case
unfolding less_eq_prod_def inv_less_ivl_def minus_ivl_def
by (auto simp: le_infI1 le_infI2 mono_plus_ivl mono_above mono_below)
qed
--- a/src/HOL/IMP/Abs_Int3.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_Int3.thy Fri Sep 18 16:42:19 2015 +0100
@@ -63,18 +63,14 @@
by(auto simp: eq_st_def)
instance
-proof
- case goal1 thus ?case
- by transfer (simp add: less_eq_st_rep_iff widen1)
+proof (standard, goal_cases)
+ case 1 thus ?case by transfer (simp add: less_eq_st_rep_iff widen1)
next
- case goal2 thus ?case
- by transfer (simp add: less_eq_st_rep_iff widen2)
+ case 2 thus ?case by transfer (simp add: less_eq_st_rep_iff widen2)
next
- case goal3 thus ?case
- by transfer (simp add: less_eq_st_rep_iff narrow1)
+ case 3 thus ?case by transfer (simp add: less_eq_st_rep_iff narrow1)
next
- case goal4 thus ?case
- by transfer (simp add: less_eq_st_rep_iff narrow2)
+ case 4 thus ?case by transfer (simp add: less_eq_st_rep_iff narrow2)
qed
end
@@ -94,17 +90,17 @@
"(Some x) \<triangle> (Some y) = Some(x \<triangle> y)"
instance
-proof
- case goal1 thus ?case
+proof (standard, goal_cases)
+ case (1 x y) thus ?case
by(induct x y rule: widen_option.induct)(simp_all add: widen1)
next
- case goal2 thus ?case
+ case (2 x y) thus ?case
by(induct x y rule: widen_option.induct)(simp_all add: widen2)
next
- case goal3 thus ?case
+ case (3 x y) thus ?case
by(induct x y rule: narrow_option.induct) (simp_all add: narrow1)
next
- case goal4 thus ?case
+ case (4 y x) thus ?case
by(induct x y rule: narrow_option.induct) (simp_all add: narrow2)
qed
@@ -550,14 +546,14 @@
and test_num' = in_ivl
and inv_plus' = inv_plus_ivl and inv_less' = inv_less_ivl
and m = m_ivl and n = n_ivl and h = 3
-proof
- case goal2 thus ?case by(rule m_ivl_anti_mono)
+proof (standard, goal_cases)
+ case 2 thus ?case by(rule m_ivl_anti_mono)
next
- case goal1 thus ?case by(rule m_ivl_height)
+ case 1 thus ?case by(rule m_ivl_height)
next
- case goal3 thus ?case by(rule m_ivl_widen)
+ case 3 thus ?case by(rule m_ivl_widen)
next
- case goal4 from goal4(2) show ?case by(rule n_ivl_narrow)
+ case 4 from 4(2) show ?case by(rule n_ivl_narrow)
-- "note that the first assms is unnecessary for intervals"
qed
--- a/src/HOL/IMP/Abs_State.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Abs_State.thy Fri Sep 18 16:42:19 2015 +0100
@@ -66,15 +66,14 @@
definition less_st where "F < (G::'a st) = (F \<le> G \<and> \<not> G \<le> F)"
instance
-proof
- case goal1 show ?case by(rule less_st_def)
-next
- case goal2 show ?case by transfer (auto simp: less_eq_st_rep_def)
+proof (standard, goal_cases)
+ case 1 show ?case by(rule less_st_def)
next
- case goal3 thus ?case
- by transfer (metis less_eq_st_rep_iff order_trans)
+ case 2 show ?case by transfer (auto simp: less_eq_st_rep_def)
next
- case goal4 thus ?case
+ case 3 thus ?case by transfer (metis less_eq_st_rep_iff order_trans)
+next
+ case 4 thus ?case
by transfer (metis less_eq_st_rep_iff eq_st_def fun_eq_iff antisym)
qed
@@ -105,15 +104,14 @@
lift_definition top_st :: "'a st" is "[]" .
instance
-proof
- case goal1 show ?case by transfer (simp add:less_eq_st_rep_iff)
-next
- case goal2 show ?case by transfer (simp add:less_eq_st_rep_iff)
+proof (standard, goal_cases)
+ case 1 show ?case by transfer (simp add:less_eq_st_rep_iff)
next
- case goal3 thus ?case by transfer (simp add:less_eq_st_rep_iff)
+ case 2 show ?case by transfer (simp add:less_eq_st_rep_iff)
next
- case goal4 show ?case
- by transfer (simp add:less_eq_st_rep_iff fun_rep_map_of)
+ case 3 thus ?case by transfer (simp add:less_eq_st_rep_iff)
+next
+ case 4 show ?case by transfer (simp add:less_eq_st_rep_iff fun_rep_map_of)
qed
end
--- a/src/HOL/IMP/Collecting.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Collecting.thy Fri Sep 18 16:42:19 2015 +0100
@@ -45,14 +45,14 @@
"less_acom x y = (x \<le> y \<and> \<not> y \<le> x)"
instance
-proof
- case goal1 show ?case by(simp add: less_acom_def)
+proof (standard, goal_cases)
+ case 1 show ?case by(simp add: less_acom_def)
next
- case goal2 thus ?case by(auto simp: less_eq_acom_def)
+ case 2 thus ?case by(auto simp: less_eq_acom_def)
next
- case goal3 thus ?case by(fastforce simp: less_eq_acom_def size_annos)
+ case 3 thus ?case by(fastforce simp: less_eq_acom_def size_annos)
next
- case goal4 thus ?case
+ case 4 thus ?case
by(fastforce simp: le_antisym less_eq_acom_def size_annos
eq_acom_iff_strip_anno)
qed
@@ -97,14 +97,14 @@
permanent_interpretation
Complete_Lattice "{C. strip C = c}" "Inf_acom c" for c
-proof
- case goal1 thus ?case
+proof (standard, goal_cases)
+ case 1 thus ?case
by(auto simp: Inf_acom_def less_eq_acom_def size_annos intro:INF_lower)
next
- case goal2 thus ?case
+ case 2 thus ?case
by(auto simp: Inf_acom_def less_eq_acom_def size_annos intro:INF_greatest)
next
- case goal3 thus ?case by(auto simp: Inf_acom_def)
+ case 3 thus ?case by(auto simp: Inf_acom_def)
qed
--- a/src/HOL/IMP/Compiler.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Compiler.thy Fri Sep 18 16:42:19 2015 +0100
@@ -81,8 +81,6 @@
where
"exec P \<equiv> star (exec1 P)"
-declare star.step[intro]
-
lemmas exec_induct = star.induct [of "exec1 P", split_format(complete)]
code_pred exec1 by (metis exec1_def)
@@ -107,7 +105,7 @@
by (auto simp: exec1_def)
lemma exec_appendR: "P \<turnstile> c \<rightarrow>* c' \<Longrightarrow> P@P' \<turnstile> c \<rightarrow>* c'"
-by (induction rule: star.induct) (fastforce intro: exec1_appendR)+
+by (induction rule: star.induct) (fastforce intro: star.step exec1_appendR)+
lemma exec1_appendL:
fixes i i' :: int
@@ -122,7 +120,7 @@
shows
"P \<turnstile> (i,s,stk) \<rightarrow>* (i',s',stk') \<Longrightarrow>
P' @ P \<turnstile> (size(P')+i,s,stk) \<rightarrow>* (size(P')+i',s',stk')"
- by (induction rule: exec_induct) (blast intro!: exec1_appendL)+
+ by (induction rule: exec_induct) (blast intro: star.step exec1_appendL)+
text{* Now we specialise the above lemmas to enable automatic proofs of
@{prop "P \<turnstile> c \<rightarrow>* c'"} where @{text P} is a mixture of concrete instructions and
--- a/src/HOL/IMP/Compiler2.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/IMP/Compiler2.thy Fri Sep 18 16:42:19 2015 +0100
@@ -44,7 +44,7 @@
lemma exec_n_exec:
"P \<turnstile> c \<rightarrow>^n c' \<Longrightarrow> P \<turnstile> c \<rightarrow>* c'"
- by (induct n arbitrary: c) auto
+ by (induct n arbitrary: c) (auto intro: star.step)
lemma exec_0 [intro!]: "P \<turnstile> c \<rightarrow>^0 c" by simp
--- a/src/HOL/Imperative_HOL/Imperative_HOL_ex.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Imperative_HOL/Imperative_HOL_ex.thy Fri Sep 18 16:42:19 2015 +0100
@@ -8,7 +8,6 @@
theory Imperative_HOL_ex
imports Imperative_HOL Overview
"ex/Imperative_Quicksort" "ex/Imperative_Reverse" "ex/Linked_Lists" "ex/SatChecker"
- Legacy_Mrec
begin
definition "everything = (Array.new, Array.of_list, Array.make, Array.len, Array.nth,
--- a/src/HOL/Imperative_HOL/Legacy_Mrec.thy Fri Sep 18 16:27:37 2015 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,169 +0,0 @@
-theory Legacy_Mrec
-imports Heap_Monad
-begin
-
-subsubsection {* A monadic combinator for simple recursive functions *}
-
-text {*
- NOTE: The use of this obsolete combinator is discouraged. Instead, use the
- @{text "partal_function (heap)"} command.
-*}
-
-text {* Using a locale to fix arguments f and g of MREC *}
-
-locale mrec =
- fixes f :: "'a \<Rightarrow> ('b + 'a) Heap"
- and g :: "'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b Heap"
-begin
-
-function (default "\<lambda>(x, h). None") mrec :: "'a \<Rightarrow> heap \<Rightarrow> ('b \<times> heap) option" where
- "mrec x h = (case execute (f x) h of
- Some (Inl r, h') \<Rightarrow> Some (r, h')
- | Some (Inr s, h') \<Rightarrow> (case mrec s h' of
- Some (z, h'') \<Rightarrow> execute (g x s z) h''
- | None \<Rightarrow> None)
- | None \<Rightarrow> None)"
-by auto
-
-lemma graph_implies_dom:
- "mrec_graph x y \<Longrightarrow> mrec_dom x"
-apply (induct rule:mrec_graph.induct)
-apply (rule accpI)
-apply (erule mrec_rel.cases)
-by simp
-
-lemma mrec_default: "\<not> mrec_dom (x, h) \<Longrightarrow> mrec x h = None"
- unfolding mrec_def
- by (rule fundef_default_value[OF mrec_sumC_def graph_implies_dom, of _ _ "(x, h)", simplified])
-
-lemma mrec_di_reverse:
- assumes "\<not> mrec_dom (x, h)"
- shows "
- (case execute (f x) h of
- Some (Inl r, h') \<Rightarrow> False
- | Some (Inr s, h') \<Rightarrow> \<not> mrec_dom (s, h')
- | None \<Rightarrow> False
- )"
-using assms apply (auto split: option.split sum.split)
-apply (rule ccontr)
-apply (erule notE, rule accpI, elim mrec_rel.cases, auto)+
-done
-
-lemma mrec_rule:
- "mrec x h =
- (case execute (f x) h of
- Some (Inl r, h') \<Rightarrow> Some (r, h')
- | Some (Inr s, h') \<Rightarrow>
- (case mrec s h' of
- Some (z, h'') \<Rightarrow> execute (g x s z) h''
- | None \<Rightarrow> None)
- | None \<Rightarrow> None
- )"
-apply (cases "mrec_dom (x,h)", simp add: mrec.psimps)
-apply (frule mrec_default)
-apply (frule mrec_di_reverse, simp)
-by (auto split: sum.split option.split simp: mrec_default)
-
-definition
- "MREC x = Heap_Monad.Heap (mrec x)"
-
-lemma MREC_rule:
- "MREC x =
- do { y \<leftarrow> f x;
- (case y of
- Inl r \<Rightarrow> return r
- | Inr s \<Rightarrow>
- do { z \<leftarrow> MREC s ;
- g x s z })}"
- unfolding MREC_def
- unfolding bind_def return_def
- apply simp
- apply (rule ext)
- apply (unfold mrec_rule[of x])
- by (auto simp add: execute_simps split: option.splits prod.splits sum.splits)
-
-lemma MREC_pinduct:
- assumes "execute (MREC x) h = Some (r, h')"
- assumes non_rec_case: "\<And> x h h' r. execute (f x) h = Some (Inl r, h') \<Longrightarrow> P x h h' r"
- assumes rec_case: "\<And> x h h1 h2 h' s z r. execute (f x) h = Some (Inr s, h1) \<Longrightarrow> execute (MREC s) h1 = Some (z, h2) \<Longrightarrow> P s h1 h2 z
- \<Longrightarrow> execute (g x s z) h2 = Some (r, h') \<Longrightarrow> P x h h' r"
- shows "P x h h' r"
-proof -
- from assms(1) have mrec: "mrec x h = Some (r, h')"
- unfolding MREC_def execute.simps .
- from mrec have dom: "mrec_dom (x, h)"
- apply -
- apply (rule ccontr)
- apply (drule mrec_default) by auto
- from mrec have h'_r: "h' = snd (the (mrec x h))" "r = fst (the (mrec x h))"
- by auto
- from mrec have "P x h (snd (the (mrec x h))) (fst (the (mrec x h)))"
- proof (induct arbitrary: r h' rule: mrec.pinduct[OF dom])
- case (1 x h)
- obtain rr h' where "the (mrec x h) = (rr, h')" by fastforce
- show ?case
- proof (cases "execute (f x) h")
- case (Some result)
- then obtain a h1 where exec_f: "execute (f x) h = Some (a, h1)" by fastforce
- note Inl' = this
- show ?thesis
- proof (cases a)
- case (Inl aa)
- from this Inl' 1(1) exec_f mrec non_rec_case show ?thesis
- by (auto simp: mrec.psimps)
- next
- case (Inr b)
- note Inr' = this
- show ?thesis
- proof (cases "mrec b h1")
- case (Some result)
- then obtain aaa h2 where mrec_rec: "mrec b h1 = Some (aaa, h2)" by fastforce
- moreover from mrec_rec have "P b h1 (snd (the (mrec b h1))) (fst (the (mrec b h1)))"
- apply (intro 1(2))
- apply (auto simp add: Inr Inl')
- done
- moreover note mrec mrec_rec exec_f Inl' Inr' 1(1) 1(3)
- ultimately show ?thesis
- apply auto
- apply (rule rec_case)
- apply auto
- unfolding MREC_def by (auto simp: mrec.psimps)
- next
- case None
- from this 1(1) exec_f mrec Inr' 1(3) show ?thesis by (auto simp: mrec.psimps)
- qed
- qed
- next
- case None
- from this 1(1) mrec 1(3) show ?thesis by (simp add: mrec.psimps)
- qed
- qed
- from this h'_r show ?thesis by simp
-qed
-
-end
-
-text {* Providing global versions of the constant and the theorems *}
-
-abbreviation "MREC == mrec.MREC"
-lemmas MREC_rule = mrec.MREC_rule
-lemmas MREC_pinduct = mrec.MREC_pinduct
-
-lemma MREC_induct:
- assumes "effect (MREC f g x) h h' r"
- assumes "\<And> x h h' r. effect (f x) h h' (Inl r) \<Longrightarrow> P x h h' r"
- assumes "\<And> x h h1 h2 h' s z r. effect (f x) h h1 (Inr s) \<Longrightarrow> effect (MREC f g s) h1 h2 z \<Longrightarrow> P s h1 h2 z
- \<Longrightarrow> effect (g x s z) h2 h' r \<Longrightarrow> P x h h' r"
- shows "P x h h' r"
-proof (rule MREC_pinduct[OF assms(1) [unfolded effect_def]])
- fix x h h1 h2 h' s z r
- assume "Heap_Monad.execute (f x) h = Some (Inr s, h1)"
- "Heap_Monad.execute (MREC f g s) h1 = Some (z, h2)"
- "P s h1 h2 z"
- "Heap_Monad.execute (g x s z) h2 = Some (r, h')"
- from assms(3) [unfolded effect_def, OF this(1) this(2) this(3) this(4)]
- show "P x h h' r" .
-next
-qed (auto simp add: assms(2)[unfolded effect_def])
-
-end
--- a/src/HOL/Imperative_HOL/Overview.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Imperative_HOL/Overview.thy Fri Sep 18 16:42:19 2015 +0100
@@ -8,18 +8,14 @@
begin
(* type constraints with spacing *)
-setup {*
-let
- val typ = Simple_Syntax.read_typ;
-in
- Sign.del_syntax (Symbol.xsymbolsN, false)
- [("_constrain", typ "logic => type => logic", Mixfix ("_\<Colon>_", [4, 0], 3)),
- ("_constrain", typ "prop' => type => prop'", Mixfix ("_\<Colon>_", [4, 0], 3))] #>
- Sign.add_syntax (Symbol.xsymbolsN, false)
- [("_constrain", typ "logic => type => logic", Mixfix ("_ \<Colon> _", [4, 0], 3)),
- ("_constrain", typ "prop' => type => prop'", Mixfix ("_ \<Colon> _", [4, 0], 3))]
-end
-*}(*>*)
+no_syntax (output)
+ "_constrain" :: "logic => type => logic" ("_::_" [4, 0] 3)
+ "_constrain" :: "prop' => type => prop'" ("_::_" [4, 0] 3)
+
+syntax (output)
+ "_constrain" :: "logic => type => logic" ("_ :: _" [4, 0] 3)
+ "_constrain" :: "prop' => type => prop'" ("_ :: _" [4, 0] 3)
+(*>*)
text {*
@{text "Imperative HOL"} is a leightweight framework for reasoning
--- a/src/HOL/Import/import_rule.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Import/import_rule.ML Fri Sep 18 16:42:19 2015 +0100
@@ -218,9 +218,12 @@
| _ => error "type_introduction: bad type definition theorem"
val tfrees = Term.add_tfrees c []
val tnames = sort_strings (map fst tfrees)
+ val typedef_bindings =
+ Typedef.make_morphisms (Binding.name tycname)
+ (SOME (Binding.name rep_name, Binding.name abs_name))
val ((_, typedef_info), thy') =
- Typedef.add_typedef_global false (Binding.name tycname, map (rpair dummyS) tnames, NoSyn) c
- (SOME (Binding.name rep_name, Binding.name abs_name)) (fn ctxt => resolve_tac ctxt [th2] 1) thy
+ Typedef.add_typedef_global (Binding.name tycname, map (rpair dummyS) tnames, NoSyn) c
+ (SOME typedef_bindings) (fn ctxt => resolve_tac ctxt [th2] 1) thy
val aty = #abs_type (#1 typedef_info)
val th = freezeT thy' (#type_definition (#2 typedef_info))
val (th_s, _) = Thm.dest_comb (Thm.dest_arg (Thm.cprop_of th))
--- a/src/HOL/Int.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Int.thy Fri Sep 18 16:42:19 2015 +0100
@@ -66,7 +66,7 @@
qed
instance
- by default (transfer, clarsimp simp: algebra_simps)+
+ by standard (transfer, clarsimp simp: algebra_simps)+
end
@@ -99,7 +99,7 @@
by auto
instance
- by default (transfer, force)+
+ by standard (transfer, force)+
end
@@ -305,13 +305,13 @@
instance int :: no_top
- apply default
+ apply standard
apply (rule_tac x="x + 1" in exI)
apply simp
done
instance int :: no_bot
- apply default
+ apply standard
apply (rule_tac x="x - 1" in exI)
apply simp
done
@@ -775,9 +775,9 @@
declaration \<open>K Int_Arith.setup\<close>
simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
- "(m::'a::linordered_idom) <= n" |
+ "(m::'a::linordered_idom) \<le> n" |
"(m::'a::linordered_idom) = n") =
- \<open>fn _ => fn ss => fn ct => Lin_Arith.simproc ss (Thm.term_of ct)\<close>
+ \<open>K Lin_Arith.simproc\<close>
subsection\<open>More Inequality Reasoning\<close>
@@ -1526,7 +1526,8 @@
definition
"HOL.equal k l \<longleftrightarrow> k = (l::int)"
-instance by default (rule equal_int_def)
+instance
+ by standard (rule equal_int_def)
end
--- a/src/HOL/Lattices.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Lattices.thy Fri Sep 18 16:42:19 2015 +0100
@@ -145,7 +145,7 @@
begin
sublocale ordering_top less_eq less 1
- by default (simp add: order_iff)
+ by standard (simp add: order_iff)
end
@@ -283,7 +283,7 @@
qed
sublocale inf!: semilattice_order inf less_eq less
- by default (auto simp add: le_iff_inf less_le)
+ by standard (auto simp add: le_iff_inf less_le)
lemma inf_assoc: "(x \<sqinter> y) \<sqinter> z = x \<sqinter> (y \<sqinter> z)"
by (fact inf.assoc)
@@ -328,7 +328,7 @@
qed
sublocale sup!: semilattice_order sup greater_eq greater
- by default (auto simp add: le_iff_sup sup.commute less_le)
+ by standard (auto simp add: le_iff_sup sup.commute less_le)
lemma sup_assoc: "(x \<squnion> y) \<squnion> z = x \<squnion> (y \<squnion> z)"
by (fact sup.assoc)
@@ -717,7 +717,7 @@
sublocale min!: semilattice_order min less_eq less
+ max!: semilattice_order max greater_eq greater
- by default (auto simp add: min_def max_def)
+ by standard (auto simp add: min_def max_def)
lemma min_le_iff_disj:
"min x y \<le> z \<longleftrightarrow> x \<le> z \<or> y \<le> z"
--- a/src/HOL/Lattices_Big.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Lattices_Big.thy Fri Sep 18 16:42:19 2015 +0100
@@ -21,7 +21,7 @@
begin
interpretation comp_fun_idem f
- by default (simp_all add: fun_eq_iff left_commute)
+ by standard (simp_all add: fun_eq_iff left_commute)
definition F :: "'a set \<Rightarrow> 'a"
where
@@ -33,7 +33,7 @@
proof (rule sym)
let ?f = "\<lambda>x y. Some (case y of None \<Rightarrow> x | Some z \<Rightarrow> f x z)"
interpret comp_fun_idem "?f"
- by default (simp_all add: fun_eq_iff commute left_commute split: option.split)
+ by standard (simp_all add: fun_eq_iff commute left_commute split: option.split)
from assms show "Finite_Set.fold f x A = F (insert x A)"
proof induct
case empty then show ?case by (simp add: eq_fold')
@@ -189,7 +189,7 @@
begin
interpretation comp_fun_idem f
- by default (simp_all add: fun_eq_iff left_commute)
+ by standard (simp_all add: fun_eq_iff left_commute)
definition F :: "'a set \<Rightarrow> 'a"
where
@@ -496,9 +496,9 @@
"semilattice_set.F min = Min"
and "semilattice_set.F max = Max"
proof -
- show "semilattice_order_set min less_eq less" by default (auto simp add: min_def)
+ show "semilattice_order_set min less_eq less" by standard (auto simp add: min_def)
then interpret Min!: semilattice_order_set min less_eq less .
- show "semilattice_order_set max greater_eq greater" by default (auto simp add: max_def)
+ show "semilattice_order_set max greater_eq greater" by standard (auto simp add: max_def)
then interpret Max!: semilattice_order_set max greater_eq greater .
from Min_def show "semilattice_set.F min = Min" by rule
from Max_def show "semilattice_set.F max = Max" by rule
--- a/src/HOL/Library/Cardinality.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Cardinality.thy Fri Sep 18 16:42:19 2015 +0100
@@ -410,7 +410,10 @@
possibly slow dictionary constructions.
\<close>
-definition card_UNIV' :: "'a card_UNIV"
+context
+begin
+
+qualified definition card_UNIV' :: "'a card_UNIV"
where [code del]: "card_UNIV' = Phantom('a) CARD('a)"
lemma CARD_code [code_unfold]:
@@ -421,7 +424,7 @@
"card_UNIV' = card_UNIV"
by(simp add: card_UNIV card_UNIV'_def)
-hide_const (open) card_UNIV'
+end
lemma card_Compl:
"finite A \<Longrightarrow> card (- A) = card (UNIV :: 'a set) - card (A :: 'a set)"
@@ -430,7 +433,7 @@
context fixes xs :: "'a :: finite_UNIV list"
begin
-definition finite' :: "'a set \<Rightarrow> bool"
+qualified definition finite' :: "'a set \<Rightarrow> bool"
where [simp, code del, code_abbrev]: "finite' = finite"
lemma finite'_code [code]:
@@ -443,7 +446,7 @@
context fixes xs :: "'a :: card_UNIV list"
begin
-definition card' :: "'a set \<Rightarrow> nat"
+qualified definition card' :: "'a set \<Rightarrow> nat"
where [simp, code del, code_abbrev]: "card' = card"
lemma card'_code [code]:
@@ -452,7 +455,7 @@
by(simp_all add: List.card_set card_Compl card_UNIV)
-definition subset' :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool"
+qualified definition subset' :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool"
where [simp, code del, code_abbrev]: "subset' = op \<subseteq>"
lemma subset'_code [code]:
@@ -462,7 +465,7 @@
by(auto simp add: Let_def card_gt_0_iff dest: card_eq_UNIV_imp_eq_UNIV intro: arg_cong[where f=card])
(metis finite_compl finite_set rev_finite_subset)
-definition eq_set :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool"
+qualified definition eq_set :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool"
where [simp, code del, code_abbrev]: "eq_set = op ="
lemma eq_set_code [code]:
@@ -476,7 +479,7 @@
and "eq_set (set ys) (List.coset xs) \<longleftrightarrow> rhs"
and "eq_set (set xs) (set ys) \<longleftrightarrow> (\<forall>x \<in> set xs. x \<in> set ys) \<and> (\<forall>y \<in> set ys. y \<in> set xs)"
and "eq_set (List.coset xs) (List.coset ys) \<longleftrightarrow> (\<forall>x \<in> set xs. x \<in> set ys) \<and> (\<forall>y \<in> set ys. y \<in> set xs)"
-proof goals
+proof goal_cases
{
case 1
show ?case (is "?lhs \<longleftrightarrow> ?rhs")
@@ -538,7 +541,4 @@
by eval
end
-hide_const (open) card' finite' subset' eq_set
-
end
-
--- a/src/HOL/Library/Code_Binary_Nat.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Code_Binary_Nat.thy Fri Sep 18 16:42:19 2015 +0100
@@ -40,6 +40,9 @@
subsection \<open>Basic arithmetic\<close>
+context
+begin
+
lemma [code, code del]:
"(plus :: nat \<Rightarrow> _) = plus" ..
@@ -51,7 +54,7 @@
text \<open>Bounded subtraction needs some auxiliary\<close>
-definition dup :: "nat \<Rightarrow> nat" where
+qualified definition dup :: "nat \<Rightarrow> nat" where
"dup n = n + n"
lemma dup_code [code]:
@@ -59,7 +62,7 @@
"dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
by (simp_all add: dup_def numeral_Bit0)
-definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
+qualified definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
"sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
lemma sub_code [code]:
@@ -139,6 +142,8 @@
"divmod_nat 0 n = (0, 0)"
by (simp_all add: prod_eq_iff nat_of_num_numeral)
+end
+
subsection \<open>Conversions\<close>
@@ -155,7 +160,4 @@
code_module Code_Binary_Nat \<rightharpoonup>
(SML) Arith and (OCaml) Arith and (Haskell) Arith
-hide_const (open) dup sub
-
end
-
--- a/src/HOL/Library/Code_Real_Approx_By_Float.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy Fri Sep 18 16:42:19 2015 +0100
@@ -85,20 +85,23 @@
and (OCaml) "Pervasives.sqrt"
declare sqrt_def[code del]
-definition real_exp :: "real \<Rightarrow> real" where "real_exp = exp"
+context
+begin
+
+qualified definition real_exp :: "real \<Rightarrow> real" where "real_exp = exp"
lemma exp_eq_real_exp[code_unfold]: "exp = real_exp"
unfolding real_exp_def ..
+end
+
code_printing
- constant real_exp \<rightharpoonup>
+ constant Code_Real_Approx_By_Float.real_exp \<rightharpoonup>
(SML) "Math.exp"
and (OCaml) "Pervasives.exp"
-declare real_exp_def[code del]
+declare Code_Real_Approx_By_Float.real_exp_def[code del]
declare exp_def[code del]
-hide_const (open) real_exp
-
code_printing
constant ln \<rightharpoonup>
(SML) "Math.ln"
@@ -149,7 +152,10 @@
(SML) "Real.fromInt"
and (OCaml) "Pervasives.float (Big'_int.int'_of'_big'_int (_))"
-definition real_of_int :: "int \<Rightarrow> real" where
+context
+begin
+
+qualified definition real_of_int :: "int \<Rightarrow> real" where
[code_abbrev]: "real_of_int = of_int"
lemma [code]:
@@ -172,7 +178,7 @@
"- numeral k \<equiv> (of_rat (- numeral k) :: real)"
by simp
-hide_const (open) real_of_int
+end
code_printing
constant Ratreal \<rightharpoonup> (SML)
--- a/src/HOL/Library/Countable.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Countable.thy Fri Sep 18 16:42:19 2015 +0100
@@ -66,15 +66,17 @@
subsection \<open>Automatically proving countability of old-style datatypes\<close>
-inductive finite_item :: "'a Old_Datatype.item \<Rightarrow> bool" where
+context
+begin
+
+qualified inductive finite_item :: "'a Old_Datatype.item \<Rightarrow> bool" where
undefined: "finite_item undefined"
| In0: "finite_item x \<Longrightarrow> finite_item (Old_Datatype.In0 x)"
| In1: "finite_item x \<Longrightarrow> finite_item (Old_Datatype.In1 x)"
| Leaf: "finite_item (Old_Datatype.Leaf a)"
| Scons: "\<lbrakk>finite_item x; finite_item y\<rbrakk> \<Longrightarrow> finite_item (Old_Datatype.Scons x y)"
-function
- nth_item :: "nat \<Rightarrow> ('a::countable) Old_Datatype.item"
+qualified function nth_item :: "nat \<Rightarrow> ('a::countable) Old_Datatype.item"
where
"nth_item 0 = undefined"
| "nth_item (Suc n) =
@@ -97,7 +99,7 @@
lemma le_sum_encode_Inr: "x \<le> y \<Longrightarrow> x \<le> sum_encode (Inr y)"
unfolding sum_encode_def by simp
-termination
+qualified termination
by (relation "measure id")
(auto simp add: sum_encode_eq [symmetric] prod_encode_eq [symmetric]
le_imp_less_Suc le_sum_encode_Inl le_sum_encode_Inr
@@ -193,7 +195,7 @@
end)
\<close>
-hide_const (open) finite_item nth_item
+end
subsection \<open>Automatically proving countability of datatypes\<close>
--- a/src/HOL/Library/DAList_Multiset.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/DAList_Multiset.thy Fri Sep 18 16:42:19 2015 +0100
@@ -275,10 +275,13 @@
"fold_impl fn e ((a,n) # ms) = (fold_impl fn ((fn a n) e) ms)"
| "fold_impl fn e [] = e"
-definition fold :: "('a \<Rightarrow> nat \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> ('a, nat) alist \<Rightarrow> 'b"
+context
+begin
+
+qualified definition fold :: "('a \<Rightarrow> nat \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> ('a, nat) alist \<Rightarrow> 'b"
where "fold f e al = fold_impl f e (DAList.impl_of al)"
-hide_const (open) fold
+end
context comp_fun_commute
begin
@@ -348,7 +351,10 @@
end
-lift_definition single_alist_entry :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'b) alist" is "\<lambda>a b. [(a, b)]"
+context
+begin
+
+private lift_definition single_alist_entry :: "'a \<Rightarrow> 'b \<Rightarrow> ('a, 'b) alist" is "\<lambda>a b. [(a, b)]"
by auto
lemma image_mset_Bag [code]:
@@ -368,7 +374,7 @@
qed
qed
-hide_const single_alist_entry
+end
(* we cannot use (\<lambda>a n. op + (a * n)) for folding, since * is not defined
in comm_monoid_add *)
--- a/src/HOL/Library/Debug.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Debug.thy Fri Sep 18 16:42:19 2015 +0100
@@ -6,37 +6,40 @@
imports Main
begin
-definition trace :: "String.literal \<Rightarrow> unit" where
+context
+begin
+
+qualified definition trace :: "String.literal \<Rightarrow> unit" where
[simp]: "trace s = ()"
-definition tracing :: "String.literal \<Rightarrow> 'a \<Rightarrow> 'a" where
+qualified definition tracing :: "String.literal \<Rightarrow> 'a \<Rightarrow> 'a" where
[simp]: "tracing s = id"
lemma [code]:
"tracing s = (let u = trace s in id)"
by simp
-definition flush :: "'a \<Rightarrow> unit" where
+qualified definition flush :: "'a \<Rightarrow> unit" where
[simp]: "flush x = ()"
-definition flushing :: "'a \<Rightarrow> 'b \<Rightarrow> 'b" where
+qualified definition flushing :: "'a \<Rightarrow> 'b \<Rightarrow> 'b" where
[simp]: "flushing x = id"
lemma [code, code_unfold]:
"flushing x = (let u = flush x in id)"
by simp
-definition timing :: "String.literal \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where
+qualified definition timing :: "String.literal \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where
[simp]: "timing s f x = f x"
+end
+
code_printing
- constant trace \<rightharpoonup> (Eval) "Output.tracing"
-| constant flush \<rightharpoonup> (Eval) "Output.tracing/ (@{make'_string} _)" -- \<open>note indirection via antiquotation\<close>
-| constant timing \<rightharpoonup> (Eval) "Timing.timeap'_msg"
+ constant Debug.trace \<rightharpoonup> (Eval) "Output.tracing"
+| constant Debug.flush \<rightharpoonup> (Eval) "Output.tracing/ (@{make'_string} _)" -- \<open>note indirection via antiquotation\<close>
+| constant Debug.timing \<rightharpoonup> (Eval) "Timing.timeap'_msg"
code_reserved Eval Output Timing
-hide_const (open) trace tracing flush flushing timing
-
end
--- a/src/HOL/Library/Discrete.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Discrete.thy Fri Sep 18 16:42:19 2015 +0100
@@ -8,7 +8,10 @@
subsection \<open>Discrete logarithm\<close>
-fun log :: "nat \<Rightarrow> nat"
+context
+begin
+
+qualified fun log :: "nat \<Rightarrow> nat"
where [simp del]: "log n = (if n < 2 then 0 else Suc (log (n div 2)))"
lemma log_zero [simp]: "log 0 = 0"
@@ -67,7 +70,7 @@
subsection \<open>Discrete square root\<close>
-definition sqrt :: "nat \<Rightarrow> nat"
+qualified definition sqrt :: "nat \<Rightarrow> nat"
where "sqrt n = Max {m. m\<^sup>2 \<le> n}"
lemma sqrt_aux:
@@ -173,7 +176,6 @@
lemma sqrt_le: "sqrt n \<le> n"
using sqrt_aux [of n] by (auto simp add: sqrt_def intro: power2_nat_le_imp_le)
-hide_const (open) log sqrt
-
end
+end
\ No newline at end of file
--- a/src/HOL/Library/Dlist.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Dlist.thy Fri Sep 18 16:42:19 2015 +0100
@@ -46,61 +46,71 @@
text \<open>Fundamental operations:\<close>
-definition empty :: "'a dlist" where
+context
+begin
+
+qualified definition empty :: "'a dlist" where
"empty = Dlist []"
-definition insert :: "'a \<Rightarrow> 'a dlist \<Rightarrow> 'a dlist" where
+qualified definition insert :: "'a \<Rightarrow> 'a dlist \<Rightarrow> 'a dlist" where
"insert x dxs = Dlist (List.insert x (list_of_dlist dxs))"
-definition remove :: "'a \<Rightarrow> 'a dlist \<Rightarrow> 'a dlist" where
+qualified definition remove :: "'a \<Rightarrow> 'a dlist \<Rightarrow> 'a dlist" where
"remove x dxs = Dlist (remove1 x (list_of_dlist dxs))"
-definition map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a dlist \<Rightarrow> 'b dlist" where
+qualified definition map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a dlist \<Rightarrow> 'b dlist" where
"map f dxs = Dlist (remdups (List.map f (list_of_dlist dxs)))"
-definition filter :: "('a \<Rightarrow> bool) \<Rightarrow> 'a dlist \<Rightarrow> 'a dlist" where
+qualified definition filter :: "('a \<Rightarrow> bool) \<Rightarrow> 'a dlist \<Rightarrow> 'a dlist" where
"filter P dxs = Dlist (List.filter P (list_of_dlist dxs))"
+end
+
text \<open>Derived operations:\<close>
-definition null :: "'a dlist \<Rightarrow> bool" where
+context
+begin
+
+qualified definition null :: "'a dlist \<Rightarrow> bool" where
"null dxs = List.null (list_of_dlist dxs)"
-definition member :: "'a dlist \<Rightarrow> 'a \<Rightarrow> bool" where
+qualified definition member :: "'a dlist \<Rightarrow> 'a \<Rightarrow> bool" where
"member dxs = List.member (list_of_dlist dxs)"
-definition length :: "'a dlist \<Rightarrow> nat" where
+qualified definition length :: "'a dlist \<Rightarrow> nat" where
"length dxs = List.length (list_of_dlist dxs)"
-definition fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a dlist \<Rightarrow> 'b \<Rightarrow> 'b" where
+qualified definition fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a dlist \<Rightarrow> 'b \<Rightarrow> 'b" where
"fold f dxs = List.fold f (list_of_dlist dxs)"
-definition foldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a dlist \<Rightarrow> 'b \<Rightarrow> 'b" where
+qualified definition foldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a dlist \<Rightarrow> 'b \<Rightarrow> 'b" where
"foldr f dxs = List.foldr f (list_of_dlist dxs)"
+end
+
subsection \<open>Executable version obeying invariant\<close>
lemma list_of_dlist_empty [simp, code abstract]:
- "list_of_dlist empty = []"
- by (simp add: empty_def)
+ "list_of_dlist Dlist.empty = []"
+ by (simp add: Dlist.empty_def)
lemma list_of_dlist_insert [simp, code abstract]:
- "list_of_dlist (insert x dxs) = List.insert x (list_of_dlist dxs)"
- by (simp add: insert_def)
+ "list_of_dlist (Dlist.insert x dxs) = List.insert x (list_of_dlist dxs)"
+ by (simp add: Dlist.insert_def)
lemma list_of_dlist_remove [simp, code abstract]:
- "list_of_dlist (remove x dxs) = remove1 x (list_of_dlist dxs)"
- by (simp add: remove_def)
+ "list_of_dlist (Dlist.remove x dxs) = remove1 x (list_of_dlist dxs)"
+ by (simp add: Dlist.remove_def)
lemma list_of_dlist_map [simp, code abstract]:
- "list_of_dlist (map f dxs) = remdups (List.map f (list_of_dlist dxs))"
- by (simp add: map_def)
+ "list_of_dlist (Dlist.map f dxs) = remdups (List.map f (list_of_dlist dxs))"
+ by (simp add: Dlist.map_def)
lemma list_of_dlist_filter [simp, code abstract]:
- "list_of_dlist (filter P dxs) = List.filter P (list_of_dlist dxs)"
- by (simp add: filter_def)
+ "list_of_dlist (Dlist.filter P dxs) = List.filter P (list_of_dlist dxs)"
+ by (simp add: Dlist.filter_def)
text \<open>Explicit executable conversion\<close>
@@ -134,28 +144,29 @@
subsection \<open>Induction principle and case distinction\<close>
lemma dlist_induct [case_names empty insert, induct type: dlist]:
- assumes empty: "P empty"
- assumes insrt: "\<And>x dxs. \<not> member dxs x \<Longrightarrow> P dxs \<Longrightarrow> P (insert x dxs)"
+ assumes empty: "P Dlist.empty"
+ assumes insrt: "\<And>x dxs. \<not> Dlist.member dxs x \<Longrightarrow> P dxs \<Longrightarrow> P (Dlist.insert x dxs)"
shows "P dxs"
proof (cases dxs)
case (Abs_dlist xs)
- then have "distinct xs" and dxs: "dxs = Dlist xs" by (simp_all add: Dlist_def distinct_remdups_id)
+ then have "distinct xs" and dxs: "dxs = Dlist xs"
+ by (simp_all add: Dlist_def distinct_remdups_id)
from \<open>distinct xs\<close> have "P (Dlist xs)"
proof (induct xs)
- case Nil from empty show ?case by (simp add: empty_def)
+ case Nil from empty show ?case by (simp add: Dlist.empty_def)
next
case (Cons x xs)
- then have "\<not> member (Dlist xs) x" and "P (Dlist xs)"
- by (simp_all add: member_def List.member_def)
- with insrt have "P (insert x (Dlist xs))" .
- with Cons show ?case by (simp add: insert_def distinct_remdups_id)
+ then have "\<not> Dlist.member (Dlist xs) x" and "P (Dlist xs)"
+ by (simp_all add: Dlist.member_def List.member_def)
+ with insrt have "P (Dlist.insert x (Dlist xs))" .
+ with Cons show ?case by (simp add: Dlist.insert_def distinct_remdups_id)
qed
with dxs show "P dxs" by simp
qed
lemma dlist_case [cases type: dlist]:
- obtains (empty) "dxs = empty"
- | (insert) x dys where "\<not> member dys x" and "dxs = insert x dys"
+ obtains (empty) "dxs = Dlist.empty"
+ | (insert) x dys where "\<not> Dlist.member dys x" and "dxs = Dlist.insert x dys"
proof (cases dxs)
case (Abs_dlist xs)
then have dxs: "dxs = Dlist xs" and distinct: "distinct xs"
@@ -163,13 +174,13 @@
show thesis
proof (cases xs)
case Nil with dxs
- have "dxs = empty" by (simp add: empty_def)
+ have "dxs = Dlist.empty" by (simp add: Dlist.empty_def)
with empty show ?thesis .
next
case (Cons x xs)
- with dxs distinct have "\<not> member (Dlist xs) x"
- and "dxs = insert x (Dlist xs)"
- by (simp_all add: member_def List.member_def insert_def distinct_remdups_id)
+ with dxs distinct have "\<not> Dlist.member (Dlist xs) x"
+ and "dxs = Dlist.insert x (Dlist xs)"
+ by (simp_all add: Dlist.member_def List.member_def Dlist.insert_def distinct_remdups_id)
with insert show ?thesis .
qed
qed
@@ -178,14 +189,11 @@
subsection \<open>Functorial structure\<close>
functor map: map
- by (simp_all add: List.map.id remdups_map_remdups fun_eq_iff dlist_eq_iff)
+ by (simp_all add: remdups_map_remdups fun_eq_iff dlist_eq_iff)
subsection \<open>Quickcheck generators\<close>
-quickcheck_generator dlist predicate: distinct constructors: empty, insert
-
-
-hide_const (open) member fold foldr empty insert remove map filter null member length fold
+quickcheck_generator dlist predicate: distinct constructors: Dlist.empty, Dlist.insert
end
--- a/src/HOL/Library/Extended_Real.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Extended_Real.thy Fri Sep 18 16:42:19 2015 +0100
@@ -333,7 +333,7 @@
| "ereal r + -\<infinity> = - \<infinity>"
| "-\<infinity> + ereal p = -(\<infinity>::ereal)"
| "-\<infinity> + -\<infinity> = -(\<infinity>::ereal)"
-proof goals
+proof goal_cases
case prems: (1 P x)
then obtain a b where "x = (a, b)"
by (cases x) auto
@@ -437,7 +437,7 @@
| "ereal x < \<infinity> \<longleftrightarrow> True"
| " -\<infinity> < ereal r \<longleftrightarrow> True"
| " -\<infinity> < (\<infinity>::ereal) \<longleftrightarrow> True"
-proof goals
+proof goal_cases
case prems: (1 P x)
then obtain a b where "x = (a,b)" by (cases x) auto
with prems show P by (cases rule: ereal2_cases[of a b]) auto
@@ -860,7 +860,7 @@
| "-(\<infinity>::ereal) * \<infinity> = -\<infinity>"
| "(\<infinity>::ereal) * -\<infinity> = -\<infinity>"
| "-(\<infinity>::ereal) * -\<infinity> = \<infinity>"
-proof goals
+proof goal_cases
case prems: (1 P x)
then obtain a b where "x = (a, b)"
by (cases x) auto
@@ -913,7 +913,7 @@
lemma ereal_times[simp]:
"1 \<noteq> (\<infinity>::ereal)" "(\<infinity>::ereal) \<noteq> 1"
"1 \<noteq> -(\<infinity>::ereal)" "-(\<infinity>::ereal) \<noteq> 1"
- by (auto simp add: times_ereal_def one_ereal_def)
+ by (auto simp: one_ereal_def)
lemma ereal_plus_1[simp]:
"1 + ereal r = ereal (r + 1)"
@@ -2195,7 +2195,7 @@
show "ereal_of_enat (Sup A) \<le> (SUP a : A. ereal_of_enat a)"
proof cases
assume "finite A"
- with `A \<noteq> {}` obtain a where "a \<in> A" "ereal_of_enat (Sup A) = ereal_of_enat a"
+ with \<open>A \<noteq> {}\<close> obtain a where "a \<in> A" "ereal_of_enat (Sup A) = ereal_of_enat a"
using Max_in[of A] by (auto simp: Sup_enat_def simp del: Max_in)
then show ?thesis
by (auto intro: SUP_upper)
@@ -2208,11 +2208,11 @@
then obtain n :: nat where "x < n"
using less_PInf_Ex_of_nat top_ereal_def by auto
obtain a where "a \<in> A - enat ` {.. n}"
- by (metis `\<not> finite A` all_not_in_conv finite_Diff2 finite_atMost finite_imageI finite.emptyI)
+ by (metis \<open>\<not> finite A\<close> all_not_in_conv finite_Diff2 finite_atMost finite_imageI finite.emptyI)
then have "a \<in> A" "ereal n \<le> ereal_of_enat a"
by (auto simp: image_iff Ball_def)
(metis enat_iless enat_ord_simps(1) ereal_of_enat_less_iff ereal_of_enat_simps(1) less_le not_less)
- with `x < n` show "\<exists>i\<in>A. x < ereal_of_enat i"
+ with \<open>x < n\<close> show "\<exists>i\<in>A. x < ereal_of_enat i"
by (auto intro!: bexI[of _ a])
qed
show ?thesis
--- a/src/HOL/Library/Fraction_Field.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Fraction_Field.thy Fri Sep 18 16:42:19 2015 +0100
@@ -13,24 +13,23 @@
subsubsection \<open>Construction of the type of fractions\<close>
-definition fractrel :: "(('a::idom * 'a ) * ('a * 'a)) set" where
- "fractrel = {(x, y). snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x}"
+context idom begin
+
+definition fractrel :: "'a \<times> 'a \<Rightarrow> 'a * 'a \<Rightarrow> bool" where
+ "fractrel = (\<lambda>x y. snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x)"
lemma fractrel_iff [simp]:
- "(x, y) \<in> fractrel \<longleftrightarrow> snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x"
+ "fractrel x y \<longleftrightarrow> snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x"
by (simp add: fractrel_def)
-lemma refl_fractrel: "refl_on {x. snd x \<noteq> 0} fractrel"
- by (auto simp add: refl_on_def fractrel_def)
-
-lemma sym_fractrel: "sym fractrel"
- by (simp add: fractrel_def sym_def)
+lemma symp_fractrel: "symp fractrel"
+ by (simp add: symp_def)
-lemma trans_fractrel: "trans fractrel"
-proof (rule transI, unfold split_paired_all)
+lemma transp_fractrel: "transp fractrel"
+proof (rule transpI, unfold split_paired_all)
fix a b a' b' a'' b'' :: 'a
- assume A: "((a, b), (a', b')) \<in> fractrel"
- assume B: "((a', b'), (a'', b'')) \<in> fractrel"
+ assume A: "fractrel (a, b) (a', b')"
+ assume B: "fractrel (a', b') (a'', b'')"
have "b' * (a * b'') = b'' * (a * b')" by (simp add: ac_simps)
also from A have "a * b' = a' * b" by auto
also have "b'' * (a' * b) = b * (a' * b'')" by (simp add: ac_simps)
@@ -39,46 +38,27 @@
finally have "b' * (a * b'') = b' * (a'' * b)" .
moreover from B have "b' \<noteq> 0" by auto
ultimately have "a * b'' = a'' * b" by simp
- with A B show "((a, b), (a'', b'')) \<in> fractrel" by auto
+ with A B show "fractrel (a, b) (a'', b'')" by auto
qed
-lemma equiv_fractrel: "equiv {x. snd x \<noteq> 0} fractrel"
- by (rule equivI [OF refl_fractrel sym_fractrel trans_fractrel])
-
-lemmas UN_fractrel = UN_equiv_class [OF equiv_fractrel]
-lemmas UN_fractrel2 = UN_equiv_class2 [OF equiv_fractrel equiv_fractrel]
-
-lemma equiv_fractrel_iff [iff]:
- assumes "snd x \<noteq> 0" and "snd y \<noteq> 0"
- shows "fractrel `` {x} = fractrel `` {y} \<longleftrightarrow> (x, y) \<in> fractrel"
- by (rule eq_equiv_class_iff, rule equiv_fractrel) (auto simp add: assms)
-
-definition "fract = {(x::'a\<times>'a). snd x \<noteq> (0::'a::idom)} // fractrel"
+lemma part_equivp_fractrel: "part_equivp fractrel"
+using _ symp_fractrel transp_fractrel
+by(rule part_equivpI)(rule exI[where x="(0, 1)"]; simp)
-typedef 'a fract = "fract :: ('a * 'a::idom) set set"
- unfolding fract_def
-proof
- have "(0::'a, 1::'a) \<in> {x. snd x \<noteq> 0}" by simp
- then show "fractrel `` {(0::'a, 1)} \<in> {x. snd x \<noteq> 0} // fractrel"
- by (rule quotientI)
-qed
+end
-lemma fractrel_in_fract [simp]: "snd x \<noteq> 0 \<Longrightarrow> fractrel `` {x} \<in> fract"
- by (simp add: fract_def quotientI)
-
-declare Abs_fract_inject [simp] Abs_fract_inverse [simp]
-
+quotient_type 'a fract = "'a :: idom \<times> 'a" / partial: "fractrel"
+by(rule part_equivp_fractrel)
subsubsection \<open>Representation and basic operations\<close>
-definition Fract :: "'a::idom \<Rightarrow> 'a \<Rightarrow> 'a fract"
- where "Fract a b = Abs_fract (fractrel `` {if b = 0 then (0, 1) else (a, b)})"
-
-code_datatype Fract
+lift_definition Fract :: "'a :: idom \<Rightarrow> 'a \<Rightarrow> 'a fract"
+ is "\<lambda>a b. if b = 0 then (0, 1) else (a, b)"
+ by simp
lemma Fract_cases [cases type: fract]:
obtains (Fract) a b where "q = Fract a b" "b \<noteq> 0"
- by (cases q) (clarsimp simp add: Fract_def fract_def quotient_def)
+by transfer simp
lemma Fract_induct [case_names Fract, induct type: fract]:
"(\<And>a b. b \<noteq> 0 \<Longrightarrow> P (Fract a b)) \<Longrightarrow> P q"
@@ -88,40 +68,37 @@
shows "\<And>a b c d. b \<noteq> 0 \<Longrightarrow> d \<noteq> 0 \<Longrightarrow> Fract a b = Fract c d \<longleftrightarrow> a * d = c * b"
and "\<And>a. Fract a 0 = Fract 0 1"
and "\<And>a c. Fract 0 a = Fract 0 c"
- by (simp_all add: Fract_def)
+by(transfer; simp)+
instantiation fract :: (idom) "{comm_ring_1,power}"
begin
-definition Zero_fract_def [code_unfold]: "0 = Fract 0 1"
+lift_definition zero_fract :: "'a fract" is "(0, 1)" by simp
-definition One_fract_def [code_unfold]: "1 = Fract 1 1"
+lemma Zero_fract_def: "0 = Fract 0 1"
+by transfer simp
+
+lift_definition one_fract :: "'a fract" is "(1, 1)" by simp
-definition add_fract_def:
- "q + r = Abs_fract (\<Union>x \<in> Rep_fract q. \<Union>y \<in> Rep_fract r.
- fractrel `` {(fst x * snd y + fst y * snd x, snd x * snd y)})"
+lemma One_fract_def: "1 = Fract 1 1"
+by transfer simp
+
+lift_definition plus_fract :: "'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract"
+ is "\<lambda>q r. (fst q * snd r + fst r * snd q, snd q * snd r)"
+by(auto simp add: algebra_simps)
lemma add_fract [simp]:
- assumes "b \<noteq> (0::'a::idom)"
- and "d \<noteq> 0"
- shows "Fract a b + Fract c d = Fract (a * d + c * b) (b * d)"
-proof -
- have "(\<lambda>x y. fractrel``{(fst x * snd y + fst y * snd x, snd x * snd y :: 'a)}) respects2 fractrel"
- by (rule equiv_fractrel [THEN congruent2_commuteI]) (simp_all add: algebra_simps)
- with assms show ?thesis by (simp add: Fract_def add_fract_def UN_fractrel2)
-qed
+ "\<lbrakk> b \<noteq> 0; d \<noteq> 0 \<rbrakk> \<Longrightarrow> Fract a b + Fract c d = Fract (a * d + c * b) (b * d)"
+by transfer simp
-definition minus_fract_def:
- "- q = Abs_fract (\<Union>x \<in> Rep_fract q. fractrel `` {(- fst x, snd x)})"
+lift_definition uminus_fract :: "'a fract \<Rightarrow> 'a fract"
+ is "\<lambda>x. (- fst x, snd x)"
+by simp
-lemma minus_fract [simp, code]:
+lemma minus_fract [simp]:
fixes a b :: "'a::idom"
shows "- Fract a b = Fract (- a) b"
-proof -
- have "(\<lambda>x. fractrel `` {(- fst x, snd x :: 'a)}) respects fractrel"
- by (simp add: congruent_def split_paired_all)
- then show ?thesis by (simp add: Fract_def minus_fract_def UN_fractrel)
-qed
+by transfer simp
lemma minus_fract_cancel [simp]: "Fract (- a) (- b) = Fract a b"
by (cases "b = 0") (simp_all add: eq_fract)
@@ -129,31 +106,19 @@
definition diff_fract_def: "q - r = q + - (r::'a fract)"
lemma diff_fract [simp]:
- assumes "b \<noteq> 0"
- and "d \<noteq> 0"
- shows "Fract a b - Fract c d = Fract (a * d - c * b) (b * d)"
- using assms by (simp add: diff_fract_def)
+ "\<lbrakk> b \<noteq> 0; d \<noteq> 0 \<rbrakk> \<Longrightarrow> Fract a b - Fract c d = Fract (a * d - c * b) (b * d)"
+ by (simp add: diff_fract_def)
-definition mult_fract_def:
- "q * r = Abs_fract (\<Union>x \<in> Rep_fract q. \<Union>y \<in> Rep_fract r.
- fractrel``{(fst x * fst y, snd x * snd y)})"
+lift_definition times_fract :: "'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract"
+ is "\<lambda>q r. (fst q * fst r, snd q * snd r)"
+by(simp add: algebra_simps)
lemma mult_fract [simp]: "Fract (a::'a::idom) b * Fract c d = Fract (a * c) (b * d)"
-proof -
- have "(\<lambda>x y. fractrel `` {(fst x * fst y, snd x * snd y :: 'a)}) respects2 fractrel"
- by (rule equiv_fractrel [THEN congruent2_commuteI]) (simp_all add: algebra_simps)
- then show ?thesis by (simp add: Fract_def mult_fract_def UN_fractrel2)
-qed
+by transfer simp
lemma mult_fract_cancel:
- assumes "c \<noteq> (0::'a)"
- shows "Fract (c * a) (c * b) = Fract a b"
-proof -
- from assms have "Fract c c = Fract 1 1"
- by (simp add: Fract_def)
- then show ?thesis
- by (simp add: mult_fract [symmetric])
-qed
+ "c \<noteq> 0 \<Longrightarrow> Fract (c * a) (c * b) = Fract a b"
+by transfer simp
instance
proof
@@ -188,14 +153,13 @@
lemma Fract_of_nat_eq: "Fract (of_nat k) 1 = of_nat k"
by (rule of_nat_fract [symmetric])
-lemma fract_collapse [code_post]:
+lemma fract_collapse:
"Fract 0 k = 0"
"Fract 1 1 = 1"
"Fract k 0 = 0"
- by (cases "k = 0")
- (simp_all add: Zero_fract_def One_fract_def eq_fract Fract_def)
+by(transfer; simp)+
-lemma fract_expand [code_unfold]:
+lemma fract_expand:
"0 = Fract 0 1"
"1 = Fract 1 1"
by (simp_all add: fract_collapse)
@@ -227,19 +191,12 @@
instantiation fract :: (idom) field
begin
-definition inverse_fract_def:
- "inverse q = Abs_fract (\<Union>x \<in> Rep_fract q.
- fractrel `` {if fst x = 0 then (0, 1) else (snd x, fst x)})"
+lift_definition inverse_fract :: "'a fract \<Rightarrow> 'a fract"
+ is "\<lambda>x. if fst x = 0 then (0, 1) else (snd x, fst x)"
+by(auto simp add: algebra_simps)
lemma inverse_fract [simp]: "inverse (Fract a b) = Fract (b::'a::idom) a"
-proof -
- have *: "\<And>x. (0::'a) = x \<longleftrightarrow> x = 0"
- by auto
- have "(\<lambda>x. fractrel `` {if fst x = 0 then (0, 1) else (snd x, fst x :: 'a)}) respects fractrel"
- by (auto simp add: congruent_def * algebra_simps)
- then show ?thesis
- by (simp add: Fract_def inverse_fract_def UN_fractrel)
-qed
+by transfer simp
definition divide_fract_def: "q div r = q * inverse (r:: 'a fract)"
@@ -266,16 +223,16 @@
subsubsection \<open>The ordered field of fractions over an ordered idom\<close>
-lemma le_congruent2:
- "(\<lambda>x y::'a \<times> 'a::linordered_idom.
- {(fst x * snd y)*(snd x * snd y) \<le> (fst y * snd x)*(snd x * snd y)})
- respects2 fractrel"
-proof (clarsimp simp add: congruent2_def)
- fix a b a' b' c d c' d' :: 'a
- assume neq: "b \<noteq> 0" "b' \<noteq> 0" "d \<noteq> 0" "d' \<noteq> 0"
- assume eq1: "a * b' = a' * b"
- assume eq2: "c * d' = c' * d"
+instantiation fract :: (linordered_idom) linorder
+begin
+lemma less_eq_fract_respect:
+ fixes a b a' b' c d c' d' :: 'a
+ assumes neq: "b \<noteq> 0" "b' \<noteq> 0" "d \<noteq> 0" "d' \<noteq> 0"
+ assumes eq1: "a * b' = a' * b"
+ assumes eq2: "c * d' = c' * d"
+ shows "((a * d) * (b * d) \<le> (c * b) * (b * d)) \<longleftrightarrow> ((a' * d') * (b' * d') \<le> (c' * b') * (b' * d'))"
+proof -
let ?le = "\<lambda>a b c d. ((a * d) * (b * d) \<le> (c * b) * (b * d))"
{
fix a b c d x :: 'a
@@ -309,25 +266,18 @@
finally show "?le a b c d = ?le a' b' c' d'" .
qed
-instantiation fract :: (linordered_idom) linorder
-begin
-
-definition le_fract_def:
- "q \<le> r \<longleftrightarrow> the_elem (\<Union>x \<in> Rep_fract q. \<Union>y \<in> Rep_fract r.
- {(fst x * snd y) * (snd x * snd y) \<le> (fst y * snd x) * (snd x * snd y)})"
+lift_definition less_eq_fract :: "'a fract \<Rightarrow> 'a fract \<Rightarrow> bool"
+ is "\<lambda>q r. (fst q * snd r) * (snd q * snd r) \<le> (fst r * snd q) * (snd q * snd r)"
+by (clarsimp simp add: less_eq_fract_respect)
definition less_fract_def: "z < (w::'a fract) \<longleftrightarrow> z \<le> w \<and> \<not> w \<le> z"
lemma le_fract [simp]:
- assumes "b \<noteq> 0"
- and "d \<noteq> 0"
- shows "Fract a b \<le> Fract c d \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)"
- by (simp add: Fract_def le_fract_def le_congruent2 UN_fractrel2 assms)
+ "\<lbrakk> b \<noteq> 0; d \<noteq> 0 \<rbrakk> \<Longrightarrow> Fract a b \<le> Fract c d \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)"
+ by transfer simp
lemma less_fract [simp]:
- assumes "b \<noteq> 0"
- and "d \<noteq> 0"
- shows "Fract a b < Fract c d \<longleftrightarrow> (a * d) * (b * d) < (c * b) * (b * d)"
+ "\<lbrakk> b \<noteq> 0; d \<noteq> 0 \<rbrakk> \<Longrightarrow> Fract a b < Fract c d \<longleftrightarrow> (a * d) * (b * d) < (c * b) * (b * d)"
by (simp add: less_fract_def less_le_not_le ac_simps assms)
instance
@@ -406,14 +356,14 @@
instantiation fract :: (linordered_idom) "{distrib_lattice,abs_if,sgn_if}"
begin
-definition abs_fract_def: "\<bar>q\<bar> = (if q < 0 then -q else (q::'a fract))"
+definition abs_fract_def2: "\<bar>q\<bar> = (if q < 0 then -q else (q::'a fract))"
definition sgn_fract_def:
"sgn (q::'a fract) = (if q = 0 then 0 else if 0 < q then 1 else - 1)"
theorem abs_fract [simp]: "\<bar>Fract a b\<bar> = Fract \<bar>a\<bar> \<bar>b\<bar>"
- by (auto simp add: abs_fract_def Zero_fract_def le_less
- eq_fract zero_less_mult_iff mult_less_0_iff split: abs_split)
+unfolding abs_fract_def2 not_le[symmetric]
+by transfer(auto simp add: zero_less_mult_iff le_less)
definition inf_fract_def:
"(inf :: 'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract) = min"
@@ -422,9 +372,7 @@
"(sup :: 'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract) = max"
instance
- by intro_classes
- (auto simp add: abs_fract_def sgn_fract_def
- max_min_distrib2 inf_fract_def sup_fract_def)
+by intro_classes (simp_all add: abs_fract_def2 sgn_fract_def inf_fract_def sup_fract_def max_min_distrib2)
end
--- a/src/HOL/Library/IArray.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/IArray.thy Fri Sep 18 16:42:19 2015 +0100
@@ -13,36 +13,35 @@
lists first. Arrays could be converted back into lists for printing if they
were wrapped up in an additional constructor.\<close>
+context
+begin
+
datatype 'a iarray = IArray "'a list"
-primrec list_of :: "'a iarray \<Rightarrow> 'a list" where
+qualified primrec list_of :: "'a iarray \<Rightarrow> 'a list" where
"list_of (IArray xs) = xs"
-hide_const (open) list_of
-definition of_fun :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a iarray" where
+qualified definition of_fun :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a iarray" where
[simp]: "of_fun f n = IArray (map f [0..<n])"
-hide_const (open) of_fun
-definition sub :: "'a iarray \<Rightarrow> nat \<Rightarrow> 'a" (infixl "!!" 100) where
+qualified definition sub :: "'a iarray \<Rightarrow> nat \<Rightarrow> 'a" (infixl "!!" 100) where
[simp]: "as !! n = IArray.list_of as ! n"
-hide_const (open) sub
-definition length :: "'a iarray \<Rightarrow> nat" where
+qualified definition length :: "'a iarray \<Rightarrow> nat" where
[simp]: "length as = List.length (IArray.list_of as)"
-hide_const (open) length
-fun all :: "('a \<Rightarrow> bool) \<Rightarrow> 'a iarray \<Rightarrow> bool" where
+qualified fun all :: "('a \<Rightarrow> bool) \<Rightarrow> 'a iarray \<Rightarrow> bool" where
"all p (IArray as) = (ALL a : set as. p a)"
-hide_const (open) all
-fun exists :: "('a \<Rightarrow> bool) \<Rightarrow> 'a iarray \<Rightarrow> bool" where
+qualified fun exists :: "('a \<Rightarrow> bool) \<Rightarrow> 'a iarray \<Rightarrow> bool" where
"exists p (IArray as) = (EX a : set as. p a)"
-hide_const (open) exists
lemma list_of_code [code]:
"IArray.list_of as = map (\<lambda>n. as !! n) [0 ..< IArray.length as]"
by (cases as) (simp add: map_nth)
+end
+
subsection "Code Generation"
@@ -86,10 +85,13 @@
"HOL.equal as bs \<longleftrightarrow> HOL.equal (IArray.list_of as) (IArray.list_of bs)"
by (cases as, cases bs) (simp add: equal)
-primrec tabulate :: "integer \<times> (integer \<Rightarrow> 'a) \<Rightarrow> 'a iarray" where
+context
+begin
+
+qualified primrec tabulate :: "integer \<times> (integer \<Rightarrow> 'a) \<Rightarrow> 'a iarray" where
"tabulate (n, f) = IArray (map (f \<circ> integer_of_nat) [0..<nat_of_integer n])"
-hide_const (open) tabulate
+end
lemma [code]:
"IArray.of_fun f n = IArray.tabulate (integer_of_nat n, f \<circ> nat_of_integer)"
@@ -98,10 +100,13 @@
code_printing
constant IArray.tabulate \<rightharpoonup> (SML) "Vector.tabulate"
-primrec sub' :: "'a iarray \<times> integer \<Rightarrow> 'a" where
+context
+begin
+
+qualified primrec sub' :: "'a iarray \<times> integer \<Rightarrow> 'a" where
[code del]: "sub' (as, n) = IArray.list_of as ! nat_of_integer n"
-hide_const (open) sub'
+end
lemma [code]:
"IArray.sub' (IArray as, n) = as ! nat_of_integer n"
@@ -114,10 +119,13 @@
code_printing
constant IArray.sub' \<rightharpoonup> (SML) "Vector.sub"
-definition length' :: "'a iarray \<Rightarrow> integer" where
+context
+begin
+
+qualified definition length' :: "'a iarray \<Rightarrow> integer" where
[code del, simp]: "length' as = integer_of_nat (List.length (IArray.list_of as))"
-hide_const (open) length'
+end
lemma [code]:
"IArray.length' (IArray as) = integer_of_nat (List.length as)"
--- a/src/HOL/Library/Library.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Library.thy Fri Sep 18 16:42:19 2015 +0100
@@ -45,6 +45,7 @@
More_List
Multiset_Order
Numeral_Type
+ Omega_Words_Fun
OptionalSugar
Option_ord
Order_Continuity
--- a/src/HOL/Library/Multiset.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Multiset.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1408,14 +1408,14 @@
proof (rule properties_for_sort_key)
from mset_equal
show "mset ys = mset xs" by simp
- from `sorted (map f ys)`
+ from \<open>sorted (map f ys)\<close>
show "sorted (map f ys)" .
show "[x\<leftarrow>ys . f k = f x] = [x\<leftarrow>xs . f k = f x]" if "k \<in> set ys" for k
proof -
from mset_equal
have set_equal: "set xs = set ys" by (rule mset_eq_setD)
with that have "insert k (set ys) = set ys" by auto
- with `inj_on f (set xs)` have inj: "inj_on f (insert k (set ys))"
+ with \<open>inj_on f (set xs)\<close> have inj: "inj_on f (insert k (set ys))"
by (simp add: set_equal)
from inj have "[x\<leftarrow>ys . f k = f x] = filter (HOL.eq k) ys"
by (auto intro!: inj_on_filter_key_eq)
--- a/src/HOL/Library/Old_SMT/old_smt_real.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Old_SMT/old_smt_real.ML Fri Sep 18 16:42:19 2015 +0100
@@ -114,8 +114,10 @@
"x + y = y + x"
by auto}
-val real_linarith_proc = Simplifier.simproc_global @{theory} "fast_real_arith" [
- "(m::real) < n", "(m::real) <= n", "(m::real) = n"] Lin_Arith.simproc
+val real_linarith_proc =
+ Simplifier.make_simproc @{context} "fast_real_arith"
+ {lhss = [@{term "(m::real) < n"}, @{term "(m::real) \<le> n"}, @{term "(m::real) = n"}],
+ proc = K Lin_Arith.simproc, identifier = []}
(* setup *)
--- a/src/HOL/Library/Old_SMT/old_z3_proof_tools.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Old_SMT/old_z3_proof_tools.ML Fri Sep 18 16:42:19 2015 +0100
@@ -304,9 +304,9 @@
fun dest_binop ((c as Const _) $ t $ u) = (c, t, u)
| dest_binop t = raise TERM ("dest_binop", [t])
- fun prove_antisym_le ctxt t =
+ fun prove_antisym_le ctxt ct =
let
- val (le, r, s) = dest_binop t
+ val (le, r, s) = dest_binop (Thm.term_of ct)
val less = Const (@{const_name less}, Term.fastype_of le)
val prems = Simplifier.prems_of ctxt
in
@@ -318,9 +318,9 @@
end
handle THM _ => NONE
- fun prove_antisym_less ctxt t =
+ fun prove_antisym_less ctxt ct =
let
- val (less, r, s) = dest_binop (HOLogic.dest_not t)
+ val (less, r, s) = dest_binop (HOLogic.dest_not (Thm.term_of ct))
val le = Const (@{const_name less_eq}, Term.fastype_of less)
val prems = Simplifier.prems_of ctxt
in
@@ -343,12 +343,15 @@
addsimps @{thms z3div_def} addsimps @{thms z3mod_def}
addsimprocs [@{simproc numeral_divmod}]
addsimprocs [
- Simplifier.simproc_global @{theory} "fast_int_arith" [
- "(m::int) < n", "(m::int) <= n", "(m::int) = n"] Lin_Arith.simproc,
- Simplifier.simproc_global @{theory} "antisym_le" ["(x::'a::order) <= y"]
- prove_antisym_le,
- Simplifier.simproc_global @{theory} "antisym_less" ["~ (x::'a::linorder) < y"]
- prove_antisym_less])
+ Simplifier.make_simproc @{context} "fast_int_arith"
+ {lhss = [@{term "(m::int) < n"}, @{term "(m::int) \<le> n"}, @{term "(m::int) = n"}],
+ proc = K Lin_Arith.simproc, identifier = []},
+ Simplifier.make_simproc @{context} "antisym_le"
+ {lhss = [@{term "(x::'a::order) \<le> y"}],
+ proc = K prove_antisym_le, identifier = []},
+ Simplifier.make_simproc @{context} "antisym_less"
+ {lhss = [@{term "\<not> (x::'a::linorder) < y"}],
+ proc = K prove_antisym_less, identifier = []}])
structure Simpset = Generic_Data
(
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Omega_Words_Fun.thy Fri Sep 18 16:42:19 2015 +0100
@@ -0,0 +1,971 @@
+(*
+ Author: Stefan Merz
+ Author: Salomon Sickert
+ Author: Julian Brunner
+ Author: Peter Lammich
+*)
+
+section \<open>$\omega$-words\<close>
+
+theory Omega_Words_Fun
+
+imports Infinite_Set
+begin
+
+text \<open>Note: This theory is based on Stefan Merz's work.\<close>
+
+text \<open>
+ Automata recognize languages, which are sets of words. For the
+ theory of $\omega$-automata, we are mostly interested in
+ $\omega$-words, but it is sometimes useful to reason about
+ finite words, too. We are modeling finite words as lists; this
+ lets us benefit from the existing library. Other formalizations
+ could be investigated, such as representing words as functions
+ whose domains are initial intervals of the natural numbers.
+\<close>
+
+
+subsection \<open>Type declaration and elementary operations\<close>
+
+text \<open>
+ We represent $\omega$-words as functions from the natural numbers
+ to the alphabet type. Other possible formalizations include
+ a coinductive definition or a uniform encoding of finite and
+ infinite words, as studied by M\"uller et al.
+\<close>
+
+type_synonym
+ 'a word = "nat \<Rightarrow> 'a"
+
+text \<open>
+ We can prefix a finite word to an $\omega$-word, and a way
+ to obtain an $\omega$-word from a finite, non-empty word is by
+ $\omega$-iteration.
+\<close>
+
+definition
+ conc :: "['a list, 'a word] \<Rightarrow> 'a word" (infixr "conc" 65)
+ where "w conc x == \<lambda>n. if n < length w then w!n else x (n - length w)"
+
+definition
+ iter :: "'a list \<Rightarrow> 'a word"
+ where "iter w == if w = [] then undefined else (\<lambda>n. w!(n mod (length w)))"
+
+notation (xsymbols)
+ conc (infixr "\<frown>" 65) and
+ iter ("(_\<^sup>\<omega>)" [1000])
+
+lemma conc_empty[simp]: "[] \<frown> w = w"
+ unfolding conc_def by auto
+
+lemma conc_fst[simp]: "n < length w \<Longrightarrow> (w \<frown> x) n = w!n"
+ by (simp add: conc_def)
+
+lemma conc_snd[simp]: "\<not>(n < length w) \<Longrightarrow> (w \<frown> x) n = x (n - length w)"
+ by (simp add: conc_def)
+
+lemma iter_nth [simp]: "0 < length w \<Longrightarrow> w\<^sup>\<omega> n = w!(n mod (length w))"
+ by (simp add: iter_def)
+
+lemma conc_conc[simp]: "u \<frown> v \<frown> w = (u @ v) \<frown> w" (is "?lhs = ?rhs")
+proof
+ fix n
+ have u: "n < length u \<Longrightarrow> ?lhs n = ?rhs n"
+ by (simp add: conc_def nth_append)
+ have v: "\<lbrakk> \<not>(n < length u); n < length u + length v \<rbrakk> \<Longrightarrow> ?lhs n = ?rhs n"
+ by (simp add: conc_def nth_append, arith)
+ have w: "\<not>(n < length u + length v) \<Longrightarrow> ?lhs n = ?rhs n"
+ by (simp add: conc_def nth_append, arith)
+ from u v w show "?lhs n = ?rhs n" by blast
+qed
+
+lemma range_conc[simp]: "range (w\<^sub>1 \<frown> w\<^sub>2) = set w\<^sub>1 \<union> range w\<^sub>2"
+proof (intro equalityI subsetI)
+ fix a
+ assume "a \<in> range (w\<^sub>1 \<frown> w\<^sub>2)"
+ then obtain i where 1: "a = (w\<^sub>1 \<frown> w\<^sub>2) i" by auto
+ then show "a \<in> set w\<^sub>1 \<union> range w\<^sub>2"
+ unfolding 1 by (cases "i < length w\<^sub>1") simp_all
+next
+ fix a
+ assume a: "a \<in> set w\<^sub>1 \<union> range w\<^sub>2"
+ then show "a \<in> range (w\<^sub>1 \<frown> w\<^sub>2)"
+ proof
+ assume "a \<in> set w\<^sub>1"
+ then obtain i where 1: "i < length w\<^sub>1" "a = w\<^sub>1 ! i"
+ using in_set_conv_nth by metis
+ show ?thesis
+ proof
+ show "a = (w\<^sub>1 \<frown> w\<^sub>2) i" using 1 by auto
+ show "i \<in> UNIV" by rule
+ qed
+ next
+ assume "a \<in> range w\<^sub>2"
+ then obtain i where 1: "a = w\<^sub>2 i" by auto
+ show ?thesis
+ proof
+ show "a = (w\<^sub>1 \<frown> w\<^sub>2) (length w\<^sub>1 + i)" using 1 by simp
+ show "length w\<^sub>1 + i \<in> UNIV" by rule
+ qed
+ qed
+qed
+
+
+lemma iter_unroll: "0 < length w \<Longrightarrow> w\<^sup>\<omega> = w \<frown> w\<^sup>\<omega>"
+ by (rule ext) (simp add: conc_def mod_geq)
+
+
+subsection \<open>Subsequence, Prefix, and Suffix\<close>
+
+definition suffix :: "[nat, 'a word] \<Rightarrow> 'a word"
+ where "suffix k x \<equiv> \<lambda>n. x (k+n)"
+
+definition subsequence :: "'a word \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list" ("_ [_ \<rightarrow> _]" 900)
+ where "subsequence w i j \<equiv> map w [i..<j]"
+
+abbreviation prefix :: "nat \<Rightarrow> 'a word \<Rightarrow> 'a list"
+ where "prefix n w \<equiv> subsequence w 0 n"
+
+lemma suffix_nth [simp]: "(suffix k x) n = x (k+n)"
+ by (simp add: suffix_def)
+
+lemma suffix_0 [simp]: "suffix 0 x = x"
+ by (simp add: suffix_def)
+
+lemma suffix_suffix [simp]: "suffix m (suffix k x) = suffix (k+m) x"
+ by (rule ext) (simp add: suffix_def add.assoc)
+
+lemma subsequence_append: "prefix (i + j) w = prefix i w @ (w [i \<rightarrow> i + j])"
+ unfolding map_append[symmetric] upt_add_eq_append[OF le0] subsequence_def ..
+
+lemma subsequence_drop[simp]: "drop i (w [j \<rightarrow> k]) = w [j + i \<rightarrow> k]"
+ by (simp add: subsequence_def drop_map)
+
+lemma subsequence_empty[simp]: "w [i \<rightarrow> j] = [] \<longleftrightarrow> j \<le> i"
+ by (auto simp add: subsequence_def)
+
+lemma subsequence_length[simp]: "length (subsequence w i j) = j - i"
+ by (simp add: subsequence_def)
+
+lemma subsequence_nth[simp]: "k < j - i \<Longrightarrow> (w [i \<rightarrow> j]) ! k = w (i + k)"
+ unfolding subsequence_def
+ by auto
+
+lemma subseq_to_zero[simp]: "w[i\<rightarrow>0] = []"
+ by simp
+
+lemma subseq_to_smaller[simp]: "i\<ge>j \<Longrightarrow> w[i\<rightarrow>j] = []"
+ by simp
+
+lemma subseq_to_Suc[simp]: "i\<le>j \<Longrightarrow> w [i \<rightarrow> Suc j] = w [ i \<rightarrow> j ] @ [w j]"
+ by (auto simp: subsequence_def)
+
+lemma subsequence_singleton[simp]: "w [i \<rightarrow> Suc i] = [w i]"
+ by (auto simp: subsequence_def)
+
+
+lemma subsequence_prefix_suffix: "prefix (j - i) (suffix i w) = w [i \<rightarrow> j]"
+proof (cases "i \<le> j")
+ case True
+ have "w [i \<rightarrow> j] = map w (map (\<lambda>n. n + i) [0..<j - i])"
+ unfolding map_add_upt subsequence_def
+ using le_add_diff_inverse2[OF True] by force
+ also
+ have "\<dots> = map (\<lambda>n. w (n + i)) [0..<j - i]"
+ unfolding map_map comp_def by blast
+ finally
+ show ?thesis
+ unfolding subsequence_def suffix_def add.commute[of i] by simp
+next
+ case False
+ then show ?thesis
+ by (simp add: subsequence_def)
+qed
+
+lemma prefix_suffix: "x = prefix n x \<frown> (suffix n x)"
+ by (rule ext) (simp add: subsequence_def conc_def)
+
+declare prefix_suffix[symmetric, simp]
+
+
+lemma word_split: obtains v\<^sub>1 v\<^sub>2 where "v = v\<^sub>1 \<frown> v\<^sub>2" "length v\<^sub>1 = k"
+proof
+ show "v = prefix k v \<frown> suffix k v"
+ by (rule prefix_suffix)
+ show "length (prefix k v) = k"
+ by simp
+qed
+
+
+lemma set_subsequence[simp]: "set (w[i\<rightarrow>j]) = w`{i..<j}"
+ unfolding subsequence_def by auto
+
+lemma subsequence_take[simp]: "take i (w [j \<rightarrow> k]) = w [j \<rightarrow> min (j + i) k]"
+ by (simp add: subsequence_def take_map min_def)
+
+lemma subsequence_shift[simp]: "(suffix i w) [j \<rightarrow> k] = w [i + j \<rightarrow> i + k]"
+ by (metis add_diff_cancel_left subsequence_prefix_suffix suffix_suffix)
+
+lemma suffix_subseq_join[simp]: "i \<le> j \<Longrightarrow> v [i \<rightarrow> j] \<frown> suffix j v = suffix i v"
+ by (metis (no_types, lifting) Nat.add_0_right le_add_diff_inverse prefix_suffix
+ subsequence_shift suffix_suffix)
+
+lemma prefix_conc_fst[simp]:
+ assumes "j \<le> length w"
+ shows "prefix j (w \<frown> w') = take j w"
+proof -
+ have "\<forall>i < j. (prefix j (w \<frown> w')) ! i = (take j w) ! i"
+ using assms by (simp add: conc_fst subsequence_def)
+ thus ?thesis
+ by (simp add: assms list_eq_iff_nth_eq min.absorb2)
+qed
+
+lemma prefix_conc_snd[simp]:
+ assumes "n \<ge> length u"
+ shows "prefix n (u \<frown> v) = u @ prefix (n - length u) v"
+proof (intro nth_equalityI allI impI)
+ show "length (prefix n (u \<frown> v)) = length (u @ prefix (n - length u) v)"
+ using assms by simp
+ fix i
+ assume "i < length (prefix n (u \<frown> v))"
+ then show "prefix n (u \<frown> v) ! i = (u @ prefix (n - length u) v) ! i"
+ by (cases "i < length u") (auto simp: nth_append)
+qed
+
+lemma prefix_conc_length[simp]: "prefix (length w) (w \<frown> w') = w"
+ by simp
+
+lemma suffix_conc_fst[simp]:
+ assumes "n \<le> length u"
+ shows "suffix n (u \<frown> v) = drop n u \<frown> v"
+proof
+ show "suffix n (u \<frown> v) i = (drop n u \<frown> v) i" for i
+ using assms by (cases "n + i < length u") (auto simp: algebra_simps)
+qed
+
+lemma suffix_conc_snd[simp]:
+ assumes "n \<ge> length u"
+ shows "suffix n (u \<frown> v) = suffix (n - length u) v"
+proof
+ show "suffix n (u \<frown> v) i = suffix (n - length u) v i" for i
+ using assms by simp
+qed
+
+lemma suffix_conc_length[simp]: "suffix (length w) (w \<frown> w') = w'"
+ unfolding conc_def by force
+
+lemma concat_eq[iff]:
+ assumes "length v\<^sub>1 = length v\<^sub>2"
+ shows "v\<^sub>1 \<frown> u\<^sub>1 = v\<^sub>2 \<frown> u\<^sub>2 \<longleftrightarrow> v\<^sub>1 = v\<^sub>2 \<and> u\<^sub>1 = u\<^sub>2"
+ (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+ assume ?lhs
+ then have 1: "(v\<^sub>1 \<frown> u\<^sub>1) i = (v\<^sub>2 \<frown> u\<^sub>2) i" for i by auto
+ show ?rhs
+ proof (intro conjI ext nth_equalityI allI impI)
+ show "length v\<^sub>1 = length v\<^sub>2" by (rule assms(1))
+ next
+ fix i
+ assume 2: "i < length v\<^sub>1"
+ have 3: "i < length v\<^sub>2" using assms(1) 2 by simp
+ show "v\<^sub>1 ! i = v\<^sub>2 ! i" using 1[of i] 2 3 by simp
+ next
+ show "u\<^sub>1 i = u\<^sub>2 i" for i
+ using 1[of "length v\<^sub>1 + i"] assms(1) by simp
+ qed
+next
+ assume ?rhs
+ then show ?lhs by simp
+qed
+
+lemma same_concat_eq[iff]: "u \<frown> v = u \<frown> w \<longleftrightarrow> v = w"
+ by simp
+
+lemma comp_concat[simp]: "f \<circ> u \<frown> v = map f u \<frown> (f \<circ> v)"
+proof
+ fix i
+ show "(f \<circ> u \<frown> v) i = (map f u \<frown> (f \<circ> v)) i"
+ by (cases "i < length u") simp_all
+qed
+
+
+subsection \<open>Prepending\<close>
+
+primrec build :: "'a \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "##" 65)
+ where "(a ## w) 0 = a" | "(a ## w) (Suc i) = w i"
+
+lemma build_eq[iff]: "a\<^sub>1 ## w\<^sub>1 = a\<^sub>2 ## w\<^sub>2 \<longleftrightarrow> a\<^sub>1 = a\<^sub>2 \<and> w\<^sub>1 = w\<^sub>2"
+proof
+ assume 1: "a\<^sub>1 ## w\<^sub>1 = a\<^sub>2 ## w\<^sub>2"
+ have 2: "(a\<^sub>1 ## w\<^sub>1) i = (a\<^sub>2 ## w\<^sub>2) i" for i
+ using 1 by auto
+ show "a\<^sub>1 = a\<^sub>2 \<and> w\<^sub>1 = w\<^sub>2"
+ proof (intro conjI ext)
+ show "a\<^sub>1 = a\<^sub>2"
+ using 2[of "0"] by simp
+ show "w\<^sub>1 i = w\<^sub>2 i" for i
+ using 2[of "Suc i"] by simp
+ qed
+next
+ assume 1: "a\<^sub>1 = a\<^sub>2 \<and> w\<^sub>1 = w\<^sub>2"
+ show "a\<^sub>1 ## w\<^sub>1 = a\<^sub>2 ## w\<^sub>2" using 1 by simp
+qed
+
+lemma build_cons[simp]: "(a # u) \<frown> v = a ## u \<frown> v"
+proof
+ fix i
+ show "((a # u) \<frown> v) i = (a ## u \<frown> v) i"
+ proof (cases i)
+ case 0
+ show ?thesis unfolding 0 by simp
+ next
+ case (Suc j)
+ show ?thesis unfolding Suc by (cases "j < length u", simp+)
+ qed
+qed
+
+lemma build_append[simp]: "(w @ a # u) \<frown> v = w \<frown> a ## u \<frown> v"
+ unfolding conc_conc[symmetric] by simp
+
+lemma build_first[simp]: "w 0 ## suffix (Suc 0) w = w"
+proof
+ show "(w 0 ## suffix (Suc 0) w) i = w i" for i
+ by (cases i) simp_all
+qed
+
+lemma build_split[intro]: "w = w 0 ## suffix 1 w"
+ by simp
+
+lemma build_range[simp]: "range (a ## w) = insert a (range w)"
+proof safe
+ show "(a ## w) i \<notin> range w \<Longrightarrow> (a ## w) i = a" for i
+ by (cases i) auto
+ show "a \<in> range (a ## w)"
+ proof (rule range_eqI)
+ show "a = (a ## w) 0" by simp
+ qed
+ show "w i \<in> range (a ## w)" for i
+ proof (rule range_eqI)
+ show "w i = (a ## w) (Suc i)" by simp
+ qed
+qed
+
+lemma suffix_singleton_suffix[simp]: "w i ## suffix (Suc i) w = suffix i w"
+ using suffix_subseq_join[of i "Suc i" w]
+ by simp
+
+text \<open>Find the first occurrence of a letter from a given set\<close>
+lemma word_first_split_set:
+ assumes "A \<inter> range w \<noteq> {}"
+ obtains u a v where "w = u \<frown> [a] \<frown> v" "A \<inter> set u = {}" "a \<in> A"
+proof -
+ def i \<equiv> "LEAST i. w i \<in> A"
+ show ?thesis
+ proof
+ show "w = prefix i w \<frown> [w i] \<frown> suffix (Suc i) w"
+ by simp
+ show "A \<inter> set (prefix i w) = {}"
+ apply safe
+ subgoal premises prems for a
+ proof -
+ from prems obtain k where 3: "k < i" "w k = a"
+ by auto
+ have 4: "w k \<notin> A"
+ using not_less_Least 3(1) unfolding i_def .
+ show ?thesis
+ using prems(1) 3(2) 4 by auto
+ qed
+ done
+ show "w i \<in> A"
+ using LeastI assms(1) unfolding i_def by fast
+ qed
+qed
+
+
+subsection \<open>The limit set of an $\omega$-word\<close>
+
+text \<open>
+ The limit set (also called infinity set) of an $\omega$-word
+ is the set of letters that appear infinitely often in the word.
+ This set plays an important role in defining acceptance conditions
+ of $\omega$-automata.
+\<close>
+
+definition limit :: "'a word \<Rightarrow> 'a set"
+ where "limit x \<equiv> {a . \<exists>\<^sub>\<infinity>n . x n = a}"
+
+lemma limit_iff_frequent: "a \<in> limit x \<longleftrightarrow> (\<exists>\<^sub>\<infinity>n . x n = a)"
+ by (simp add: limit_def)
+
+text \<open>
+ The following is a different way to define the limit,
+ using the reverse image, making the laws about reverse
+ image applicable to the limit set.
+ (Might want to change the definition above?)
+\<close>
+
+lemma limit_vimage: "(a \<in> limit x) = infinite (x -` {a})"
+ by (simp add: limit_def Inf_many_def vimage_def)
+
+lemma two_in_limit_iff:
+ "({a, b} \<subseteq> limit x) =
+ ((\<exists>n. x n =a ) \<and> (\<forall>n. x n = a \<longrightarrow> (\<exists>m>n. x m = b)) \<and> (\<forall>m. x m = b \<longrightarrow> (\<exists>n>m. x n = a)))"
+ (is "?lhs = (?r1 \<and> ?r2 \<and> ?r3)")
+proof
+ assume lhs: "?lhs"
+ hence 1: "?r1" by (auto simp: limit_def elim: INFM_EX)
+ from lhs have "\<forall>n. \<exists>m>n. x m = b" by (auto simp: limit_def INFM_nat)
+ hence 2: "?r2" by simp
+ from lhs have "\<forall>m. \<exists>n>m. x n = a" by (auto simp: limit_def INFM_nat)
+ hence 3: "?r3" by simp
+ from 1 2 3 show "?r1 \<and> ?r2 \<and> ?r3" by simp
+next
+ assume "?r1 \<and> ?r2 \<and> ?r3"
+ hence 1: "?r1" and 2: "?r2" and 3: "?r3" by simp+
+ have infa: "\<forall>m. \<exists>n\<ge>m. x n = a"
+ proof
+ fix m
+ show "\<exists>n\<ge>m. x n = a" (is "?A m")
+ proof (induct m)
+ from 1 show "?A 0" by simp
+ next
+ fix m
+ assume ih: "?A m"
+ then obtain n where n: "n \<ge> m" "x n = a" by auto
+ with 2 obtain k where k: "k>n" "x k = b" by auto
+ with 3 obtain l where l: "l>k" "x l = a" by auto
+ from n k l have "l \<ge> Suc m" by auto
+ with l show "?A (Suc m)" by auto
+ qed
+ qed
+ hence infa': "\<exists>\<^sub>\<infinity>n. x n = a" by (simp add: INFM_nat_le)
+ have "\<forall>n. \<exists>m>n. x m = b"
+ proof
+ fix n
+ from infa obtain k where k1: "k\<ge>n" and k2: "x k = a" by auto
+ from 2 k2 obtain l where l1: "l>k" and l2: "x l = b" by auto
+ from k1 l1 have "l > n" by auto
+ with l2 show "\<exists>m>n. x m = b" by auto
+ qed
+ hence "\<exists>\<^sub>\<infinity>m. x m = b" by (simp add: INFM_nat)
+ with infa' show "?lhs" by (auto simp: limit_def)
+qed
+
+text \<open>
+ For $\omega$-words over a finite alphabet, the limit set is
+ non-empty. Moreover, from some position onward, any such word
+ contains only letters from its limit set.
+\<close>
+
+lemma limit_nonempty:
+ assumes fin: "finite (range x)"
+ shows "\<exists>a. a \<in> limit x"
+proof -
+ from fin obtain a where "a \<in> range x \<and> infinite (x -` {a})"
+ by (rule inf_img_fin_domE) auto
+ hence "a \<in> limit x"
+ by (auto simp add: limit_vimage)
+ thus ?thesis ..
+qed
+
+lemmas limit_nonemptyE = limit_nonempty[THEN exE]
+
+lemma limit_inter_INF:
+ assumes hyp: "limit w \<inter> S \<noteq> {}"
+ shows "\<exists>\<^sub>\<infinity> n. w n \<in> S"
+proof -
+ from hyp obtain x where "\<exists>\<^sub>\<infinity> n. w n = x" and "x \<in> S"
+ by (auto simp add: limit_def)
+ thus ?thesis
+ by (auto elim: INFM_mono)
+qed
+
+text \<open>
+ The reverse implication is true only if $S$ is finite.
+\<close>
+
+lemma INF_limit_inter:
+ assumes hyp: "\<exists>\<^sub>\<infinity> n. w n \<in> S"
+ and fin: "finite (S \<inter> range w)"
+ shows "\<exists>a. a \<in> limit w \<inter> S"
+proof (rule ccontr)
+ assume contra: "\<not>(\<exists>a. a \<in> limit w \<inter> S)"
+ hence "\<forall>a\<in>S. finite {n. w n = a}"
+ by (auto simp add: limit_def Inf_many_def)
+ with fin have "finite (UN a:S \<inter> range w. {n. w n = a})"
+ by auto
+ moreover
+ have "(UN a:S \<inter> range w. {n. w n = a}) = {n. w n \<in> S}"
+ by auto
+ moreover
+ note hyp
+ ultimately show "False"
+ by (simp add: Inf_many_def)
+qed
+
+lemma fin_ex_inf_eq_limit: "finite A \<Longrightarrow> (\<exists>\<^sub>\<infinity>i. w i \<in> A) \<longleftrightarrow> limit w \<inter> A \<noteq> {}"
+ by (metis INF_limit_inter equals0D finite_Int limit_inter_INF)
+
+lemma limit_in_range_suffix: "limit x \<subseteq> range (suffix k x)"
+proof
+ fix a
+ assume "a \<in> limit x"
+ then obtain l where
+ kl: "k < l" and xl: "x l = a"
+ by (auto simp add: limit_def INFM_nat)
+ from kl obtain m where "l = k+m"
+ by (auto simp add: less_iff_Suc_add)
+ with xl show "a \<in> range (suffix k x)"
+ by auto
+qed
+
+lemma limit_in_range: "limit r \<subseteq> range r"
+ using limit_in_range_suffix[of r 0] by simp
+
+lemmas limit_in_range_suffixD = limit_in_range_suffix[THEN subsetD]
+
+lemma limit_subset: "limit f \<subseteq> f ` {n..}"
+ using limit_in_range_suffix[of f n] unfolding suffix_def by auto
+
+theorem limit_is_suffix:
+ assumes fin: "finite (range x)"
+ shows "\<exists>k. limit x = range (suffix k x)"
+proof -
+ have "\<exists>k. range (suffix k x) \<subseteq> limit x"
+ proof -
+ -- "The set of letters that are not in the limit is certainly finite."
+ from fin have "finite (range x - limit x)"
+ by simp
+ -- "Moreover, any such letter occurs only finitely often"
+ moreover
+ have "\<forall>a \<in> range x - limit x. finite (x -` {a})"
+ by (auto simp add: limit_vimage)
+ -- "Thus, there are only finitely many occurrences of such letters."
+ ultimately have "finite (UN a : range x - limit x. x -` {a})"
+ by (blast intro: finite_UN_I)
+ -- "Therefore these occurrences are within some initial interval."
+ then obtain k where "(UN a : range x - limit x. x -` {a}) \<subseteq> {..<k}"
+ by (blast dest: finite_nat_bounded)
+ -- "This is just the bound we are looking for."
+ hence "\<forall>m. k \<le> m \<longrightarrow> x m \<in> limit x"
+ by (auto simp add: limit_vimage)
+ hence "range (suffix k x) \<subseteq> limit x"
+ by auto
+ thus ?thesis ..
+ qed
+ then obtain k where "range (suffix k x) \<subseteq> limit x" ..
+ with limit_in_range_suffix
+ have "limit x = range (suffix k x)"
+ by (rule subset_antisym)
+ thus ?thesis ..
+qed
+
+theorems limit_is_suffixE = limit_is_suffix[THEN exE]
+
+
+text \<open>
+ The limit set enjoys some simple algebraic laws with respect
+ to concatenation, suffixes, iteration, and renaming.
+\<close>
+
+theorem limit_conc [simp]: "limit (w \<frown> x) = limit x"
+proof (auto)
+ fix a assume a: "a \<in> limit (w \<frown> x)"
+ have "\<forall>m. \<exists>n. m<n \<and> x n = a"
+ proof
+ fix m
+ from a obtain n where "m + length w < n \<and> (w \<frown> x) n = a"
+ by (auto simp add: limit_def Inf_many_def infinite_nat_iff_unbounded)
+ hence "m < n - length w \<and> x (n - length w) = a"
+ by (auto simp add: conc_def)
+ thus "\<exists>n. m<n \<and> x n = a" ..
+ qed
+ hence "infinite {n . x n = a}"
+ by (simp add: infinite_nat_iff_unbounded)
+ thus "a \<in> limit x"
+ by (simp add: limit_def Inf_many_def)
+next
+ fix a assume a: "a \<in> limit x"
+ have "\<forall>m. length w < m \<longrightarrow> (\<exists>n. m<n \<and> (w \<frown> x) n = a)"
+ proof (clarify)
+ fix m
+ assume m: "length w < m"
+ with a obtain n where "m - length w < n \<and> x n = a"
+ by (auto simp add: limit_def Inf_many_def infinite_nat_iff_unbounded)
+ with m have "m < n + length w \<and> (w \<frown> x) (n + length w) = a"
+ by (simp add: conc_def, arith)
+ thus "\<exists>n. m<n \<and> (w \<frown> x) n = a" ..
+ qed
+ hence "infinite {n . (w \<frown> x) n = a}"
+ by (simp add: unbounded_k_infinite)
+ thus "a \<in> limit (w \<frown> x)"
+ by (simp add: limit_def Inf_many_def)
+qed
+
+theorem limit_suffix [simp]: "limit (suffix n x) = limit x"
+proof -
+ have "x = (prefix n x) \<frown> (suffix n x)"
+ by (simp add: prefix_suffix)
+ hence "limit x = limit (prefix n x \<frown> suffix n x)"
+ by simp
+ also have "\<dots> = limit (suffix n x)"
+ by (rule limit_conc)
+ finally show ?thesis
+ by (rule sym)
+qed
+
+theorem limit_iter [simp]:
+ assumes nempty: "0 < length w"
+ shows "limit w\<^sup>\<omega> = set w"
+proof
+ have "limit w\<^sup>\<omega> \<subseteq> range w\<^sup>\<omega>"
+ by (auto simp add: limit_def dest: INFM_EX)
+ also from nempty have "\<dots> \<subseteq> set w"
+ by auto
+ finally show "limit w\<^sup>\<omega> \<subseteq> set w" .
+next
+ {
+ fix a assume a: "a \<in> set w"
+ then obtain k where k: "k < length w \<and> w!k = a"
+ by (auto simp add: set_conv_nth)
+ -- "the following bound is terrible, but it simplifies the proof"
+ from nempty k have "\<forall>m. w\<^sup>\<omega> ((Suc m)*(length w) + k) = a"
+ by (simp add: mod_add_left_eq)
+ moreover
+ -- "why is the following so hard to prove??"
+ have "\<forall>m. m < (Suc m)*(length w) + k"
+ proof
+ fix m
+ from nempty have "1 \<le> length w" by arith
+ hence "m*1 \<le> m*length w" by simp
+ hence "m \<le> m*length w" by simp
+ with nempty have "m < length w + (m*length w) + k" by arith
+ thus "m < (Suc m)*(length w) + k" by simp
+ qed
+ moreover note nempty
+ ultimately have "a \<in> limit w\<^sup>\<omega>"
+ by (auto simp add: limit_iff_frequent INFM_nat)
+ }
+ then show "set w \<subseteq> limit w\<^sup>\<omega>" by auto
+qed
+
+lemma limit_o [simp]:
+ assumes a: "a \<in> limit w"
+ shows "f a \<in> limit (f \<circ> w)"
+proof -
+ from a
+ have "\<exists>\<^sub>\<infinity>n. w n = a"
+ by (simp add: limit_iff_frequent)
+ hence "\<exists>\<^sub>\<infinity>n. f (w n) = f a"
+ by (rule INFM_mono, simp)
+ thus "f a \<in> limit (f \<circ> w)"
+ by (simp add: limit_iff_frequent)
+qed
+
+text \<open>
+ The converse relation is not true in general: $f(a)$ can be in the
+ limit of $f \circ w$ even though $a$ is not in the limit of $w$.
+ However, @{text limit} commutes with renaming if the function is
+ injective. More generally, if $f(a)$ is the image of only finitely
+ many elements, some of these must be in the limit of $w$.
+\<close>
+
+lemma limit_o_inv:
+ assumes fin: "finite (f -` {x})"
+ and x: "x \<in> limit (f \<circ> w)"
+ shows "\<exists>a \<in> (f -` {x}). a \<in> limit w"
+proof (rule ccontr)
+ assume contra: "\<not> ?thesis"
+ -- "hence, every element in the pre-image occurs only finitely often"
+ then have "\<forall>a \<in> (f -` {x}). finite {n. w n = a}"
+ by (simp add: limit_def Inf_many_def)
+ -- "so there are only finitely many occurrences of any such element"
+ with fin have "finite (\<Union> a \<in> (f -` {x}). {n. w n = a})"
+ by auto
+ -- \<open>these are precisely those positions where $x$ occurs in $f \circ w$\<close>
+ moreover
+ have "(\<Union> a \<in> (f -` {x}). {n. w n = a}) = {n. f(w n) = x}"
+ by auto
+ ultimately
+ -- "so $x$ can occur only finitely often in the translated word"
+ have "finite {n. f(w n) = x}"
+ by simp
+ -- \<open>\ldots\ which yields a contradiction\<close>
+ with x show "False"
+ by (simp add: limit_def Inf_many_def)
+qed
+
+theorem limit_inj [simp]:
+ assumes inj: "inj f"
+ shows "limit (f \<circ> w) = f ` (limit w)"
+proof
+ show "f ` limit w \<subseteq> limit (f \<circ> w)"
+ by auto
+ show "limit (f \<circ> w) \<subseteq> f ` limit w"
+ proof
+ fix x
+ assume x: "x \<in> limit (f \<circ> w)"
+ from inj have "finite (f -` {x})"
+ by (blast intro: finite_vimageI)
+ with x obtain a where a: "a \<in> (f -` {x}) \<and> a \<in> limit w"
+ by (blast dest: limit_o_inv)
+ thus "x \<in> f ` (limit w)"
+ by auto
+ qed
+qed
+
+lemma limit_inter_empty:
+ assumes fin: "finite (range w)"
+ assumes hyp: "limit w \<inter> S = {}"
+ shows "\<forall>\<^sub>\<infinity>n. w n \<notin> S"
+proof -
+ from fin obtain k where k_def: "limit w = range (suffix k w)"
+ using limit_is_suffix by blast
+ have "w (k + k') \<notin> S" for k'
+ using hyp unfolding k_def suffix_def image_def by blast
+ thus ?thesis
+ unfolding MOST_nat_le using le_Suc_ex by blast
+qed
+
+text \<open>If the limit is the suffix of the sequence's range,
+ we may increase the suffix index arbitrarily\<close>
+lemma limit_range_suffix_incr:
+ assumes "limit r = range (suffix i r)"
+ assumes "j\<ge>i"
+ shows "limit r = range (suffix j r)"
+ (is "?lhs = ?rhs")
+proof -
+ have "?lhs = range (suffix i r)"
+ using assms by simp
+ moreover
+ have "\<dots> \<supseteq> ?rhs" using \<open>j\<ge>i\<close>
+ by (metis (mono_tags, lifting) assms(2)
+ image_subsetI le_Suc_ex range_eqI suffix_def suffix_suffix)
+ moreover
+ have "\<dots> \<supseteq> ?lhs" by (rule limit_in_range_suffix)
+ ultimately
+ show "?lhs = ?rhs"
+ by (metis antisym_conv limit_in_range_suffix)
+qed
+
+text \<open>For two finite sequences, we can find a common suffix index such
+ that the limits can be represented as these suffixes' ranges.\<close>
+lemma common_range_limit:
+ assumes "finite (range x)"
+ and "finite (range y)"
+ obtains i where "limit x = range (suffix i x)"
+ and "limit y = range (suffix i y)"
+proof -
+ obtain i j where 1: "limit x = range (suffix i x)"
+ and 2: "limit y = range (suffix j y)"
+ using assms limit_is_suffix by metis
+ have "limit x = range (suffix (max i j) x)"
+ and "limit y = range (suffix (max i j) y)"
+ using limit_range_suffix_incr[OF 1] limit_range_suffix_incr[OF 2]
+ by auto
+ thus ?thesis
+ using that by metis
+qed
+
+
+subsection \<open>Index sequences and piecewise definitions\<close>
+
+text \<open>
+ A word can be defined piecewise: given a sequence of words $w_0, w_1, \ldots$
+ and a strictly increasing sequence of integers $i_0, i_1, \ldots$ where $i_0=0$,
+ a single word is obtained by concatenating subwords of the $w_n$ as given by
+ the integers: the resulting word is
+ \[
+ (w_0)_{i_0} \ldots (w_0)_{i_1-1} (w_1)_{i_1} \ldots (w_1)_{i_2-1} \ldots
+ \]
+ We prepare the field by proving some trivial facts about such sequences of
+ indexes.
+\<close>
+
+definition idx_sequence :: "nat word \<Rightarrow> bool"
+ where "idx_sequence idx \<equiv> (idx 0 = 0) \<and> (\<forall>n. idx n < idx (Suc n))"
+
+lemma idx_sequence_less:
+ assumes iseq: "idx_sequence idx"
+ shows "idx n < idx (Suc(n+k))"
+proof (induct k)
+ from iseq show "idx n < idx (Suc (n + 0))"
+ by (simp add: idx_sequence_def)
+next
+ fix k
+ assume ih: "idx n < idx (Suc(n+k))"
+ from iseq have "idx (Suc(n+k)) < idx (Suc(n + Suc k))"
+ by (simp add: idx_sequence_def)
+ with ih show "idx n < idx (Suc(n + Suc k))"
+ by (rule less_trans)
+qed
+
+lemma idx_sequence_inj:
+ assumes iseq: "idx_sequence idx"
+ and eq: "idx m = idx n"
+ shows "m = n"
+proof (rule nat_less_cases)
+ assume "n<m"
+ then obtain k where "m = Suc(n+k)"
+ by (auto simp add: less_iff_Suc_add)
+ with iseq have "idx n < idx m"
+ by (simp add: idx_sequence_less)
+ with eq show ?thesis
+ by simp
+next
+ assume "m<n"
+ then obtain k where "n = Suc(m+k)"
+ by (auto simp add: less_iff_Suc_add)
+ with iseq have "idx m < idx n"
+ by (simp add: idx_sequence_less)
+ with eq show ?thesis
+ by simp
+qed (simp)
+
+lemma idx_sequence_mono:
+ assumes iseq: "idx_sequence idx"
+ and m: "m \<le> n"
+ shows "idx m \<le> idx n"
+proof (cases "m=n")
+ case True
+ thus ?thesis by simp
+next
+ case False
+ with m have "m < n" by simp
+ then obtain k where "n = Suc(m+k)"
+ by (auto simp add: less_iff_Suc_add)
+ with iseq have "idx m < idx n"
+ by (simp add: idx_sequence_less)
+ thus ?thesis by simp
+qed
+
+text \<open>
+ Given an index sequence, every natural number is contained in the
+ interval defined by two adjacent indexes, and in fact this interval
+ is determined uniquely.
+\<close>
+
+lemma idx_sequence_idx:
+ assumes "idx_sequence idx"
+ shows "idx k \<in> {idx k ..< idx (Suc k)}"
+using assms by (auto simp add: idx_sequence_def)
+
+lemma idx_sequence_interval:
+ assumes iseq: "idx_sequence idx"
+ shows "\<exists>k. n \<in> {idx k ..< idx (Suc k) }"
+ (is "?P n" is "\<exists>k. ?in n k")
+proof (induct n)
+ from iseq have "0 = idx 0"
+ by (simp add: idx_sequence_def)
+ moreover
+ from iseq have "idx 0 \<in> {idx 0 ..< idx (Suc 0) }"
+ by (rule idx_sequence_idx)
+ ultimately
+ show "?P 0" by auto
+next
+ fix n
+ assume "?P n"
+ then obtain k where k: "?in n k" ..
+ show "?P (Suc n)"
+ proof (cases "Suc n < idx (Suc k)")
+ case True
+ with k have "?in (Suc n) k"
+ by simp
+ thus ?thesis ..
+ next
+ case False
+ with k have "Suc n = idx (Suc k)"
+ by auto
+ with iseq have "?in (Suc n) (Suc k)"
+ by (simp add: idx_sequence_def)
+ thus ?thesis ..
+ qed
+qed
+
+lemma idx_sequence_interval_unique:
+ assumes iseq: "idx_sequence idx"
+ and k: "n \<in> {idx k ..< idx (Suc k)}"
+ and m: "n \<in> {idx m ..< idx (Suc m)}"
+ shows "k = m"
+proof (rule nat_less_cases)
+ assume "k < m"
+ hence "Suc k \<le> m" by simp
+ with iseq have "idx (Suc k) \<le> idx m"
+ by (rule idx_sequence_mono)
+ with m have "idx (Suc k) \<le> n"
+ by auto
+ with k have "False"
+ by simp
+ thus ?thesis ..
+next
+ assume "m < k"
+ hence "Suc m \<le> k" by simp
+ with iseq have "idx (Suc m) \<le> idx k"
+ by (rule idx_sequence_mono)
+ with k have "idx (Suc m) \<le> n"
+ by auto
+ with m have "False"
+ by simp
+ thus ?thesis ..
+qed (simp)
+
+lemma idx_sequence_unique_interval:
+ assumes iseq: "idx_sequence idx"
+ shows "\<exists>! k. n \<in> {idx k ..< idx (Suc k) }"
+proof (rule ex_ex1I)
+ from iseq show "\<exists>k. n \<in> {idx k ..< idx (Suc k)}"
+ by (rule idx_sequence_interval)
+next
+ fix k y
+ assume "n \<in> {idx k..<idx (Suc k)}" and "n \<in> {idx y..<idx (Suc y)}"
+ with iseq show "k = y" by (auto elim: idx_sequence_interval_unique)
+qed
+
+text \<open>
+ Now we can define the piecewise construction of a word using
+ an index sequence.
+\<close>
+
+definition merge :: "'a word word \<Rightarrow> nat word \<Rightarrow> 'a word"
+ where "merge ws idx \<equiv> \<lambda>n. let i = THE i. n \<in> {idx i ..< idx (Suc i) } in ws i n"
+
+lemma merge:
+ assumes idx: "idx_sequence idx"
+ and n: "n \<in> {idx i ..< idx (Suc i)}"
+ shows "merge ws idx n = ws i n"
+proof -
+ from n have "(THE k. n \<in> {idx k ..< idx (Suc k) }) = i"
+ by (rule the_equality[OF _ sym[OF idx_sequence_interval_unique[OF idx n]]]) simp
+ thus ?thesis
+ by (simp add: merge_def Let_def)
+qed
+
+lemma merge0:
+ assumes idx: "idx_sequence idx"
+ shows "merge ws idx 0 = ws 0 0"
+proof (rule merge[OF idx])
+ from idx have "idx 0 < idx (Suc 0)"
+ unfolding idx_sequence_def by blast
+ with idx show "0 \<in> {idx 0 ..< idx (Suc 0)}"
+ by (simp add: idx_sequence_def)
+qed
+
+lemma merge_Suc:
+ assumes idx: "idx_sequence idx"
+ and n: "n \<in> {idx i ..< idx (Suc i)}"
+ shows "merge ws idx (Suc n) = (if Suc n = idx (Suc i) then ws (Suc i) else ws i) (Suc n)"
+proof auto
+ assume eq: "Suc n = idx (Suc i)"
+ from idx have "idx (Suc i) < idx (Suc(Suc i))"
+ unfolding idx_sequence_def by blast
+ with eq idx show "merge ws idx (idx (Suc i)) = ws (Suc i) (idx (Suc i))"
+ by (simp add: merge)
+next
+ assume neq: "Suc n \<noteq> idx (Suc i)"
+ with n have "Suc n \<in> {idx i ..< idx (Suc i) }"
+ by auto
+ with idx show "merge ws idx (Suc n) = ws i (Suc n)"
+ by (rule merge)
+qed
+
+end
--- a/src/HOL/Library/OptionalSugar.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/OptionalSugar.thy Fri Sep 18 16:42:19 2015 +0100
@@ -48,14 +48,13 @@
"_bind (CONST DUMMY # p) e" <= "_bind p (CONST tl e)"
(* type constraints with spacing *)
+no_syntax (output)
+ "_constrain" :: "logic => type => logic" ("_::_" [4, 0] 3)
+ "_constrain" :: "prop' => type => prop'" ("_::_" [4, 0] 3)
-no_syntax (xsymbols output)
- "_constrain" :: "logic => type => logic" ("_\<Colon>_" [4, 0] 3)
- "_constrain" :: "prop' => type => prop'" ("_\<Colon>_" [4, 0] 3)
-
-syntax (xsymbols output)
- "_constrain" :: "logic => type => logic" ("_ \<Colon> _" [4, 0] 3)
- "_constrain" :: "prop' => type => prop'" ("_ \<Colon> _" [4, 0] 3)
+syntax (output)
+ "_constrain" :: "logic => type => logic" ("_ :: _" [4, 0] 3)
+ "_constrain" :: "prop' => type => prop'" ("_ :: _" [4, 0] 3)
(* sorts as intersections *)
--- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Fri Sep 18 16:42:19 2015 +0100
@@ -22,7 +22,7 @@
section \<open>Pairs\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name fst}, @{const_name snd}, @{const_name case_prod}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name fst}, @{const_name snd}, @{const_name uncurry}]\<close>
section \<open>Filters\<close>
@@ -212,6 +212,30 @@
done
qed
+subsection \<open>Alternative rules for membership in lists\<close>
+
+declare in_set_member[code_pred_inline]
+
+lemma member_intros [code_pred_intro]:
+ "List.member (x#xs) x"
+ "List.member xs x \<Longrightarrow> List.member (y#xs) x"
+by(simp_all add: List.member_def)
+
+code_pred List.member
+ by(auto simp add: List.member_def elim: list.set_cases)
+
+code_identifier constant member_i_i
+ \<rightharpoonup> (SML) "List.member_i_i"
+ and (OCaml) "List.member_i_i"
+ and (Haskell) "List.member_i_i"
+ and (Scala) "List.member_i_i"
+
+code_identifier constant member_i_o
+ \<rightharpoonup> (SML) "List.member_i_o"
+ and (OCaml) "List.member_i_o"
+ and (Haskell) "List.member_i_o"
+ and (Scala) "List.member_i_o"
+
section \<open>Setup for String.literal\<close>
setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name "STR"}]\<close>
--- a/src/HOL/Library/Product_Order.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/Product_Order.thy Fri Sep 18 16:42:19 2015 +0100
@@ -233,7 +233,7 @@
(* Contribution: Alessandro Coglio *)
instance prod :: (complete_distrib_lattice, complete_distrib_lattice) complete_distrib_lattice
-proof (standard, goals)
+proof (standard, goal_cases)
case 1
then show ?case
by (auto simp: sup_prod_def Inf_prod_def INF_prod_alt_def sup_Inf sup_INF comp_def)
--- a/src/HOL/Library/RBT_Impl.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/RBT_Impl.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1757,9 +1757,9 @@
compare.eq.refl compare.eq.simps
compare.EQ_def compare.GT_def compare.LT_def
equal_compare_def
- skip_red_def skip_red.simps skip_red.cases skip_red.induct
+ skip_red.simps skip_red.cases skip_red.induct
skip_black_def
- compare_height_def compare_height.simps
+ compare_height.simps
subsection \<open>union and intersection of sorted associative lists\<close>
--- a/src/HOL/Library/While_Combinator.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/While_Combinator.thy Fri Sep 18 16:42:19 2015 +0100
@@ -157,7 +157,7 @@
note b = this(1) and body = this(2) and inv = this(3)
hence k': "f ((c ^^ k') s) = (c' ^^ k') (f s)" by auto
ultimately show ?thesis unfolding Suc using b
- proof (intro Least_equality[symmetric], goals)
+ proof (intro Least_equality[symmetric], goal_cases)
case 1
hence Test: "\<not> b' (f ((c ^^ Suc k') s))"
by (auto simp: BodyCommute inv b)
@@ -314,10 +314,10 @@
and x :: 'a
begin
-fun rtrancl_while_test :: "'a list \<times> 'a set \<Rightarrow> bool"
+qualified fun rtrancl_while_test :: "'a list \<times> 'a set \<Rightarrow> bool"
where "rtrancl_while_test (ws,_) = (ws \<noteq> [] \<and> p(hd ws))"
-fun rtrancl_while_step :: "'a list \<times> 'a set \<Rightarrow> 'a list \<times> 'a set"
+qualified fun rtrancl_while_step :: "'a list \<times> 'a set \<Rightarrow> 'a list \<times> 'a set"
where "rtrancl_while_step (ws, Z) =
(let x = hd ws; new = remdups (filter (\<lambda>y. y \<notin> Z) (f x))
in (new @ tl ws, set new \<union> Z))"
@@ -325,12 +325,12 @@
definition rtrancl_while :: "('a list * 'a set) option"
where "rtrancl_while = while_option rtrancl_while_test rtrancl_while_step ([x],{x})"
-fun rtrancl_while_invariant :: "'a list \<times> 'a set \<Rightarrow> bool"
+qualified fun rtrancl_while_invariant :: "'a list \<times> 'a set \<Rightarrow> bool"
where "rtrancl_while_invariant (ws, Z) =
(x \<in> Z \<and> set ws \<subseteq> Z \<and> distinct ws \<and> {(x,y). y \<in> set(f x)} `` (Z - set ws) \<subseteq> Z \<and>
Z \<subseteq> {(x,y). y \<in> set(f x)}^* `` {x} \<and> (\<forall>z\<in>Z - set ws. p z))"
-lemma rtrancl_while_invariant:
+qualified lemma rtrancl_while_invariant:
assumes inv: "rtrancl_while_invariant st" and test: "rtrancl_while_test st"
shows "rtrancl_while_invariant (rtrancl_while_step st)"
proof (cases st)
@@ -392,7 +392,4 @@
end
-hide_const (open) rtrancl_while_test rtrancl_while_step rtrancl_while_invariant
-hide_fact (open) rtrancl_while_invariant
-
end
--- a/src/HOL/Library/bnf_axiomatization.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/bnf_axiomatization.ML Fri Sep 18 16:42:19 2015 +0100
@@ -86,9 +86,10 @@
fun mk_wit_thms set_maps =
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced wit_goals)
(fn {context = ctxt, prems = _} => mk_wits_tac ctxt set_maps)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length wit_goals)
|> map2 (Conjunction.elim_balanced o length) wit_goalss
- |> map (map (Thm.close_derivation o Thm.forall_elim_vars 0));
+ |> (map o map) (Thm.forall_elim_vars 0);
val phi = Proof_Context.export_morphism lthy_old lthy;
val thms = unflat all_goalss (Morphism.fact phi raw_thms);
--- a/src/HOL/Library/old_recdef.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Library/old_recdef.ML Fri Sep 18 16:42:19 2015 +0100
@@ -551,7 +551,7 @@
local
fun mk_uncurry (xt, yt, zt) =
- Const(@{const_name case_prod}, (xt --> yt --> zt) --> prod_ty xt yt --> zt)
+ Const(@{const_name uncurry}, (xt --> yt --> zt) --> prod_ty xt yt --> zt)
fun dest_pair(Const(@{const_name Pair},_) $ M $ N) = {fst=M, snd=N}
| dest_pair _ = raise USYN_ERR "dest_pair" "not a pair"
fun is_var (Var _) = true | is_var (Free _) = true | is_var _ = false
@@ -631,7 +631,7 @@
| dest_pair _ = raise USYN_ERR "dest_pair" "not a pair";
-local fun ucheck t = (if #Name (dest_const t) = @{const_name case_prod} then t
+local fun ucheck t = (if #Name (dest_const t) = @{const_name uncurry} then t
else raise Match)
in
fun dest_pabs used tm =
--- a/src/HOL/Limits.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Limits.thy Fri Sep 18 16:42:19 2015 +0100
@@ -710,13 +710,15 @@
lemma (in bounded_bilinear) flip:
"bounded_bilinear (\<lambda>x y. y ** x)"
- apply default
+ apply standard
apply (rule add_right)
apply (rule add_left)
apply (rule scaleR_right)
apply (rule scaleR_left)
apply (subst mult.commute)
- using bounded by fast
+ using bounded
+ apply fast
+ done
lemma (in bounded_bilinear) Bfun_prod_Zfun:
assumes f: "Bfun f F"
--- a/src/HOL/List.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/List.thy Fri Sep 18 16:42:19 2015 +0100
@@ -2868,7 +2868,7 @@
"F (set (x # xs)) = fold f xs x"
proof -
interpret comp_fun_idem f
- by default (simp_all add: fun_eq_iff left_commute)
+ by standard (simp_all add: fun_eq_iff left_commute)
show ?thesis by (simp add: eq_fold fold_set_fold)
qed
@@ -5161,7 +5161,7 @@
"folding.F insort [] = sorted_list_of_set"
proof -
interpret comp_fun_commute insort by (fact comp_fun_commute_insort)
- show "folding insort" by default (fact comp_fun_commute)
+ show "folding insort" by standard (fact comp_fun_commute)
show "folding.F insort [] = sorted_list_of_set" by (simp only: sorted_list_of_set_def)
qed
--- a/src/HOL/Matrix_LP/Matrix.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Matrix_LP/Matrix.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1448,7 +1448,7 @@
definition "sup = combine_matrix sup"
instance
- by default (auto simp add: le_infI le_matrix_def inf_matrix_def sup_matrix_def)
+ by standard (auto simp add: le_infI le_matrix_def inf_matrix_def sup_matrix_def)
end
--- a/src/HOL/Matrix_LP/SparseMatrix.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Matrix_LP/SparseMatrix.thy Fri Sep 18 16:42:19 2015 +0100
@@ -120,8 +120,11 @@
done
instance matrix :: (lattice_ab_group_add_abs) lattice_ab_group_add_abs
-apply default
-unfolding abs_matrix_def .. (*FIXME move*)
+ apply standard
+ unfolding abs_matrix_def
+ apply rule
+ done
+ (*FIXME move*)
lemma sparse_row_vector_abs:
"sorted_spvec (v :: 'a::lattice_ring spvec) \<Longrightarrow> sparse_row_vector (abs_spvec v) = abs (sparse_row_vector v)"
--- a/src/HOL/MicroJava/J/State.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/MicroJava/J/State.thy Fri Sep 18 16:42:19 2015 +0100
@@ -191,7 +191,7 @@
begin
definition "HOL.equal (l :: loc') l' \<longleftrightarrow> l = l'"
-instance by default (simp add: equal_loc'_def)
+instance by standard (simp add: equal_loc'_def)
end
--- a/src/HOL/MicroJava/J/Type.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/MicroJava/J/Type.thy Fri Sep 18 16:42:19 2015 +0100
@@ -13,7 +13,7 @@
begin
definition "HOL.equal (cn :: cnam) cn' \<longleftrightarrow> cn = cn'"
-instance by default (simp add: equal_cnam_def)
+instance by standard (simp add: equal_cnam_def)
end
@@ -63,7 +63,7 @@
begin
definition "HOL.equal (vn :: vnam) vn' \<longleftrightarrow> vn = vn'"
-instance by default (simp add: equal_vnam_def)
+instance by standard (simp add: equal_vnam_def)
end
@@ -98,7 +98,7 @@
begin
definition "HOL.equal (M :: mname) M' \<longleftrightarrow> M = M'"
-instance by default (simp add: equal_mname_def)
+instance by standard (simp add: equal_mname_def)
end
--- a/src/HOL/Multivariate_Analysis/Bounded_Continuous_Function.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Bounded_Continuous_Function.thy Fri Sep 18 16:42:19 2015 +0100
@@ -315,7 +315,7 @@
by (simp add: scaleR_bcontfun_def Abs_bcontfun_inverse scaleR_cont Rep_bcontfun)
instance
- by default
+ by standard
(simp_all add: plus_bcontfun_def zero_bcontfun_def minus_bcontfun_def scaleR_bcontfun_def
Abs_bcontfun_inverse Rep_bcontfun_inverse Rep_bcontfun algebra_simps
plus_cont const_bcontfun minus_cont scaleR_cont)
--- a/src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy Fri Sep 18 16:42:19 2015 +0100
@@ -589,7 +589,7 @@
using enum_Suc[of 0] na[rule_format, OF \<open>enum 1 \<in> s - {a}\<close>] \<open>a = enum 0\<close> by (auto simp: \<open>upd 0 = n\<close>)
show ?thesis
- proof (rule ksimplex.intros, default)
+ proof (rule ksimplex.intros, standard)
show "bij_betw (upd\<circ>Suc) {..< n} {..< n}" by fact
show "base(n := p) \<in> {..<n} \<rightarrow> {..<p}" "\<And>i. n\<le>i \<Longrightarrow> (base(n := p)) i = p"
using base base_out by (auto simp: Pi_iff)
@@ -620,7 +620,7 @@
def u \<equiv> "\<lambda>i. case i of 0 \<Rightarrow> n | Suc i \<Rightarrow> upd i"
have "ksimplex p (Suc n) (s' \<union> {b})"
- proof (rule ksimplex.intros, default)
+ proof (rule ksimplex.intros, standard)
show "b \<in> {..<Suc n} \<rightarrow> {..<p}"
using base \<open>0 < p\<close> unfolding lessThan_Suc b_def by (auto simp: PiE_iff)
show "\<And>i. Suc n \<le> i \<Longrightarrow> b i = p"
--- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Fri Sep 18 16:42:19 2015 +0100
@@ -73,7 +73,7 @@
end
instance vec:: (order, finite) order
- by default (auto simp: less_eq_vec_def less_vec_def vec_eq_iff
+ by standard (auto simp: less_eq_vec_def less_vec_def vec_eq_iff
intro: order.trans order.antisym order.strict_implies_order)
instance vec :: (linorder, cart_one) linorder
@@ -183,26 +183,26 @@
subsection \<open>Some frequently useful arithmetic lemmas over vectors.\<close>
instance vec :: (semigroup_mult, finite) semigroup_mult
- by default (vector mult.assoc)
+ by standard (vector mult.assoc)
instance vec :: (monoid_mult, finite) monoid_mult
- by default vector+
+ by standard vector+
instance vec :: (ab_semigroup_mult, finite) ab_semigroup_mult
- by default (vector mult.commute)
+ by standard (vector mult.commute)
instance vec :: (comm_monoid_mult, finite) comm_monoid_mult
- by default vector
+ by standard vector
instance vec :: (semiring, finite) semiring
- by default (vector field_simps)+
+ by standard (vector field_simps)+
instance vec :: (semiring_0, finite) semiring_0
- by default (vector field_simps)+
+ by standard (vector field_simps)+
instance vec :: (semiring_1, finite) semiring_1
- by default vector
+ by standard vector
instance vec :: (comm_semiring, finite) comm_semiring
- by default (vector field_simps)+
+ by standard (vector field_simps)+
instance vec :: (comm_semiring_0, finite) comm_semiring_0 ..
instance vec :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add ..
@@ -215,7 +215,7 @@
instance vec :: (ring_1, finite) ring_1 ..
instance vec :: (real_algebra, finite) real_algebra
- by default (simp_all add: vec_eq_iff)
+ by standard (simp_all add: vec_eq_iff)
instance vec :: (real_algebra_1, finite) real_algebra_1 ..
--- a/src/HOL/Multivariate_Analysis/Derivative.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Derivative.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1191,8 +1191,9 @@
have lem1: "\<forall>e>0. \<exists>d>0. \<forall>z.
norm (z - y) < d \<longrightarrow> norm (g z - g y - g'(z - y)) \<le> e * norm (g z - g y)"
proof (rule, rule)
- case goal1
- have *: "e / C > 0" using \<open>e > 0\<close> C(1) by auto
+ fix e :: real
+ assume "e > 0"
+ with C(1) have *: "e / C > 0" by auto
obtain d0 where d0:
"0 < d0"
"\<forall>ya. norm (ya - g y) < d0 \<longrightarrow> norm (f ya - f (g y) - f' (ya - g y)) \<le> e / C * norm (ya - g y)"
@@ -1213,7 +1214,7 @@
using assms(6) by blast
obtain d where d: "0 < d" "d < d1" "d < d2"
using real_lbound_gt_zero[OF d1(1) d2(1)] by blast
- then show ?case
+ then show "\<exists>d>0. \<forall>z. norm (z - y) < d \<longrightarrow> norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
apply (rule_tac x=d in exI)
apply rule
defer
@@ -1257,14 +1258,13 @@
def B \<equiv> "C * 2"
have "B > 0"
unfolding B_def using C by auto
- have lem2: "\<forall>z. norm(z - y) < d \<longrightarrow> norm (g z - g y) \<le> B * norm (z - y)"
- proof (rule, rule)
- case goal1
+ have lem2: "norm (g z - g y) \<le> B * norm (z - y)" if z: "norm(z - y) < d" for z
+ proof -
have "norm (g z - g y) \<le> norm(g' (z - y)) + norm ((g z - g y) - g'(z - y))"
by (rule norm_triangle_sub)
also have "\<dots> \<le> norm (g' (z - y)) + 1 / 2 * norm (g z - g y)"
apply (rule add_left_mono)
- using d and goal1
+ using d and z
apply auto
done
also have "\<dots> \<le> norm (z - y) * C + 1 / 2 * norm (g z - g y)"
@@ -1272,7 +1272,7 @@
using C
apply auto
done
- finally show ?case
+ finally show "norm (g z - g y) \<le> B * norm (z - y)"
unfolding B_def
by (auto simp add: field_simps)
qed
@@ -1283,15 +1283,16 @@
apply rule
apply rule
proof -
- case goal1
- hence *: "e / B >0" by (metis \<open>0 < B\<close> divide_pos_pos)
+ fix e :: real
+ assume "e > 0"
+ then have *: "e / B > 0" by (metis \<open>B > 0\<close> divide_pos_pos)
obtain d' where d':
"0 < d'"
"\<forall>z. norm (z - y) < d' \<longrightarrow> norm (g z - g y - g' (z - y)) \<le> e / B * norm (g z - g y)"
using lem1 * by blast
obtain k where k: "0 < k" "k < d" "k < d'"
using real_lbound_gt_zero[OF d(1) d'(1)] by blast
- show ?case
+ show "\<exists>d>0. \<forall>ya. norm (ya - y) < d \<longrightarrow> norm (g ya - g y - g' (ya - y)) \<le> e * norm (ya - y)"
apply (rule_tac x=k in exI)
apply auto
proof -
@@ -1301,7 +1302,7 @@
using d' k by auto
also have "\<dots> \<le> e * norm (z - y)"
unfolding times_divide_eq_left pos_divide_le_eq[OF \<open>B>0\<close>]
- using lem2[THEN spec[where x=z]]
+ using lem2[of z]
using k as using \<open>e > 0\<close>
by (auto simp add: field_simps)
finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (z - y)"
@@ -1650,7 +1651,8 @@
apply rule
apply rule
proof -
- case goal1
+ fix y
+ assume "0 < dist y (f x) \<and> dist y (f x) < d"
then have "g y \<in> g ` f ` (ball x e \<inter> s)"
using d(2)[unfolded subset_eq,THEN bspec[where x=y]]
by (auto simp add: dist_commute)
@@ -1667,13 +1669,12 @@
using interior_open[OF assms(1)] and \<open>x \<in> s\<close>
apply auto
done
- moreover have "\<And>y. y \<in> interior (f ` s) \<Longrightarrow> f (g y) = y"
+ moreover have "f (g y) = y" if "y \<in> interior (f ` s)" for y
proof -
- case goal1
- then have "y \<in> f ` s"
+ from that have "y \<in> f ` s"
using interior_subset by auto
then obtain z where "z \<in> s" "y = f z" unfolding image_iff ..
- then show ?case
+ then show ?thesis
using assms(4) by auto
qed
ultimately show ?thesis using assms
@@ -1882,11 +1883,13 @@
shows "\<forall>e>0. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>y\<in>s.
norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
proof (rule, rule)
- case goal1 have *: "2 * (1/2* e) = e" "1/2 * e >0"
- using \<open>e > 0\<close> by auto
+ fix e :: real
+ assume "e > 0"
+ then have *: "2 * (1/2* e) = e" "1/2 * e >0"
+ by auto
obtain N where "\<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. norm (f' n x h - g' x h) \<le> 1 / 2 * e * norm h"
using assms(3) *(2) by blast
- then show ?case
+ then show "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>y\<in>s. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
apply (rule_tac x=N in exI)
apply (rule has_derivative_sequence_lipschitz_lemma[where e="1/2 *e", unfolded *])
using assms \<open>e > 0\<close>
@@ -2060,9 +2063,10 @@
qed
show "\<forall>e>0. eventually (\<lambda>y. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)) (at x within s)"
proof (rule, rule)
- case goal1
- have *: "e / 3 > 0"
- using goal1 by auto
+ fix e :: real
+ assume "e > 0"
+ then have *: "e / 3 > 0"
+ by auto
obtain N1 where N1: "\<forall>n\<ge>N1. \<forall>x\<in>s. \<forall>h. norm (f' n x h - g' x h) \<le> e / 3 * norm h"
using assms(3) * by blast
obtain N2 where
@@ -2073,7 +2077,7 @@
using assms(2)[unfolded has_derivative_within_alt2] and \<open>x \<in> s\<close> and * by fast
moreover have "eventually (\<lambda>y. y \<in> s) (at x within s)"
unfolding eventually_at by (fast intro: zero_less_one)
- ultimately show ?case
+ ultimately show "\<forall>\<^sub>F y in at x within s. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
proof (rule eventually_elim2)
fix y
assume "y \<in> s"
@@ -2150,15 +2154,20 @@
using reals_Archimedean[OF \<open>e>0\<close>] ..
show "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
apply (rule_tac x=N in exI)
- proof rule+
- case goal1
+ apply rule
+ apply rule
+ apply rule
+ apply rule
+ proof -
+ fix n x h
+ assume n: "N \<le> n" and x: "x \<in> s"
have *: "inverse (real (Suc n)) \<le> e"
apply (rule order_trans[OF _ N[THEN less_imp_le]])
- using goal1(1)
+ using n
apply (auto simp add: field_simps)
done
- show ?case
- using f[rule_format,THEN conjunct2,OF goal1(2), of n, THEN spec[where x=h]]
+ show "norm (f' n x h - g' x h) \<le> e * norm h"
+ using f[rule_format,THEN conjunct2, OF x, of n, THEN spec[where x=h]]
apply (rule order_trans)
using N *
apply (cases "h = 0")
--- a/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Fri Sep 18 16:42:19 2015 +0100
@@ -139,7 +139,7 @@
[simp]: "Basis = {1::real}"
instance
- by default auto
+ by standard auto
end
@@ -155,7 +155,7 @@
"Basis = {1, ii}"
instance
- by default (auto simp add: Basis_complex_def intro: complex_eqI split: split_if_asm)
+ by standard (auto simp add: Basis_complex_def intro: complex_eqI split: split_if_asm)
end
--- a/src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy Fri Sep 18 16:42:19 2015 +0100
@@ -53,7 +53,7 @@
qed
instance ereal :: second_countable_topology
-proof (default, intro exI conjI)
+proof (standard, intro exI conjI)
let ?B = "(\<Union>r\<in>\<rat>. {{..< r}, {r <..}} :: ereal set set)"
show "countable ?B"
by (auto intro: countable_rat)
--- a/src/HOL/Multivariate_Analysis/Fashoda.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Fashoda.thy Fri Sep 18 16:42:19 2015 +0100
@@ -175,9 +175,8 @@
qed
have 3: "(negatex \<circ> sqprojection \<circ> ?F) ` cbox (-1) 1 \<subseteq> cbox (-1) 1"
unfolding subset_eq
- apply rule
- proof -
- case goal1
+ proof (rule, goal_cases)
+ case (1 x)
then obtain y :: "real^2" where y:
"y \<in> cbox (- 1) 1"
"x = (negatex \<circ> sqprojection \<circ> (\<lambda>w. (f \<circ> (\<lambda>x. x $ 1)) w - (g \<circ> (\<lambda>x. x $ 2)) w)) y"
@@ -198,8 +197,9 @@
apply -
apply rule
proof -
- case goal1
- then show ?case
+ fix i
+ assume "max \<bar>x $ 1\<bar> \<bar>x $ 2\<bar> = 1"
+ then show "(- 1) $ i \<le> x $ i \<and> x $ i \<le> 1 $ i"
apply (cases "i = 1")
defer
apply (drule 21)
@@ -834,15 +834,14 @@
z \<in> closed_segment (pathfinish g) (vector [pathfinish g $ 1, a $ 2 - 1])) \<or>
z \<in> closed_segment (vector [pathfinish g $ 1, a $ 2 - 1]) (vector [b $ 1 + 1, a $ 2 - 1])) \<or>
z \<in> closed_segment (vector [b $ 1 + 1, a $ 2 - 1]) (vector [b $ 1 + 1, b $ 2 + 3]) \<Longrightarrow> False"
- apply (simp only: segment_vertical segment_horizontal vector_2)
- proof -
- case goal1 note as=this
+ proof (simp only: segment_vertical segment_horizontal vector_2, goal_cases)
+ case prems: 1
have "pathfinish f \<in> cbox a b"
using assms(3) pathfinish_in_path_image[of f] by auto
then have "1 + b $ 1 \<le> pathfinish f $ 1 \<Longrightarrow> False"
unfolding mem_interval_cart forall_2 by auto
then have "z$1 \<noteq> pathfinish f$1"
- using as(2)
+ using prems(2)
using assms ab
by (auto simp add: field_simps)
moreover have "pathstart f \<in> cbox a b"
@@ -852,13 +851,13 @@
unfolding mem_interval_cart forall_2
by auto
then have "z$1 \<noteq> pathstart f$1"
- using as(2) using assms ab
+ using prems(2) using assms ab
by (auto simp add: field_simps)
ultimately have *: "z$2 = a$2 - 2"
- using goal1(1)
+ using prems(1)
by auto
have "z$1 \<noteq> pathfinish g$1"
- using as(2)
+ using prems(2)
using assms ab
by (auto simp add: field_simps *)
moreover have "pathstart g \<in> cbox a b"
@@ -866,11 +865,11 @@
by auto
note this[unfolded mem_interval_cart forall_2]
then have "z$1 \<noteq> pathstart g$1"
- using as(1)
+ using prems(1)
using assms ab
by (auto simp add: field_simps *)
ultimately have "a $ 2 - 1 \<le> z $ 2 \<and> z $ 2 \<le> b $ 2 + 3 \<or> b $ 2 + 3 \<le> z $ 2 \<and> z $ 2 \<le> a $ 2 - 1"
- using as(2)
+ using prems(2)
unfolding * assms
by (auto simp add: field_simps)
then show False
--- a/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Fri Sep 18 16:42:19 2015 +0100
@@ -95,30 +95,30 @@
unfolding uminus_vec_def by simp
instance vec :: (semigroup_add, finite) semigroup_add
- by default (simp add: vec_eq_iff add.assoc)
+ by standard (simp add: vec_eq_iff add.assoc)
instance vec :: (ab_semigroup_add, finite) ab_semigroup_add
- by default (simp add: vec_eq_iff add.commute)
+ by standard (simp add: vec_eq_iff add.commute)
instance vec :: (monoid_add, finite) monoid_add
- by default (simp_all add: vec_eq_iff)
+ by standard (simp_all add: vec_eq_iff)
instance vec :: (comm_monoid_add, finite) comm_monoid_add
- by default (simp add: vec_eq_iff)
+ by standard (simp add: vec_eq_iff)
instance vec :: (cancel_semigroup_add, finite) cancel_semigroup_add
- by default (simp_all add: vec_eq_iff)
+ by standard (simp_all add: vec_eq_iff)
instance vec :: (cancel_ab_semigroup_add, finite) cancel_ab_semigroup_add
- by default (simp_all add: vec_eq_iff diff_diff_eq)
+ by standard (simp_all add: vec_eq_iff diff_diff_eq)
instance vec :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add ..
instance vec :: (group_add, finite) group_add
- by default (simp_all add: vec_eq_iff)
+ by standard (simp_all add: vec_eq_iff)
instance vec :: (ab_group_add, finite) ab_group_add
- by default (simp_all add: vec_eq_iff)
+ by standard (simp_all add: vec_eq_iff)
subsection \<open>Real vector space\<close>
@@ -132,7 +132,7 @@
unfolding scaleR_vec_def by simp
instance
- by default (simp_all add: vec_eq_iff scaleR_left_distrib scaleR_right_distrib)
+ by standard (simp_all add: vec_eq_iff scaleR_left_distrib scaleR_right_distrib)
end
@@ -412,7 +412,7 @@
by (rule member_le_setL2) simp_all
lemma bounded_linear_vec_nth: "bounded_linear (\<lambda>x. x $ i)"
-apply default
+apply standard
apply (rule vector_add_component)
apply (rule vector_scaleR_component)
apply (rule_tac x="1" in exI, simp add: norm_nth_le)
--- a/src/HOL/Multivariate_Analysis/Integration.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Integration.thy Fri Sep 18 16:42:19 2015 +0100
@@ -15,7 +15,7 @@
shows "S \<noteq> {} \<Longrightarrow> (\<And>x. x\<in>S \<Longrightarrow> \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>Sup S\<bar> \<le> a"
by (auto simp add: abs_le_interval_iff intro: cSup_least) (metis cSup_upper2 bdd_aboveI)
-lemma cInf_abs_ge:
+lemma cInf_abs_ge:
fixes S :: "real set"
shows "S \<noteq> {} \<Longrightarrow> (\<And>x. x\<in>S \<Longrightarrow> \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>Inf S\<bar> \<le> a"
using cSup_abs_le [of "uminus ` S"]
@@ -248,156 +248,153 @@
have lem1: "\<And>x e s U. ball x e \<subseteq> s \<inter> interior U \<longleftrightarrow> ball x e \<subseteq> s \<inter> U"
using interior_subset
by auto (meson Topology_Euclidean_Space.open_ball contra_subsetD interior_maximal mem_ball)
- have "\<And>f. finite f \<Longrightarrow> \<forall>t\<in>f. \<exists>a b. t = cbox a b \<Longrightarrow>
- \<exists>x. x \<in> s \<inter> interior (\<Union>f) \<Longrightarrow> \<exists>t\<in>f. \<exists>x. \<exists>e>0. ball x e \<subseteq> s \<inter> t"
- proof -
- case goal1
- then show ?case
- proof (induct rule: finite_induct)
- case empty
- obtain x where "x \<in> s \<inter> interior (\<Union>{})"
- using empty(2) ..
- then have False
- unfolding Union_empty interior_empty by auto
- then show ?case by auto
+ have "\<exists>t\<in>f. \<exists>x. \<exists>e>0. ball x e \<subseteq> s \<inter> t"
+ if "finite f" and "\<forall>t\<in>f. \<exists>a b. t = cbox a b" and "\<exists>x. x \<in> s \<inter> interior (\<Union>f)" for f
+ using that
+ proof (induct rule: finite_induct)
+ case empty
+ obtain x where "x \<in> s \<inter> interior (\<Union>{})"
+ using empty(2) ..
+ then have False
+ unfolding Union_empty interior_empty by auto
+ then show ?case by auto
+ next
+ case (insert i f)
+ obtain x where x: "x \<in> s \<inter> interior (\<Union>insert i f)"
+ using insert(5) ..
+ then obtain e where e: "0 < e \<and> ball x e \<subseteq> s \<inter> interior (\<Union>insert i f)"
+ unfolding open_contains_ball_eq[OF open_Int[OF assms(2) open_interior], rule_format] ..
+ obtain a where "\<exists>b. i = cbox a b"
+ using insert(4)[rule_format,OF insertI1] ..
+ then obtain b where ab: "i = cbox a b" ..
+ show ?case
+ proof (cases "x \<in> i")
+ case False
+ then have "x \<in> UNIV - cbox a b"
+ unfolding ab by auto
+ then obtain d where "0 < d \<and> ball x d \<subseteq> UNIV - cbox a b"
+ unfolding open_contains_ball_eq[OF open_Diff[OF open_UNIV closed_cbox],rule_format] ..
+ then have "0 < d" "ball x (min d e) \<subseteq> UNIV - i"
+ unfolding ab ball_min_Int by auto
+ then have "ball x (min d e) \<subseteq> s \<inter> interior (\<Union>f)"
+ using e unfolding lem1 unfolding ball_min_Int by auto
+ then have "x \<in> s \<inter> interior (\<Union>f)" using \<open>d>0\<close> e by auto
+ then have "\<exists>t\<in>f. \<exists>x e. 0 < e \<and> ball x e \<subseteq> s \<inter> t"
+ using insert.hyps(3) insert.prems(1) by blast
+ then show ?thesis by auto
next
- case (insert i f)
- obtain x where x: "x \<in> s \<inter> interior (\<Union>insert i f)"
- using insert(5) ..
- then obtain e where e: "0 < e \<and> ball x e \<subseteq> s \<inter> interior (\<Union>insert i f)"
- unfolding open_contains_ball_eq[OF open_Int[OF assms(2) open_interior], rule_format] ..
- obtain a where "\<exists>b. i = cbox a b"
- using insert(4)[rule_format,OF insertI1] ..
- then obtain b where ab: "i = cbox a b" ..
- show ?case
- proof (cases "x \<in> i")
+ case True show ?thesis
+ proof (cases "x\<in>box a b")
+ case True
+ then obtain d where "0 < d \<and> ball x d \<subseteq> box a b"
+ unfolding open_contains_ball_eq[OF open_box,rule_format] ..
+ then show ?thesis
+ apply (rule_tac x=i in bexI, rule_tac x=x in exI, rule_tac x="min d e" in exI)
+ unfolding ab
+ using box_subset_cbox[of a b] and e
+ apply fastforce+
+ done
+ next
case False
- then have "x \<in> UNIV - cbox a b"
- unfolding ab by auto
- then obtain d where "0 < d \<and> ball x d \<subseteq> UNIV - cbox a b"
- unfolding open_contains_ball_eq[OF open_Diff[OF open_UNIV closed_cbox],rule_format] ..
- then have "0 < d" "ball x (min d e) \<subseteq> UNIV - i"
- unfolding ab ball_min_Int by auto
- then have "ball x (min d e) \<subseteq> s \<inter> interior (\<Union>f)"
- using e unfolding lem1 unfolding ball_min_Int by auto
- then have "x \<in> s \<inter> interior (\<Union>f)" using \<open>d>0\<close> e by auto
- then have "\<exists>t\<in>f. \<exists>x e. 0 < e \<and> ball x e \<subseteq> s \<inter> t"
- using insert.hyps(3) insert.prems(1) by blast
- then show ?thesis by auto
- next
- case True show ?thesis
- proof (cases "x\<in>box a b")
- case True
- then obtain d where "0 < d \<and> ball x d \<subseteq> box a b"
- unfolding open_contains_ball_eq[OF open_box,rule_format] ..
- then show ?thesis
- apply (rule_tac x=i in bexI, rule_tac x=x in exI, rule_tac x="min d e" in exI)
- unfolding ab
- using box_subset_cbox[of a b] and e
- apply fastforce+
+ then obtain k where "x\<bullet>k \<le> a\<bullet>k \<or> x\<bullet>k \<ge> b\<bullet>k" and k: "k \<in> Basis"
+ unfolding mem_box by (auto simp add: not_less)
+ then have "x\<bullet>k = a\<bullet>k \<or> x\<bullet>k = b\<bullet>k"
+ using True unfolding ab and mem_box
+ apply (erule_tac x = k in ballE)
+ apply auto
done
- next
- case False
- then obtain k where "x\<bullet>k \<le> a\<bullet>k \<or> x\<bullet>k \<ge> b\<bullet>k" and k: "k \<in> Basis"
- unfolding mem_box by (auto simp add: not_less)
- then have "x\<bullet>k = a\<bullet>k \<or> x\<bullet>k = b\<bullet>k"
- using True unfolding ab and mem_box
- apply (erule_tac x = k in ballE)
+ then have "\<exists>x. ball x (e/2) \<subseteq> s \<inter> (\<Union>f)"
+ proof (rule disjE)
+ let ?z = "x - (e/2) *\<^sub>R k"
+ assume as: "x\<bullet>k = a\<bullet>k"
+ have "ball ?z (e / 2) \<inter> i = {}"
+ proof (clarsimp simp only: all_not_in_conv [symmetric])
+ fix y
+ assume "y \<in> ball ?z (e / 2)" and yi: "y \<in> i"
+ then have "dist ?z y < e/2" by auto
+ then have "\<bar>(?z - y) \<bullet> k\<bar> < e/2"
+ using Basis_le_norm[OF k, of "?z - y"] unfolding dist_norm by auto
+ then have "y\<bullet>k < a\<bullet>k"
+ using e k
+ by (auto simp add: field_simps abs_less_iff as inner_simps)
+ then have "y \<notin> i"
+ unfolding ab mem_box by (auto intro!: bexI[OF _ k])
+ then show False using yi by auto
+ qed
+ moreover
+ have "ball ?z (e/2) \<subseteq> s \<inter> (\<Union>insert i f)"
+ apply (rule order_trans[OF _ e[THEN conjunct2, unfolded lem1]])
+ proof
+ fix y
+ assume as: "y \<in> ball ?z (e/2)"
+ have "norm (x - y) \<le> \<bar>e\<bar> / 2 + norm (x - y - (e / 2) *\<^sub>R k)"
+ apply (rule order_trans,rule norm_triangle_sub[of "x - y" "(e/2) *\<^sub>R k"])
+ unfolding norm_scaleR norm_Basis[OF k]
apply auto
done
- then have "\<exists>x. ball x (e/2) \<subseteq> s \<inter> (\<Union>f)"
- proof (rule disjE)
- let ?z = "x - (e/2) *\<^sub>R k"
- assume as: "x\<bullet>k = a\<bullet>k"
- have "ball ?z (e / 2) \<inter> i = {}"
- proof (clarsimp simp only: all_not_in_conv [symmetric])
- fix y
- assume "y \<in> ball ?z (e / 2)" and yi: "y \<in> i"
- then have "dist ?z y < e/2" by auto
- then have "\<bar>(?z - y) \<bullet> k\<bar> < e/2"
- using Basis_le_norm[OF k, of "?z - y"] unfolding dist_norm by auto
- then have "y\<bullet>k < a\<bullet>k"
- using e k
- by (auto simp add: field_simps abs_less_iff as inner_simps)
- then have "y \<notin> i"
- unfolding ab mem_box by (auto intro!: bexI[OF _ k])
- then show False using yi by auto
- qed
- moreover
- have "ball ?z (e/2) \<subseteq> s \<inter> (\<Union>insert i f)"
- apply (rule order_trans[OF _ e[THEN conjunct2, unfolded lem1]])
- proof
- fix y
- assume as: "y \<in> ball ?z (e/2)"
- have "norm (x - y) \<le> \<bar>e\<bar> / 2 + norm (x - y - (e / 2) *\<^sub>R k)"
- apply (rule order_trans,rule norm_triangle_sub[of "x - y" "(e/2) *\<^sub>R k"])
- unfolding norm_scaleR norm_Basis[OF k]
- apply auto
- done
- also have "\<dots> < \<bar>e\<bar> / 2 + \<bar>e\<bar> / 2"
- apply (rule add_strict_left_mono)
- using as e
- apply (auto simp add: field_simps dist_norm)
- done
- finally show "y \<in> ball x e"
- unfolding mem_ball dist_norm using e by (auto simp add:field_simps)
- qed
- ultimately show ?thesis
- apply (rule_tac x="?z" in exI)
- unfolding Union_insert
- apply auto
+ also have "\<dots> < \<bar>e\<bar> / 2 + \<bar>e\<bar> / 2"
+ apply (rule add_strict_left_mono)
+ using as e
+ apply (auto simp add: field_simps dist_norm)
done
- next
- let ?z = "x + (e/2) *\<^sub>R k"
- assume as: "x\<bullet>k = b\<bullet>k"
- have "ball ?z (e / 2) \<inter> i = {}"
- proof (clarsimp simp only: all_not_in_conv [symmetric])
- fix y
- assume "y \<in> ball ?z (e / 2)" and yi: "y \<in> i"
- then have "dist ?z y < e/2"
- by auto
- then have "\<bar>(?z - y) \<bullet> k\<bar> < e/2"
- using Basis_le_norm[OF k, of "?z - y"]
- unfolding dist_norm by auto
- then have "y\<bullet>k > b\<bullet>k"
- using e k
- by (auto simp add:field_simps inner_simps inner_Basis as)
- then have "y \<notin> i"
- unfolding ab mem_box by (auto intro!: bexI[OF _ k])
- then show False using yi by auto
- qed
- moreover
- have "ball ?z (e/2) \<subseteq> s \<inter> (\<Union>insert i f)"
- apply (rule order_trans[OF _ e[THEN conjunct2, unfolded lem1]])
- proof
- fix y
- assume as: "y\<in> ball ?z (e/2)"
- have "norm (x - y) \<le> \<bar>e\<bar> / 2 + norm (x - y + (e / 2) *\<^sub>R k)"
- apply (rule order_trans,rule norm_triangle_sub[of "x - y" "- (e/2) *\<^sub>R k"])
- unfolding norm_scaleR
- apply (auto simp: k)
- done
- also have "\<dots> < \<bar>e\<bar> / 2 + \<bar>e\<bar> / 2"
- apply (rule add_strict_left_mono)
- using as unfolding mem_ball dist_norm
- using e apply (auto simp add: field_simps)
- done
- finally show "y \<in> ball x e"
- unfolding mem_ball dist_norm using e by (auto simp add:field_simps)
- qed
- ultimately show ?thesis
- apply (rule_tac x="?z" in exI)
- unfolding Union_insert
- apply auto
+ finally show "y \<in> ball x e"
+ unfolding mem_ball dist_norm using e by (auto simp add:field_simps)
+ qed
+ ultimately show ?thesis
+ apply (rule_tac x="?z" in exI)
+ unfolding Union_insert
+ apply auto
+ done
+ next
+ let ?z = "x + (e/2) *\<^sub>R k"
+ assume as: "x\<bullet>k = b\<bullet>k"
+ have "ball ?z (e / 2) \<inter> i = {}"
+ proof (clarsimp simp only: all_not_in_conv [symmetric])
+ fix y
+ assume "y \<in> ball ?z (e / 2)" and yi: "y \<in> i"
+ then have "dist ?z y < e/2"
+ by auto
+ then have "\<bar>(?z - y) \<bullet> k\<bar> < e/2"
+ using Basis_le_norm[OF k, of "?z - y"]
+ unfolding dist_norm by auto
+ then have "y\<bullet>k > b\<bullet>k"
+ using e k
+ by (auto simp add:field_simps inner_simps inner_Basis as)
+ then have "y \<notin> i"
+ unfolding ab mem_box by (auto intro!: bexI[OF _ k])
+ then show False using yi by auto
+ qed
+ moreover
+ have "ball ?z (e/2) \<subseteq> s \<inter> (\<Union>insert i f)"
+ apply (rule order_trans[OF _ e[THEN conjunct2, unfolded lem1]])
+ proof
+ fix y
+ assume as: "y\<in> ball ?z (e/2)"
+ have "norm (x - y) \<le> \<bar>e\<bar> / 2 + norm (x - y + (e / 2) *\<^sub>R k)"
+ apply (rule order_trans,rule norm_triangle_sub[of "x - y" "- (e/2) *\<^sub>R k"])
+ unfolding norm_scaleR
+ apply (auto simp: k)
done
+ also have "\<dots> < \<bar>e\<bar> / 2 + \<bar>e\<bar> / 2"
+ apply (rule add_strict_left_mono)
+ using as unfolding mem_ball dist_norm
+ using e apply (auto simp add: field_simps)
+ done
+ finally show "y \<in> ball x e"
+ unfolding mem_ball dist_norm using e by (auto simp add:field_simps)
qed
- then obtain x where "ball x (e / 2) \<subseteq> s \<inter> \<Union>f" ..
- then have "x \<in> s \<inter> interior (\<Union>f)"
- unfolding lem1[where U="\<Union>f", symmetric]
- using centre_in_ball e by auto
- then show ?thesis
- using insert.hyps(3) insert.prems(1) by blast
+ ultimately show ?thesis
+ apply (rule_tac x="?z" in exI)
+ unfolding Union_insert
+ apply auto
+ done
qed
+ then obtain x where "ball x (e / 2) \<subseteq> s \<inter> \<Union>f" ..
+ then have "x \<in> s \<inter> interior (\<Union>f)"
+ unfolding lem1[where U="\<Union>f", symmetric]
+ using centre_in_ball e by auto
+ then show ?thesis
+ using insert.hyps(3) insert.prems(1) by blast
qed
qed
qed
@@ -1097,15 +1094,16 @@
note p = division_ofD[OF assms(1)]
have div_cbox: "\<forall>k\<in>p. \<exists>q. q division_of cbox a b \<and> k \<in> q"
proof
- case goal1
+ fix k
+ assume kp: "k \<in> p"
obtain c d where k: "k = cbox c d"
- using p(4)[OF goal1] by blast
+ using p(4)[OF kp] by blast
have *: "cbox c d \<subseteq> cbox a b" "cbox c d \<noteq> {}"
- using p(2,3)[OF goal1, unfolded k] using assms(2)
+ using p(2,3)[OF kp, unfolded k] using assms(2)
by (blast intro: order.trans)+
obtain q where "q division_of cbox a b" "cbox c d \<in> q"
by (rule partial_division_extend_1[OF *])
- then show ?case
+ then show "\<exists>q. q division_of cbox a b \<and> k \<in> q"
unfolding k by auto
qed
obtain q where q: "\<And>x. x \<in> p \<Longrightarrow> q x division_of cbox a b" "\<And>x. x \<in> p \<Longrightarrow> x \<in> q x"
@@ -1275,9 +1273,10 @@
assume as: "p \<noteq> {}" "interior (cbox a b) \<noteq> {}" "cbox a b \<noteq> {}"
have "\<forall>k\<in>p. \<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
proof
- case goal1
- from assm(4)[OF this] obtain c d where "k = cbox c d" by blast
- then show ?case
+ fix k
+ assume kp: "k \<in> p"
+ from assm(4)[OF kp] obtain c d where "k = cbox c d" by blast
+ then show "\<exists>q. (insert (cbox a b) q) division_of (cbox a b \<union> k)"
by (meson as(3) division_union_intervals_exists)
qed
from bchoice[OF this] obtain q where "\<forall>x\<in>p. insert (cbox a b) (q x) division_of (cbox a b) \<union> x" ..
@@ -1910,7 +1909,8 @@
(\<Sum>i\<in>Basis. (if i \<in> s then (a\<bullet>i + b\<bullet>i) / 2 else b\<bullet>i) *\<^sub>R i)) ` {s. s \<subseteq> Basis}"
have "?A \<subseteq> ?B"
proof
- case goal1
+ fix x
+ assume "x \<in> ?A"
then obtain c d
where x: "x = cbox c d"
"\<And>i. i \<in> Basis \<Longrightarrow>
@@ -2034,15 +2034,14 @@
proof -
have "\<forall>x. \<exists>y. \<not> P (cbox (fst x) (snd x)) \<longrightarrow> (\<not> P (cbox (fst y) (snd y)) \<and>
(\<forall>i\<in>Basis. fst x\<bullet>i \<le> fst y\<bullet>i \<and> fst y\<bullet>i \<le> snd y\<bullet>i \<and> snd y\<bullet>i \<le> snd x\<bullet>i \<and>
- 2 * (snd y\<bullet>i - fst y\<bullet>i) \<le> snd x\<bullet>i - fst x\<bullet>i))"
+ 2 * (snd y\<bullet>i - fst y\<bullet>i) \<le> snd x\<bullet>i - fst x\<bullet>i))" (is "\<forall>x. ?P x")
proof
- case goal1
- show ?case
- proof -
- presume "\<not> P (cbox (fst x) (snd x)) \<Longrightarrow> ?thesis"
- then show ?thesis by (cases "P (cbox (fst x) (snd x))") auto
+ show "?P x" for x
+ proof (cases "P (cbox (fst x) (snd x))")
+ case True
+ then show ?thesis by auto
next
- assume as: "\<not> P (cbox (fst x) (snd x))"
+ case as: False
obtain c d where "\<not> P (cbox c d)"
"\<forall>i\<in>Basis.
fst x \<bullet> i \<le> c \<bullet> i \<and>
@@ -2080,9 +2079,8 @@
proof -
show "A 0 = a" "B 0 = b"
unfolding ab_def by auto
- case goal3
note S = ab_def funpow.simps o_def id_apply
- show ?case
+ show "?P n" for n
proof (induct n)
case 0
then show ?case
@@ -2103,12 +2101,12 @@
qed
note AB = this(1-2) conjunctD2[OF this(3),rule_format]
- have interv: "\<And>e. 0 < e \<Longrightarrow> \<exists>n. \<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e"
+ have interv: "\<exists>n. \<forall>x\<in>cbox (A n) (B n). \<forall>y\<in>cbox (A n) (B n). dist x y < e"
+ if e: "0 < e" for e
proof -
- case goal1
obtain n where n: "(\<Sum>i\<in>Basis. b \<bullet> i - a \<bullet> i) / e < 2 ^ n"
using real_arch_pow2[of "(setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis) / e"] ..
- show ?case
+ show ?thesis
proof (rule exI [where x=n], clarify)
fix x y
assume xy: "x\<in>cbox (A n) (B n)" "y\<in>cbox (A n) (B n)"
@@ -2125,8 +2123,7 @@
also have "\<dots> \<le> setsum (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis / 2^n"
unfolding setsum_divide_distrib
proof (rule setsum_mono)
- case goal1
- then show ?case
+ show "B n \<bullet> i - A n \<bullet> i \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ n" if i: "i \<in> Basis" for i
proof (induct n)
case 0
then show ?case
@@ -2134,14 +2131,14 @@
next
case (Suc n)
have "B (Suc n) \<bullet> i - A (Suc n) \<bullet> i \<le> (B n \<bullet> i - A n \<bullet> i) / 2"
- using AB(4)[of i n] using goal1 by auto
+ using AB(4)[of i n] using i by auto
also have "\<dots> \<le> (b \<bullet> i - a \<bullet> i) / 2 ^ Suc n"
- using Suc by (auto simp add:field_simps)
+ using Suc by (auto simp add: field_simps)
finally show ?case .
qed
qed
also have "\<dots> < e"
- using n using goal1 by (auto simp add:field_simps)
+ using n using e by (auto simp add: field_simps)
finally show "dist x y < e" .
qed
qed
@@ -2240,25 +2237,27 @@
shows "k1 = k2"
proof (rule ccontr)
let ?e = "norm (k1 - k2) / 2"
- assume as:"k1 \<noteq> k2"
+ assume as: "k1 \<noteq> k2"
then have e: "?e > 0"
by auto
- have lem: "\<And>f::'n \<Rightarrow> 'a. \<And>a b k1 k2.
- (f has_integral k1) (cbox a b) \<Longrightarrow> (f has_integral k2) (cbox a b) \<Longrightarrow> k1 \<noteq> k2 \<Longrightarrow> False"
+ have lem: False
+ if f_k1: "(f has_integral k1) (cbox a b)"
+ and f_k2: "(f has_integral k2) (cbox a b)"
+ and "k1 \<noteq> k2"
+ for f :: "'n \<Rightarrow> 'a" and a b k1 k2
proof -
- case goal1
let ?e = "norm (k1 - k2) / 2"
- from goal1(3) have e: "?e > 0" by auto
+ from \<open>k1 \<noteq> k2\<close> have e: "?e > 0" by auto
obtain d1 where d1:
"gauge d1"
"\<And>p. p tagged_division_of cbox a b \<Longrightarrow>
d1 fine p \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k1) < norm (k1 - k2) / 2"
- by (rule has_integralD[OF goal1(1) e]) blast
+ by (rule has_integralD[OF f_k1 e]) blast
obtain d2 where d2:
"gauge d2"
"\<And>p. p tagged_division_of cbox a b \<Longrightarrow>
d2 fine p \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k2) < norm (k1 - k2) / 2"
- by (rule has_integralD[OF goal1(2) e]) blast
+ by (rule has_integralD[OF f_k2 e]) blast
obtain p where p:
"p tagged_division_of cbox a b"
"(\<lambda>x. d1 x \<inter> d2 x) fine p"
@@ -2336,26 +2335,26 @@
fix a b e
fix f :: "'n \<Rightarrow> 'a"
assume as: "\<forall>x\<in>cbox a b. f x = 0" "0 < (e::real)"
- have "\<And>p. p tagged_division_of cbox a b \<Longrightarrow> (\<lambda>x. ball x 1) fine p \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e"
+ have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e"
+ if p: "p tagged_division_of cbox a b" for p
proof -
- case goal1
have "(\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) = 0"
proof (rule setsum.neutral, rule)
fix x
assume x: "x \<in> p"
have "f (fst x) = 0"
- using tagged_division_ofD(2-3)[OF goal1(1), of "fst x" "snd x"] using as x by auto
+ using tagged_division_ofD(2-3)[OF p, of "fst x" "snd x"] using as x by auto
then show "(\<lambda>(x, k). content k *\<^sub>R f x) x = 0"
apply (subst surjective_pairing[of x])
unfolding split_conv
apply auto
done
qed
- then show ?case
+ then show ?thesis
using as by auto
qed
then show "\<exists>d. gauge d \<and>
- (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e)"
+ (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) < e)"
by auto
qed
{
@@ -2392,19 +2391,20 @@
by blast
have lem: "\<And>(f :: 'n \<Rightarrow> 'a) y a b.
(f has_integral y) (cbox a b) \<Longrightarrow> ((h o f) has_integral h y) (cbox a b)"
- unfolding has_integral
- proof clarify
- case goal1
+ unfolding has_integral
+ proof (clarify, goal_cases)
+ case prems: (1 f y a b e)
from pos_bounded
obtain B where B: "0 < B" "\<And>x. norm (h x) \<le> norm x * B"
by blast
- have "e / B > 0" using goal1(2) B by simp
+ have "e / B > 0" using prems(2) B by simp
then obtain g
where g: "gauge g"
"\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> g fine p \<Longrightarrow>
norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - y) < e / B"
- using goal1(1) by auto
- { fix p
+ using prems(1) by auto
+ {
+ fix p
assume as: "p tagged_division_of (cbox a b)" "g fine p"
have hc: "\<And>x k. h ((\<lambda>(x, k). content k *\<^sub>R f x) x) = (\<lambda>(x, k). h (content k *\<^sub>R f x)) x"
by auto
@@ -2441,18 +2441,19 @@
using has_integral_altD[OF assms(1) as *] by blast
show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
(\<exists>z. ((\<lambda>x. if x \<in> s then (h \<circ> f) x else 0) has_integral z) (cbox a b) \<and> norm (z - h y) < e)"
- proof (rule_tac x=M in exI, clarsimp simp add: M)
- case goal1
+ proof (rule_tac x=M in exI, clarsimp simp add: M, goal_cases)
+ case prems: (1 a b)
obtain z where z:
"((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b)"
"norm (z - y) < e / B"
- using M(2)[OF goal1(1)] by blast
+ using M(2)[OF prems(1)] by blast
have *: "(\<lambda>x. if x \<in> s then (h \<circ> f) x else 0) = h \<circ> (\<lambda>x. if x \<in> s then f x else 0)"
using zero by auto
show ?case
apply (rule_tac x="h z" in exI)
- apply (simp add: "*" lem z(1))
- by (metis B diff le_less_trans pos_less_divide_eq z(2))
+ apply (simp add: * lem z(1))
+ apply (metis B diff le_less_trans pos_less_divide_eq z(2))
+ done
qed
qed
qed
@@ -2475,7 +2476,7 @@
fixes c :: "'a :: real_normed_algebra"
shows "(f has_integral y) i \<Longrightarrow> ((\<lambda>x. c * f x) has_integral (c * y)) i"
using has_integral_linear[OF _ bounded_linear_mult_right] by (simp add: comp_def)
-
+
lemma has_integral_cmul: "(f has_integral k) s \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) s"
unfolding o_def[symmetric]
by (metis has_integral_linear bounded_linear_scaleR_right)
@@ -2502,51 +2503,47 @@
and "(g has_integral l) s"
shows "((\<lambda>x. f x + g x) has_integral (k + l)) s"
proof -
- have lem:"\<And>(f:: 'n \<Rightarrow> 'a) g a b k l.
- (f has_integral k) (cbox a b) \<Longrightarrow>
- (g has_integral l) (cbox a b) \<Longrightarrow>
- ((\<lambda>x. f x + g x) has_integral (k + l)) (cbox a b)"
- proof -
- case goal1
- show ?case
- unfolding has_integral
- proof clarify
- fix e :: real
- assume e: "e > 0"
- then have *: "e/2 > 0"
+ have lem: "((\<lambda>x. f x + g x) has_integral (k + l)) (cbox a b)"
+ if f_k: "(f has_integral k) (cbox a b)"
+ and g_l: "(g has_integral l) (cbox a b)"
+ for f :: "'n \<Rightarrow> 'a" and g a b k l
+ unfolding has_integral
+ proof clarify
+ fix e :: real
+ assume e: "e > 0"
+ then have *: "e / 2 > 0"
+ by auto
+ obtain d1 where d1:
+ "gauge d1"
+ "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d1 fine p \<Longrightarrow>
+ norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k) < e / 2"
+ using has_integralD[OF f_k *] by blast
+ obtain d2 where d2:
+ "gauge d2"
+ "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d2 fine p \<Longrightarrow>
+ norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - l) < e / 2"
+ using has_integralD[OF g_l *] by blast
+ show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
+ norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) < e)"
+ proof (rule exI [where x="\<lambda>x. (d1 x) \<inter> (d2 x)"], clarsimp simp add: gauge_inter[OF d1(1) d2(1)])
+ fix p
+ assume as: "p tagged_division_of (cbox a b)" "(\<lambda>x. d1 x \<inter> d2 x) fine p"
+ have *: "(\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) =
+ (\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p. content k *\<^sub>R g x)"
+ unfolding scaleR_right_distrib setsum.distrib[of "\<lambda>(x,k). content k *\<^sub>R f x" "\<lambda>(x,k). content k *\<^sub>R g x" p,symmetric]
+ by (rule setsum.cong) auto
+ from as have fine: "d1 fine p" "d2 fine p"
+ unfolding fine_inter by auto
+ have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) =
+ norm (((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k) + ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - l))"
+ unfolding * by (auto simp add: algebra_simps)
+ also have "\<dots> < e/2 + e/2"
+ apply (rule le_less_trans[OF norm_triangle_ineq])
+ using as d1 d2 fine
+ apply (blast intro: add_strict_mono)
+ done
+ finally show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) < e"
by auto
- obtain d1 where d1:
- "gauge d1"
- "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d1 fine p \<Longrightarrow>
- norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k) < e / 2"
- using has_integralD[OF goal1(1) *] by blast
- obtain d2 where d2:
- "gauge d2"
- "\<And>p. p tagged_division_of (cbox a b) \<Longrightarrow> d2 fine p \<Longrightarrow>
- norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - l) < e / 2"
- using has_integralD[OF goal1(2) *] by blast
- show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
- norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) < e)"
- proof (rule exI [where x="\<lambda>x. (d1 x) \<inter> (d2 x)"], clarsimp simp add: gauge_inter[OF d1(1) d2(1)])
- fix p
- assume as: "p tagged_division_of (cbox a b)" "(\<lambda>x. d1 x \<inter> d2 x) fine p"
- have *: "(\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) =
- (\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p. content k *\<^sub>R g x)"
- unfolding scaleR_right_distrib setsum.distrib[of "\<lambda>(x,k). content k *\<^sub>R f x" "\<lambda>(x,k). content k *\<^sub>R g x" p,symmetric]
- by (rule setsum.cong) auto
- from as have fine: "d1 fine p" "d2 fine p"
- unfolding fine_inter by auto
- have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) =
- norm (((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - k) + ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - l))"
- unfolding * by (auto simp add: algebra_simps)
- also have "\<dots> < e/2 + e/2"
- apply (rule le_less_trans[OF norm_triangle_ineq])
- using as d1 d2 fine
- apply (blast intro: add_strict_mono)
- done
- finally show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R (f x + g x)) - (k + l)) < e"
- by auto
- qed
qed
qed
{
@@ -2556,9 +2553,9 @@
}
assume as: "\<not> (\<exists>a b. s = cbox a b)"
then show ?thesis
- proof (subst has_integral_alt, clarsimp)
- case goal1
- then have *: "e/2 > 0"
+ proof (subst has_integral_alt, clarsimp, goal_cases)
+ case (1 e)
+ then have *: "e / 2 > 0"
by auto
from has_integral_altD[OF assms(1) as *]
obtain B1 where B1:
@@ -2812,8 +2809,8 @@
assume ?l
then guess y unfolding integrable_on_def has_integral .. note y=this
show "\<forall>e>0. \<exists>d. ?P e d"
- proof clarify
- case goal1
+ proof (clarify, goal_cases)
+ case (1 e)
then have "e/2 > 0" by auto
then guess d
apply -
@@ -2847,8 +2844,8 @@
have dp: "\<And>i n. i\<le>n \<Longrightarrow> d i fine p n"
using p(2) unfolding fine_inters by auto
have "Cauchy (\<lambda>n. setsum (\<lambda>(x,k). content k *\<^sub>R (f x)) (p n))"
- proof (rule CauchyI)
- case goal1
+ proof (rule CauchyI, goal_cases)
+ case (1 e)
then guess N unfolding real_arch_inv[of e] .. note N=this
show ?case
apply (rule_tac x=N in exI)
@@ -3107,8 +3104,8 @@
and fj: "(f has_integral j) (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
and k: "k \<in> Basis"
shows "(f has_integral (i + j)) (cbox a b)"
-proof (unfold has_integral, rule, rule)
- case goal1
+proof (unfold has_integral, rule, rule, goal_cases)
+ case (1 e)
then have e: "e/2 > 0"
by auto
obtain d1
@@ -3176,12 +3173,11 @@
have lem1: "\<And>f P Q. (\<forall>x k. (x, k) \<in> {(x, f k) | x k. P x k} \<longrightarrow> Q x k) \<longleftrightarrow>
(\<forall>x k. P x k \<longrightarrow> Q x (f k))"
by auto
- have fin_finite: "\<And>f s P f. finite s \<Longrightarrow> finite {(x,f k) | x k. (x,k) \<in> s \<and> P x k}"
+ have fin_finite: "finite {(x,f k) | x k. (x,k) \<in> s \<and> P x k}" if "finite s" for f s P
proof -
- case goal1
- then have "finite ((\<lambda>(x, k). (x, f k)) ` s)"
+ from that have "finite ((\<lambda>(x, k). (x, f k)) ` s)"
by auto
- then show ?case
+ then show ?thesis
by (rule rev_finite_subset) auto
qed
{ fix g :: "'a set \<Rightarrow> 'a set"
@@ -3848,16 +3844,18 @@
lemma iterate_image:
assumes "monoidal opp"
- and "inj_on f s"
- shows "iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
-proof -
- have *: "\<And>s. finite s \<Longrightarrow> \<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<longrightarrow> x = y \<Longrightarrow>
- iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
- proof -
- case goal1
- then show ?case
- apply (induct s)
- using assms(1) by auto
+ and "inj_on f s"
+ shows "iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
+proof -
+ have *: "iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
+ if "finite s" "\<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<longrightarrow> x = y" for s
+ using that
+ proof (induct s)
+ case empty
+ then show ?case by simp
+ next
+ case insert
+ with assms(1) show ?case by auto
qed
show ?thesis
apply (cases "finite (support opp g (f ` s))")
@@ -4333,14 +4331,17 @@
and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
shows "i\<bullet>k \<le> j\<bullet>k"
proof -
- have lem: "\<And>a b i j::'b. \<And>g f::'a \<Rightarrow> 'b. (f has_integral i) (cbox a b) \<Longrightarrow>
- (g has_integral j) (cbox a b) \<Longrightarrow> \<forall>x\<in>cbox a b. (f x)\<bullet>k \<le> (g x)\<bullet>k \<Longrightarrow> i\<bullet>k \<le> j\<bullet>k"
+ have lem: "i\<bullet>k \<le> j\<bullet>k"
+ if f_i: "(f has_integral i) (cbox a b)"
+ and g_j: "(g has_integral j) (cbox a b)"
+ and le: "\<forall>x\<in>cbox a b. (f x)\<bullet>k \<le> (g x)\<bullet>k"
+ for a b i and j :: 'b and f g :: "'a \<Rightarrow> 'b"
proof (rule ccontr)
- case goal1
+ assume "\<not> ?thesis"
then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3"
by auto
- guess d1 using goal1(1)[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d1=this[rule_format]
- guess d2 using goal1(2)[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d2=this[rule_format]
+ guess d1 using f_i[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d1=this[rule_format]
+ guess d2 using g_j[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d2=this[rule_format]
obtain p where p: "p tagged_division_of cbox a b" "d1 fine p" "d2 fine p"
using fine_division_exists[OF gauge_inter[OF d1(1) d2(1)], of a b] unfolding fine_inter
by metis
@@ -4351,7 +4352,7 @@
by blast+
then show False
unfolding inner_simps
- using rsum_component_le[OF p(1) goal1(3)]
+ using rsum_component_le[OF p(1) le]
by (simp add: abs_real_def split: split_if_asm)
qed
show ?thesis
@@ -4747,9 +4748,10 @@
assumes k: "k \<in> Basis"
shows "negligible {x. x\<bullet>k = c}"
unfolding negligible_def has_integral
-proof clarify
- case goal1
- from content_doublesplit[OF this k,of a b c] guess d . note d=this
+proof (clarify, goal_cases)
+ case (1 a b e)
+ from this and k obtain d where d: "0 < d" "content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) < e"
+ by (rule content_doublesplit)
let ?i = "indicator {x::'a. x\<bullet>k = c} :: 'a\<Rightarrow>real"
show ?case
apply (rule_tac x="\<lambda>x. ball x d" in exI)
@@ -4821,9 +4823,8 @@
apply (auto simp add:interval_doublesplit[OF k])
done
also have "\<dots> < e"
- apply (subst setsum_over_tagged_division_lemma[OF p[THEN conjunct1]])
- proof -
- case goal1
+ proof (subst setsum_over_tagged_division_lemma[OF p[THEN conjunct1]], goal_cases)
+ case prems: (1 u v)
have "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<le> content (cbox u v)"
unfolding interval_doublesplit[OF k]
apply (rule content_subset)
@@ -4831,8 +4832,7 @@
apply auto
done
then show ?case
- unfolding goal1
- unfolding interval_doublesplit[OF k]
+ unfolding prems interval_doublesplit[OF k]
by (blast intro: antisym)
next
have *: "setsum content {l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} |l. l \<in> snd ` p \<and> l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}} \<ge> 0"
@@ -5111,8 +5111,8 @@
assume assm: "\<forall>x. x \<notin> s \<longrightarrow> f x = 0"
show "(f has_integral 0) (cbox a b)"
unfolding has_integral
- proof safe
- case goal1
+ proof (safe, goal_cases)
+ case prems: (1 e)
then have "\<And>n. e / 2 / ((real n+1) * (2 ^ n)) > 0"
apply -
apply (rule divide_pos_pos)
@@ -5135,7 +5135,7 @@
presume "p \<noteq> {} \<Longrightarrow> ?goal"
then show ?goal
apply (cases "p = {}")
- using goal1
+ using prems
apply auto
done
}
@@ -5159,21 +5159,16 @@
apply (drule tagged_division_ofD(4)[OF q(1)])
apply (auto intro: mult_nonneg_nonneg)
done
- have **: "\<And>f g s t. finite s \<Longrightarrow> finite t \<Longrightarrow> (\<forall>(x,y) \<in> t. (0::real) \<le> g(x,y)) \<Longrightarrow>
- (\<forall>y\<in>s. \<exists>x. (x,y) \<in> t \<and> f(y) \<le> g(x,y)) \<Longrightarrow> setsum f s \<le> setsum g t"
- proof -
- case goal1
- then show ?case
- apply -
- apply (rule setsum_le_included[of s t g snd f])
- prefer 4
- apply safe
- apply (erule_tac x=x in ballE)
- apply (erule exE)
- apply (rule_tac x="(xa,x)" in bexI)
- apply auto
- done
- qed
+ have **: "finite s \<Longrightarrow> finite t \<Longrightarrow> (\<forall>(x,y) \<in> t. (0::real) \<le> g(x,y)) \<Longrightarrow>
+ (\<forall>y\<in>s. \<exists>x. (x,y) \<in> t \<and> f(y) \<le> g(x,y)) \<Longrightarrow> setsum f s \<le> setsum g t" for f g s t
+ apply (rule setsum_le_included[of s t g snd f])
+ prefer 4
+ apply safe
+ apply (erule_tac x=x in ballE)
+ apply (erule exE)
+ apply (rule_tac x="(xa,x)" in bexI)
+ apply auto
+ done
have "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - 0) \<le> setsum (\<lambda>i. (real i + 1) *
norm (setsum (\<lambda>(x,k). content k *\<^sub>R indicator s x :: real) (q i))) {..N+1}"
unfolding real_norm_def setsum_right_distrib abs_of_nonneg[OF *] diff_0_right
@@ -5244,12 +5239,11 @@
done
qed (insert as, auto)
also have "\<dots> \<le> setsum (\<lambda>i. e / 2 / 2 ^ i) {..N+1}"
- apply (rule setsum_mono)
- proof -
- case goal1
+ proof (rule setsum_mono, goal_cases)
+ case (1 i)
then show ?case
apply (subst mult.commute, subst pos_le_divide_eq[symmetric])
- using d(2)[rule_format,of "q i" i]
+ using d(2)[rule_format, of "q i" i]
using q[rule_format]
apply (auto simp add: field_simps)
done
@@ -5259,7 +5253,7 @@
apply (rule mult_strict_left_mono)
unfolding power_inverse [symmetric] lessThan_Suc_atMost[symmetric]
apply (subst geometric_sum)
- using goal1
+ using prems
apply auto
done
finally show "?goal" by auto
@@ -5352,8 +5346,8 @@
and "t \<subseteq> s"
shows "negligible t"
unfolding negligible_def
-proof safe
- case goal1
+proof (safe, goal_cases)
+ case (1 a b)
show ?case
using assms(1)[unfolded negligible_def,rule_format,of a b]
apply -
@@ -5381,8 +5375,8 @@
and "negligible t"
shows "negligible (s \<union> t)"
unfolding negligible_def
-proof safe
- case goal1
+proof (safe, goal_cases)
+ case (1 a b)
note assm = assms[unfolded negligible_def,rule_format,of a b]
then show ?case
apply (subst has_integral_spike_eq[OF assms(2)])
@@ -5557,20 +5551,18 @@
by auto
lemma operative_approximable:
- fixes f::"'b::euclidean_space \<Rightarrow> 'a::banach"
+ fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
assumes "0 \<le> e"
shows "operative op \<and> (\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i)"
unfolding operative_def neutral_and
proof safe
fix a b :: 'b
- {
- assume "content (cbox a b) = 0"
- then show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
- apply (rule_tac x=f in exI)
- using assms
- apply (auto intro!:integrable_on_null)
- done
- }
+ show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
+ if "content (cbox a b) = 0"
+ apply (rule_tac x=f in exI)
+ using assms that
+ apply (auto intro!: integrable_on_null)
+ done
{
fix c g
fix k :: 'b
@@ -5590,8 +5582,9 @@
let ?g = "\<lambda>x. if x\<bullet>k = c then f x else if x\<bullet>k \<le> c then g1 x else g2 x"
show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
apply (rule_tac x="?g" in exI)
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case (1 x)
then show ?case
apply -
apply (cases "x\<bullet>k=c")
@@ -5600,7 +5593,7 @@
apply auto
done
next
- case goal2
+ case 2
presume "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
and "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
then guess h1 h2 unfolding integrable_on_def by auto
@@ -6080,7 +6073,7 @@
"f b = (\<Sum>i<p. ((b - a) ^ i / fact i) *\<^sub>R Df i a) + integral {a..b} i"
and taylor_integrable:
"i integrable_on {a .. b}"
-proof goals
+proof goal_cases
case 1
interpret bounded_bilinear "scaleR::real\<Rightarrow>'a\<Rightarrow>'a"
by (rule bounded_bilinear_scaleR)
@@ -6437,8 +6430,8 @@
let ?I = "\<lambda>a b. integral {a .. b} f"
show "\<exists>d>0. \<forall>y\<in>{a .. b}. norm (y - x) < d \<longrightarrow>
norm (?I a y - ?I a x - (y - x) *\<^sub>R f x) \<le> e * norm (y - x)"
- proof (rule, rule, rule d, safe)
- case goal1
+ proof (rule, rule, rule d, safe, goal_cases)
+ case prems: (1 y)
show ?case
proof (cases "y < x")
case False
@@ -6446,7 +6439,7 @@
apply (rule integrable_subinterval_real,rule integrable_continuous_real)
apply (rule assms)
unfolding not_less
- using assms(2) goal1
+ using assms(2) prems
apply auto
done
then have *: "?I a y - ?I a x = ?I x y"
@@ -6455,7 +6448,7 @@
apply (rule integral_combine)
using False
unfolding not_less
- using assms(2) goal1
+ using assms(2) prems
apply auto
done
have **: "norm (y - x) = content {x .. y}"
@@ -6472,7 +6465,7 @@
apply (rule assms)+
proof -
show "{x .. y} \<subseteq> {a .. b}"
- using goal1 assms(2) by auto
+ using prems assms(2) by auto
have *: "y - x = norm (y - x)"
using False by auto
show "((\<lambda>xa. f x) has_integral (y - x) *\<^sub>R f x) {x .. y}"
@@ -6484,7 +6477,7 @@
apply (rule less_imp_le)
apply (rule d(2)[unfolded dist_norm])
using assms(2)
- using goal1
+ using prems
apply auto
done
qed (insert e, auto)
@@ -6495,14 +6488,14 @@
unfolding box_real
apply (rule assms)+
unfolding not_less
- using assms(2) goal1
+ using assms(2) prems
apply auto
done
then have *: "?I a x - ?I a y = ?I y x"
unfolding algebra_simps
apply (subst eq_commute)
apply (rule integral_combine)
- using True using assms(2) goal1
+ using True using assms(2) prems
apply auto
done
have **: "norm (y - x) = content {y .. x}"
@@ -6528,7 +6521,7 @@
apply (rule assms)+
proof -
show "{y .. x} \<subseteq> {a .. b}"
- using goal1 assms(2) by auto
+ using prems assms(2) by auto
have *: "x - y = norm (y - x)"
using True by auto
show "((\<lambda>xa. f x) has_integral (x - y) *\<^sub>R f x) {y .. x}"
@@ -6541,7 +6534,7 @@
apply (rule less_imp_le)
apply (rule d(2)[unfolded dist_norm])
using assms(2)
- using goal1
+ using prems
apply auto
done
qed (insert e, auto)
@@ -6570,17 +6563,18 @@
from antiderivative_continuous[OF assms] guess g . note g=this
show ?thesis
apply (rule that[of g])
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case prems: (1 u v)
have "\<forall>x\<in>cbox u v. (g has_vector_derivative f x) (at x within cbox u v)"
apply rule
apply (rule has_vector_derivative_within_subset)
apply (rule g[rule_format])
- using goal1(1-2)
+ using prems(1,2)
apply auto
done
then show ?case
- using fundamental_theorem_of_calculus[OF goal1(3),of "g" "f"] by auto
+ using fundamental_theorem_of_calculus[OF prems(3), of g f] by auto
qed
qed
@@ -6598,18 +6592,16 @@
and "(f has_integral i) (cbox a b)"
shows "((\<lambda>x. f(g x)) has_integral (1 / r) *\<^sub>R i) (h ` cbox a b)"
proof -
- {
- presume *: "cbox a b \<noteq> {} \<Longrightarrow> ?thesis"
- show ?thesis
- apply cases
- defer
- apply (rule *)
- apply assumption
- proof -
- case goal1
- then show ?thesis
- unfolding goal1 assms(8)[unfolded goal1 has_integral_empty_eq] by auto qed
- }
+ show ?thesis when *: "cbox a b \<noteq> {} \<Longrightarrow> ?thesis"
+ apply cases
+ defer
+ apply (rule *)
+ apply assumption
+ proof goal_cases
+ case prems: 1
+ then show ?thesis
+ unfolding prems assms(8)[unfolded prems has_integral_empty_eq] by auto
+ qed
assume "cbox a b \<noteq> {}"
from assms(6)[rule_format,of a b] guess w z by (elim exE) note wz=this
have inj: "inj g" "inj h"
@@ -6809,7 +6801,7 @@
using assms
apply (safe intro!: interval_image_affinity_interval content_image_affinity_cbox)
apply (rule zero_less_power)
- unfolding scaleR_right_distrib
+ unfolding scaleR_right_distrib
apply auto
done
@@ -7102,10 +7094,9 @@
by (rule norm_triangle_ineq4)
also have "\<dots> \<le> e * (b - a) / 8 + e * (b - a) / 8"
proof (rule add_mono)
- case goal1
have "\<bar>c - a\<bar> \<le> \<bar>l\<bar>"
using as' by auto
- then show ?case
+ then show "norm ((c - a) *\<^sub>R f' a) \<le> e * (b - a) / 8"
apply -
apply (rule order_trans[OF _ l(2)])
unfolding norm_scaleR
@@ -7113,8 +7104,7 @@
apply auto
done
next
- case goal2
- show ?case
+ show "norm (f c - f a) \<le> e * (b - a) / 8"
apply (rule less_imp_le)
apply (cases "a = c")
defer
@@ -7165,10 +7155,9 @@
by (rule norm_triangle_ineq4)
also have "\<dots> \<le> e * (b - a) / 8 + e * (b - a) / 8"
proof (rule add_mono)
- case goal1
have "\<bar>c - b\<bar> \<le> \<bar>l\<bar>"
using as' by auto
- then show ?case
+ then show "norm ((b - c) *\<^sub>R f' b) \<le> e * (b - a) / 8"
apply -
apply (rule order_trans[OF _ l(2)])
unfolding norm_scaleR
@@ -7176,8 +7165,7 @@
apply auto
done
next
- case goal2
- show ?case
+ show "norm (f b - f c) \<le> e * (b - a) / 8"
apply (rule less_imp_le)
apply (cases "b = c")
defer
@@ -7196,21 +7184,20 @@
let ?d = "(\<lambda>x. ball x (if x=a then da else if x=b then db else d x))"
show "?P e"
apply (rule_tac x="?d" in exI)
- proof safe
- case goal1
+ proof (safe, goal_cases)
+ case 1
show ?case
apply (rule gauge_ball_dependent)
using ab db(1) da(1) d(1)
apply auto
done
next
- case goal2
- note as=this
+ case as: (2 p)
let ?A = "{t. fst t \<in> {a, b}}"
- note p = tagged_division_ofD[OF goal2(1)]
+ note p = tagged_division_ofD[OF as(1)]
have pA: "p = (p \<inter> ?A) \<union> (p - ?A)" "finite (p \<inter> ?A)" "finite (p - ?A)" "(p \<inter> ?A) \<inter> (p - ?A) = {}"
- using goal2 by auto
- note * = additive_tagged_division_1'[OF assms(1) goal2(1), symmetric]
+ using as by auto
+ note * = additive_tagged_division_1'[OF assms(1) as(1), symmetric]
have **: "\<And>n1 s1 n2 s2::real. n2 \<le> s2 / 2 \<Longrightarrow> n1 - s1 \<le> s2 / 2 \<Longrightarrow> n1 + n2 \<le> s1 + s2"
by arith
show ?case
@@ -7219,8 +7206,8 @@
apply (subst(2) pA)
apply (subst pA)
unfolding setsum.union_disjoint[OF pA(2-)]
- proof (rule norm_triangle_le, rule **)
- case goal1
+ proof (rule norm_triangle_le, rule **, goal_cases)
+ case 1
show ?case
apply (rule order_trans)
apply (rule setsum_norm_le)
@@ -7231,17 +7218,17 @@
apply (unfold not_le o_def split_conv fst_conv)
proof (rule ccontr)
fix x k
- assume as: "(x, k) \<in> p"
+ assume xk: "(x, k) \<in> p"
"e * (Sup k - Inf k) / 2 <
norm (content k *\<^sub>R f' x - (f (Sup k) - f (Inf k)))"
from p(4)[OF this(1)] guess u v by (elim exE) note k=this
then have "u \<le> v" and uv: "{u, v} \<subseteq> cbox u v"
- using p(2)[OF as(1)] by auto
- note result = as(2)[unfolded k box_real interval_bounds_real[OF this(1)] content_real[OF this(1)]]
+ using p(2)[OF xk(1)] by auto
+ note result = xk(2)[unfolded k box_real interval_bounds_real[OF this(1)] content_real[OF this(1)]]
assume as': "x \<noteq> a" "x \<noteq> b"
then have "x \<in> box a b"
- using p(2-3)[OF as(1)] by (auto simp: mem_box)
+ using p(2-3)[OF xk(1)] by (auto simp: mem_box)
note * = d(2)[OF this]
have "norm ((v - u) *\<^sub>R f' (x) - (f (v) - f (u))) =
norm ((f (u) - f (x) - (u - x) *\<^sub>R f' (x)) - (f (v) - f (x) - (v - x) *\<^sub>R f' (x)))"
@@ -7253,7 +7240,7 @@
apply (rule norm_triangle_le_sub)
apply (rule add_mono)
apply (rule_tac[!] *)
- using fineD[OF goal2(2) as(1)] as'
+ using fineD[OF as(2) xk(1)] as'
unfolding k subset_eq
apply -
apply (erule_tac x=u in ballE)
@@ -7262,7 +7249,7 @@
apply (auto simp:dist_real_def)
done
also have "\<dots> \<le> e / 2 * norm (v - u)"
- using p(2)[OF as(1)]
+ using p(2)[OF xk(1)]
unfolding k
by (auto simp add: field_simps)
finally have "e * (v - u) / 2 < e * (v - u) / 2"
@@ -7276,7 +7263,7 @@
next
have *: "\<And>x s1 s2::real. 0 \<le> s1 \<Longrightarrow> x \<le> (s1 + s2) / 2 \<Longrightarrow> x - s1 \<le> s2 / 2"
by auto
- case goal2
+ case 2
show ?case
apply (rule *)
apply (rule setsum_nonneg)
@@ -7285,7 +7272,6 @@
defer
unfolding setsum.union_disjoint[OF pA(2-),symmetric] pA(1)[symmetric]
unfolding setsum_right_distrib[symmetric]
- thm additive_tagged_division_1
apply (subst additive_tagged_division_1[OF _ as(1)])
apply (rule assms)
proof -
@@ -7307,7 +7293,7 @@
defer
apply rule
unfolding split_paired_all split_conv o_def
- proof -
+ proof goal_cases
fix x k
assume "(x, k) \<in> p \<inter> {t. fst t \<in> {a, b}} - p \<inter> {t. fst t \<in> {a, b} \<and> content (snd t) \<noteq> 0}"
then have xk: "(x, k) \<in> p" "content k = 0"
@@ -7325,18 +7311,24 @@
have *: "p \<inter> {t. fst t \<in> {a, b} \<and> content(snd t) \<noteq> 0} =
{t. t\<in>p \<and> fst t = a \<and> content(snd t) \<noteq> 0} \<union> {t. t\<in>p \<and> fst t = b \<and> content(snd t) \<noteq> 0}"
by blast
- have **: "\<And>s f. \<And>e::real. (\<forall>x y. x \<in> s \<and> y \<in> s \<longrightarrow> x = y) \<Longrightarrow>
- (\<forall>x. x \<in> s \<longrightarrow> norm (f x) \<le> e) \<Longrightarrow> e > 0 \<Longrightarrow> norm (setsum f s) \<le> e"
- proof (case_tac "s = {}")
- case goal2
+ have **: "norm (setsum f s) \<le> e"
+ if "\<forall>x y. x \<in> s \<and> y \<in> s \<longrightarrow> x = y"
+ and "\<forall>x. x \<in> s \<longrightarrow> norm (f x) \<le> e"
+ and "e > 0"
+ for s f and e :: real
+ proof (cases "s = {}")
+ case True
+ with that show ?thesis by auto
+ next
+ case False
then obtain x where "x \<in> s"
by auto
then have *: "s = {x}"
- using goal2(1) by auto
- then show ?case
- using \<open>x \<in> s\<close> goal2(2) by auto
- qed auto
- case goal2
+ using that(1) by auto
+ then show ?thesis
+ using \<open>x \<in> s\<close> that(2) by auto
+ qed
+ case 2
show ?case
apply (subst *)
apply (subst setsum.union_disjoint)
@@ -7346,48 +7338,46 @@
apply (rule_tac[1-2] **)
proof -
let ?B = "\<lambda>x. {t \<in> p. fst t = x \<and> content (snd t) \<noteq> 0}"
- have pa: "\<And>k. (a, k) \<in> p \<Longrightarrow> \<exists>v. k = cbox a v \<and> a \<le> v"
+ have pa: "\<exists>v. k = cbox a v \<and> a \<le> v" if "(a, k) \<in> p" for k
proof -
- case goal1
- guess u v using p(4)[OF goal1] by (elim exE) note uv=this
+ guess u v using p(4)[OF that] by (elim exE) note uv=this
have *: "u \<le> v"
- using p(2)[OF goal1] unfolding uv by auto
+ using p(2)[OF that] unfolding uv by auto
have u: "u = a"
proof (rule ccontr)
have "u \<in> cbox u v"
- using p(2-3)[OF goal1(1)] unfolding uv by auto
+ using p(2-3)[OF that(1)] unfolding uv by auto
have "u \<ge> a"
- using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto
+ using p(2-3)[OF that(1)] unfolding uv subset_eq by auto
moreover assume "\<not> ?thesis"
ultimately have "u > a" by auto
then show False
- using p(2)[OF goal1(1)] unfolding uv by (auto simp add:)
+ using p(2)[OF that(1)] unfolding uv by (auto simp add:)
qed
- then show ?case
+ then show ?thesis
apply (rule_tac x=v in exI)
unfolding uv
using *
apply auto
done
qed
- have pb: "\<And>k. (b, k) \<in> p \<Longrightarrow> \<exists>v. k = cbox v b \<and> b \<ge> v"
+ have pb: "\<exists>v. k = cbox v b \<and> b \<ge> v" if "(b, k) \<in> p" for k
proof -
- case goal1
- guess u v using p(4)[OF goal1] by (elim exE) note uv=this
+ guess u v using p(4)[OF that] by (elim exE) note uv=this
have *: "u \<le> v"
- using p(2)[OF goal1] unfolding uv by auto
- have u: "v = b"
+ using p(2)[OF that] unfolding uv by auto
+ have u: "v = b"
proof (rule ccontr)
have "u \<in> cbox u v"
- using p(2-3)[OF goal1(1)] unfolding uv by auto
+ using p(2-3)[OF that(1)] unfolding uv by auto
have "v \<le> b"
- using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto
+ using p(2-3)[OF that(1)] unfolding uv subset_eq by auto
moreover assume "\<not> ?thesis"
ultimately have "v < b" by auto
then show False
- using p(2)[OF goal1(1)] unfolding uv by (auto simp add:)
+ using p(2)[OF that(1)] unfolding uv by (auto simp add:)
qed
- then show ?case
+ then show ?thesis
apply (rule_tac x=u in exI)
unfolding uv
using *
@@ -7458,15 +7448,15 @@
apply rule
unfolding mem_Collect_eq
unfolding split_paired_all fst_conv snd_conv
- proof safe
- case goal1
- guess v using pa[OF goal1(1)] .. note v = conjunctD2[OF this]
+ proof (safe, goal_cases)
+ case prems: 1
+ guess v using pa[OF prems(1)] .. note v = conjunctD2[OF this]
have "?a \<in> {?a..v}"
using v(2) by auto
then have "v \<le> ?b"
- using p(3)[OF goal1(1)] unfolding subset_eq v by auto
+ using p(3)[OF prems(1)] unfolding subset_eq v by auto
moreover have "{?a..v} \<subseteq> ball ?a da"
- using fineD[OF as(2) goal1(1)]
+ using fineD[OF as(2) prems(1)]
apply -
apply (subst(asm) if_P)
apply (rule refl)
@@ -7479,7 +7469,7 @@
unfolding v interval_bounds_real[OF v(2)] box_real
apply -
apply(rule da(2)[of "v"])
- using goal1 fineD[OF as(2) goal1(1)]
+ using prems fineD[OF as(2) prems(1)]
unfolding v content_eq_0
apply auto
done
@@ -7490,14 +7480,15 @@
apply rule
unfolding mem_Collect_eq
unfolding split_paired_all fst_conv snd_conv
- proof safe
- case goal1 guess v using pb[OF goal1(1)] .. note v = conjunctD2[OF this]
+ proof (safe, goal_cases)
+ case prems: 1
+ guess v using pb[OF prems(1)] .. note v = conjunctD2[OF this]
have "?b \<in> {v.. ?b}"
using v(2) by auto
- then have "v \<ge> ?a" using p(3)[OF goal1(1)]
+ then have "v \<ge> ?a" using p(3)[OF prems(1)]
unfolding subset_eq v by auto
moreover have "{v..?b} \<subseteq> ball ?b db"
- using fineD[OF as(2) goal1(1)]
+ using fineD[OF as(2) prems(1)]
apply -
apply (subst(asm) if_P, rule refl)
unfolding subset_eq
@@ -7511,7 +7502,7 @@
unfolding interval_bounds_real[OF v(2)] box_real
apply -
apply(rule db(2)[of "v"])
- using goal1 fineD[OF as(2) goal1(1)]
+ using prems fineD[OF as(2) prems(1)]
unfolding v content_eq_0
apply auto
done
@@ -7705,9 +7696,9 @@
from fine_division_exists_real[OF this, of a t] guess p . note p=this
note p'=tagged_division_ofD[OF this(1)]
have pt: "\<forall>(x,k)\<in>p. x \<le> t"
- proof safe
- case goal1
- from p'(2,3)[OF this] show ?case
+ proof (safe, goal_cases)
+ case prems: 1
+ from p'(2,3)[OF prems] show ?case
by auto
qed
with p(2) have "d2 fine p"
@@ -7760,9 +7751,9 @@
have **: "\<And>x F. F \<union> {x} = insert x F"
by auto
have "(c, cbox t c) \<notin> p"
- proof safe
- case goal1
- from p'(2-3)[OF this] have "c \<in> cbox a t"
+ proof (safe, goal_cases)
+ case prems: 1
+ from p'(2-3)[OF prems] have "c \<in> cbox a t"
by auto
then show False using \<open>t < c\<close>
by auto
@@ -7862,8 +7853,8 @@
apply cases
apply (rule *)
apply assumption
- proof -
- case goal1
+ proof goal_cases
+ case 1
then have "cbox a b = {x}"
using as(1)
apply -
@@ -8001,12 +7992,11 @@
using assms(4,7)
apply auto
done
- have *: "\<And>t xa. (1 - t) *\<^sub>R c + t *\<^sub>R x = (1 - xa) *\<^sub>R c + xa *\<^sub>R x \<Longrightarrow> t = xa"
+ have *: "t = xa" if "(1 - t) *\<^sub>R c + t *\<^sub>R x = (1 - xa) *\<^sub>R c + xa *\<^sub>R x" for t xa
proof -
- case goal1
- then have "(t - xa) *\<^sub>R x = (t - xa) *\<^sub>R c"
+ from that have "(t - xa) *\<^sub>R x = (t - xa) *\<^sub>R c"
unfolding scaleR_simps by (auto simp add: algebra_simps)
- then show ?case
+ then show ?thesis
using \<open>x \<noteq> c\<close> by auto
qed
have as2: "finite {t. ((1 - t) *\<^sub>R c + t *\<^sub>R x) \<in> k}"
@@ -8151,14 +8141,14 @@
apply cases
apply (rule *)
apply assumption
- proof -
- case goal1
+ proof goal_cases
+ case prems: 1
then have *: "box c d = {}"
by (metis bot.extremum_uniqueI box_subset_cbox)
show ?thesis
using assms(1)
unfolding *
- using goal1
+ using prems
by auto
qed
}
@@ -8187,13 +8177,14 @@
have iterate:"iterate (lifted op +) (p - {cbox c d})
(\<lambda>i. if g integrable_on i then Some (integral i g) else None) = Some 0"
proof (rule *)
- case goal1
+ fix x
+ assume x: "x \<in> p - {cbox c d}"
then have "x \<in> p"
by auto
note div = division_ofD(2-5)[OF p(1) this]
from div(3) guess u v by (elim exE) note uv=this
have "interior x \<inter> interior (cbox c d) = {}"
- using div(4)[OF p(2)] goal1 by auto
+ using div(4)[OF p(2)] x by auto
then have "(g has_integral 0) x"
unfolding uv
apply -
@@ -8201,7 +8192,7 @@
unfolding g_def interior_cbox
apply auto
done
- then show ?case
+ then show "(if g integrable_on x then Some (integral x g) else None) = Some 0"
by auto
qed
@@ -8345,19 +8336,20 @@
apply (drule B(2))
unfolding mem_box
proof
- case goal1
- then show ?case
- using Basis_le_norm[OF \<open>i\<in>Basis\<close>, of x]
+ fix x i
+ show "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" if "norm x \<le> B" and "i \<in> Basis"
+ using that and Basis_le_norm[OF \<open>i\<in>Basis\<close>, of x]
unfolding c_def d_def
by (auto simp add: field_simps setsum_negf)
qed
have "ball 0 C \<subseteq> cbox c d"
- apply safe
+ apply (rule subsetI)
unfolding mem_box mem_ball dist_norm
proof
- case goal1
- then show ?case
- using Basis_le_norm[OF \<open>i\<in>Basis\<close>, of x]
+ fix x i :: 'n
+ assume x: "norm (0 - x) < C" and i: "i \<in> Basis"
+ show "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
+ using Basis_le_norm[OF i, of x] and x i
unfolding c_def d_def
by (auto simp: setsum_negf)
qed
@@ -8380,18 +8372,20 @@
apply (drule B(2))
unfolding mem_box
proof
- case goal1
- then show ?case
+ fix x i :: 'n
+ assume "norm x \<le> B" and "i \<in> Basis"
+ then show "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
using Basis_le_norm[of i x]
unfolding c_def d_def
by (auto simp add: field_simps setsum_negf)
qed
have "ball 0 C \<subseteq> cbox c d"
- apply safe
+ apply (rule subsetI)
unfolding mem_box mem_ball dist_norm
proof
- case goal1
- then show ?case
+ fix x i :: 'n
+ assume "norm (0 - x) < C" and "i \<in> Basis"
+ then show "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
using Basis_le_norm[of i x]
unfolding c_def d_def
by (auto simp: setsum_negf)
@@ -8521,8 +8515,8 @@
show ?l
unfolding negligible_def
proof safe
- case goal1
- show ?case
+ fix a b
+ show "(indicator s has_integral 0) (cbox a b)"
apply (rule has_integral_negligible[OF \<open>?r\<close>[rule_format,of a b]])
unfolding indicator_def
apply auto
@@ -8662,8 +8656,8 @@
show ?l
apply (subst has_integral')
apply safe
- proof -
- case goal1
+ proof goal_cases
+ case (1 e)
from \<open>?r\<close>[THEN conjunct2,rule_format,OF this] guess B .. note B=conjunctD2[OF this]
show ?case
apply rule
@@ -8688,10 +8682,10 @@
show "?f integrable_on cbox a b"
proof (rule integrable_subinterval[of _ ?a ?b])
have "ball 0 B \<subseteq> cbox ?a ?b"
- apply safe
+ apply (rule subsetI)
unfolding mem_ball mem_box dist_norm
- proof
- case goal1
+ proof (rule, goal_cases)
+ case (1 x i)
then show ?case using Basis_le_norm[of i x]
by (auto simp add:field_simps)
qed
@@ -8716,8 +8710,8 @@
apply rule
apply (rule B)
apply safe
- proof -
- case goal1
+ proof goal_cases
+ case 1
from B(2)[OF this] guess z .. note z=conjunctD2[OF this]
from integral_unique[OF this(1)] show ?case
using z(2) by auto
@@ -8743,8 +8737,8 @@
show ?r
apply safe
apply (rule y)
- proof -
- case goal1
+ proof goal_cases
+ case (1 e)
then have "e/2 > 0"
by auto
from y(2)[OF this] guess B .. note B=conjunctD2[OF this,rule_format]
@@ -8753,11 +8747,11 @@
apply rule
apply (rule B)
apply safe
- proof -
- case goal1
+ proof goal_cases
+ case prems: (1 a b c d)
show ?case
apply (rule norm_triangle_half_l)
- using B(2)[OF goal1(1)] B(2)[OF goal1(2)]
+ using B(2)[OF prems(1)] B(2)[OF prems(2)]
apply auto
done
qed
@@ -8767,18 +8761,18 @@
note as = conjunctD2[OF this,rule_format]
let ?cube = "\<lambda>n. cbox (\<Sum>i\<in>Basis. - real n *\<^sub>R i::'n) (\<Sum>i\<in>Basis. real n *\<^sub>R i)"
have "Cauchy (\<lambda>n. integral (?cube n) (\<lambda>x. if x \<in> s then f x else 0))"
- proof (unfold Cauchy_def, safe)
- case goal1
+ proof (unfold Cauchy_def, safe, goal_cases)
+ case (1 e)
from as(2)[OF this] guess B .. note B = conjunctD2[OF this,rule_format]
from real_arch_simple[of B] guess N .. note N = this
{
fix n
assume n: "n \<ge> N"
have "ball 0 B \<subseteq> ?cube n"
- apply safe
+ apply (rule subsetI)
unfolding mem_ball mem_box dist_norm
- proof
- case goal1
+ proof (rule, goal_cases)
+ case (1 x i)
then show ?case
using Basis_le_norm[of i x] \<open>i\<in>Basis\<close>
using n N
@@ -8801,8 +8795,8 @@
apply (rule_tac x=i in exI)
apply safe
apply (rule as(1)[unfolded integrable_on_def])
- proof -
- case goal1
+ proof goal_cases
+ case (1 e)
then have *: "e/2 > 0" by auto
from i[OF this] guess N .. note N =this[rule_format]
from as(2)[OF *] guess B .. note B=conjunctD2[OF this,rule_format]
@@ -8834,8 +8828,8 @@
using x
unfolding mem_box mem_ball dist_norm
apply -
- proof
- case goal1
+ proof (rule, goal_cases)
+ case (1 i)
then show ?case
using Basis_le_norm[of i x] \<open>i \<in> Basis\<close>
using n
@@ -8874,8 +8868,8 @@
assumes "\<forall>e>0. \<exists>g h i j. (g has_integral i) (cbox a b) \<and> (h has_integral j) (cbox a b) \<and>
norm (i - j) < e \<and> (\<forall>x\<in>cbox a b. (g x) \<le> f x \<and> f x \<le> h x)"
shows "f integrable_on cbox a b"
-proof (subst integrable_cauchy, safe)
- case goal1
+proof (subst integrable_cauchy, safe, goal_cases)
+ case (1 e)
then have e: "e/3 > 0"
by auto
note assms[rule_format,OF this]
@@ -8886,13 +8880,13 @@
apply (rule_tac x="\<lambda>x. d1 x \<inter> d2 x" in exI)
apply (rule conjI gauge_inter d1 d2)+
unfolding fine_inter
- proof safe
+ proof (safe, goal_cases)
have **: "\<And>i j g1 g2 h1 h2 f1 f2. g1 - h2 \<le> f1 - f2 \<Longrightarrow> f1 - f2 \<le> h1 - g2 \<Longrightarrow>
abs (i - j) < e / 3 \<Longrightarrow> abs (g2 - i) < e / 3 \<Longrightarrow> abs (g1 - i) < e / 3 \<Longrightarrow>
abs (h2 - j) < e / 3 \<Longrightarrow> abs (h1 - j) < e / 3 \<Longrightarrow> abs (f1 - f2) < e"
using \<open>e > 0\<close> by arith
- case goal1
- note tagged_division_ofD(2-4) note * = this[OF goal1(1)] this[OF goal1(4)]
+ case prems: (1 p1 p2)
+ note tagged_division_ofD(2-4) note * = this[OF prems(1)] this[OF prems(4)]
have "(\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p1. content k *\<^sub>R g x) \<ge> 0"
and "0 \<le> (\<Sum>(x, k)\<in>p2. content k *\<^sub>R h x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)"
@@ -8937,10 +8931,10 @@
defer
unfolding real_norm_def[symmetric]
apply (rule obt(3))
- apply (rule d1(2)[OF conjI[OF goal1(4,5)]])
- apply (rule d1(2)[OF conjI[OF goal1(1,2)]])
- apply (rule d2(2)[OF conjI[OF goal1(4,6)]])
- apply (rule d2(2)[OF conjI[OF goal1(1,3)]])
+ apply (rule d1(2)[OF conjI[OF prems(4,5)]])
+ apply (rule d1(2)[OF conjI[OF prems(1,2)]])
+ apply (rule d2(2)[OF conjI[OF prems(4,6)]])
+ apply (rule d2(2)[OF conjI[OF prems(1,3)]])
apply auto
done
qed
@@ -8953,8 +8947,8 @@
shows "f integrable_on s"
proof -
have "\<And>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b"
- proof (rule integrable_straddle_interval, safe)
- case goal1
+ proof (rule integrable_straddle_interval, safe, goal_cases)
+ case (1 a b e)
then have *: "e/4 > 0"
by auto
from assms[rule_format,OF this] guess g h i j by (elim exE conjE) note obt=this
@@ -8972,16 +8966,16 @@
apply safe
unfolding mem_ball mem_box dist_norm
apply (rule_tac[!] ballI)
- proof -
- case goal1
+ proof goal_cases
+ case (1 x i)
then show ?case using Basis_le_norm[of i x]
unfolding c_def d_def by auto
next
- case goal2
+ case (2 x i)
then show ?case using Basis_le_norm[of i x]
unfolding c_def d_def by auto
qed
- have **:" \<And>ch cg ag ah::real. norm (ah - ag) \<le> norm (ch - cg) \<Longrightarrow> norm (cg - i) < e / 4 \<Longrightarrow>
+ have **: "\<And>ch cg ag ah::real. norm (ah - ag) \<le> norm (ch - cg) \<Longrightarrow> norm (cg - i) < e / 4 \<Longrightarrow>
norm (ch - j) < e / 4 \<Longrightarrow> norm (ag - ah) < e"
using obt(3)
unfolding real_norm_def
@@ -9031,8 +9025,8 @@
unfolding integrable_alt[of f]
apply safe
apply (rule interv)
- proof -
- case goal1
+ proof goal_cases
+ case (1 e)
then have *: "e/3 > 0"
by auto
from assms[rule_format,OF this] guess g h i j by (elim exE conjE) note obt=this
@@ -9129,15 +9123,21 @@
done
note assms(2)[unfolded *]
note has_integral_setsum[OF assms(1) this]
- then show ?thesis unfolding * apply-apply(rule has_integral_spike[OF **]) defer apply assumption
- proof safe
- case goal1
+ then show ?thesis
+ unfolding *
+ apply -
+ apply (rule has_integral_spike[OF **])
+ defer
+ apply assumption
+ apply safe
+ proof goal_cases
+ case prems: (1 x)
then show ?case
proof (cases "x \<in> \<Union>t")
case True
then guess s unfolding Union_iff .. note s=this
then have *: "\<forall>b\<in>t. x \<in> b \<longleftrightarrow> b = s"
- using goal1(3) by blast
+ using prems(3) by blast
show ?thesis
unfolding if_P[OF True]
apply (rule trans)
@@ -9172,10 +9172,10 @@
apply rule
apply rule
apply rule
- proof -
- case goal1
+ proof goal_cases
+ case prems: (1 s s')
from d(4)[OF this(1)] d(4)[OF this(2)] guess a c b d by (elim exE) note obt=this
- from d(5)[OF goal1] show ?case
+ from d(5)[OF prems] show ?case
unfolding obt interior_cbox
apply -
apply (rule negligible_subset[of "(cbox a b-box a b) \<union> (cbox c d-box c d)"])
@@ -9206,8 +9206,8 @@
apply (rule has_integral_combine_division[OF assms(2)])
apply safe
unfolding has_integral_integral[symmetric]
-proof -
- case goal1
+proof goal_cases
+ case (1 k)
from division_ofD(2,4)[OF assms(2) this]
show ?case
apply safe
@@ -9245,8 +9245,9 @@
and "i \<subseteq> s"
shows "f integrable_on i"
apply (rule integrable_combine_division assms)+
-proof safe
- case goal1
+ apply safe
+proof goal_cases
+ case 1
note division_ofD(2,4)[OF assms(1) this]
then show ?case
apply safe
@@ -9306,8 +9307,9 @@
and "p tagged_division_of (cbox a b)"
shows "(f has_integral (setsum (\<lambda>(x,k). integral k f) p)) (cbox a b)"
apply (rule has_integral_combine_tagged_division[OF assms(2)])
-proof safe
- case goal1
+ apply safe
+proof goal_cases
+ case 1
note tagged_division_ofD(3-4)[OF assms(2) this]
then show ?case
using integrable_subinterval[OF assms(1)] by blast
@@ -9354,8 +9356,9 @@
have "\<forall>i\<in>r. \<exists>p. p tagged_division_of i \<and> d fine p \<and>
norm (setsum (\<lambda>(x,j). content j *\<^sub>R f x) p - integral i f) < k / (real (card r) + 1)"
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case (1 i)
then have i: "i \<in> q"
unfolding r_def by auto
from q'(4)[OF this] guess u v by (elim exE) note uv=this
@@ -9392,14 +9395,13 @@
done
note * = tagged_partial_division_of_union_self[OF p(1)]
have "p \<union> \<Union>(qq ` r) tagged_division_of \<Union>(snd ` p) \<union> \<Union>r"
- proof (rule tagged_division_union[OF * tagged_division_unions])
- show "finite r"
- by fact
- case goal2
+ using r
+ proof (rule tagged_division_union[OF * tagged_division_unions], goal_cases)
+ case 1
then show ?case
using qq by auto
next
- case goal3
+ case 2
then show ?case
apply rule
apply rule
@@ -9409,7 +9411,7 @@
apply auto
done
next
- case goal4
+ case 3
then show ?case
apply (rule inter_interior_unions_intervals)
apply fact
@@ -9514,22 +9516,40 @@
using as(3) unfolding as by auto
qed
- have *: "\<And>ir ip i cr cp. norm ((cp + cr) - i) < e \<Longrightarrow> norm(cr - ir) < k \<Longrightarrow>
- ip + ir = i \<Longrightarrow> norm (cp - ip) \<le> e + k"
+ have *: "norm (cp - ip) \<le> e + k"
+ if "norm ((cp + cr) - i) < e"
+ and "norm (cr - ir) < k"
+ and "ip + ir = i"
+ for ir ip i cr cp
proof -
- case goal1
- then show ?case
+ from that show ?thesis
using norm_triangle_le[of "cp + cr - i" "- (cr - ir)"]
- unfolding goal1(3)[symmetric] norm_minus_cancel
+ unfolding that(3)[symmetric] norm_minus_cancel
by (auto simp add: algebra_simps)
qed
have "?x = norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p. integral k f))"
unfolding split_def setsum_subtractf ..
also have "\<dots> \<le> e + k"
- apply (rule *[OF **, where ir="setsum (\<lambda>k. integral k f) r"])
- proof -
- case goal2
+ apply (rule *[OF **, where ir2="setsum (\<lambda>k. integral k f) r"])
+ proof goal_cases
+ case 1
+ have *: "k * real (card r) / (1 + real (card r)) < k"
+ using k by (auto simp add: field_simps)
+ show ?case
+ apply (rule le_less_trans[of _ "setsum (\<lambda>x. k / (real (card r) + 1)) r"])
+ unfolding setsum_subtractf[symmetric]
+ apply (rule setsum_norm_le)
+ apply rule
+ apply (drule qq)
+ defer
+ unfolding divide_inverse setsum_left_distrib[symmetric]
+ unfolding divide_inverse[symmetric]
+ using *
+ apply (auto simp add: field_simps real_eq_of_nat)
+ done
+ next
+ case 2
have *: "(\<Sum>(x, k)\<in>p. integral k f) = (\<Sum>k\<in>snd ` p. integral k f)"
apply (subst setsum.reindex_nontrivial)
apply fact
@@ -9553,22 +9573,6 @@
unfolding integral_combine_division_topdown[OF assms(1) q(2)] * r_def
using ** q'(1) p'(1) setsum.union_disjoint [of "snd ` p" "q - snd ` p" "\<lambda>k. integral k f", symmetric]
by simp
- next
- case goal1
- have *: "k * real (card r) / (1 + real (card r)) < k"
- using k by (auto simp add: field_simps)
- show ?case
- apply (rule le_less_trans[of _ "setsum (\<lambda>x. k / (real (card r) + 1)) r"])
- unfolding setsum_subtractf[symmetric]
- apply (rule setsum_norm_le)
- apply rule
- apply (drule qq)
- defer
- unfolding divide_inverse setsum_left_distrib[symmetric]
- unfolding divide_inverse[symmetric]
- using *
- apply (auto simp add: field_simps real_eq_of_nat)
- done
qed
finally show "?x \<le> e + k" .
qed
@@ -9614,8 +9618,8 @@
show thesis
apply (rule that)
apply (rule d)
- proof safe
- case goal1
+ proof (safe, goal_cases)
+ case (1 p)
note * = henstock_lemma_part2[OF assms(1) * d this]
show ?case
apply (rule le_less_trans[OF *])
@@ -9727,18 +9731,18 @@
by auto
next
case False
- have fg: "\<forall>x\<in>cbox a b. \<forall> k. (f k x) \<bullet> 1 \<le> (g x) \<bullet> 1"
+ have fg: "\<forall>x\<in>cbox a b. \<forall>k. (f k x) \<bullet> 1 \<le> (g x) \<bullet> 1"
proof safe
- case goal1
- note assms(3)[rule_format,OF this]
- note * = Lim_component_ge[OF this trivial_limit_sequentially]
- show ?case
+ fix x k
+ assume x: "x \<in> cbox a b"
+ note * = Lim_component_ge[OF assms(3)[rule_format, OF x] trivial_limit_sequentially]
+ show "f k x \<bullet> 1 \<le> g x \<bullet> 1"
apply (rule *)
unfolding eventually_sequentially
apply (rule_tac x=k in exI)
apply -
apply (rule transitive_stepwise_le)
- using assms(2)[rule_format,OF goal1]
+ using assms(2)[rule_format, OF x]
apply auto
done
qed
@@ -9770,9 +9774,8 @@
have "(g has_integral i) (cbox a b)"
unfolding has_integral
- proof safe
- case goal1
- note e=this
+ proof (safe, goal_cases)
+ case e: (1 e)
then have "\<forall>k. (\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
norm ((\<Sum>(x, ka)\<in>p. content ka *\<^sub>R f k x) - integral (cbox a b) (f k)) < e / 2 ^ (k + 2)))"
apply -
@@ -9784,36 +9787,32 @@
have "\<exists>r. \<forall>k\<ge>r. 0 \<le> i\<bullet>1 - (integral (cbox a b) (f k)) \<and> i\<bullet>1 - (integral (cbox a b) (f k)) < e / 4"
proof -
- case goal1
have "e/4 > 0"
using e by auto
from LIMSEQ_D [OF i this] guess r ..
- then show ?case
+ then show ?thesis
apply (rule_tac x=r in exI)
apply rule
apply (erule_tac x=k in allE)
- proof -
- case goal1
- then show ?case
- using i'[of k] by auto
- qed
+ subgoal for k using i'[of k] by auto
+ done
qed
then guess r .. note r=conjunctD2[OF this[rule_format]]
have "\<forall>x\<in>cbox a b. \<exists>n\<ge>r. \<forall>k\<ge>n. 0 \<le> (g x)\<bullet>1 - (f k x)\<bullet>1 \<and>
(g x)\<bullet>1 - (f k x)\<bullet>1 < e / (4 * content(cbox a b))"
- proof
- case goal1
+ proof (rule, goal_cases)
+ case prems: (1 x)
have "e / (4 * content (cbox a b)) > 0"
using \<open>e>0\<close> False content_pos_le[of a b] by auto
- from assms(3)[rule_format, OF goal1, THEN LIMSEQ_D, OF this]
+ from assms(3)[rule_format, OF prems, THEN LIMSEQ_D, OF this]
guess n .. note n=this
then show ?case
apply (rule_tac x="n + r" in exI)
apply safe
apply (erule_tac[2-3] x=k in allE)
unfolding dist_real_def
- using fg[rule_format,OF goal1]
+ using fg[rule_format, OF prems]
apply (auto simp add: field_simps)
done
qed
@@ -9834,8 +9833,8 @@
then guess s .. note s=this
have *: "\<forall>a b c d. norm(a - b) \<le> e / 4 \<and> norm(b - c) < e / 2 \<and>
norm (c - d) < e / 4 \<longrightarrow> norm (a - d) < e"
- proof safe
- case goal1
+ proof (safe, goal_cases)
+ case (1 a b c d)
then show ?case
using norm_triangle_lt[of "a - b" "b - c" "3* e/4"]
norm_triangle_lt[of "a - b + (b - c)" "c - d" e]
@@ -9845,8 +9844,8 @@
show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - i) < e"
apply (rule *[rule_format,where
b="\<Sum>(x, k)\<in>p. content k *\<^sub>R f (m x) x" and c="\<Sum>(x, k)\<in>p. integral k (f (m x))"])
- proof safe
- case goal1
+ proof (safe, goal_cases)
+ case 1
show ?case
apply (rule order_trans[of _ "\<Sum>(x, k)\<in>p. content k * (e / (4 * content (cbox a b)))"])
unfolding setsum_subtractf[symmetric]
@@ -9872,7 +9871,7 @@
qed (insert False, auto)
next
- case goal2
+ case 2
show ?case
apply (rule le_less_trans[of _ "norm (\<Sum>j = 0..s.
\<Sum>(x, k)\<in>{xk\<in>p. m (fst xk) = j}. content k *\<^sub>R f (m x) x - integral k (f (m x)))"])
@@ -9927,7 +9926,7 @@
qed
qed (insert s, auto)
next
- case goal3
+ case 3
note comb = integral_combine_tagged_division_topdown[OF assms(1)[rule_format] p(1)]
have *: "\<And>sr sx ss ks kr::real. kr = sr \<longrightarrow> ks = ss \<longrightarrow>
ks \<le> i \<and> sr \<le> sx \<and> sx \<le> ss \<and> 0 \<le> i\<bullet>1 - kr\<bullet>1 \<and> i\<bullet>1 - kr\<bullet>1 < e/4 \<longrightarrow> abs (sx - i) < e/4"
@@ -9994,42 +9993,43 @@
and "bounded {integral s (f k)| k. True}"
shows "g integrable_on s \<and> ((\<lambda>k. integral s (f k)) ---> integral s g) sequentially"
proof -
- have lem: "\<And>f::nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real.
- \<And>g s. \<forall>k.\<forall>x\<in>s. 0 \<le> f k x \<Longrightarrow> \<forall>k. (f k) integrable_on s \<Longrightarrow>
- \<forall>k. \<forall>x\<in>s. f k x \<le> f (Suc k) x \<Longrightarrow> \<forall>x\<in>s. ((\<lambda>k. f k x) ---> g x) sequentially \<Longrightarrow>
- bounded {integral s (f k)| k. True} \<Longrightarrow>
- g integrable_on s \<and> ((\<lambda>k. integral s (f k)) ---> integral s g) sequentially"
+ have lem: "g integrable_on s \<and> ((\<lambda>k. integral s (f k)) ---> integral s g) sequentially"
+ if "\<forall>k. \<forall>x\<in>s. 0 \<le> f k x"
+ and "\<forall>k. (f k) integrable_on s"
+ and "\<forall>k. \<forall>x\<in>s. f k x \<le> f (Suc k) x"
+ and "\<forall>x\<in>s. ((\<lambda>k. f k x) ---> g x) sequentially"
+ and "bounded {integral s (f k)| k. True}"
+ for f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real" and g s
proof -
- case goal1
- note assms=this[rule_format]
+ note assms=that[rule_format]
have "\<forall>x\<in>s. \<forall>k. (f k x)\<bullet>1 \<le> (g x)\<bullet>1"
apply safe
apply (rule Lim_component_ge)
- apply (rule goal1(4)[rule_format])
+ apply (rule that(4)[rule_format])
apply assumption
apply (rule trivial_limit_sequentially)
unfolding eventually_sequentially
apply (rule_tac x=k in exI)
apply (rule transitive_stepwise_le)
- using goal1(3)
+ using that(3)
apply auto
done
note fg=this[rule_format]
have "\<exists>i. ((\<lambda>k. integral s (f k)) ---> i) sequentially"
apply (rule bounded_increasing_convergent)
- apply (rule goal1(5))
+ apply (rule that(5))
apply rule
apply (rule integral_le)
- apply (rule goal1(2)[rule_format])+
- using goal1(3)
+ apply (rule that(2)[rule_format])+
+ using that(3)
apply auto
done
then guess i .. note i=this
have "\<And>k. \<forall>x\<in>s. \<forall>n\<ge>k. f k x \<le> f n x"
apply rule
apply (rule transitive_stepwise_le)
- using goal1(3)
+ using that(3)
apply auto
done
then have i': "\<forall>k. (integral s (f k))\<bullet>1 \<le> i\<bullet>1"
@@ -10043,7 +10043,7 @@
apply safe
apply (rule integral_component_le)
apply simp
- apply (rule goal1(2)[rule_format])+
+ apply (rule that(2)[rule_format])+
apply auto
done
@@ -10060,25 +10060,25 @@
have "\<And>a b. (\<lambda>x. if x \<in> s then g x else 0) integrable_on cbox a b \<and>
((\<lambda>k. integral (cbox a b) (\<lambda>x. if x \<in> s then f k x else 0)) --->
integral (cbox a b) (\<lambda>x. if x \<in> s then g x else 0)) sequentially"
- proof (rule monotone_convergence_interval, safe)
- case goal1
+ proof (rule monotone_convergence_interval, safe, goal_cases)
+ case 1
show ?case by (rule int)
next
- case goal2
+ case (2 _ _ _ x)
then show ?case
apply (cases "x \<in> s")
using assms(3)
apply auto
done
next
- case goal3
+ case (3 _ _ x)
then show ?case
apply (cases "x \<in> s")
using assms(4)
apply auto
done
next
- case goal4
+ case (4 a b)
note * = integral_nonneg
have "\<And>k. norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f k x else 0)) \<le> norm (integral s (f k))"
unfolding real_norm_def
@@ -10089,7 +10089,7 @@
apply (drule assms(1))
prefer 3
apply (subst abs_of_nonneg)
- apply (rule *[OF assms(2) goal1(1)[THEN spec]])
+ apply (rule *[OF assms(2) that(1)[THEN spec]])
apply (subst integral_restrict_univ[symmetric,OF int])
unfolding ifif
unfolding integral_restrict_univ[OF int']
@@ -10115,8 +10115,8 @@
unfolding has_integral_alt'
apply safe
apply (rule g(1))
- proof -
- case goal1
+ proof goal_cases
+ case (1 e)
then have "e/4>0"
by auto
from LIMSEQ_D [OF i this] guess N .. note N=this
@@ -10153,8 +10153,8 @@
apply (rule integral_le[OF int int])
defer
apply (rule order_trans[OF _ i'[rule_format,of "M + N",unfolded real_inner_1_right]])
- proof safe
- case goal2
+ proof (safe, goal_cases)
+ case (2 x)
have "\<And>m. x \<in> s \<Longrightarrow> \<forall>n\<ge>m. (f m x)\<bullet>1 \<le> (f n x)\<bullet>1"
apply (rule transitive_stepwise_le)
using assms(3)
@@ -10163,7 +10163,7 @@
then show ?case
by auto
next
- case goal1
+ case 1
show ?case
apply (subst integral_restrict_univ[symmetric,OF int])
unfolding ifif integral_restrict_univ[OF int']
@@ -10174,7 +10174,7 @@
qed
qed
qed
- then show ?case
+ then show ?thesis
apply safe
defer
apply (drule integral_unique)
@@ -10198,23 +10198,23 @@
integral s (\<lambda>x. g x - f 0 x)) sequentially"
apply (rule lem)
apply safe
- proof -
- case goal1
+ proof goal_cases
+ case (1 k x)
then show ?case
using *[of x 0 "Suc k"] by auto
next
- case goal2
+ case (2 k)
then show ?case
apply (rule integrable_sub)
using assms(1)
apply auto
done
next
- case goal3
+ case (3 k x)
then show ?case
using *[of x "Suc k" "Suc (Suc k)"] by auto
next
- case goal4
+ case (4 x)
then show ?case
apply -
apply (rule tendsto_diff)
@@ -10222,7 +10222,7 @@
apply auto
done
next
- case goal5
+ case 5
then show ?case
using assms(4)
unfolding bounded_iff
@@ -10352,43 +10352,44 @@
and "\<forall>x\<in>s. norm (f x) \<le> g x"
shows "norm (integral s f) \<le> integral s g"
proof -
- have *: "\<And>x y. (\<forall>e::real. 0 < e \<longrightarrow> x < y + e) \<longrightarrow> x \<le> y"
- apply safe
+ have *: "\<And>x y. (\<forall>e::real. 0 < e \<longrightarrow> x < y + e) \<Longrightarrow> x \<le> y"
apply (rule ccontr)
apply (erule_tac x="x - y" in allE)
apply auto
done
- have "\<And>e sg dsa dia ig.
- norm sg \<le> dsa \<longrightarrow> abs (dsa - dia) < e / 2 \<longrightarrow> norm (sg - ig) < e / 2 \<longrightarrow> norm ig < dia + e"
- proof safe
- case goal1
- show ?case
- apply (rule le_less_trans[OF norm_triangle_sub[of ig sg]])
- apply (subst real_sum_of_halves[of e,symmetric])
- unfolding add.assoc[symmetric]
- apply (rule add_le_less_mono)
- defer
- apply (subst norm_minus_commute)
- apply (rule goal1)
- apply (rule order_trans[OF goal1(1)])
- using goal1(2)
- apply arith
- done
- qed
- note norm=this[rule_format]
- have lem: "\<And>f::'n \<Rightarrow> 'a. \<And>g a b. f integrable_on cbox a b \<Longrightarrow> g integrable_on cbox a b \<Longrightarrow>
- \<forall>x\<in>cbox a b. norm (f x) \<le> g x \<Longrightarrow> norm (integral(cbox a b) f) \<le> integral (cbox a b) g"
+ have norm: "norm ig < dia + e"
+ if "norm sg \<le> dsa"
+ and "abs (dsa - dia) < e / 2"
+ and "norm (sg - ig) < e / 2"
+ for e dsa dia and sg ig :: 'a
+ apply (rule le_less_trans[OF norm_triangle_sub[of ig sg]])
+ apply (subst real_sum_of_halves[of e,symmetric])
+ unfolding add.assoc[symmetric]
+ apply (rule add_le_less_mono)
+ defer
+ apply (subst norm_minus_commute)
+ apply (rule that(3))
+ apply (rule order_trans[OF that(1)])
+ using that(2)
+ apply arith
+ done
+ have lem: "norm (integral(cbox a b) f) \<le> integral (cbox a b) g"
+ if "f integrable_on cbox a b"
+ and "g integrable_on cbox a b"
+ and "\<forall>x\<in>cbox a b. norm (f x) \<le> g x"
+ for f :: "'n \<Rightarrow> 'a" and g a b
proof (rule *[rule_format])
- case goal1
+ fix e :: real
+ assume "e > 0"
then have *: "e/2 > 0"
by auto
- from integrable_integral[OF goal1(1),unfolded has_integral[of f],rule_format,OF *]
+ from integrable_integral[OF that(1),unfolded has_integral[of f],rule_format,OF *]
guess d1 .. note d1 = conjunctD2[OF this,rule_format]
- from integrable_integral[OF goal1(2),unfolded has_integral[of g],rule_format,OF *]
+ from integrable_integral[OF that(2),unfolded has_integral[of g],rule_format,OF *]
guess d2 .. note d2 = conjunctD2[OF this,rule_format]
note gauge_inter[OF d1(1) d2(1)]
from fine_division_exists[OF this, of a b] guess p . note p=this
- show ?case
+ show "norm (integral (cbox a b) f) < integral (cbox a b) g + e"
apply (rule norm)
defer
apply (rule d2(2)[OF conjI[OF p(1)],unfolded real_norm_def])
@@ -10405,7 +10406,7 @@
unfolding uv norm_scaleR
unfolding abs_of_nonneg[OF content_pos_le] real_scaleR_def
apply (rule mult_left_mono)
- using goal1(3) as
+ using that(3) as
apply auto
done
qed (insert p[unfolded fine_inter], auto)
@@ -10534,9 +10535,10 @@
assumes "f absolutely_integrable_on UNIV"
obtains B where "\<forall>d. d division_of (\<Union>d) \<longrightarrow> setsum (\<lambda>k. norm(integral k f)) d \<le> B"
apply (rule that[of "integral UNIV (\<lambda>x. norm (f x))"])
-proof safe
- case goal1
- note d = division_ofD[OF this(2)]
+ apply safe
+proof goal_cases
+ case prems: (1 d)
+ note d = division_ofD[OF prems(2)]
have "(\<Sum>k\<in>d. norm (integral k f)) \<le> (\<Sum>i\<in>d. integral i (\<lambda>x. norm (f x)))"
apply (rule setsum_mono,rule absolutely_integrable_le)
apply (drule d(4))
@@ -10545,14 +10547,14 @@
apply auto
done
also have "\<dots> \<le> integral (\<Union>d) (\<lambda>x. norm (f x))"
- apply (subst integral_combine_division_topdown[OF _ goal1(2)])
- using integrable_on_subdivision[OF goal1(2)]
+ apply (subst integral_combine_division_topdown[OF _ prems(2)])
+ using integrable_on_subdivision[OF prems(2)]
using assms
apply auto
done
also have "\<dots> \<le> integral UNIV (\<lambda>x. norm (f x))"
apply (rule integral_subset_le)
- using integrable_on_subdivision[OF goal1(2)]
+ using integrable_on_subdivision[OF prems(2)]
using assms
apply auto
done
@@ -10586,8 +10588,9 @@
show ?thesis
apply (rule absolutely_integrable_onI [OF f has_integral_integrable])
apply (subst has_integral[of _ ?S])
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case e: (1 e)
then have "?S - e / 2 < ?S" by simp
then obtain d where d: "d division_of (cbox a b)" "?S - e / 2 < (\<Sum>k\<in>d. norm (integral k f))"
unfolding less_cSUP_iff[OF D] by auto
@@ -10595,7 +10598,7 @@
have "\<forall>x. \<exists>e>0. \<forall>i\<in>d. x \<notin> i \<longrightarrow> ball x e \<inter> i = {}"
proof
- case goal1
+ fix x
have "\<exists>da>0. \<forall>xa\<in>\<Union>{i \<in> d. x \<notin> i}. da \<le> dist x xa"
apply (rule separate_point_closed)
apply (rule closed_Union)
@@ -10603,13 +10606,13 @@
using d'(4)
apply auto
done
- then show ?case
+ then show "\<exists>e>0. \<forall>i\<in>d. x \<notin> i \<longrightarrow> ball x e \<inter> i = {}"
by force
qed
from choice[OF this] guess k .. note k=conjunctD2[OF this[rule_format],rule_format]
have "e/2 > 0"
- using goal1 by auto
+ using e by auto
from henstock_lemma[OF assms(1) this] guess g . note g=this[rule_format]
let ?g = "\<lambda>x. g x \<inter> ball x (k x)"
show ?case
@@ -10720,23 +10723,23 @@
by (force intro!: helplemma)
have p'alt: "p' = {(x,(i \<inter> l)) | x i l. (x,l) \<in> p \<and> i \<in> d \<and> i \<inter> l \<noteq> {}}"
- proof safe
- case goal2
+ proof (safe, goal_cases)
+ case prems: (2 _ _ x i l)
have "x \<in> i"
- using fineD[OF p(3) goal2(1)] k(2)[OF goal2(2), of x] goal2(4-)
+ using fineD[OF p(3) prems(1)] k(2)[OF prems(2), of x] prems(4-)
by auto
then have "(x, i \<inter> l) \<in> p'"
unfolding p'_def
- using goal2
+ using prems
apply safe
apply (rule_tac x=x in exI)
apply (rule_tac x="i \<inter> l" in exI)
apply safe
- using goal2
+ using prems
apply auto
done
then show ?case
- using goal2(3) by auto
+ using prems(3) by auto
next
fix x k
assume "(x, k) \<in> p'"
@@ -10768,18 +10771,18 @@
apply (rule *[rule_format,OF **])
apply safe
apply(rule d(2))
- proof -
- case goal1 show ?case
+ proof goal_cases
+ case 1
+ show ?case
by (auto simp: sum_p' division_of_tagged_division[OF p''] D intro!: cSUP_upper)
next
- case goal2
+ case 2
have *: "{k \<inter> l | k l. k \<in> d \<and> l \<in> snd ` p} =
(\<lambda>(k,l). k \<inter> l) ` {(k,l)|k l. k \<in> d \<and> l \<in> snd ` p}"
by auto
have "(\<Sum>k\<in>d. norm (integral k f)) \<le> (\<Sum>i\<in>d. \<Sum>l\<in>snd ` p. norm (integral (i \<inter> l) f))"
- proof (rule setsum_mono)
- case goal1
- note k=this
+ proof (rule setsum_mono, goal_cases)
+ case k: (1 k)
from d'(4)[OF this] guess u v by (elim exE) note uv=this
def d' \<equiv> "{cbox u v \<inter> l |l. l \<in> snd ` p \<and> cbox u v \<inter> l \<noteq> {}}"
note uvab = d'(2)[OF k[unfolded uv]]
@@ -10804,13 +10807,13 @@
apply fact
unfolding d'_def uv
apply blast
- proof
- case goal1
+ proof (rule, goal_cases)
+ case prems: (1 i)
then have "i \<in> {cbox u v \<inter> l |l. l \<in> snd ` p}"
by auto
from this[unfolded mem_Collect_eq] guess l .. note l=this
then have "cbox u v \<inter> l = {}"
- using goal1 by auto
+ using prems by auto
then show ?case
using l by auto
qed
@@ -10819,18 +10822,18 @@
apply (rule setsum.reindex_nontrivial [unfolded o_def])
apply (rule finite_imageI)
apply (rule p')
- proof -
- case goal1
+ proof goal_cases
+ case prems: (1 l y)
have "interior (k \<inter> l) \<subseteq> interior (l \<inter> y)"
apply (subst(2) interior_inter)
apply (rule Int_greatest)
defer
- apply (subst goal1(4))
+ apply (subst prems(4))
apply auto
done
then have *: "interior (k \<inter> l) = {}"
- using snd_p(5)[OF goal1(1-3)] by auto
- from d'(4)[OF k] snd_p(4)[OF goal1(1)] guess u1 v1 u2 v2 by (elim exE) note uv=this
+ using snd_p(5)[OF prems(1-3)] by auto
+ from d'(4)[OF k] snd_p(4)[OF prems(1)] guess u1 v1 u2 v2 by (elim exE) note uv=this
show ?case
using *
unfolding uv inter_interval content_eq_0_interior[symmetric]
@@ -10895,10 +10898,9 @@
apply fact
apply (rule finite_imageI[OF p'(1)])
apply safe
- proof -
- case goal2
- have "ia \<inter> b = {}"
- using goal2
+ proof goal_cases
+ case (2 i ia l a b)
+ then have "ia \<inter> b = {}"
unfolding p'alt image_iff Bex_def not_ex
apply (erule_tac x="(a, ia \<inter> b)" in allE)
apply auto
@@ -10906,7 +10908,7 @@
then show ?case
by auto
next
- case goal1
+ case (1 x a b)
then show ?case
unfolding p'_def
apply safe
@@ -10920,7 +10922,7 @@
qed
finally show ?case .
next
- case goal3
+ case 3
let ?S = "{(x, i \<inter> l) |x i l. (x, l) \<in> p \<and> i \<in> d}"
have Sigma_alt: "\<And>s t. s \<times> t = {(i, j) |i j. i \<in> s \<and> j \<in> t}"
by auto
@@ -11007,19 +11009,19 @@
unfolding simple_image
apply (rule setsum.reindex_nontrivial [unfolded o_def, symmetric])
apply (rule d')
- proof -
- case goal1
+ proof goal_cases
+ case prems: (1 k y)
from d'(4)[OF this(1)] d'(4)[OF this(2)]
guess u1 v1 u2 v2 by (elim exE) note uv=this
have "{} = interior ((k \<inter> y) \<inter> cbox u v)"
apply (subst interior_inter)
- using d'(5)[OF goal1(1-3)]
+ using d'(5)[OF prems(1-3)]
apply auto
done
also have "\<dots> = interior (y \<inter> (k \<inter> cbox u v))"
by auto
also have "\<dots> = interior (k \<inter> cbox u v)"
- unfolding goal1(4) by auto
+ unfolding prems(4) by auto
finally show ?case
unfolding uv inter_interval content_eq_0_interior ..
qed
@@ -11031,15 +11033,15 @@
apply blast
apply safe
apply (rule_tac x=k in exI)
- proof -
- case goal1
+ proof goal_cases
+ case prems: (1 i k)
from d'(4)[OF this(1)] guess a b by (elim exE) note ab=this
have "interior (k \<inter> cbox u v) \<noteq> {}"
- using goal1(2)
+ using prems(2)
unfolding ab inter_interval content_eq_0_interior
by auto
then show ?case
- using goal1(1)
+ using prems(1)
using interior_subset[of "k \<inter> cbox u v"]
by auto
qed
@@ -11081,19 +11083,19 @@
show "((\<lambda>x. norm (f x)) has_integral ?S) UNIV"
apply (subst has_integral_alt')
apply safe
- proof -
- case goal1
+ proof goal_cases
+ case (1 a b)
show ?case
using f_int[of a b] by auto
next
- case goal2
+ case prems: (2 e)
have "\<exists>y\<in>setsum (\<lambda>k. norm (integral k f)) ` {d. d division_of \<Union>d}. \<not> y \<le> ?S - e"
proof (rule ccontr)
assume "\<not> ?thesis"
then have "?S \<le> ?S - e"
by (intro cSUP_least[OF D(1)]) auto
then show False
- using goal2 by auto
+ using prems by auto
qed
then obtain K where *: "\<exists>x\<in>{d. d division_of \<Union>d}. K = (\<Sum>k\<in>x. norm (integral k f))"
"SUPREMUM {d. d division_of \<Union>d} (setsum (\<lambda>k. norm (integral k f))) - e < K"
@@ -11120,8 +11122,8 @@
apply (rule *[rule_format])
apply safe
apply (rule d(2))
- proof -
- case goal1
+ proof goal_cases
+ case 1
have "(\<Sum>k\<in>d. norm (integral k f)) \<le> setsum (\<lambda>k. integral k (\<lambda>x. norm (f x))) d"
apply (rule setsum_mono)
apply (rule absolutely_integrable_le)
@@ -11138,14 +11140,13 @@
done
also have "\<dots> \<le> integral (cbox a b) (\<lambda>x. if x \<in> UNIV then norm (f x) else 0)"
proof -
- case goal1
have "\<Union>d \<subseteq> cbox a b"
apply rule
apply (drule K(2)[rule_format])
apply (rule ab[unfolded subset_eq,rule_format])
apply (auto simp add: dist_norm)
done
- then show ?case
+ then show ?thesis
apply -
apply (subst if_P)
apply rule
@@ -11247,10 +11248,11 @@
apply (rule bounded_variation_absolutely_integrable[of _ "B1+B2"])
apply (rule integrable_add)
prefer 3
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case prems: (1 d)
have "\<And>k. k \<in> d \<Longrightarrow> f integrable_on k \<and> g integrable_on k"
- apply (drule division_ofD(4)[OF goal1])
+ apply (drule division_ofD(4)[OF prems])
apply safe
apply (rule_tac[!] integrable_on_subcbox[of _ UNIV])
using assms
@@ -11267,7 +11269,7 @@
apply auto
done
also have "\<dots> \<le> B1 + B2"
- using B(1)[OF goal1] B(2)[OF goal1] by auto
+ using B(1)[OF prems] B(2)[OF prems] by auto
finally show ?case .
qed (insert assms, auto)
qed
@@ -11305,14 +11307,15 @@
show "(h \<circ> f) absolutely_integrable_on UNIV"
apply (rule bounded_variation_absolutely_integrable[of _ "B * b"])
apply (rule integrable_linear[OF _ assms(2)])
- proof safe
- case goal2
+ apply safe
+ proof goal_cases
+ case prems: (2 d)
have "(\<Sum>k\<in>d. norm (integral k (h \<circ> f))) \<le> setsum (\<lambda>k. norm(integral k f)) d * b"
unfolding setsum_left_distrib
apply (rule setsum_mono)
- proof -
- case goal1
- from division_ofD(4)[OF goal2 this]
+ proof goal_cases
+ case (1 k)
+ from division_ofD(4)[OF prems this]
guess u v by (elim exE) note uv=this
have *: "f integrable_on k"
unfolding uv
@@ -11328,7 +11331,7 @@
qed
also have "\<dots> \<le> B * b"
apply (rule mult_right_mono)
- using B goal2 b
+ using B prems b
apply auto
done
finally show ?case .
@@ -11450,9 +11453,9 @@
show "f absolutely_integrable_on UNIV"
apply (rule bounded_variation_absolutely_integrable[OF assms(1), where B="?B"])
apply safe
- proof -
- case goal1
- note d=this and d'=division_ofD[OF this]
+ proof goal_cases
+ case d: (1 d)
+ note d'=division_ofD[OF d]
have "(\<Sum>k\<in>d. norm (integral k f)) \<le>
(\<Sum>k\<in>d. setsum (op \<bullet> (integral k (\<lambda>x. (\<Sum>i\<in>Basis. \<bar>f x\<bullet>i\<bar> *\<^sub>R i)::'m))) Basis)"
apply (rule setsum_mono)
@@ -11481,8 +11484,8 @@
also have "\<dots> \<le> setsum (op \<bullet> (integral UNIV (\<lambda>x. (\<Sum>i\<in>Basis. \<bar>f x\<bullet>i\<bar> *\<^sub>R i)::'m))) Basis"
apply (subst setsum.commute)
apply (rule setsum_mono)
- proof -
- case goal1
+ proof goal_cases
+ case (1 j)
have *: "(\<lambda>x. \<Sum>i\<in>Basis. \<bar>f x\<bullet>i\<bar> *\<^sub>R i::'m) integrable_on \<Union>d"
using integrable_on_subdivision[OF d assms(2)] by auto
have "(\<Sum>i\<in>d. integral i (\<lambda>x. \<Sum>i\<in>Basis. \<bar>f x\<bullet>i\<bar> *\<^sub>R i::'m) \<bullet> j) =
@@ -11535,9 +11538,10 @@
assume assms: "\<forall>x. norm (f x) \<le> g x" "f integrable_on UNIV" "g integrable_on UNIV"
show "f absolutely_integrable_on UNIV"
apply (rule bounded_variation_absolutely_integrable[OF assms(2),where B="integral UNIV g"])
- proof safe
- case goal1
- note d=this and d'=division_ofD[OF this]
+ apply safe
+ proof goal_cases
+ case d: (1 d)
+ note d'=division_ofD[OF d]
have "(\<Sum>k\<in>d. norm (integral k f)) \<le> (\<Sum>k\<in>d. integral k g)"
apply (rule setsum_mono)
apply (rule integral_norm_bound_integral)
@@ -11725,9 +11729,8 @@
by (rule cInf_superset_mono) auto
let ?S = "{f j x| j. m \<le> j}"
show "((\<lambda>k. Inf {f j x |j. j \<in> {m..m + k}}) ---> Inf ?S) sequentially"
- proof (rule LIMSEQ_I)
- case goal1
- note r = this
+ proof (rule LIMSEQ_I, goal_cases)
+ case r: (1 r)
have "\<exists>y\<in>?S. y < Inf ?S + r"
by (subst cInf_less_iff[symmetric]) (auto simp: \<open>x\<in>s\<close> r)
@@ -11736,8 +11739,9 @@
show ?case
apply (rule_tac x=N in exI)
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case prems: (1 n)
have *: "\<And>y ix. y < Inf ?S + r \<longrightarrow> Inf ?S \<le> ix \<longrightarrow> ix \<le> y \<longrightarrow> abs(ix - Inf ?S) < r"
by arith
show ?case
@@ -11745,7 +11749,7 @@
apply (rule *[rule_format, OF N(1)])
apply (rule cInf_superset_mono, auto simp: \<open>x\<in>s\<close>) []
apply (rule cInf_lower)
- using N goal1
+ using N prems
apply auto []
apply simp
done
@@ -11796,8 +11800,8 @@
by (rule cSup_subset_mono) auto
let ?S = "{f j x| j. m \<le> j}"
show "((\<lambda>k. Sup {f j x |j. j \<in> {m..m + k}}) ---> Sup ?S) sequentially"
- proof (rule LIMSEQ_I)
- case goal1 note r=this
+ proof (rule LIMSEQ_I, goal_cases)
+ case r: (1 r)
have "\<exists>y\<in>?S. Sup ?S - r < y"
by (subst less_cSup_iff[symmetric]) (auto simp: r \<open>x\<in>s\<close>)
then obtain N where N: "Sup ?S - r < f N x" "m \<le> N"
@@ -11805,8 +11809,9 @@
show ?case
apply (rule_tac x=N in exI)
- proof safe
- case goal1
+ apply safe
+ proof goal_cases
+ case prems: (1 n)
have *: "\<And>y ix. Sup ?S - r < y \<longrightarrow> ix \<le> Sup ?S \<longrightarrow> y \<le> ix \<longrightarrow> abs(ix - Sup ?S) < r"
by arith
show ?case
@@ -11814,7 +11819,7 @@
apply (rule *[rule_format, OF N(1)])
apply (rule cSup_subset_mono, auto simp: \<open>x\<in>s\<close>) []
apply (subst cSup_upper)
- using N goal1
+ using N prems
apply auto
done
qed
@@ -11849,20 +11854,21 @@
by (intro cInf_superset_mono) (auto simp: \<open>x\<in>s\<close>)
show "(\<lambda>k::nat. Inf {f j x |j. k \<le> j}) ----> g x"
- proof (rule LIMSEQ_I)
- case goal1
+ proof (rule LIMSEQ_I, goal_cases)
+ case r: (1 r)
then have "0<r/2"
by auto
from assms(4)[THEN bspec, THEN LIMSEQ_D, OF x this] guess N .. note N = this
show ?case
- apply (rule_tac x=N in exI,safe)
+ apply (rule_tac x=N in exI)
+ apply safe
unfolding real_norm_def
apply (rule le_less_trans[of _ "r/2"])
apply (rule cInf_asclose)
apply safe
defer
apply (rule less_imp_le)
- using N goal1
+ using N r
apply auto
done
qed
@@ -11896,8 +11902,8 @@
show "Sup {f j x |j. k \<le> j} \<ge> Sup {f j x |j. Suc k \<le> j}"
by (rule cSup_subset_mono) (auto simp: \<open>x\<in>s\<close>)
show "((\<lambda>k. Sup {f j x |j. k \<le> j}) ---> g x) sequentially"
- proof (rule LIMSEQ_I)
- case goal1
+ proof (rule LIMSEQ_I, goal_cases)
+ case r: (1 r)
then have "0<r/2"
by auto
from assms(4)[THEN bspec, THEN LIMSEQ_D, OF x this] guess N .. note N=this
@@ -11909,7 +11915,7 @@
apply safe
defer
apply (rule less_imp_le)
- using N goal1
+ using N r
apply auto
done
qed
@@ -11918,10 +11924,10 @@
show "g integrable_on s" by fact
show "((\<lambda>k. integral s (f k)) ---> integral s g) sequentially"
- proof (rule LIMSEQ_I)
- case goal1
- from LIMSEQ_D [OF inc2(2) goal1] guess N1 .. note N1=this[unfolded real_norm_def]
- from LIMSEQ_D [OF dec2(2) goal1] guess N2 .. note N2=this[unfolded real_norm_def]
+ proof (rule LIMSEQ_I, goal_cases)
+ case r: (1 r)
+ from LIMSEQ_D [OF inc2(2) r] guess N1 .. note N1=this[unfolded real_norm_def]
+ from LIMSEQ_D [OF dec2(2) r] guess N2 .. note N2=this[unfolded real_norm_def]
show ?case
proof (rule_tac x="N1+N2" in exI, safe)
fix n
--- a/src/HOL/Multivariate_Analysis/Ordered_Euclidean_Space.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Multivariate_Analysis/Ordered_Euclidean_Space.thy Fri Sep 18 16:42:19 2015 +0100
@@ -17,20 +17,20 @@
begin
subclass order
- by default
+ by standard
(auto simp: eucl_le eucl_less_le_not_le intro!: euclidean_eqI antisym intro: order.trans)
subclass ordered_ab_group_add_abs
- by default (auto simp: eucl_le inner_add_left eucl_abs abs_leI)
+ by standard (auto simp: eucl_le inner_add_left eucl_abs abs_leI)
subclass ordered_real_vector
- by default (auto simp: eucl_le intro!: mult_left_mono mult_right_mono)
+ by standard (auto simp: eucl_le intro!: mult_left_mono mult_right_mono)
subclass lattice
- by default (auto simp: eucl_inf eucl_sup eucl_le)
+ by standard (auto simp: eucl_inf eucl_sup eucl_le)
subclass distrib_lattice
- by default (auto simp: eucl_inf eucl_sup sup_inf_distrib1 intro!: euclidean_eqI)
+ by standard (auto simp: eucl_inf eucl_sup sup_inf_distrib1 intro!: euclidean_eqI)
subclass conditionally_complete_lattice
proof
@@ -152,7 +152,7 @@
by (auto)
instance real :: ordered_euclidean_space
- by default (auto simp: INF_def SUP_def)
+ by standard (auto simp: INF_def SUP_def)
lemma in_Basis_prod_iff:
fixes i::"'a::euclidean_space*'b::euclidean_space"
@@ -168,7 +168,7 @@
end
instance prod :: (ordered_euclidean_space, ordered_euclidean_space) ordered_euclidean_space
- by default
+ by standard
(auto intro!: add_mono simp add: euclidean_representation_setsum' Ball_def inner_prod_def
in_Basis_prod_iff inner_Basis_inf_left inner_Basis_sup_left inner_Basis_INF_left Inf_prod_def
inner_Basis_SUP_left Sup_prod_def less_prod_def less_eq_prod_def eucl_le[where 'a='a]
@@ -281,7 +281,7 @@
definition "abs x = (\<chi> i. abs (x $ i))"
instance
- apply default
+ apply standard
unfolding euclidean_representation_setsum'
apply (auto simp: less_eq_vec_def inf_vec_def sup_vec_def Inf_vec_def Sup_vec_def inner_axis
Basis_vec_def inner_Basis_inf_left inner_Basis_sup_left inner_Basis_INF_left
--- a/src/HOL/NSA/HyperDef.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/NSA/HyperDef.thy Fri Sep 18 16:42:19 2015 +0100
@@ -337,7 +337,7 @@
*}
simproc_setup fast_arith_hypreal ("(m::hypreal) < n" | "(m::hypreal) <= n" | "(m::hypreal) = n") =
- {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (Thm.term_of ct) *}
+ {* K Lin_Arith.simproc *}
subsection {* Exponentials on the Hyperreals *}
--- a/src/HOL/Nat.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nat.thy Fri Sep 18 16:42:19 2015 +0100
@@ -529,7 +529,7 @@
end
instance nat :: no_top
- by default (auto intro: less_Suc_eq_le [THEN iffD2])
+ by standard (auto intro: less_Suc_eq_le [THEN iffD2])
subsubsection \<open>Introduction properties\<close>
@@ -1664,8 +1664,8 @@
setup \<open>Lin_Arith.global_setup\<close>
declaration \<open>K Lin_Arith.setup\<close>
-simproc_setup fast_arith_nat ("(m::nat) < n" | "(m::nat) <= n" | "(m::nat) = n") =
- \<open>fn _ => fn ss => fn ct => Lin_Arith.simproc ss (Thm.term_of ct)\<close>
+simproc_setup fast_arith_nat ("(m::nat) < n" | "(m::nat) \<le> n" | "(m::nat) = n") =
+ \<open>K Lin_Arith.simproc\<close>
(* Because of this simproc, the arithmetic solver is really only
useful to detect inconsistencies among the premises for subgoals which are
*not* themselves (in)equalities, because the latter activate
--- a/src/HOL/Nitpick.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nitpick.thy Fri Sep 18 16:42:19 2015 +0100
@@ -239,8 +239,8 @@
hide_fact (open) Ex1_unfold rtrancl_unfold rtranclp_unfold tranclp_unfold prod_def refl'_def wf'_def
card'_def setsum'_def fold_graph'_def The_psimp Eps_psimp case_unit_unfold case_nat_unfold
- size_list_simp nat_gcd_def nat_lcm_def int_gcd_def int_lcm_def Frac_def zero_frac_def one_frac_def
- num_def denom_def norm_frac_def frac_def plus_frac_def times_frac_def uminus_frac_def
+ size_list_simp nat_lcm_def int_gcd_def int_lcm_def Frac_def zero_frac_def one_frac_def
+ num_def denom_def frac_def plus_frac_def times_frac_def uminus_frac_def
number_of_frac_def inverse_frac_def less_frac_def less_eq_frac_def of_frac_def wf_wfrec'_def
wfrec'_def
--- a/src/HOL/Nominal/Examples/Pattern.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nominal/Examples/Pattern.thy Fri Sep 18 16:42:19 2015 +0100
@@ -62,7 +62,7 @@
by (simp add: supp_def Collect_disj_eq del: disj_not1)
instance pat :: pt_name
-proof (default, goals)
+proof (standard, goal_cases)
case (1 x)
show ?case by (induct x) simp_all
next
@@ -74,7 +74,7 @@
qed
instance pat :: fs_name
-proof (default, goals)
+proof (standard, goal_cases)
case (1 x)
show ?case by (induct x) (simp_all add: fin_supp)
qed
--- a/src/HOL/Nominal/nominal_datatype.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nominal/nominal_datatype.ML Fri Sep 18 16:42:19 2015 +0100
@@ -98,12 +98,15 @@
fun permTs_of (Const (@{const_name Nominal.perm}, T) $ t $ u) = fst (dest_permT T) :: permTs_of u
| permTs_of _ = [];
-fun perm_simproc' ctxt (Const (@{const_name Nominal.perm}, T) $ t $ (u as Const (@{const_name Nominal.perm}, U) $ r $ s)) =
+fun perm_simproc' ctxt ct =
+ (case Thm.term_of ct of
+ Const (@{const_name Nominal.perm}, T) $ t $ (u as Const (@{const_name Nominal.perm}, U) $ r $ s) =>
let
val thy = Proof_Context.theory_of ctxt;
val (aT as Type (a, []), S) = dest_permT T;
val (bT as Type (b, []), _) = dest_permT U;
- in if member (op =) (permTs_of u) aT andalso aT <> bT then
+ in
+ if member (op =) (permTs_of u) aT andalso aT <> bT then
let
val cp = cp_inst_of thy a b;
val dj = dj_thm_of thy b a;
@@ -115,10 +118,11 @@
end
else NONE
end
- | perm_simproc' _ _ = NONE;
+ | _ => NONE);
val perm_simproc =
- Simplifier.simproc_global @{theory} "perm_simp" ["pi1 \<bullet> (pi2 \<bullet> x)"] perm_simproc';
+ Simplifier.make_simproc @{context} "perm_simp"
+ {lhss = [@{term "pi1 \<bullet> (pi2 \<bullet> x)"}], proc = K perm_simproc', identifier = []};
fun projections ctxt rule =
Project_Rule.projections ctxt rule
@@ -582,7 +586,7 @@
val (typedefs, thy6) =
thy4
|> fold_map (fn (((name, mx), tvs), (cname, U)) => fn thy =>
- Typedef.add_typedef_global false
+ Typedef.add_typedef_global
(name, map (fn (v, _) => (v, dummyS)) tvs, mx) (* FIXME keep constraints!? *)
(Const (@{const_name Collect}, (U --> HOLogic.boolT) --> HOLogic.mk_setT U) $
Const (cname, U --> HOLogic.boolT)) NONE
--- a/src/HOL/Nominal/nominal_inductive.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nominal/nominal_inductive.ML Fri Sep 18 16:42:19 2015 +0100
@@ -40,11 +40,15 @@
th RS infer_instantiate ctxt [(#1 (dest_Var (Thm.term_of perm_boolI_pi)), pi)] perm_boolI;
fun mk_perm_bool_simproc names =
- Simplifier.simproc_global_i @{theory} "perm_bool" [@{term "perm pi x"}] (fn ctxt =>
- fn Const (@{const_name Nominal.perm}, _) $ _ $ t =>
- if member (op =) names (the_default "" (try (head_of #> dest_Const #> fst) t))
- then SOME perm_bool else NONE
- | _ => NONE);
+ Simplifier.make_simproc @{context} "perm_bool"
+ {lhss = [@{term "perm pi x"}],
+ proc = fn _ => fn _ => fn ct =>
+ (case Thm.term_of ct of
+ Const (@{const_name Nominal.perm}, _) $ _ $ t =>
+ if member (op =) names (the_default "" (try (head_of #> dest_Const #> fst) t))
+ then SOME perm_bool else NONE
+ | _ => NONE),
+ identifier = []};
fun transp ([] :: _) = []
| transp xs = map hd xs :: transp (map tl xs);
--- a/src/HOL/Nominal/nominal_inductive2.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nominal/nominal_inductive2.ML Fri Sep 18 16:42:19 2015 +0100
@@ -44,11 +44,15 @@
th RS infer_instantiate ctxt [(#1 (dest_Var (Thm.term_of perm_boolI_pi)), pi)] perm_boolI;
fun mk_perm_bool_simproc names =
- Simplifier.simproc_global_i @{theory} "perm_bool" [@{term "perm pi x"}] (fn ctxt =>
- fn Const (@{const_name Nominal.perm}, _) $ _ $ t =>
- if member (op =) names (the_default "" (try (head_of #> dest_Const #> fst) t))
- then SOME perm_bool else NONE
- | _ => NONE);
+ Simplifier.make_simproc @{context} "perm_bool"
+ {lhss = [@{term "perm pi x"}],
+ proc = fn _ => fn _ => fn ct =>
+ (case Thm.term_of ct of
+ Const (@{const_name Nominal.perm}, _) $ _ $ t =>
+ if member (op =) names (the_default "" (try (head_of #> dest_Const #> fst) t))
+ then SOME perm_bool else NONE
+ | _ => NONE),
+ identifier = []};
fun transp ([] :: _) = []
| transp xs = map hd xs :: transp (map tl xs);
--- a/src/HOL/Nominal/nominal_permeq.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Nominal/nominal_permeq.ML Fri Sep 18 16:42:19 2015 +0100
@@ -3,7 +3,7 @@
Author: Julien Narboux, TU Muenchen
Methods for simplifying permutations and for analysing equations
-involving permutations.
+involving permutations.
*)
(*
@@ -18,8 +18,8 @@
[(a,b)] o pi1 o pi2 = ....
- rather it tries to permute pi1 over pi2, which
- results in a failure when used with the
+ rather it tries to permute pi1 over pi2, which
+ results in a failure when used with the
perm_(full)_simp tactics
*)
@@ -67,7 +67,7 @@
val supp_unit = @{thm "supp_unit"};
val pt_perm_compose_aux = @{thm "pt_perm_compose_aux"};
val cp1_aux = @{thm "cp1_aux"};
-val perm_aux_fold = @{thm "perm_aux_fold"};
+val perm_aux_fold = @{thm "perm_aux_fold"};
val supports_fresh_rule = @{thm "supports_fresh"};
(* needed in the process of fully simplifying permutations *)
@@ -76,31 +76,32 @@
val weak_congs = [@{thm "if_weak_cong"}]
(* debugging *)
-fun DEBUG ctxt (msg,tac) =
- CHANGED (EVERY [print_tac ctxt ("before "^msg), tac, print_tac ctxt ("after "^msg)]);
-fun NO_DEBUG _ (_,tac) = CHANGED tac;
+fun DEBUG ctxt (msg,tac) =
+ CHANGED (EVERY [print_tac ctxt ("before "^msg), tac, print_tac ctxt ("after "^msg)]);
+fun NO_DEBUG _ (_,tac) = CHANGED tac;
(* simproc that deals with instances of permutations in front *)
(* of applications; just adding this rule to the simplifier *)
(* would loop; it also needs careful tuning with the simproc *)
(* for functions to avoid further possibilities for looping *)
-fun perm_simproc_app' ctxt redex =
- let
- val thy = Proof_Context.theory_of ctxt;
+fun perm_simproc_app' ctxt ct =
+ let
+ val thy = Proof_Context.theory_of ctxt
+ val redex = Thm.term_of ct
(* the "application" case is only applicable when the head of f is not a *)
(* constant or when (f x) is a permuation with two or more arguments *)
- fun applicable_app t =
+ fun applicable_app t =
(case (strip_comb t) of
(Const (@{const_name Nominal.perm},_),ts) => (length ts) >= 2
| (Const _,_) => false
| _ => true)
in
- case redex of
+ case redex of
(* case pi o (f x) == (pi o f) (pi o x) *)
(Const(@{const_name Nominal.perm},
Type(@{type_name fun},
- [Type(@{type_name list}, [Type(@{type_name prod},[Type(n,_),_])]),_])) $ pi $ (f $ x)) =>
+ [Type(@{type_name list}, [Type(@{type_name prod},[Type(n,_),_])]),_])) $ pi $ (f $ x)) =>
(if (applicable_app f) then
let
val name = Long_Name.base_name n
@@ -111,12 +112,14 @@
| _ => NONE
end
-val perm_simproc_app = Simplifier.simproc_global @{theory} "perm_simproc_app"
- ["Nominal.perm pi x"] perm_simproc_app';
+val perm_simproc_app =
+ Simplifier.make_simproc @{context} "perm_simproc_app"
+ {lhss = [@{term "Nominal.perm pi x"}], proc = K perm_simproc_app', identifier = []}
(* a simproc that deals with permutation instances in front of functions *)
-fun perm_simproc_fun' ctxt redex =
- let
+fun perm_simproc_fun' ctxt ct =
+ let
+ val redex = Thm.term_of ct
fun applicable_fun t =
(case (strip_comb t) of
(Abs _ ,[]) => true
@@ -124,20 +127,21 @@
| (Const _, _) => true
| _ => false)
in
- case redex of
- (* case pi o f == (%x. pi o (f ((rev pi)o x))) *)
- (Const(@{const_name Nominal.perm},_) $ pi $ f) =>
+ case redex of
+ (* case pi o f == (%x. pi o (f ((rev pi)o x))) *)
+ (Const(@{const_name Nominal.perm},_) $ pi $ f) =>
(if applicable_fun f then SOME perm_fun_def else NONE)
| _ => NONE
end
-val perm_simproc_fun = Simplifier.simproc_global @{theory} "perm_simproc_fun"
- ["Nominal.perm pi x"] perm_simproc_fun';
+val perm_simproc_fun =
+ Simplifier.make_simproc @{context} "perm_simproc_fun"
+ {lhss = [@{term "Nominal.perm pi x"}], proc = K perm_simproc_fun', identifier = []}
(* function for simplyfying permutations *)
(* stac contains the simplifiation tactic that is *)
(* applied (see (no_asm) options below *)
-fun perm_simp_gen stac dyn_thms eqvt_thms ctxt i =
+fun perm_simp_gen stac dyn_thms eqvt_thms ctxt i =
("general simplification of permutations", fn st => SUBGOAL (fn _ =>
let
val ctxt' = ctxt
@@ -150,23 +154,23 @@
end) i st);
(* general simplification of permutations and permutation that arose from eqvt-problems *)
-fun perm_simp stac ctxt =
+fun perm_simp stac ctxt =
let val simps = ["perm_swap","perm_fresh_fresh","perm_bij","perm_pi_simp","swap_simps"]
- in
+ in
perm_simp_gen stac simps [] ctxt
end;
-fun eqvt_simp stac ctxt =
+fun eqvt_simp stac ctxt =
let val simps = ["perm_swap","perm_fresh_fresh","perm_pi_simp"]
val eqvts_thms = NominalThmDecls.get_eqvt_thms ctxt;
- in
+ in
perm_simp_gen stac simps eqvts_thms ctxt
end;
(* main simplification tactics for permutations *)
fun perm_simp_tac_gen_i stac tactical ctxt i = DETERM (tactical ctxt (perm_simp stac ctxt i));
-fun eqvt_simp_tac_gen_i stac tactical ctxt i = DETERM (tactical ctxt (eqvt_simp stac ctxt i));
+fun eqvt_simp_tac_gen_i stac tactical ctxt i = DETERM (tactical ctxt (eqvt_simp stac ctxt i));
val perm_simp_tac_i = perm_simp_tac_gen_i simp_tac
val perm_asm_simp_tac_i = perm_simp_tac_gen_i asm_simp_tac
@@ -177,18 +181,18 @@
(* applies the perm_compose rule such that *)
(* pi o (pi' o lhs) = rhs *)
-(* is transformed to *)
+(* is transformed to *)
(* (pi o pi') o (pi' o lhs) = rhs *)
(* *)
(* this rule would loop in the simplifier, so some trick is used with *)
(* generating perm_aux'es for the outermost permutation and then un- *)
(* folding the definition *)
-fun perm_compose_simproc' ctxt redex =
- (case redex of
+fun perm_compose_simproc' ctxt ct =
+ (case Thm.term_of ct of
(Const (@{const_name Nominal.perm}, Type (@{type_name fun}, [Type (@{type_name list},
- [Type (@{type_name Product_Type.prod}, [T as Type (tname,_),_])]),_])) $ pi1 $ (Const (@{const_name Nominal.perm},
- Type (@{type_name fun}, [Type (@{type_name list}, [Type (@{type_name Product_Type.prod}, [U as Type (uname,_),_])]),_])) $
+ [Type (@{type_name Product_Type.prod}, [T as Type (tname,_),_])]),_])) $ pi1 $ (Const (@{const_name Nominal.perm},
+ Type (@{type_name fun}, [Type (@{type_name list}, [Type (@{type_name Product_Type.prod}, [U as Type (uname,_),_])]),_])) $
pi2 $ t)) =>
let
val thy = Proof_Context.theory_of ctxt
@@ -196,7 +200,7 @@
val uname' = Long_Name.base_name uname
in
if pi1 <> pi2 then (* only apply the composition rule in this case *)
- if T = U then
+ if T = U then
SOME (Thm.instantiate'
[SOME (Thm.global_ctyp_of thy (fastype_of t))]
[SOME (Thm.global_cterm_of thy pi1), SOME (Thm.global_cterm_of thy pi2), SOME (Thm.global_cterm_of thy t)]
@@ -206,16 +210,18 @@
SOME (Thm.instantiate'
[SOME (Thm.global_ctyp_of thy (fastype_of t))]
[SOME (Thm.global_cterm_of thy pi1), SOME (Thm.global_cterm_of thy pi2), SOME (Thm.global_cterm_of thy t)]
- (mk_meta_eq (Global_Theory.get_thm thy ("cp_"^tname'^"_"^uname'^"_inst") RS
+ (mk_meta_eq (Global_Theory.get_thm thy ("cp_"^tname'^"_"^uname'^"_inst") RS
cp1_aux)))
else NONE
end
| _ => NONE);
-val perm_compose_simproc = Simplifier.simproc_global @{theory} "perm_compose"
- ["Nominal.perm pi1 (Nominal.perm pi2 t)"] perm_compose_simproc';
+val perm_compose_simproc =
+ Simplifier.make_simproc @{context} "perm_compose"
+ {lhss = [@{term "Nominal.perm pi1 (Nominal.perm pi2 t)"}],
+ proc = K perm_compose_simproc', identifier = []}
-fun perm_compose_tac ctxt i =
+fun perm_compose_tac ctxt i =
("analysing permutation compositions on the lhs",
fn st => EVERY
[resolve_tac ctxt [trans] i,
@@ -227,11 +233,11 @@
(* unfolds the definition of permutations *)
(* applied to functions such that *)
-(* pi o f = rhs *)
+(* pi o f = rhs *)
(* is transformed to *)
(* %x. pi o (f ((rev pi) o x)) = rhs *)
fun unfold_perm_fun_def_tac ctxt i =
- ("unfolding of permutations on functions",
+ ("unfolding of permutations on functions",
resolve_tac ctxt [perm_fun_def RS meta_eq_to_obj_eq RS trans] i)
(* applies the ext-rule such that *)
@@ -246,14 +252,14 @@
(* since it contains looping rules the "recursion" - depth is set *)
(* to 10 - this seems to be sufficient in most cases *)
fun perm_extend_simp_tac_i tactical ctxt =
- let fun perm_extend_simp_tac_aux tactical ctxt n =
+ let fun perm_extend_simp_tac_aux tactical ctxt n =
if n=0 then K all_tac
- else DETERM o
+ else DETERM o
(FIRST'
[fn i => tactical ctxt ("splitting conjunctions on the rhs", resolve_tac ctxt [conjI] i),
fn i => tactical ctxt (perm_simp asm_full_simp_tac ctxt i),
fn i => tactical ctxt (perm_compose_tac ctxt i),
- fn i => tactical ctxt (apply_cong_tac ctxt i),
+ fn i => tactical ctxt (apply_cong_tac ctxt i),
fn i => tactical ctxt (unfold_perm_fun_def_tac ctxt i),
fn i => tactical ctxt (ext_fun_tac ctxt i)]
THEN_ALL_NEW (TRY o (perm_extend_simp_tac_aux tactical ctxt (n-1))))
@@ -264,7 +270,7 @@
(* unfolds the support definition and strips off the *)
(* intros, then applies eqvt_simp_tac *)
fun supports_tac_i tactical ctxt i =
- let
+ let
val simps = [supports_def, Thm.symmetric fresh_def, fresh_prod]
in
EVERY [tactical ctxt ("unfolding of supports ", simp_tac (put_simpset HOL_basic_ss ctxt addsimps simps) i),
@@ -323,11 +329,11 @@
(* tactic that guesses whether an atom is fresh for an expression *)
-(* it first collects all free variables and tries to show that the *)
+(* it first collects all free variables and tries to show that the *)
(* support of these free variables (op supports) the goal *)
(* FIXME proper SUBGOAL/CSUBGOAL instead of cprems_of etc. *)
fun fresh_guess_tac_i tactical ctxt i st =
- let
+ let
val goal = nth (cprems_of st) (i - 1)
val fin_supp = Proof_Context.get_thms ctxt "fin_supp"
val fresh_atm = Proof_Context.get_thms ctxt "fresh_atm"
@@ -335,7 +341,7 @@
val ctxt2 = ctxt addsimps [supp_prod,supp_unit,finite_Un,finite_emptyI,conj_absorb]@fin_supp
in
case Logic.strip_assums_concl (Thm.term_of goal) of
- _ $ (Const (@{const_name Nominal.fresh}, Type ("fun", [T, _])) $ _ $ t) =>
+ _ $ (Const (@{const_name Nominal.fresh}, Type ("fun", [T, _])) $ _ $ t) =>
let
val ps = Logic.strip_params (Thm.term_of goal);
val Ts = rev (map snd ps);
@@ -353,15 +359,15 @@
infer_instantiate ctxt
[(#1 (dest_Var (head_of S)), Thm.cterm_of ctxt s')] supports_fresh_rule';
in
- (tactical ctxt ("guessing of the right set that supports the goal",
+ (tactical ctxt ("guessing of the right set that supports the goal",
(EVERY [compose_tac ctxt (false, supports_fresh_rule'', 3) i,
asm_full_simp_tac ctxt1 (i+2),
- asm_full_simp_tac ctxt2 (i+1),
+ asm_full_simp_tac ctxt2 (i+1),
supports_tac_i tactical ctxt i]))) st
end
- (* when a term-constructor contains more than one binder, it is useful *)
+ (* when a term-constructor contains more than one binder, it is useful *)
(* in nominal_primrecs to try whether the goal can be solved by an hammer *)
- | _ => (tactical ctxt ("if it is not of the form _\<sharp>_, then try the simplifier",
+ | _ => (tactical ctxt ("if it is not of the form _\<sharp>_, then try the simplifier",
(asm_full_simp_tac (put_simpset HOL_ss ctxt addsimps [fresh_prod]@fresh_atm) i))) st
end
handle General.Subscript => Seq.empty;
@@ -383,7 +389,7 @@
(* Code opied from the Simplifer for setting up the perm_simp method *)
(* behaves nearly identical to the simp-method, for example can handle *)
-(* options like (no_asm) etc. *)
+(* options like (no_asm) etc. *)
val no_asmN = "no_asm";
val no_asm_useN = "no_asm_use";
val no_asm_simpN = "no_asm_simp";
--- a/src/HOL/Num.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Num.thy Fri Sep 18 16:42:19 2015 +0100
@@ -106,7 +106,7 @@
"m < n \<longleftrightarrow> nat_of_num m < nat_of_num n"
instance
- by (default, auto simp add: less_num_def less_eq_num_def num_eq_iff)
+ by standard (auto simp add: less_num_def less_eq_num_def num_eq_iff)
end
--- a/src/HOL/Number_Theory/Eratosthenes.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Number_Theory/Eratosthenes.thy Fri Sep 18 16:42:19 2015 +0100
@@ -122,7 +122,7 @@
"mark_out_aux n m [] = []"
"mark_out_aux n 0 (b # bs) = False # mark_out_aux n n bs"
"mark_out_aux n (Suc m) (b # bs) = b # mark_out_aux n m bs"
-proof goals
+proof goal_cases
case 1
show ?case
by (simp add: mark_out_aux_def)
--- a/src/HOL/Orderings.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Orderings.thy Fri Sep 18 16:42:19 2015 +0100
@@ -196,7 +196,7 @@
by (auto simp add: less_le_not_le intro: antisym)
sublocale order!: ordering less_eq less + dual_order!: ordering greater_eq greater
- by default (auto intro: antisym order_trans simp add: less_le)
+ by standard (auto intro: antisym order_trans simp add: less_le)
text \<open>Reflexivity.\<close>
@@ -1197,7 +1197,7 @@
begin
sublocale bot!: ordering_top greater_eq greater bot
- by default (fact bot_least)
+ by standard (fact bot_least)
lemma le_bot:
"a \<le> \<bottom> \<Longrightarrow> a = \<bottom>"
@@ -1225,7 +1225,7 @@
begin
sublocale top!: ordering_top less_eq less top
- by default (fact top_greatest)
+ by standard (fact top_greatest)
lemma top_le:
"\<top> \<le> a \<Longrightarrow> a = \<top>"
--- a/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Quickcheck_Examples.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Quickcheck_Examples.thy Fri Sep 18 16:42:19 2015 +0100
@@ -2,6 +2,7 @@
imports "~~/src/HOL/Library/Predicate_Compile_Quickcheck"
begin
+(*
section {* Sets *}
lemma "x \<in> {(1::nat)} ==> False"
@@ -35,6 +36,7 @@
"x \<in> {1, 2} \<union> {3, 4} ==> x = (1::nat) \<or> x = (2::nat)"
quickcheck[generator=predicate_compile_wo_ff]
oops
+*)
section {* Equivalences *}
@@ -48,7 +50,7 @@
lemma
"is_ten x = is_eleven x"
-quickcheck[tester = predicate_compile_wo_ff, iterations = 1, size = 1, expect = counterexample]
+quickcheck[tester = smart_exhaustive, iterations = 1, size = 1, expect = counterexample]
oops
section {* Context Free Grammar *}
@@ -64,13 +66,13 @@
| "\<lbrakk>v \<in> B\<^sub>1; v \<in> B\<^sub>1\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>1"
lemma
- "w \<in> S\<^sub>1 \<Longrightarrow> w = []"
-quickcheck[tester = predicate_compile_ff_nofs, iterations=1]
+ "S\<^sub>1p w \<Longrightarrow> w = []"
+quickcheck[tester = smart_exhaustive, iterations=1]
oops
theorem S\<^sub>1_sound:
-"w \<in> S\<^sub>1 \<Longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
-quickcheck[generator=predicate_compile_ff_nofs, size=15]
+"S\<^sub>1p w \<Longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
+quickcheck[tester=smart_exhaustive, size=15]
oops
@@ -111,8 +113,8 @@
oops
*)
theorem S\<^sub>2_sound:
-"w \<in> S\<^sub>2 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
-quickcheck[generator=predicate_compile_ff_nofs, size=5, iterations=10]
+"S\<^sub>2p w \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
+quickcheck[tester=smart_exhaustive, size=5, iterations=10]
oops
inductive_set S\<^sub>3 and A\<^sub>3 and B\<^sub>3 where
@@ -123,26 +125,26 @@
| "w \<in> S\<^sub>3 \<Longrightarrow> b # w \<in> B\<^sub>3"
| "\<lbrakk>v \<in> B\<^sub>3; w \<in> B\<^sub>3\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>3"
-code_pred [inductify, skip_proof] S\<^sub>3 .
-thm S\<^sub>3.equation
+code_pred [inductify, skip_proof] S\<^sub>3p .
+thm S\<^sub>3p.equation
(*
values 10 "{x. S\<^sub>3 x}"
*)
lemma S\<^sub>3_sound:
-"w \<in> S\<^sub>3 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
-quickcheck[generator=predicate_compile_ff_fs, size=10, iterations=10]
+"S\<^sub>3p w \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
+quickcheck[tester=smart_exhaustive, size=10, iterations=10]
oops
lemma "\<not> (length w > 2) \<or> \<not> (length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b])"
-quickcheck[size=10, tester = predicate_compile_ff_fs]
+quickcheck[size=10, tester = smart_exhaustive]
oops
theorem S\<^sub>3_complete:
-"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. b = x] \<longrightarrow> w \<in> S\<^sub>3"
+"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. b = x] \<longrightarrow> S\<^sub>3p w"
(*quickcheck[generator=SML]*)
-quickcheck[generator=predicate_compile_ff_fs, size=10, iterations=100]
+quickcheck[tester=smart_exhaustive, size=10, iterations=100]
oops
@@ -156,13 +158,13 @@
| "\<lbrakk>v \<in> B\<^sub>4; w \<in> B\<^sub>4\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>4"
theorem S\<^sub>4_sound:
-"w \<in> S\<^sub>4 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
-quickcheck[tester = predicate_compile_ff_nofs, size=5, iterations=1]
+"S\<^sub>4p w \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
+quickcheck[tester = smart_exhaustive, size=5, iterations=1]
oops
theorem S\<^sub>4_complete:
-"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> w \<in> S\<^sub>4"
-quickcheck[tester = predicate_compile_ff_nofs, size=5, iterations=1]
+"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> S\<^sub>4p w"
+quickcheck[tester = smart_exhaustive, size=5, iterations=1]
oops
hide_const a b
@@ -201,7 +203,7 @@
lemma
"exec c s s' ==> exec (Seq c c) s s'"
- quickcheck[tester = predicate_compile_wo_ff, size=2, iterations=20, expect = counterexample]
+ quickcheck[tester = smart_exhaustive, size=2, iterations=20, expect = counterexample]
oops
subsection {* Lambda *}
@@ -256,7 +258,7 @@
lemma
"\<Gamma> \<turnstile> t : U \<Longrightarrow> t \<rightarrow>\<^sub>\<beta> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : U"
-quickcheck[tester = predicate_compile_ff_fs, size = 7, iterations = 10]
+quickcheck[tester = smart_exhaustive, size = 7, iterations = 10]
oops
subsection {* JAD *}
@@ -281,17 +283,16 @@
unfolding matrix_def by auto
qed
-code_pred [random_dseq inductify] matrix
+code_pred [random_dseq] matrix
apply (cases x)
unfolding matrix_def apply fastforce
apply fastforce done
-
values [random_dseq 2, 2, 15] 6 "{(M::int list list, n, m). matrix M n m}"
definition "scalar_product v w = (\<Sum> (x, y)\<leftarrow>zip v w. x * y)"
-definition mv :: "('a \<Colon> semiring_0) list list \<Rightarrow> 'a list \<Rightarrow> 'a list"
+definition mv :: "('a :: semiring_0) list list \<Rightarrow> 'a list \<Rightarrow> 'a list"
where [simp]: "mv M v = map (scalar_product v) M"
text {*
This defines the matrix vector multiplication. To work properly @{term
@@ -306,7 +307,7 @@
by (auto simp: sparsify_def set_zip)
lemma listsum_sparsify[simp]:
- fixes v :: "('a \<Colon> semiring_0) list"
+ fixes v :: "('a :: semiring_0) list"
assumes "length w = length v"
shows "(\<Sum>x\<leftarrow>sparsify w. (\<lambda>(i, x). v ! i) x * snd x) = scalar_product v w"
(is "(\<Sum>x\<leftarrow>_. ?f x) = _")
@@ -316,11 +317,11 @@
*)
definition [simp]: "unzip w = (map fst w, map snd w)"
-primrec insert :: "('a \<Rightarrow> 'b \<Colon> linorder) => 'a \<Rightarrow> 'a list => 'a list" where
+primrec insert :: "('a \<Rightarrow> 'b :: linorder) => 'a \<Rightarrow> 'a list => 'a list" where
"insert f x [] = [x]" |
"insert f x (y # ys) = (if f y < f x then y # insert f x ys else x # y # ys)"
-primrec sort :: "('a \<Rightarrow> 'b \<Colon> linorder) \<Rightarrow> 'a list => 'a list" where
+primrec sort :: "('a \<Rightarrow> 'b :: linorder) \<Rightarrow> 'a list => 'a list" where
"sort f [] = []" |
"sort f (x # xs) = insert f x (sort f xs)"
@@ -340,12 +341,12 @@
"jad_mv v = inflate o split zip o apsnd (map listsum o transpose o map (map (\<lambda> (i, x). v ! i * x)))"
lemma "matrix (M::int list list) rs cs \<Longrightarrow> False"
-quickcheck[tester = predicate_compile_ff_nofs, size = 6]
+quickcheck[tester = smart_exhaustive, size = 6]
oops
lemma
"\<lbrakk> matrix M rs cs ; length v = cs \<rbrakk> \<Longrightarrow> jad_mv v (jad M) = mv M v"
-quickcheck[tester = predicate_compile_wo_ff]
+quickcheck[tester = smart_exhaustive]
oops
end
--- a/src/HOL/Probability/Binary_Product_Measure.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Binary_Product_Measure.thy Fri Sep 18 16:42:19 2015 +0100
@@ -702,7 +702,7 @@
proof (rule measure_eqI)
interpret A: finite_measure "count_space A" by (rule finite_measure_count_space) fact
interpret B: finite_measure "count_space B" by (rule finite_measure_count_space) fact
- interpret P: pair_sigma_finite "count_space A" "count_space B" by default
+ interpret P: pair_sigma_finite "count_space A" "count_space B" ..
show eq: "sets ?P = sets ?C"
by (simp add: sets_pair_measure sigma_sets_pair_measure_generator_finite A B)
fix X assume X: "X \<in> sets ?P"
@@ -890,7 +890,7 @@
proof -
interpret M1: sigma_finite_measure M1 by fact
interpret M2: sigma_finite_measure M2 by fact
- interpret pair_sigma_finite M1 M2 by default
+ interpret pair_sigma_finite M1 M2 ..
from sigma_finite_up_in_pair_measure_generator guess F :: "nat \<Rightarrow> ('a \<times> 'b) set" .. note F = this
let ?E = "{a \<times> b |a b. a \<in> sets M1 \<and> b \<in> sets M2}"
let ?P = "M1 \<Otimes>\<^sub>M M2"
--- a/src/HOL/Probability/Bochner_Integration.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Bochner_Integration.thy Fri Sep 18 16:42:19 2015 +0100
@@ -2549,7 +2549,7 @@
assumes "integrable (M1 \<Otimes>\<^sub>M M2) f"
shows "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x,y). f (y,x))"
proof -
- interpret Q: pair_sigma_finite M2 M1 by default
+ interpret Q: pair_sigma_finite M2 M1 ..
have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
show ?thesis unfolding *
by (rule integrable_distr[OF measurable_pair_swap'])
@@ -2560,7 +2560,7 @@
fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
shows "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x,y). f (y,x)) \<longleftrightarrow> integrable (M1 \<Otimes>\<^sub>M M2) f"
proof -
- interpret Q: pair_sigma_finite M2 M1 by default
+ interpret Q: pair_sigma_finite M2 M1 ..
from Q.integrable_product_swap[of "\<lambda>(x,y). f (y,x)"] integrable_product_swap[of f]
show ?thesis by auto
qed
@@ -2751,7 +2751,7 @@
and integrable_snd: "integrable M2 (\<lambda>y. \<integral>x. f x y \<partial>M1)" (is "?INT")
and integral_snd: "(\<integral>y. (\<integral>x. f x y \<partial>M1) \<partial>M2) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (split f)" (is "?EQ")
proof -
- interpret Q: pair_sigma_finite M2 M1 by default
+ interpret Q: pair_sigma_finite M2 M1 ..
have Q_int: "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x, y). f y x)"
using f unfolding integrable_product_swap_iff[symmetric] by simp
show ?AE using Q.AE_integrable_fst'[OF Q_int] by simp
@@ -2780,11 +2780,11 @@
and f: "integrable (Pi\<^sub>M (I \<union> J) M) f"
shows "integral\<^sup>L (Pi\<^sub>M (I \<union> J) M) f = (\<integral>x. (\<integral>y. f (merge I J (x, y)) \<partial>Pi\<^sub>M J M) \<partial>Pi\<^sub>M I M)"
proof -
- interpret I: finite_product_sigma_finite M I by default fact
- interpret J: finite_product_sigma_finite M J by default fact
+ interpret I: finite_product_sigma_finite M I by standard fact
+ interpret J: finite_product_sigma_finite M J by standard fact
have "finite (I \<union> J)" using fin by auto
- interpret IJ: finite_product_sigma_finite M "I \<union> J" by default fact
- interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" by default
+ interpret IJ: finite_product_sigma_finite M "I \<union> J" by standard fact
+ interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" ..
let ?M = "merge I J"
let ?f = "\<lambda>x. f (?M x)"
from f have f_borel: "f \<in> borel_measurable (Pi\<^sub>M (I \<union> J) M)"
@@ -2830,7 +2830,7 @@
assumes [simp]: "finite I" and integrable: "\<And>i. i \<in> I \<Longrightarrow> integrable (M i) (f i)"
shows "integrable (Pi\<^sub>M I M) (\<lambda>x. (\<Prod>i\<in>I. f i (x i)))" (is "integrable _ ?f")
proof (unfold integrable_iff_bounded, intro conjI)
- interpret finite_product_sigma_finite M I by default fact
+ interpret finite_product_sigma_finite M I by standard fact
show "?f \<in> borel_measurable (Pi\<^sub>M I M)"
using assms by simp
@@ -2859,7 +2859,7 @@
then have prod: "\<And>J. J \<subseteq> insert i I \<Longrightarrow>
integrable (Pi\<^sub>M J M) (\<lambda>x. (\<Prod>i\<in>J. f i (x i)))"
by (intro product_integrable_setprod insert(4)) (auto intro: finite_subset)
- interpret I: finite_product_sigma_finite M I by default fact
+ interpret I: finite_product_sigma_finite M I by standard fact
have *: "\<And>x y. (\<Prod>j\<in>I. f j (if j = i then y else x j)) = (\<Prod>j\<in>I. f j (x j))"
using `i \<notin> I` by (auto intro!: setprod.cong)
show ?case
--- a/src/HOL/Probability/Embed_Measure.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Embed_Measure.thy Fri Sep 18 16:42:19 2015 +0100
@@ -169,7 +169,7 @@
from A_props and inj have "\<forall>a\<in>op ` f ` A. emeasure (embed_measure M f) a \<noteq> \<infinity>"
by (intro ballI, subst emeasure_embed_measure)
(auto simp: inj_vimage_image_eq intro: in_sets_embed_measure)
- ultimately show ?thesis by - (default, blast)
+ ultimately show ?thesis by - (standard, blast)
qed
lemma embed_measure_count_space':
--- a/src/HOL/Probability/Finite_Product_Measure.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Finite_Product_Measure.thy Fri Sep 18 16:42:19 2015 +0100
@@ -193,7 +193,7 @@
assumes "I = J" "\<And>x. x \<in> I \<Longrightarrow> M x = N x"
shows "PiM I M = PiM J N"
unfolding PiM_def
-proof (rule extend_measure_cong, goals)
+proof (rule extend_measure_cong, goal_cases)
case 1
show ?case using assms
by (subst assms(1), intro PiE_cong[of J "\<lambda>i. space (M i)" "\<lambda>i. space (N i)"]) simp_all
@@ -764,9 +764,9 @@
"finite I \<Longrightarrow> (\<And>i. i\<in>I \<Longrightarrow> A i \<in> sets (M i)) \<Longrightarrow> emeasure (PiM I M) (Pi\<^sub>E I A) = (\<Prod>i\<in>I. emeasure (M i) (A i))"
proof (induct I arbitrary: A rule: finite_induct)
case (insert i I)
- interpret finite_product_sigma_finite M I by default fact
+ interpret finite_product_sigma_finite M I by standard fact
have "finite (insert i I)" using `finite I` by auto
- interpret I': finite_product_sigma_finite M "insert i I" by default fact
+ interpret I': finite_product_sigma_finite M "insert i I" by standard fact
let ?h = "(\<lambda>(f, y). f(i := y))"
let ?P = "distr (Pi\<^sub>M I M \<Otimes>\<^sub>M M i) (Pi\<^sub>M (insert i I) M) ?h"
@@ -821,7 +821,7 @@
assumes "finite I"
shows "sigma_finite_measure (PiM I M)"
proof
- interpret finite_product_sigma_finite M I by default fact
+ interpret finite_product_sigma_finite M I by standard fact
obtain F where F: "\<And>j. countable (F j)" "\<And>j f. f \<in> F j \<Longrightarrow> f \<in> sets (M j)"
"\<And>j f. f \<in> F j \<Longrightarrow> emeasure (M j) f \<noteq> \<infinity>" and
@@ -846,7 +846,7 @@
assumes pos: "0 \<le> f (\<lambda>k. undefined)"
shows "integral\<^sup>N (Pi\<^sub>M {} M) f = f (\<lambda>k. undefined)"
proof -
- interpret finite_product_sigma_finite M "{}" by default (fact finite.emptyI)
+ interpret finite_product_sigma_finite M "{}" by standard (fact finite.emptyI)
have "\<And>A. emeasure (Pi\<^sub>M {} M) (Pi\<^sub>E {} A) = 1"
using assms by (subst measure_times) auto
then show ?thesis
@@ -864,11 +864,11 @@
shows "distr (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) (Pi\<^sub>M (I \<union> J) M) (merge I J) = Pi\<^sub>M (I \<union> J) M"
(is "?D = ?P")
proof -
- interpret I: finite_product_sigma_finite M I by default fact
- interpret J: finite_product_sigma_finite M J by default fact
+ interpret I: finite_product_sigma_finite M I by standard fact
+ interpret J: finite_product_sigma_finite M J by standard fact
have "finite (I \<union> J)" using fin by auto
- interpret IJ: finite_product_sigma_finite M "I \<union> J" by default fact
- interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" by default
+ interpret IJ: finite_product_sigma_finite M "I \<union> J" by standard fact
+ interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" by standard
let ?g = "merge I J"
from IJ.sigma_finite_pairs obtain F where
@@ -928,9 +928,9 @@
shows "integral\<^sup>N (Pi\<^sub>M (I \<union> J) M) f =
(\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. f (merge I J (x, y)) \<partial>(Pi\<^sub>M J M)) \<partial>(Pi\<^sub>M I M))"
proof -
- interpret I: finite_product_sigma_finite M I by default fact
- interpret J: finite_product_sigma_finite M J by default fact
- interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" by default
+ interpret I: finite_product_sigma_finite M I by standard fact
+ interpret J: finite_product_sigma_finite M J by standard fact
+ interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" by standard
have P_borel: "(\<lambda>x. f (merge I J x)) \<in> borel_measurable (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M)"
using measurable_comp[OF measurable_merge f] by (simp add: comp_def)
show ?thesis
@@ -944,7 +944,7 @@
lemma (in product_sigma_finite) distr_singleton:
"distr (Pi\<^sub>M {i} M) (M i) (\<lambda>x. x i) = M i" (is "?D = _")
proof (intro measure_eqI[symmetric])
- interpret I: finite_product_sigma_finite M "{i}" by default simp
+ interpret I: finite_product_sigma_finite M "{i}" by standard simp
fix A assume A: "A \<in> sets (M i)"
then have "(\<lambda>x. x i) -` A \<inter> space (Pi\<^sub>M {i} M) = (\<Pi>\<^sub>E i\<in>{i}. A)"
using sets.sets_into_space by (auto simp: space_PiM)
@@ -957,7 +957,7 @@
assumes f: "f \<in> borel_measurable (M i)"
shows "integral\<^sup>N (Pi\<^sub>M {i} M) (\<lambda>x. f (x i)) = integral\<^sup>N (M i) f"
proof -
- interpret I: finite_product_sigma_finite M "{i}" by default simp
+ interpret I: finite_product_sigma_finite M "{i}" by standard simp
from f show ?thesis
apply (subst distr_singleton[symmetric])
apply (subst nn_integral_distr[OF measurable_component_singleton])
@@ -970,8 +970,8 @@
and f: "f \<in> borel_measurable (Pi\<^sub>M (insert i I) M)"
shows "integral\<^sup>N (Pi\<^sub>M (insert i I) M) f = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. f (x(i := y)) \<partial>(M i)) \<partial>(Pi\<^sub>M I M))"
proof -
- interpret I: finite_product_sigma_finite M I by default auto
- interpret i: finite_product_sigma_finite M "{i}" by default auto
+ interpret I: finite_product_sigma_finite M I by standard auto
+ interpret i: finite_product_sigma_finite M "{i}" by standard auto
have IJ: "I \<inter> {i} = {}" and insert: "I \<union> {i} = insert i I"
using f by auto
show ?thesis
@@ -1008,7 +1008,7 @@
using assms proof induct
case (insert i I)
note `finite I`[intro, simp]
- interpret I: finite_product_sigma_finite M I by default auto
+ interpret I: finite_product_sigma_finite M I by standard auto
have *: "\<And>x y. (\<Prod>j\<in>I. f j (if j = i then y else x j)) = (\<Prod>j\<in>I. f j (x j))"
using insert by (auto intro!: setprod.cong)
have prod: "\<And>J. J \<subseteq> insert i I \<Longrightarrow> (\<lambda>x. (\<Prod>i\<in>J. f i (x i))) \<in> borel_measurable (Pi\<^sub>M J M)"
@@ -1044,7 +1044,7 @@
lemma (in product_sigma_finite) distr_component:
"distr (M i) (Pi\<^sub>M {i} M) (\<lambda>x. \<lambda>i\<in>{i}. x) = Pi\<^sub>M {i} M" (is "?D = ?P")
proof (intro measure_eqI[symmetric])
- interpret I: finite_product_sigma_finite M "{i}" by default simp
+ interpret I: finite_product_sigma_finite M "{i}" by standard simp
have eq: "\<And>x. x \<in> extensional {i} \<Longrightarrow> (\<lambda>j\<in>{i}. x i) = x"
by (auto simp: extensional_def restrict_def)
@@ -1068,8 +1068,8 @@
and emeasure_fold_measurable:
"(\<lambda>x. emeasure (Pi\<^sub>M J M) ((\<lambda>y. merge I J (x, y)) -` A \<inter> space (Pi\<^sub>M J M))) \<in> borel_measurable (Pi\<^sub>M I M)" (is ?B)
proof -
- interpret I: finite_product_sigma_finite M I by default fact
- interpret J: finite_product_sigma_finite M J by default fact
+ interpret I: finite_product_sigma_finite M I by standard fact
+ interpret J: finite_product_sigma_finite M J by standard fact
interpret IJ: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" ..
have merge: "merge I J -` A \<inter> space (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) \<in> sets (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M)"
by (intro measurable_sets[OF _ A] measurable_merge assms)
--- a/src/HOL/Probability/Giry_Monad.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Giry_Monad.thy Fri Sep 18 16:42:19 2015 +0100
@@ -25,7 +25,7 @@
proof
show "emeasure M (space M) \<noteq> \<infinity>" using * by auto
qed
- show "subprob_space M" by default fact+
+ show "subprob_space M" by standard fact+
qed
lemma prob_space_imp_subprob_space:
--- a/src/HOL/Probability/Infinite_Product_Measure.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Infinite_Product_Measure.thy Fri Sep 18 16:42:19 2015 +0100
@@ -50,8 +50,8 @@
have "finite (K - J)" using K by auto
- interpret J: finite_product_prob_space M J by default fact+
- interpret KmJ: finite_product_prob_space M "K - J" by default fact+
+ interpret J: finite_product_prob_space M J by standard fact+
+ interpret KmJ: finite_product_prob_space M "K - J" by standard fact+
have "\<mu>G Z = emeasure (Pi\<^sub>M (J \<union> (K - J)) M) (emb (J \<union> (K - J)) K X)"
using K J by simp
@@ -84,7 +84,7 @@
proof (rule G.caratheodory_empty_continuous[OF positive_mu_G additive_mu_G])
fix A assume "A \<in> ?G"
with generatorE guess J X . note JX = this
- interpret JK: finite_product_prob_space M J by default fact+
+ interpret JK: finite_product_prob_space M J by standard fact+
from JX show "\<mu>G A \<noteq> \<infinity>" by simp
next
fix A assume A: "range A \<subseteq> ?G" "decseq A" "(\<Inter>i. A i) = {}"
@@ -113,7 +113,7 @@
have J_mono: "\<And>n m. n \<le> m \<Longrightarrow> J n \<subseteq> J m"
unfolding J_def by force
- interpret J: finite_product_prob_space M "J i" for i by default fact+
+ interpret J: finite_product_prob_space M "J i" for i by standard fact+
have a_le_1: "?a \<le> 1"
using mu_G_spec[of "J 0" "A 0" "X 0"] J A_eq
@@ -124,7 +124,7 @@
{ fix Z k assume Z: "range Z \<subseteq> ?G" "decseq Z" "\<forall>n. ?a / 2^k \<le> \<mu>G (Z n)"
then have Z_sets: "\<And>n. Z n \<in> ?G" by auto
fix J' assume J': "J' \<noteq> {}" "finite J'" "J' \<subseteq> I"
- interpret J': finite_product_prob_space M J' by default fact+
+ interpret J': finite_product_prob_space M J' by standard fact+
let ?q = "\<lambda>n y. \<mu>G (?M J' (Z n) y)"
let ?Q = "\<lambda>n. ?q n -` {?a / 2^(k+1) ..} \<inter> space (Pi\<^sub>M J' M)"
--- a/src/HOL/Probability/Information.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Information.thy Fri Sep 18 16:42:19 2015 +0100
@@ -311,7 +311,7 @@
shows "0 \<le> KL_divergence b (density M f) (density M g)"
proof -
interpret Mf: prob_space "density M f" by fact
- interpret Mf: information_space "density M f" b by default fact
+ interpret Mf: information_space "density M f" b by standard fact
have eq: "density (density M f) (\<lambda>x. g x / f x) = density M g" (is "?DD = _")
using f g ac by (subst density_density_divide) simp_all
@@ -443,8 +443,8 @@
by (rule prob_space_distr) fact
interpret Y: prob_space "distr M T Y"
by (rule prob_space_distr) fact
- interpret XY: pair_prob_space "distr M S X" "distr M T Y" by default
- interpret P: information_space P b unfolding P_def by default (rule b_gt_1)
+ interpret XY: pair_prob_space "distr M S X" "distr M T Y" by standard
+ interpret P: information_space P b unfolding P_def by standard (rule b_gt_1)
interpret Q: prob_space Q unfolding Q_def
by (rule prob_space_distr) simp
@@ -770,7 +770,7 @@
interpret X: prob_space "distr M S X"
using D(1) by (rule prob_space_distr)
- have sf: "sigma_finite_measure (distr M S X)" by default
+ have sf: "sigma_finite_measure (distr M S X)" by standard
show ?thesis
using D
apply (subst eq_commute)
--- a/src/HOL/Probability/Measure_Space.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Measure_Space.thy Fri Sep 18 16:42:19 2015 +0100
@@ -2078,7 +2078,7 @@
"less_measure M N \<longleftrightarrow> (M \<le> N \<and> \<not> N \<le> M)"
instance
-proof (standard, goals)
+proof (standard, goal_cases)
case 1 then show ?case
unfolding less_measure_def ..
next
--- a/src/HOL/Probability/Nonnegative_Lebesgue_Integration.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Nonnegative_Lebesgue_Integration.thy Fri Sep 18 16:42:19 2015 +0100
@@ -2454,7 +2454,7 @@
lemma (in finite_measure) finite_measure_restricted:
"S \<in> sets M \<Longrightarrow> finite_measure (density M (indicator S))"
- by default (simp add: emeasure_restricted)
+ by standard (simp add: emeasure_restricted)
lemma emeasure_density_const:
"A \<in> sets M \<Longrightarrow> 0 \<le> c \<Longrightarrow> emeasure (density M (\<lambda>_. c)) A = c * emeasure M A"
--- a/src/HOL/Probability/Probability_Mass_Function.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Probability_Mass_Function.thy Fri Sep 18 16:42:19 2015 +0100
@@ -653,7 +653,7 @@
measure (density (count_space UNIV) (ereal \<circ> f)) {x} \<noteq> 0"
by (simp add: AE_density nonneg measure_def emeasure_density max_def)
show "prob_space (density (count_space UNIV) (ereal \<circ> f))"
- by default (simp add: emeasure_density prob)
+ by standard (simp add: emeasure_density prob)
qed simp
lemma pmf_embed_pmf: "pmf embed_pmf x = f x"
--- a/src/HOL/Probability/Probability_Measure.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Probability_Measure.thy Fri Sep 18 16:42:19 2015 +0100
@@ -20,7 +20,7 @@
proof
show "emeasure M (space M) \<noteq> \<infinity>" using * by simp
qed
- show "prob_space M" by default fact
+ show "prob_space M" by standard fact
qed
lemma prob_space_imp_sigma_finite: "prob_space M \<Longrightarrow> sigma_finite_measure M"
@@ -278,7 +278,7 @@
in
go ((x, 0) :: pattern) (bound_dummyT $ tx :: elem) t
end
- | go pattern elem (Const (@{const_syntax case_prod}, _) $ t) =
+ | go pattern elem (Const (@{const_syntax uncurry}, _) $ t) =
go
((Syntax.const @{syntax_const "_pattern"}, 2) :: pattern)
(Syntax.const @{const_syntax Pair} :: elem)
@@ -626,7 +626,7 @@
proof safe
interpret S: sigma_finite_measure S by fact
interpret T: sigma_finite_measure T by fact
- interpret ST: pair_sigma_finite S T by default
+ interpret ST: pair_sigma_finite S T ..
from ST.sigma_finite_up_in_pair_measure_generator guess F :: "nat \<Rightarrow> ('b \<times> 'c) set" .. note F = this
let ?E = "{a \<times> b |a b. a \<in> sets S \<and> b \<in> sets T}"
@@ -666,8 +666,8 @@
proof -
interpret S: sigma_finite_measure S by fact
interpret T: sigma_finite_measure T by fact
- interpret ST: pair_sigma_finite S T by default
- interpret TS: pair_sigma_finite T S by default
+ interpret ST: pair_sigma_finite S T ..
+ interpret TS: pair_sigma_finite T S ..
note Pxy[measurable]
show ?thesis
@@ -715,7 +715,7 @@
proof safe
interpret S: sigma_finite_measure S by fact
interpret T: sigma_finite_measure T by fact
- interpret ST: pair_sigma_finite S T by default
+ interpret ST: pair_sigma_finite S T ..
note Pxy[measurable]
show X: "X \<in> measurable M S" by simp
@@ -792,7 +792,7 @@
proof safe
interpret S: sigma_finite_measure S by fact
interpret T: sigma_finite_measure T by fact
- interpret ST: pair_sigma_finite S T by default
+ interpret ST: pair_sigma_finite S T ..
interpret X: prob_space "density S Px"
unfolding distributed_distr_eq_density[OF X, symmetric]
@@ -1133,7 +1133,7 @@
qed
lemma prob_space_uniform_count_measure: "finite A \<Longrightarrow> A \<noteq> {} \<Longrightarrow> prob_space (uniform_count_measure A)"
- by default (auto simp: emeasure_uniform_count_measure space_uniform_count_measure one_ereal_def)
+ by standard (auto simp: emeasure_uniform_count_measure space_uniform_count_measure one_ereal_def)
lemma (in prob_space) measure_uniform_measure_eq_cond_prob:
assumes [measurable]: "Measurable.pred M P" "Measurable.pred M Q"
--- a/src/HOL/Probability/Radon_Nikodym.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Radon_Nikodym.thy Fri Sep 18 16:42:19 2015 +0100
@@ -993,7 +993,7 @@
note A_in_sets = this
show "sigma_finite_measure ?N"
- proof (default, intro exI conjI ballI)
+ proof (standard, intro exI conjI ballI)
show "countable (range (\<lambda>(i, j). A i \<inter> Q j))"
by auto
show "range (\<lambda>(i, j). A i \<inter> Q j) \<subseteq> sets (density M f)"
--- a/src/HOL/Probability/Sigma_Algebra.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Sigma_Algebra.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1333,7 +1333,7 @@
assumes "N \<subseteq> M"
shows "dynkin \<Omega> N \<subseteq> M"
proof -
- have "dynkin_system \<Omega> M" by default
+ have "dynkin_system \<Omega> M" ..
then have "dynkin_system \<Omega> M"
using assms unfolding dynkin_system_def dynkin_system_axioms_def subset_class_def by simp
with `N \<subseteq> M` show ?thesis by (auto simp add: dynkin_def)
@@ -1432,7 +1432,7 @@
using closed by (rule sigma_algebra_sigma_sets)
from compl[OF _ empty] closed have space: "P \<Omega>" by simp
interpret dynkin_system \<Omega> ?D
- by default (auto dest: sets_into_space intro!: space compl union)
+ by standard (auto dest: sets_into_space intro!: space compl union)
have "sigma_sets \<Omega> G = ?D"
by (rule dynkin_lemma) (auto simp: basic `Int_stable G`)
with A show ?thesis by auto
@@ -1967,7 +1967,7 @@
assume "\<not> (\<forall>i\<in>I. \<mu> i = 0)"
moreover
have "measure_space (space M) (sets M) \<mu>'"
- using ms unfolding measure_space_def by auto default
+ using ms unfolding measure_space_def by auto standard
with ms eq have "\<exists>\<mu>'. P \<mu>'"
unfolding P_def
by (intro exI[of _ \<mu>']) (auto simp add: M space_extend_measure sets_extend_measure)
--- a/src/HOL/Probability/Stream_Space.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/Stream_Space.thy Fri Sep 18 16:42:19 2015 +0100
@@ -160,7 +160,7 @@
lemma (in prob_space) prob_space_stream_space: "prob_space (stream_space M)"
proof -
- interpret product_prob_space "