--- 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 "\<lambda>_. M" UNIV by default
+ interpret product_prob_space "\<lambda>_. M" UNIV ..
show ?thesis
by (subst stream_space_eq_distr) (auto intro!: P.prob_space_distr)
qed
@@ -169,10 +169,8 @@
assumes [measurable]: "f \<in> borel_measurable (stream_space M)"
shows "(\<integral>\<^sup>+X. f X \<partial>stream_space M) = (\<integral>\<^sup>+x. (\<integral>\<^sup>+X. f (x ## X) \<partial>stream_space M) \<partial>M)"
proof -
- interpret S: sequence_space M
- by default
- interpret P: pair_sigma_finite M "\<Pi>\<^sub>M i::nat\<in>UNIV. M"
- by default
+ interpret S: sequence_space M ..
+ interpret P: pair_sigma_finite M "\<Pi>\<^sub>M i::nat\<in>UNIV. M" ..
have "(\<integral>\<^sup>+X. f X \<partial>stream_space M) = (\<integral>\<^sup>+X. f (to_stream X) \<partial>S.S)"
by (subst stream_space_eq_distr) (simp add: nn_integral_distr)
--- a/src/HOL/Probability/ex/Dining_Cryptographers.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/ex/Dining_Cryptographers.thy Fri Sep 18 16:42:19 2015 +0100
@@ -399,7 +399,7 @@
(insert n_gt_3, auto simp: dc_crypto intro: exI[of _ "replicate n True"])
sublocale dining_cryptographers_space \<subseteq> information_space "uniform_count_measure dc_crypto" 2
- by default auto
+ by standard auto
notation (in dining_cryptographers_space)
mutual_information_Pow ("\<I>'( _ ; _ ')")
--- a/src/HOL/Probability/ex/Koepf_Duermuth_Countermeasure.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Probability/ex/Koepf_Duermuth_Countermeasure.thy Fri Sep 18 16:42:19 2015 +0100
@@ -125,10 +125,10 @@
by (auto intro!: setsum_nonneg)
sublocale finite_information \<subseteq> prob_space "point_measure \<Omega> p"
- by default (simp add: one_ereal_def emeasure_point_measure_finite)
+ by standard (simp add: one_ereal_def emeasure_point_measure_finite)
sublocale finite_information \<subseteq> information_space "point_measure \<Omega> p" b
- by default simp
+ by standard simp
lemma (in finite_information) \<mu>'_eq: "A \<subseteq> \<Omega> \<Longrightarrow> prob A = setsum p A"
by (auto simp: measure_point_measure)
@@ -150,7 +150,7 @@
end
sublocale koepf_duermuth \<subseteq> finite_information msgs P b
-proof default
+proof
show "finite msgs" unfolding msgs_def
using finite_lists_length_eq[OF M.finite_space, of n]
by auto
--- a/src/HOL/Product_Type.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Product_Type.thy Fri Sep 18 16:42:19 2015 +0100
@@ -240,7 +240,7 @@
lemma prod_cases: "(\<And>a b. P (Pair a b)) \<Longrightarrow> P p"
by (cases p) (auto simp add: prod_def Pair_def Pair_Rep_def)
-free_constructors case_prod for Pair fst snd
+free_constructors uncurry for Pair fst snd
proof -
fix P :: bool and p :: "'a \<times> 'b"
show "(\<And>x1 x2. p = Pair x1 x2 \<Longrightarrow> P) \<Longrightarrow> P"
@@ -300,90 +300,16 @@
"_patterns" :: "[pttrn, patterns] => patterns" ("_,/ _")
translations
- "(x, y)" == "CONST Pair x y"
- "_pattern x y" => "CONST Pair x y"
- "_patterns x y" => "CONST Pair x y"
- "_tuple x (_tuple_args y z)" == "_tuple x (_tuple_arg (_tuple y z))"
- "%(x, y, zs). b" == "CONST case_prod (%x (y, zs). b)"
- "%(x, y). b" == "CONST case_prod (%x y. b)"
- "_abs (CONST Pair x y) t" => "%(x, y). t"
-
-
-
-
-
- -- \<open>The last rule accommodates tuples in `case C ... (x,y) ... => ...'
- The (x,y) is parsed as `Pair x y' because it is logic, not pttrn\<close>
-
-(*reconstruct pattern from (nested) splits, avoiding eta-contraction of body;
- works best with enclosing "let", if "let" does not avoid eta-contraction*)
-print_translation \<open>
- let
- fun split_tr' [Abs (x, T, t as (Abs abs))] =
- (* split (%x y. t) => %(x,y) t *)
- let
- val (y, t') = Syntax_Trans.atomic_abs_tr' abs;
- val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, T, t');
- in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
- end
- | split_tr' [Abs (x, T, (s as Const (@{const_syntax case_prod}, _) $ t))] =
- (* split (%x. (split (%y z. t))) => %(x,y,z). t *)
- let
- val Const (@{syntax_const "_abs"}, _) $
- (Const (@{syntax_const "_pattern"}, _) $ y $ z) $ t' = split_tr' [t];
- val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, T, t');
- in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $
- (Syntax.const @{syntax_const "_patterns"} $ y $ z)) $ t''
- end
- | split_tr' [Const (@{const_syntax case_prod}, _) $ t] =
- (* split (split (%x y z. t)) => %((x, y), z). t *)
- split_tr' [(split_tr' [t])] (* inner split_tr' creates next pattern *)
- | split_tr' [Const (@{syntax_const "_abs"}, _) $ x_y $ Abs abs] =
- (* split (%pttrn z. t) => %(pttrn,z). t *)
- let val (z, t) = Syntax_Trans.atomic_abs_tr' abs in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x_y $ z) $ t
- end
- | split_tr' _ = raise Match;
- in [(@{const_syntax case_prod}, K split_tr')] end
-\<close>
-
-(* print "split f" as "\<lambda>(x,y). f x y" and "split (\<lambda>x. f x)" as "\<lambda>(x,y). f x y" *)
-typed_print_translation \<open>
- let
- fun split_guess_names_tr' T [Abs (x, _, Abs _)] = raise Match
- | split_guess_names_tr' T [Abs (x, xT, t)] =
- (case (head_of t) of
- Const (@{const_syntax case_prod}, _) => raise Match
- | _ =>
- let
- val (_ :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
- val (y, t') = Syntax_Trans.atomic_abs_tr' ("y", yT, incr_boundvars 1 t $ Bound 0);
- val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, xT, t');
- in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
- end)
- | split_guess_names_tr' T [t] =
- (case head_of t of
- Const (@{const_syntax case_prod}, _) => raise Match
- | _ =>
- let
- val (xT :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
- val (y, t') =
- Syntax_Trans.atomic_abs_tr' ("y", yT, incr_boundvars 2 t $ Bound 1 $ Bound 0);
- val (x', t'') = Syntax_Trans.atomic_abs_tr' ("x", xT, t');
- in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
- end)
- | split_guess_names_tr' _ _ = raise Match;
- in [(@{const_syntax case_prod}, K split_guess_names_tr')] end
-\<close>
+ "(x, y)" \<rightleftharpoons> "CONST Pair x y"
+ "_pattern x y" \<rightleftharpoons> "CONST Pair x y"
+ "_patterns x y" \<rightleftharpoons> "CONST Pair x y"
+ "_tuple x (_tuple_args y z)" \<rightleftharpoons> "_tuple x (_tuple_arg (_tuple y z))"
+ "\<lambda>(x, y, zs). b" \<rightleftharpoons> "CONST uncurry (\<lambda>x (y, zs). b)"
+ "\<lambda>(x, y). b" \<rightleftharpoons> "CONST uncurry (\<lambda>x y. b)"
+ "_abs (CONST Pair x y) t" \<rightharpoonup> "\<lambda>(x, y). t"
+ -- \<open>This rule accommodates tuples in @{text "case C \<dots> (x, y) \<dots> \<Rightarrow> \<dots>"}:
+ The @{text "(x, y)"} is parsed as @{text "Pair x y"} because it is @{text logic},
+ not @{text pttrn}.\<close>
subsubsection \<open>Code generator setup\<close>
@@ -420,7 +346,7 @@
constant fst \<rightharpoonup> (Haskell) "fst"
| constant snd \<rightharpoonup> (Haskell) "snd"
-lemma case_prod_unfold [nitpick_unfold]: "case_prod = (%c p. c (fst p) (snd p))"
+lemma case_prod_unfold [nitpick_unfold]: "uncurry = (%c p. c (fst p) (snd p))"
by (simp add: fun_eq_iff split: prod.split)
lemma fst_eqD: "fst (x, y) = a ==> x = a"
@@ -437,29 +363,29 @@
lemma prod_eqI [intro?]: "fst p = fst q \<Longrightarrow> snd p = snd q \<Longrightarrow> p = q"
by (simp add: prod_eq_iff)
-lemma split_conv [simp, code]: "case_prod f (a, b) = f a b"
+lemma split_conv [simp, code]: "(case (a, b) of (c, d) \<Rightarrow> f c d) = f a b"
by (fact prod.case)
-lemma splitI: "f a b \<Longrightarrow> case_prod f (a, b)"
+lemma splitI: "f a b \<Longrightarrow> case (a, b) of (c, d) \<Rightarrow> f c d"
by (rule split_conv [THEN iffD2])
-lemma splitD: "case_prod f (a, b) \<Longrightarrow> f a b"
+lemma splitD: "(case (a, b) of (c, d) \<Rightarrow> f c d) \<Longrightarrow> f a b"
by (rule split_conv [THEN iffD1])
-lemma split_Pair [simp]: "(\<lambda>(x, y). (x, y)) = id"
+lemma split_Pair [simp]: "uncurry Pair = id"
by (simp add: fun_eq_iff split: prod.split)
lemma split_eta: "(\<lambda>(x, y). f (x, y)) = f"
-- \<open>Subsumes the old @{text split_Pair} when @{term f} is the identity function.\<close>
by (simp add: fun_eq_iff split: prod.split)
-lemma split_comp: "case_prod (f \<circ> g) x = f (g (fst x)) (snd x)"
+lemma split_comp: "(case x of (a, b) \<Rightarrow> (f \<circ> g) a b) = f (g (fst x)) (snd x)"
by (cases x) simp
-lemma split_twice: "case_prod f (case_prod g p) = case_prod (\<lambda>x y. case_prod f (g x y)) p"
+lemma split_twice: "uncurry f (uncurry g p) = uncurry (\<lambda>x y. uncurry f (g x y)) p"
by (fact prod.case_distrib)
-lemma The_split: "The (case_prod P) = (THE xy. P (fst xy) (snd xy))"
+lemma The_split: "The (uncurry P) = (THE xy. P (fst xy) (snd xy))"
by (simp add: case_prod_unfold)
lemmas split_weak_cong = prod.case_cong_weak
@@ -479,7 +405,7 @@
from \<open>PROP P (fst x, snd x)\<close> show "PROP P x" by simp
qed
-lemma case_prod_distrib: "f (case x of (x, y) \<Rightarrow> g x y) = (case x of (x, y) \<Rightarrow> f (g x y))"
+lemma uncurry_distrib: "f (case x of (x, y) \<Rightarrow> g x y) = (case x of (x, y) \<Rightarrow> f (g x y))"
by (cases x) simp
text \<open>
@@ -551,7 +477,7 @@
| no_args k i (Bound m) = m < k orelse m > k + i
| no_args _ _ _ = true;
fun split_pat tp i (Abs (_, _, t)) = if tp 0 i t then SOME (i, t) else NONE
- | split_pat tp i (Const (@{const_name case_prod}, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
+ | split_pat tp i (Const (@{const_name uncurry}, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
| split_pat tp i _ = NONE;
fun metaeq ctxt lhs rhs = mk_meta_eq (Goal.prove ctxt [] []
(HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)))
@@ -569,12 +495,12 @@
else (subst arg k i t $ subst arg k i u)
| subst arg k i t = t;
in
- fun beta_proc ctxt (s as Const (@{const_name case_prod}, _) $ Abs (_, _, t) $ arg) =
+ fun beta_proc ctxt (s as Const (@{const_name uncurry}, _) $ Abs (_, _, t) $ arg) =
(case split_pat beta_term_pat 1 t of
SOME (i, f) => SOME (metaeq ctxt s (subst arg 0 i f))
| NONE => NONE)
| beta_proc _ _ = NONE;
- fun eta_proc ctxt (s as Const (@{const_name case_prod}, _) $ Abs (_, _, t)) =
+ fun eta_proc ctxt (s as Const (@{const_name uncurry}, _) $ Abs (_, _, t)) =
(case split_pat eta_term_pat 1 t of
SOME (_, ft) => SOME (metaeq ctxt s (let val f $ _ = ft in f end))
| NONE => NONE)
@@ -604,31 +530,31 @@
lemmas split_split_asm [no_atp] = prod.split_asm
text \<open>
- \medskip @{const case_prod} used as a logical connective or set former.
+ \medskip @{const uncurry} used as a logical connective or set former.
\medskip These rules are for use with @{text blast}; could instead
call @{text simp} using @{thm [source] prod.split} as rewrite.\<close>
-lemma splitI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> case_prod c p"
+lemma splitI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> case p of (a, b) \<Rightarrow> c a b"
apply (simp only: split_tupled_all)
apply (simp (no_asm_simp))
done
-lemma splitI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> case_prod c p x"
+lemma splitI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> (case p of (a, b) \<Rightarrow> c a b) x"
apply (simp only: split_tupled_all)
apply (simp (no_asm_simp))
done
-lemma splitE: "case_prod c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
+lemma splitE: "(case p of (a, b) \<Rightarrow> c a b) ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
by (induct p) auto
-lemma splitE': "case_prod c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
+lemma splitE': "(case p of (a, b) \<Rightarrow> c a b) z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
by (induct p) auto
lemma splitE2:
- "[| Q (case_prod P z); !!x y. [|z = (x, y); Q (P x y)|] ==> R |] ==> R"
+ "[| Q (case z of (a, b) \<Rightarrow> P a b); !!x y. [|z = (x, y); Q (P x y)|] ==> R |] ==> R"
proof -
- assume q: "Q (case_prod P z)"
+ assume q: "Q (uncurry P z)"
assume r: "!!x y. [|z = (x, y); Q (P x y)|] ==> R"
show R
apply (rule r surjective_pairing)+
@@ -636,17 +562,20 @@
done
qed
-lemma splitD': "case_prod R (a,b) c ==> R a b c"
- by simp
-
-lemma mem_splitI: "z: c a b ==> z: case_prod c (a, b)"
+lemma splitD':
+ "(case (a, b) of (c, d) \<Rightarrow> R c d) c \<Longrightarrow> R a b c"
by simp
-lemma mem_splitI2: "!!p. [| !!a b. p = (a, b) ==> z: c a b |] ==> z: case_prod c p"
-by (simp only: split_tupled_all, simp)
+lemma mem_splitI:
+ "z \<in> c a b \<Longrightarrow> z \<in> (case (a, b) of (d, e) \<Rightarrow> c d e)"
+ by simp
+
+lemma mem_splitI2:
+ "\<And>p. (\<And>a b. p = (a, b) \<Longrightarrow> z \<in> c a b) \<Longrightarrow> z \<in> (case p of (a, b) \<Rightarrow> c a b)"
+ by (simp only: split_tupled_all) simp
lemma mem_splitE:
- assumes "z \<in> case_prod c p"
+ assumes "z \<in> uncurry c p"
obtains x y where "p = (x, y)" and "z \<in> c x y"
using assms by (rule splitE2)
@@ -655,7 +584,7 @@
ML \<open>
local (* filtering with exists_p_split is an essential optimization *)
- fun exists_p_split (Const (@{const_name case_prod},_) $ _ $ (Const (@{const_name Pair},_)$_$_)) = true
+ fun exists_p_split (Const (@{const_name uncurry},_) $ _ $ (Const (@{const_name Pair},_)$_$_)) = true
| exists_p_split (t $ u) = exists_p_split t orelse exists_p_split u
| exists_p_split (Abs (_, _, t)) = exists_p_split t
| exists_p_split _ = false;
@@ -674,10 +603,10 @@
lemma split_eta_SetCompr [simp, no_atp]: "(%u. EX x y. u = (x, y) & P (x, y)) = P"
by (rule ext) fast
-lemma split_eta_SetCompr2 [simp, no_atp]: "(%u. EX x y. u = (x, y) & P x y) = case_prod P"
+lemma split_eta_SetCompr2 [simp, no_atp]: "(%u. EX x y. u = (x, y) & P x y) = uncurry P"
by (rule ext) fast
-lemma split_part [simp]: "(%(a,b). P & Q a b) = (%ab. P & case_prod Q ab)"
+lemma split_part [simp]: "(%(a,b). P & Q a b) = (%ab. P & uncurry Q ab)"
-- \<open>Allows simplifications of nested splits in case of independent predicates.\<close>
by (rule ext) blast
@@ -687,7 +616,7 @@
*)
lemma split_comp_eq:
fixes f :: "'a => 'b => 'c" and g :: "'d => 'a"
- shows "(%u. f (g (fst u)) (snd u)) = (case_prod (%x. f (g x)))"
+ shows "(%u. f (g (fst u)) (snd u)) = (uncurry (%x. f (g x)))"
by (rule ext) auto
lemma pair_imageI [intro]: "(a, b) : A ==> f a b : (%(a, b). f a b) ` A"
@@ -717,22 +646,22 @@
lemmas case_prodI = prod.case [THEN iffD2]
-lemma case_prodI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> case_prod c p"
+lemma case_prodI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> uncurry c p"
by (fact splitI2)
-lemma case_prodI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> case_prod c p x"
+lemma case_prodI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> uncurry c p x"
by (fact splitI2')
-lemma case_prodE: "case_prod c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
+lemma case_prodE: "uncurry c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
by (fact splitE)
-lemma case_prodE': "case_prod c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
+lemma case_prodE': "uncurry c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
by (fact splitE')
declare case_prodI [intro!]
lemma case_prod_beta:
- "case_prod f p = f (fst p) (snd p)"
+ "uncurry f p = f (fst p) (snd p)"
by (fact split_beta)
lemma prod_cases3 [cases type]:
@@ -776,7 +705,7 @@
by (cases x) blast
definition internal_split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
- "internal_split == case_prod"
+ "internal_split == uncurry"
lemma internal_split_conv: "internal_split c (a, b) = c a b"
by (simp only: internal_split_def split_conv)
@@ -803,10 +732,10 @@
lemma curryE: "curry f a b \<Longrightarrow> (f (a, b) \<Longrightarrow> Q) \<Longrightarrow> Q"
by (simp add: curry_def)
-lemma curry_split [simp]: "curry (case_prod f) = f"
+lemma curry_split [simp]: "curry (uncurry f) = f"
by (simp add: curry_def case_prod_unfold)
-lemma split_curry [simp]: "case_prod (curry f) = f"
+lemma split_curry [simp]: "uncurry (curry f) = f"
by (simp add: curry_def case_prod_unfold)
lemma curry_K: "curry (\<lambda>x. c) = (\<lambda>x y. c)"
@@ -819,12 +748,12 @@
notation fcomp (infixl "\<circ>>" 60)
definition scomp :: "('a \<Rightarrow> 'b \<times> 'c) \<Rightarrow> ('b \<Rightarrow> 'c \<Rightarrow> 'd) \<Rightarrow> 'a \<Rightarrow> 'd" (infixl "\<circ>\<rightarrow>" 60) where
- "f \<circ>\<rightarrow> g = (\<lambda>x. case_prod g (f x))"
+ "f \<circ>\<rightarrow> g = (\<lambda>x. uncurry g (f x))"
lemma scomp_unfold: "scomp = (\<lambda>f g x. g (fst (f x)) (snd (f x)))"
by (simp add: fun_eq_iff scomp_def case_prod_unfold)
-lemma scomp_apply [simp]: "(f \<circ>\<rightarrow> g) x = case_prod g (f x)"
+lemma scomp_apply [simp]: "(f \<circ>\<rightarrow> g) x = uncurry g (f x)"
by (simp add: scomp_unfold case_prod_unfold)
lemma Pair_scomp: "Pair x \<circ>\<rightarrow> f = f x"
@@ -1118,44 +1047,52 @@
by (blast elim: equalityE)
lemma SetCompr_Sigma_eq:
- "Collect (case_prod (%x y. P x & Q x y)) = (SIGMA x:Collect P. Collect (Q x))"
+ "{(x, y). P x \<and> Q x y} = (SIGMA x:Collect P. Collect (Q x))"
by blast
-lemma Collect_split [simp]: "{(a,b). P a & Q b} = Collect P <*> Collect Q"
+lemma Collect_split [simp]:
+ "{(a, b). P a \<and> Q b} = Collect P \<times> Collect Q "
by (fact SetCompr_Sigma_eq)
lemma UN_Times_distrib:
- "(UN (a,b):(A <*> B). E a <*> F b) = (UNION A E) <*> (UNION B F)"
+ "(\<Union>(a, b)\<in>A \<times> B. E a \<times> F b) = UNION A E \<times> UNION B F"
-- \<open>Suggested by Pierre Chartier\<close>
by blast
lemma split_paired_Ball_Sigma [simp, no_atp]:
- "(ALL z: Sigma A B. P z) = (ALL x:A. ALL y: B x. P(x,y))"
+ "(\<forall>z\<in>Sigma A B. P z) \<longleftrightarrow> (\<forall>x\<in>A. \<forall>y\<in>B x. P (x, y))"
by blast
lemma split_paired_Bex_Sigma [simp, no_atp]:
- "(EX z: Sigma A B. P z) = (EX x:A. EX y: B x. P(x,y))"
+ "(\<exists>z\<in>Sigma A B. P z) \<longleftrightarrow> (\<exists>x\<in>A. \<exists>y\<in>B x. P (x, y))"
+ by blast
+
+lemma Sigma_Un_distrib1:
+ "Sigma (I \<union> J) C = Sigma I C \<union> Sigma J C"
by blast
-lemma Sigma_Un_distrib1: "(SIGMA i:I Un J. C(i)) = (SIGMA i:I. C(i)) Un (SIGMA j:J. C(j))"
+lemma Sigma_Un_distrib2:
+ "(SIGMA i:I. A i \<union> B i) = Sigma I A \<union> Sigma I B"
by blast
-lemma Sigma_Un_distrib2: "(SIGMA i:I. A(i) Un B(i)) = (SIGMA i:I. A(i)) Un (SIGMA i:I. B(i))"
+lemma Sigma_Int_distrib1:
+ "Sigma (I \<inter> J) C = Sigma I C \<inter> Sigma J C"
by blast
-lemma Sigma_Int_distrib1: "(SIGMA i:I Int J. C(i)) = (SIGMA i:I. C(i)) Int (SIGMA j:J. C(j))"
- by blast
-
-lemma Sigma_Int_distrib2: "(SIGMA i:I. A(i) Int B(i)) = (SIGMA i:I. A(i)) Int (SIGMA i:I. B(i))"
+lemma Sigma_Int_distrib2:
+ "(SIGMA i:I. A i \<inter> B i) = Sigma I A \<inter> Sigma I B"
by blast
-lemma Sigma_Diff_distrib1: "(SIGMA i:I - J. C(i)) = (SIGMA i:I. C(i)) - (SIGMA j:J. C(j))"
+lemma Sigma_Diff_distrib1:
+ "Sigma (I - J) C = Sigma I C - Sigma J C"
by blast
-lemma Sigma_Diff_distrib2: "(SIGMA i:I. A(i) - B(i)) = (SIGMA i:I. A(i)) - (SIGMA i:I. B(i))"
+lemma Sigma_Diff_distrib2:
+ "(SIGMA i:I. A i - B i) = Sigma I A - Sigma I B"
by blast
-lemma Sigma_Union: "Sigma (Union X) B = (UN A:X. Sigma A B)"
+lemma Sigma_Union:
+ "Sigma (\<Union>X) B = (\<Union>A\<in>X. Sigma A B)"
by blast
text \<open>
@@ -1163,25 +1100,32 @@
matching, especially when the rules are re-oriented.
\<close>
-lemma Times_Un_distrib1: "(A Un B) <*> C = (A <*> C) Un (B <*> C)"
+lemma Times_Un_distrib1:
+ "(A \<union> B) \<times> C = A \<times> C \<union> B \<times> C "
by (fact Sigma_Un_distrib1)
-lemma Times_Int_distrib1: "(A Int B) <*> C = (A <*> C) Int (B <*> C)"
+lemma Times_Int_distrib1:
+ "(A \<inter> B) \<times> C = A \<times> C \<inter> B \<times> C "
by (fact Sigma_Int_distrib1)
-lemma Times_Diff_distrib1: "(A - B) <*> C = (A <*> C) - (B <*> C)"
+lemma Times_Diff_distrib1:
+ "(A - B) \<times> C = A \<times> C - B \<times> C "
by (fact Sigma_Diff_distrib1)
-lemma Times_empty[simp]: "A \<times> B = {} \<longleftrightarrow> A = {} \<or> B = {}"
+lemma Times_empty [simp]:
+ "A \<times> B = {} \<longleftrightarrow> A = {} \<or> B = {}"
by auto
-lemma times_eq_iff: "A \<times> B = C \<times> D \<longleftrightarrow> A = C \<and> B = D \<or> ((A = {} \<or> B = {}) \<and> (C = {} \<or> D = {}))"
+lemma times_eq_iff:
+ "A \<times> B = C \<times> D \<longleftrightarrow> A = C \<and> B = D \<or> (A = {} \<or> B = {}) \<and> (C = {} \<or> D = {})"
by auto
-lemma fst_image_times[simp]: "fst ` (A \<times> B) = (if B = {} then {} else A)"
+lemma fst_image_times [simp]:
+ "fst ` (A \<times> B) = (if B = {} then {} else A)"
by force
-lemma snd_image_times[simp]: "snd ` (A \<times> B) = (if A = {} then {} else B)"
+lemma snd_image_times [simp]:
+ "snd ` (A \<times> B) = (if A = {} then {} else B)"
by force
lemma vimage_fst:
@@ -1195,15 +1139,18 @@
lemma insert_times_insert[simp]:
"insert a A \<times> insert b B =
insert (a,b) (A \<times> insert b B \<union> insert a A \<times> B)"
-by blast
+ by blast
-lemma vimage_Times: "f -` (A \<times> B) = ((fst \<circ> f) -` A) \<inter> ((snd \<circ> f) -` B)"
- apply auto
- apply (case_tac "f x")
- apply auto
- done
+lemma vimage_Times:
+ "f -` (A \<times> B) = (fst \<circ> f) -` A \<inter> (snd \<circ> f) -` B"
+proof (rule set_eqI)
+ fix x
+ show "x \<in> f -` (A \<times> B) \<longleftrightarrow> x \<in> (fst \<circ> f) -` A \<inter> (snd \<circ> f) -` B"
+ by (cases "f x") (auto split: prod.split)
+qed
-lemma times_Int_times: "A \<times> B \<inter> C \<times> D = (A \<inter> C) \<times> (B \<inter> D)"
+lemma times_Int_times:
+ "A \<times> B \<inter> C \<times> D = (A \<inter> C) \<times> (B \<inter> D)"
by auto
lemma product_swap:
@@ -1234,15 +1181,18 @@
lemma inj_apsnd [simp]: "inj (apsnd f) \<longleftrightarrow> inj f"
using inj_on_apsnd[of f UNIV] by simp
-definition product :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<times> 'b) set" where
+context
+begin
+
+qualified definition product :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<times> 'b) set" where
[code_abbrev]: "product A B = A \<times> B"
-hide_const (open) product
-
lemma member_product:
"x \<in> Product_Type.product A B \<longleftrightarrow> x \<in> A \<times> B"
- by (simp add: product_def)
+ by (simp add: Product_Type.product_def)
+end
+
text \<open>The following @{const map_prod} lemmas are due to Joachim Breitner:\<close>
lemma map_prod_inj_on:
@@ -1311,8 +1261,10 @@
setup \<open>
Code_Preproc.map_pre (fn ctxt => ctxt addsimprocs
- [Raw_Simplifier.make_simproc {name = "set comprehension", lhss = [@{cpat "Collect ?P"}],
- proc = K Set_Comprehension_Pointfree.code_simproc, identifier = []}])
+ [Simplifier.make_simproc @{context} "set comprehension"
+ {lhss = [@{term "Collect P"}],
+ proc = K Set_Comprehension_Pointfree.code_simproc,
+ identifier = []}])
\<close>
@@ -1355,8 +1307,11 @@
subsection \<open>Legacy theorem bindings and duplicates\<close>
+abbreviation (input) case_prod :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
+ "case_prod \<equiv> uncurry"
+
abbreviation (input) split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
- "split \<equiv> case_prod"
+ "split \<equiv> uncurry"
lemmas PairE = prod.exhaust
lemmas Pair_eq = prod.inject
--- a/src/HOL/Quickcheck_Examples/Quickcheck_Examples.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Quickcheck_Examples/Quickcheck_Examples.thy Fri Sep 18 16:42:19 2015 +0100
@@ -478,8 +478,8 @@
fixes R
assumes "R x y --> R y x --> x = y"
-interpretation equal : antisym "op =" by default simp
-interpretation order_nat : antisym "op <= :: nat => _ => _" by default simp
+interpretation equal : antisym "op =" by standard simp
+interpretation order_nat : antisym "op <= :: nat => _ => _" by standard simp
lemma (in antisym)
"R x y --> R y z --> R x z"
--- a/src/HOL/Quickcheck_Exhaustive.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Quickcheck_Exhaustive.thy Fri Sep 18 16:42:19 2015 +0100
@@ -646,11 +646,6 @@
hide_fact (open) orelse_def
no_notation orelse (infixr "orelse" 55)
-hide_fact
- exhaustive_int'_def
- exhaustive_integer'_def
- exhaustive_natural'_def
-
hide_const valtermify_absdummy valtermify_fun_upd valterm_emptyset valtermify_insert valtermify_pair
valtermify_Inl valtermify_Inr
termify_fun_upd term_emptyset termify_insert termify_pair setify
--- a/src/HOL/Quotient_Examples/Lifting_Code_Dt_Test.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Quotient_Examples/Lifting_Code_Dt_Test.thy Fri Sep 18 16:42:19 2015 +0100
@@ -91,7 +91,7 @@
datatype ('a::finite, 'b::finite) F = F 'a | F2 'b
-instance T :: (finite) finite by (default, transfer, auto)
+instance T :: (finite) finite by standard (transfer, auto)
lift_definition(code_dt) f17 :: "bool \<Rightarrow> (bool T, 'b::finite) F" is "\<lambda>b. F b" by auto
--- a/src/HOL/Quotient_Examples/Quotient_Int.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Quotient_Examples/Quotient_Int.thy Fri Sep 18 16:42:19 2015 +0100
@@ -188,8 +188,7 @@
"(sup :: int \<Rightarrow> int \<Rightarrow> int) = max"
instance
- by default
- (auto simp add: inf_int_def sup_int_def max_min_distrib2)
+ by standard (auto simp add: inf_int_def sup_int_def max_min_distrib2)
end
--- a/src/HOL/ROOT Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ROOT Fri Sep 18 16:42:19 2015 +0100
@@ -14,7 +14,7 @@
"root.bib"
"root.tex"
-session "HOL-Proofs" = Pure +
+session "HOL-Proofs" (slow) = Pure +
description {*
HOL-Main with explicit proof terms.
*}
@@ -975,15 +975,14 @@
theories
Examples
Predicate_Compile_Tests
- (* FIXME
- Predicate_Compile_Quickcheck_Examples -- should be added again soon (since 21-Oct-2010) *)
+ Predicate_Compile_Quickcheck_Examples
Specialisation_Examples
IMP_1
IMP_2
(* FIXME since 21-Jul-2011
- Hotel_Example_Small_Generator
+ Hotel_Example_Small_Generator *)
IMP_3
- IMP_4 *)
+ IMP_4
theories [condition = "ISABELLE_SWIPL"]
Code_Prolog_Examples
Context_Free_Grammar_Example
--- a/src/HOL/Rat.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Rat.thy Fri Sep 18 16:42:19 2015 +0100
@@ -629,7 +629,7 @@
@{thm minus_divide_left} RS sym, @{thm minus_divide_right} RS sym,
@{thm of_int_minus}, @{thm of_int_diff},
@{thm of_int_of_nat_eq}]
- #> Lin_Arith.add_simprocs Numeral_Simprocs.field_divide_cancel_numeral_factor
+ #> Lin_Arith.add_simprocs [Numeral_Simprocs.field_divide_cancel_numeral_factor]
#> Lin_Arith.add_inj_const (@{const_name of_nat}, @{typ "nat => rat"})
#> Lin_Arith.add_inj_const (@{const_name of_int}, @{typ "int => rat"}))
\<close>
--- a/src/HOL/Real_Vector_Spaces.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Real_Vector_Spaces.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1294,7 +1294,7 @@
assumes "\<And>x y. f (x + y) = f x + f y"
assumes "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
shows "linear f"
- by default (rule assms)+
+ by standard (rule assms)+
locale bounded_linear = linear f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
assumes bounded: "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
@@ -1334,7 +1334,7 @@
assumes "\<And>r x. f (scaleR r x) = scaleR r (f x)"
assumes "\<And>x. norm (f x) \<le> norm x * K"
shows "bounded_linear f"
- by default (fast intro: assms)+
+ by standard (fast intro: assms)+
locale bounded_bilinear =
fixes prod :: "['a::real_normed_vector, 'b::real_normed_vector]
@@ -1415,10 +1415,10 @@
end
lemma bounded_linear_ident[simp]: "bounded_linear (\<lambda>x. x)"
- by default (auto intro!: exI[of _ 1])
+ by standard (auto intro!: exI[of _ 1])
lemma bounded_linear_zero[simp]: "bounded_linear (\<lambda>x. 0)"
- by default (auto intro!: exI[of _ 1])
+ by standard (auto intro!: exI[of _ 1])
lemma bounded_linear_add:
assumes "bounded_linear f"
@@ -1859,7 +1859,7 @@
class banach = real_normed_vector + complete_space
-instance real :: banach by default
+instance real :: banach ..
lemma tendsto_at_topI_sequentially:
fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
--- a/src/HOL/Relation.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Relation.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1116,7 +1116,7 @@
assumes "finite A"
shows "Id_on A = Finite_Set.fold (\<lambda>x. Set.insert (Pair x x)) {} A"
proof -
- interpret comp_fun_commute "\<lambda>x. Set.insert (Pair x x)" by default auto
+ interpret comp_fun_commute "\<lambda>x. Set.insert (Pair x x)" by standard auto
show ?thesis using assms unfolding Id_on_def by (induct A) simp_all
qed
@@ -1126,7 +1126,7 @@
interpret comp_fun_idem Set.insert
by (fact comp_fun_idem_insert)
show ?thesis
- by default (auto simp add: fun_eq_iff comp_fun_commute split:prod.split)
+ by standard (auto simp add: fun_eq_iff comp_fun_commute split:prod.split)
qed
lemma Image_fold:
@@ -1148,7 +1148,7 @@
proof -
interpret comp_fun_idem Set.insert by (fact comp_fun_idem_insert)
show "comp_fun_commute (\<lambda>(w,z) A'. if snd x = w then Set.insert (fst x,z) A' else A')"
- by default (auto simp add: fun_eq_iff split:prod.split)
+ by standard (auto simp add: fun_eq_iff split:prod.split)
qed
have *: "{x} O S = {(x', z). x' = fst x \<and> (snd x,z) \<in> S}" by (auto simp: relcomp_unfold intro!: exI)
show ?thesis unfolding *
@@ -1172,7 +1172,7 @@
have *: "\<And>a b A.
Finite_Set.fold (\<lambda>(w, z) A'. if b = w then Set.insert (a, z) A' else A') A S = {(a,b)} O S \<union> A"
by (auto simp: insert_relcomp_union_fold[OF assms] cong: if_cong)
- show ?thesis by default (auto simp: *)
+ show ?thesis by standard (auto simp: *)
qed
lemma relcomp_fold:
--- a/src/HOL/SPARK/Manual/Reference.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/SPARK/Manual/Reference.thy Fri Sep 18 16:42:19 2015 +0100
@@ -4,7 +4,7 @@
begin
syntax (my_constrain output)
- "_constrain" :: "logic => type => logic" ("_ \<Colon> _" [4, 0] 3)
+ "_constrain" :: "logic => type => logic" ("_ :: _" [4, 0] 3)
(*>*)
chapter {* HOL-\SPARK{} Reference *}
--- a/src/HOL/Semiring_Normalization.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Semiring_Normalization.thy Fri Sep 18 16:42:19 2015 +0100
@@ -72,101 +72,120 @@
context comm_semiring_1
begin
-declaration \<open>
-let
- val rules = @{lemma
- "(a * m) + (b * m) = (a + b) * m"
- "(a * m) + m = (a + 1) * m"
- "m + (a * m) = (a + 1) * m"
- "m + m = (1 + 1) * m"
- "0 + a = a"
- "a + 0 = a"
- "a * b = b * a"
- "(a + b) * c = (a * c) + (b * c)"
- "0 * a = 0"
- "a * 0 = 0"
- "1 * a = a"
- "a * 1 = a"
- "(lx * ly) * (rx * ry) = (lx * rx) * (ly * ry)"
- "(lx * ly) * (rx * ry) = lx * (ly * (rx * ry))"
- "(lx * ly) * (rx * ry) = rx * ((lx * ly) * ry)"
- "(lx * ly) * rx = (lx * rx) * ly"
- "(lx * ly) * rx = lx * (ly * rx)"
- "lx * (rx * ry) = (lx * rx) * ry"
- "lx * (rx * ry) = rx * (lx * ry)"
- "(a + b) + (c + d) = (a + c) + (b + d)"
- "(a + b) + c = a + (b + c)"
- "a + (c + d) = c + (a + d)"
- "(a + b) + c = (a + c) + b"
- "a + c = c + a"
- "a + (c + d) = (a + c) + d"
- "(x ^ p) * (x ^ q) = x ^ (p + q)"
- "x * (x ^ q) = x ^ (Suc q)"
- "(x ^ q) * x = x ^ (Suc q)"
- "x * x = x\<^sup>2"
- "(x * y) ^ q = (x ^ q) * (y ^ q)"
- "(x ^ p) ^ q = x ^ (p * q)"
- "x ^ 0 = 1"
- "x ^ 1 = x"
- "x * (y + z) = (x * y) + (x * z)"
- "x ^ (Suc q) = x * (x ^ q)"
- "x ^ (2*n) = (x ^ n) * (x ^ n)"
- by (simp_all add: algebra_simps power_add power2_eq_square
- power_mult_distrib power_mult del: one_add_one)}
-in
+lemma semiring_normalization_rules:
+ "(a * m) + (b * m) = (a + b) * m"
+ "(a * m) + m = (a + 1) * m"
+ "m + (a * m) = (a + 1) * m"
+ "m + m = (1 + 1) * m"
+ "0 + a = a"
+ "a + 0 = a"
+ "a * b = b * a"
+ "(a + b) * c = (a * c) + (b * c)"
+ "0 * a = 0"
+ "a * 0 = 0"
+ "1 * a = a"
+ "a * 1 = a"
+ "(lx * ly) * (rx * ry) = (lx * rx) * (ly * ry)"
+ "(lx * ly) * (rx * ry) = lx * (ly * (rx * ry))"
+ "(lx * ly) * (rx * ry) = rx * ((lx * ly) * ry)"
+ "(lx * ly) * rx = (lx * rx) * ly"
+ "(lx * ly) * rx = lx * (ly * rx)"
+ "lx * (rx * ry) = (lx * rx) * ry"
+ "lx * (rx * ry) = rx * (lx * ry)"
+ "(a + b) + (c + d) = (a + c) + (b + d)"
+ "(a + b) + c = a + (b + c)"
+ "a + (c + d) = c + (a + d)"
+ "(a + b) + c = (a + c) + b"
+ "a + c = c + a"
+ "a + (c + d) = (a + c) + d"
+ "(x ^ p) * (x ^ q) = x ^ (p + q)"
+ "x * (x ^ q) = x ^ (Suc q)"
+ "(x ^ q) * x = x ^ (Suc q)"
+ "x * x = x\<^sup>2"
+ "(x * y) ^ q = (x ^ q) * (y ^ q)"
+ "(x ^ p) ^ q = x ^ (p * q)"
+ "x ^ 0 = 1"
+ "x ^ 1 = x"
+ "x * (y + z) = (x * y) + (x * z)"
+ "x ^ (Suc q) = x * (x ^ q)"
+ "x ^ (2*n) = (x ^ n) * (x ^ n)"
+ by (simp_all add: algebra_simps power_add power2_eq_square
+ power_mult_distrib power_mult del: one_add_one)
+
+local_setup \<open>
Semiring_Normalizer.declare @{thm comm_semiring_1_axioms}
- {semiring = ([@{cpat "?x + ?y"}, @{cpat "?x * ?y"}, @{cpat "?x ^ ?n"}, @{cpat 0}, @{cpat 1}],
- rules), ring = ([], []), field = ([], []), idom = [], ideal = []}
-end\<close>
+ {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ @{thms semiring_normalization_rules}),
+ ring = ([], []),
+ field = ([], []),
+ idom = [],
+ ideal = []}
+\<close>
end
context comm_ring_1
begin
-declaration \<open>
-let
- val rules = @{lemma
- "- x = (- 1) * x"
- "x - y = x + (- y)"
- by simp_all}
-in
+lemma ring_normalization_rules:
+ "- x = (- 1) * x"
+ "x - y = x + (- y)"
+ by simp_all
+
+local_setup \<open>
Semiring_Normalizer.declare @{thm comm_ring_1_axioms}
- {semiring = Semiring_Normalizer.the_semiring @{context} @{thm comm_semiring_1_axioms},
- ring = ([@{cpat "?x - ?y"}, @{cpat "- ?x"}], rules), field = ([], []), idom = [], ideal = []}
-end\<close>
+ {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ @{thms semiring_normalization_rules}),
+ ring = ([@{term "x - y"}, @{term "- x"}], @{thms ring_normalization_rules}),
+ field = ([], []),
+ idom = [],
+ ideal = []}
+\<close>
end
context comm_semiring_1_cancel_crossproduct
begin
-declaration \<open>Semiring_Normalizer.declare @{thm comm_semiring_1_cancel_crossproduct_axioms}
- {semiring = Semiring_Normalizer.the_semiring @{context} @{thm comm_semiring_1_axioms},
- ring = ([], []), field = ([], []), idom = @{thms crossproduct_noteq add_scale_eq_noteq}, ideal = []}\<close>
+local_setup \<open>
+ Semiring_Normalizer.declare @{thm comm_semiring_1_cancel_crossproduct_axioms}
+ {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ @{thms semiring_normalization_rules}),
+ ring = ([], []),
+ field = ([], []),
+ idom = @{thms crossproduct_noteq add_scale_eq_noteq},
+ ideal = []}
+\<close>
end
context idom
begin
-declaration \<open>Semiring_Normalizer.declare @{thm idom_axioms}
- {semiring = Semiring_Normalizer.the_semiring @{context} @{thm comm_ring_1_axioms},
- ring = Semiring_Normalizer.the_ring @{context} @{thm comm_ring_1_axioms},
- field = ([], []), idom = @{thms crossproduct_noteq add_scale_eq_noteq},
- ideal = @{thms right_minus_eq add_0_iff}}\<close>
+local_setup \<open>
+ Semiring_Normalizer.declare @{thm idom_axioms}
+ {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ @{thms semiring_normalization_rules}),
+ ring = ([@{term "x - y"}, @{term "- x"}], @{thms ring_normalization_rules}),
+ field = ([], []),
+ idom = @{thms crossproduct_noteq add_scale_eq_noteq},
+ ideal = @{thms right_minus_eq add_0_iff}}
+\<close>
end
context field
begin
-declaration \<open>Semiring_Normalizer.declare @{thm field_axioms}
- {semiring = Semiring_Normalizer.the_semiring @{context} @{thm idom_axioms},
- ring = Semiring_Normalizer.the_ring @{context} @{thm idom_axioms},
- field = ([@{cpat "?x / ?y"}, @{cpat "inverse ?x"}], @{thms divide_inverse inverse_eq_divide}),
- idom = Semiring_Normalizer.the_idom @{context} @{thm idom_axioms},
- ideal = Semiring_Normalizer.the_ideal @{context} @{thm idom_axioms}}\<close>
+local_setup \<open>
+ Semiring_Normalizer.declare @{thm field_axioms}
+ {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ @{thms semiring_normalization_rules}),
+ ring = ([@{term "x - y"}, @{term "- x"}], @{thms ring_normalization_rules}),
+ field = ([@{term "x / y"}, @{term "inverse x"}], @{thms divide_inverse inverse_eq_divide}),
+ idom = @{thms crossproduct_noteq add_scale_eq_noteq},
+ ideal = @{thms right_minus_eq add_0_iff}}
+\<close>
end
--- a/src/HOL/Statespace/distinct_tree_prover.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Statespace/distinct_tree_prover.ML Fri Sep 18 16:42:19 2015 +0100
@@ -353,12 +353,15 @@
mk_solver "distinctFieldSolver" (distinctTree_tac names);
fun distinct_simproc names =
- Simplifier.simproc_global @{theory HOL} "DistinctTreeProver.distinct_simproc" ["x = y"]
- (fn ctxt =>
- (fn Const (@{const_name HOL.eq}, _) $ x $ y =>
+ Simplifier.make_simproc @{context} "DistinctTreeProver.distinct_simproc"
+ {lhss = [@{term "x = y"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of
+ Const (@{const_name HOL.eq}, _) $ x $ y =>
Option.map (fn neq => @{thm neq_to_eq_False} OF [neq])
(get_fst_success (neq_x_y ctxt x y) names)
- | _ => NONE));
+ | _ => NONE),
+ identifier = []};
end;
--- a/src/HOL/Statespace/state_fun.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Statespace/state_fun.ML Fri Sep 18 16:42:19 2015 +0100
@@ -51,26 +51,29 @@
in
val lazy_conj_simproc =
- Simplifier.simproc_global @{theory HOL} "lazy_conj_simp" ["P & Q"]
- (fn ctxt => fn t =>
- (case t of (Const (@{const_name HOL.conj},_) $ P $ Q) =>
- let
- val P_P' = Simplifier.rewrite ctxt (Thm.cterm_of ctxt P);
- val P' = P_P' |> Thm.prop_of |> Logic.dest_equals |> #2;
- in
- if isFalse P' then SOME (conj1_False OF [P_P'])
- else
- let
- val Q_Q' = Simplifier.rewrite ctxt (Thm.cterm_of ctxt Q);
- val Q' = Q_Q' |> Thm.prop_of |> Logic.dest_equals |> #2;
- in
- if isFalse Q' then SOME (conj2_False OF [Q_Q'])
- else if isTrue P' andalso isTrue Q' then SOME (conj_True OF [P_P', Q_Q'])
- else if P aconv P' andalso Q aconv Q' then NONE
- else SOME (conj_cong OF [P_P', Q_Q'])
- end
- end
- | _ => NONE));
+ Simplifier.make_simproc @{context} "lazy_conj_simp"
+ {lhss = [@{term "P & Q"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of
+ Const (@{const_name HOL.conj},_) $ P $ Q =>
+ let
+ val P_P' = Simplifier.rewrite ctxt (Thm.cterm_of ctxt P);
+ val P' = P_P' |> Thm.prop_of |> Logic.dest_equals |> #2;
+ in
+ if isFalse P' then SOME (conj1_False OF [P_P'])
+ else
+ let
+ val Q_Q' = Simplifier.rewrite ctxt (Thm.cterm_of ctxt Q);
+ val Q' = Q_Q' |> Thm.prop_of |> Logic.dest_equals |> #2;
+ in
+ if isFalse Q' then SOME (conj2_False OF [Q_Q'])
+ else if isTrue P' andalso isTrue Q' then SOME (conj_True OF [P_P', Q_Q'])
+ else if P aconv P' andalso Q aconv Q' then NONE
+ else SOME (conj_cong OF [P_P', Q_Q'])
+ end
+ end
+ | _ => NONE),
+ identifier = []};
fun string_eq_simp_tac ctxt =
simp_tac (put_simpset HOL_basic_ss ctxt
@@ -106,13 +109,14 @@
val _ = Theory.setup (Context.theory_map (Data.put (lookup_ss, ex_lookup_ss, false)));
val lookup_simproc =
- Simplifier.simproc_global @{theory} "lookup_simp" ["lookup d n (update d' c m v s)"]
- (fn ctxt => fn t =>
- (case t of (Const (@{const_name StateFun.lookup}, lT) $ destr $ n $
+ Simplifier.make_simproc @{context} "lookup_simp"
+ {lhss = [@{term "lookup d n (update d' c m v s)"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of (Const (@{const_name StateFun.lookup}, lT) $ destr $ n $
(s as Const (@{const_name StateFun.update}, uT) $ _ $ _ $ _ $ _ $ _)) =>
(let
val (_::_::_::_::sT::_) = binder_types uT;
- val mi = maxidx_of_term t;
+ val mi = Term.maxidx_of_term (Thm.term_of ct);
fun mk_upds (Const (@{const_name StateFun.update}, uT) $ d' $ c $ m $ v $ s) =
let
val (_ :: _ :: _ :: fT :: _ :: _) = binder_types uT;
@@ -149,7 +153,8 @@
else SOME thm
end
handle Option.Option => NONE)
- | _ => NONE ));
+ | _ => NONE),
+ identifier = []};
local
@@ -165,9 +170,10 @@
in
val update_simproc =
- Simplifier.simproc_global @{theory} "update_simp" ["update d c n v s"]
- (fn ctxt => fn t =>
- (case t of
+ Simplifier.make_simproc @{context} "update_simp"
+ {lhss = [@{term "update d c n v s"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of
Const (@{const_name StateFun.update}, uT) $ _ $ _ $ _ $ _ $ _ =>
let
val (_ :: _ :: _ :: _ :: sT :: _) = binder_types uT;
@@ -242,7 +248,7 @@
val ctxt1 = put_simpset ss' ctxt0;
val ctxt2 = put_simpset (#1 (Data.get (Context.Proof ctxt0))) ctxt0;
in
- (case mk_updterm [] t of
+ (case mk_updterm [] (Thm.term_of ct) of
(trm, trm', vars, _, true) =>
let
val eq1 =
@@ -253,7 +259,8 @@
in SOME (Thm.transitive eq1 eq2) end
| _ => NONE)
end
- | _ => NONE));
+ | _ => NONE),
+ identifier = []};
end;
@@ -269,10 +276,12 @@
in
val ex_lookup_eq_simproc =
- Simplifier.simproc_global @{theory HOL} "ex_lookup_eq_simproc" ["Ex t"]
- (fn ctxt => fn t =>
+ Simplifier.make_simproc @{context} "ex_lookup_eq_simproc"
+ {lhss = [@{term "Ex t"}],
+ proc = fn _ => fn ctxt => fn ct =>
let
val thy = Proof_Context.theory_of ctxt;
+ val t = Thm.term_of ct;
val ex_lookup_ss = #2 (Data.get (Context.Proof ctxt));
val ctxt' = ctxt |> Config.put simp_depth_limit 100 |> put_simpset ex_lookup_ss;
@@ -316,7 +325,8 @@
val thm' = if swap then swap_ex_eq OF [thm] else thm
in SOME thm' end handle TERM _ => NONE)
| _ => NONE)
- end handle Option.Option => NONE);
+ end handle Option.Option => NONE,
+ identifier = []};
end;
--- a/src/HOL/Statespace/state_space.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Statespace/state_space.ML Fri Sep 18 16:42:19 2015 +0100
@@ -211,10 +211,15 @@
val distinctNameSolver = mk_solver "distinctNameSolver" distinctTree_tac;
val distinct_simproc =
- Simplifier.simproc_global @{theory HOL} "StateSpace.distinct_simproc" ["x = y"]
- (fn ctxt => (fn (Const (@{const_name HOL.eq},_)$(x as Free _)$(y as Free _)) =>
- Option.map (fn neq => DistinctTreeProver.neq_to_eq_False OF [neq]) (neq_x_y ctxt x y)
- | _ => NONE));
+ Simplifier.make_simproc @{context} "StateSpace.distinct_simproc"
+ {lhss = [@{term "x = y"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of
+ Const (@{const_name HOL.eq},_) $ (x as Free _) $ (y as Free _) =>
+ Option.map (fn neq => DistinctTreeProver.neq_to_eq_False OF [neq])
+ (neq_x_y ctxt x y)
+ | _ => NONE),
+ identifier = []};
fun interprete_parent name dist_thm_name parent_expr thy =
let
--- a/src/HOL/Tools/BNF/bnf_def.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_def.ML Fri Sep 18 16:42:19 2015 +0100
@@ -1484,9 +1484,9 @@
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, prems = _} =>
mk_set_transfer_tac ctxt (Lazy.force in_rel) (map Lazy.force set_map))
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
val set_transfer = Lazy.lazy mk_set_transfer;
@@ -1566,9 +1566,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);
in
map2 (Thm.close_derivation oo Goal.prove_sorry lthy [] [])
goals (map (fn tac => fn {context = ctxt, prems = _} =>
@@ -1585,9 +1586,10 @@
fun mk_triv_wit_thms tac set_maps =
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced wit_goals)
(fn {context = ctxt, prems = _} => TRYALL Goal.conjunction_tac THEN 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 (mk_wit_thms, nontriv_wit_goals) =
(case triv_tac_opt of
NONE => (fn _ => [], map (map (rpair [])) wit_goalss)
--- a/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML Fri Sep 18 16:42:19 2015 +0100
@@ -680,9 +680,9 @@
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, prems = _} =>
mk_ctr_transfer_tac ctxt rel_intro_thms live_nesting_rel_eqs)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
val (set_cases_thms, set_cases_attrss) =
@@ -785,9 +785,9 @@
else
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, prems = _} => mk_set_intros_tac ctxt set0_thms)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
- |> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation)
+ |> Proof_Context.export names_lthy lthy)
end;
val rel_sel_thms =
@@ -884,9 +884,9 @@
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, prems = _} =>
mk_sel_transfer_tac ctxt n sel_defs case_transfer_thm)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
val disc_transfer_thms =
@@ -897,9 +897,9 @@
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, prems = _} => mk_disc_transfer_tac ctxt (the_single rel_sel_thms)
(the_single exhaust_discs) (flat (flat distinct_discsss)))
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
val map_disc_iff_thms =
@@ -921,9 +921,9 @@
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, prems = _} =>
mk_map_disc_iff_tac ctxt (Thm.cterm_of ctxt ta) exhaust (flat disc_thmss) map_thms)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
val (map_sel_thmss, map_sel_thms) =
@@ -956,9 +956,9 @@
(fn {context = ctxt, prems = _} =>
mk_map_sel_tac ctxt (Thm.cterm_of ctxt ta) exhaust (flat disc_thmss) map_thms
(flat sel_thmss) live_nesting_map_id0s)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
- |> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation)
+ |> Proof_Context.export names_lthy lthy)
end;
val (set_sel_thmssss, set_sel_thms) =
@@ -1015,9 +1015,9 @@
(fn {context = ctxt, prems = _} =>
mk_set_sel_tac ctxt (Thm.cterm_of ctxt ta) exhaust (flat disc_thmss)
(flat sel_thmss) set0_thms)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
- |> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation)
+ |> Proof_Context.export names_lthy lthy)
end;
val code_attrs = if plugins code_plugin then [Code.add_default_eqn_attrib] else [];
@@ -2256,9 +2256,9 @@
(fn {context = ctxt, prems = _} =>
mk_rec_transfer_tac ctxt nn ns (map (Thm.cterm_of ctxt) Ss) (map (Thm.cterm_of ctxt) Rs) xsssss
rec_defs xtor_co_rec_transfers pre_rel_defs live_nesting_rel_eqs)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced nn
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
fun derive_rec_o_map_thmss lthy recs rec_defs =
@@ -2408,9 +2408,9 @@
mk_corec_transfer_tac ctxt (map (Thm.cterm_of ctxt) Ss) (map (Thm.cterm_of ctxt) Rs)
type_definitions corec_defs xtor_co_rec_transfers pre_rel_defs
live_nesting_rel_eqs (flat pgss) pss qssss gssss)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
fun derive_map_o_corec_thmss lthy0 lthy2 corecs corec_defs =
--- a/src/HOL/Tools/BNF/bnf_fp_n2m_sugar.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_n2m_sugar.ML Fri Sep 18 16:42:19 2015 +0100
@@ -66,7 +66,7 @@
| unfold_lets_splits (t $ u) = betapply (unfold_lets_splits t, unfold_lets_splits u)
| unfold_lets_splits (Abs (s, T, t)) = Abs (s, T, unfold_lets_splits t)
| unfold_lets_splits t = t
-and unfold_splits_lets ((t as Const (@{const_name case_prod}, _)) $ u) =
+and unfold_splits_lets ((t as Const (@{const_name uncurry}, _)) $ u) =
(case unfold_splits_lets u of
u' as Abs (s1, T1, Abs (s2, T2, _)) =>
let val v = Var ((s1 ^ s2, Term.maxidx_of_term u' + 1), HOLogic.mk_prodT (T1, T2)) in
--- a/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML Fri Sep 18 16:42:19 2015 +0100
@@ -294,7 +294,7 @@
| (_, branches') =>
Term.list_comb (If_const (typof (hd branches')) $ tap (check_no_call bound_Ts) obj,
branches'))
- | (c as Const (@{const_name case_prod}, _), arg :: args) =>
+ | (c as Const (@{const_name uncurry}, _), arg :: args) =>
massage_rec bound_Ts
(unfold_splits_lets (Term.list_comb (c $ Envir.eta_long bound_Ts arg, args)))
| (Const (c, _), args as _ :: _ :: _) =>
@@ -398,12 +398,12 @@
end
| NONE =>
(case t of
- Const (@{const_name case_prod}, _) $ t' =>
+ Const (@{const_name uncurry}, _) $ t' =>
let
val U' = curried_type U;
val T' = curried_type T;
in
- Const (@{const_name case_prod}, U' --> U) $ massage_any_call bound_Ts U' T' t'
+ Const (@{const_name uncurry}, U' --> U) $ massage_any_call bound_Ts U' T' t'
end
| t1 $ t2 =>
(if has_call t2 then
@@ -927,7 +927,7 @@
let val (u, vs) = strip_comb t in
if is_Free u andalso has_call u then
Inr_const T U2 $ mk_tuple1_balanced bound_Ts vs
- else if try (fst o dest_Const) u = SOME @{const_name case_prod} then
+ else if try (fst o dest_Const) u = SOME @{const_name uncurry} then
map (rewrite bound_Ts) vs |> chop 1
|>> HOLogic.mk_split o the_single
|> Term.list_comb
--- a/src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML Fri Sep 18 16:42:19 2015 +0100
@@ -164,7 +164,7 @@
set_cases = @{thms fsts.cases[unfolded eq_fst_iff ex_neg_all_pos]
snds.cases[unfolded eq_snd_iff ex_neg_all_pos]}},
fp_co_induct_sugar =
- {co_rec = Const (@{const_name case_prod}, (ctr_Ts ---> C) --> fpT --> C),
+ {co_rec = Const (@{const_name uncurry}, (ctr_Ts ---> C) --> fpT --> C),
common_co_inducts = @{thms prod.induct},
co_inducts = @{thms prod.induct},
co_rec_def = @{thm ctor_rec_def_alt[of "case_prod f" for f]},
--- a/src/HOL/Tools/BNF/bnf_util.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_util.ML Fri Sep 18 16:42:19 2015 +0100
@@ -143,10 +143,20 @@
let
(*Work around loss of qualification in "typedef" axioms by replicating it in the name*)
val b' = fold_rev Binding.prefix_name (map (suffix "_" o fst) (Binding.path_of b)) b;
+
+ val default_bindings = Typedef.default_bindings (Binding.concealed b');
+ val bindings =
+ (case opt_morphs of
+ NONE => default_bindings
+ | SOME (Rep_name, Abs_name) =>
+ {Rep_name = Binding.concealed Rep_name,
+ Abs_name = Binding.concealed Abs_name,
+ type_definition_name = #type_definition_name default_bindings});
+
val ((name, info), (lthy, lthy_old)) =
lthy
|> Local_Theory.open_target |> snd
- |> Typedef.add_typedef true (b', Ts, mx) set opt_morphs tac
+ |> Typedef.add_typedef (b', Ts, mx) set (SOME bindings) tac
||> `Local_Theory.close_target;
val phi = Proof_Context.export_morphism lthy_old lthy;
in
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML Fri Sep 18 16:42:19 2015 +0100
@@ -1017,9 +1017,9 @@
Goal.prove_sorry lthy [] [] (Logic.mk_conjunction_balanced goals)
(fn {context = ctxt, ...} => mk_disc_eq_case_tac ctxt (Thm.cterm_of ctxt u)
exhaust_thm (flat nontriv_disc_thmss) distinct_thms case_thms)
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> Proof_Context.export names_lthy lthy
- |> map Thm.close_derivation
end;
in
(sel_defs, all_sel_thms, sel_thmss, disc_defs, disc_thmss, nontriv_disc_thmss,
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML Fri Sep 18 16:42:19 2015 +0100
@@ -76,6 +76,7 @@
fun proves goals = goals
|> Logic.mk_conjunction_balanced
|> prove
+ |> Thm.close_derivation
|> Conjunction.elim_balanced (length goals)
|> map Simpdata.mk_eq;
in
--- a/src/HOL/Tools/Function/function.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/function.ML Fri Sep 18 16:42:19 2015 +0100
@@ -273,8 +273,7 @@
val cong = #case_cong (Old_Datatype_Data.the_info thy n)
|> safe_mk_meta_eq
in
- Context.theory_map
- (Function_Context_Tree.map_function_congs (Thm.add_thm cong)) thy
+ Context.theory_map (Function_Context_Tree.add_function_cong cong) thy
end
val _ = Theory.setup (Old_Datatype_Data.interpretation (K (fold add_case_cong)))
--- a/src/HOL/Tools/Function/function_common.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/function_common.ML Fri Sep 18 16:42:19 2015 +0100
@@ -282,7 +282,7 @@
fun termination_rule_tac ctxt = resolve_tac ctxt (#1 (Data.get (Context.Proof ctxt)))
-val store_termination_rule = Data.map o @{apply 4(1)} o cons
+val store_termination_rule = Data.map o @{apply 4(1)} o cons o Thm.trim_context
val get_functions = #2 o Data.get o Context.Proof
fun add_function_data (info : info as {fs, termination, ...}) =
--- a/src/HOL/Tools/Function/function_context_tree.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/function_context_tree.ML Fri Sep 18 16:42:19 2015 +0100
@@ -10,10 +10,8 @@
type ctxt = (string * typ) list * thm list
type ctx_tree
- (* FIXME: This interface is a mess and needs to be cleaned up! *)
val get_function_congs : Proof.context -> thm list
val add_function_cong : thm -> Context.generic -> Context.generic
- val map_function_congs : (thm list -> thm list) -> Context.generic -> Context.generic
val cong_add: attribute
val cong_del: attribute
@@ -53,14 +51,17 @@
val merge = Thm.merge_thms
);
-val get_function_congs = FunctionCongs.get o Context.Proof
-val map_function_congs = FunctionCongs.map
-val add_function_cong = FunctionCongs.map o Thm.add_thm
+fun get_function_congs ctxt =
+ FunctionCongs.get (Context.Proof ctxt)
+ |> map (Thm.transfer (Proof_Context.theory_of ctxt));
+
+val add_function_cong = FunctionCongs.map o Thm.add_thm o Thm.trim_context;
+
(* congruence rules *)
-val cong_add = Thm.declaration_attribute (map_function_congs o Thm.add_thm o safe_mk_meta_eq);
-val cong_del = Thm.declaration_attribute (map_function_congs o Thm.del_thm o safe_mk_meta_eq);
+val cong_add = Thm.declaration_attribute (add_function_cong o safe_mk_meta_eq);
+val cong_del = Thm.declaration_attribute (FunctionCongs.map o Thm.del_thm o safe_mk_meta_eq);
type depgraph = int Int_Graph.T
--- a/src/HOL/Tools/Function/function_core.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/function_core.ML Fri Sep 18 16:42:19 2015 +0100
@@ -7,7 +7,6 @@
signature FUNCTION_CORE =
sig
val trace: bool Unsynchronized.ref
-
val prepare_function : Function_Common.function_config
-> string (* defname *)
-> ((bstring * typ) * mixfix) list (* defined symbol *)
@@ -504,10 +503,12 @@
Abs ("x", domT, Const (@{const_name Fun_Def.THE_default}, ranT --> (ranT --> boolT) --> ranT)
$ (default $ Bound 0) $ Abs ("y", ranT, G $ Bound 1 $ Bound 0))
|> Syntax.check_term lthy
+ val def_binding =
+ if Config.get lthy function_defs then (Binding.name fdefname, [])
+ else Attrib.empty_binding
in
Local_Theory.define
- ((Binding.name (function_name fname), mixfix),
- ((Binding.concealed (Binding.name fdefname), []), f_def)) lthy
+ ((Binding.name (function_name fname), mixfix), (def_binding, f_def)) lthy
end
fun define_recursion_relation Rname domT qglrs clauses RCss lthy =
--- a/src/HOL/Tools/Function/function_lib.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/function_lib.ML Fri Sep 18 16:42:19 2015 +0100
@@ -7,6 +7,8 @@
signature FUNCTION_LIB =
sig
+ val function_defs: bool Config.T
+
val plural: string -> string -> 'a list -> string
val dest_all_all: term -> term list * term
@@ -30,6 +32,9 @@
structure Function_Lib: FUNCTION_LIB =
struct
+val function_defs = Attrib.setup_config_bool @{binding function_defs} (K false)
+
+
(* "The variable" ^ plural " is" "s are" vs *)
fun plural sg pl [x] = sg
| plural sg pl _ = pl
--- a/src/HOL/Tools/Function/mutual.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/mutual.ML Fri Sep 18 16:42:19 2015 +0100
@@ -128,11 +128,13 @@
let
fun def ((MutualPart {i=i, i'=i', fvar=(fname, fT), cargTs, f_def, ...}), (_, mixfix)) lthy =
let
+ val def_binding =
+ if Config.get lthy function_defs then (Binding.name (Thm.def_name fname), [])
+ else Attrib.empty_binding
val ((f, (_, f_defthm)), lthy') =
Local_Theory.define
((Binding.name fname, mixfix),
- ((Binding.concealed (Binding.name (Thm.def_name fname)), []),
- Term.subst_bound (fsum, f_def))) lthy
+ (def_binding, Term.subst_bound (fsum, f_def))) lthy
in
(MutualPart {i=i, i'=i', fvar=(fname, fT), cargTs=cargTs, f_def=f_def,
f=SOME f, f_defthm=SOME f_defthm },
--- a/src/HOL/Tools/Function/partial_function.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Function/partial_function.ML Fri Sep 18 16:42:19 2015 +0100
@@ -7,29 +7,35 @@
signature PARTIAL_FUNCTION =
sig
val init: string -> term -> term -> thm -> thm -> thm option -> declaration
-
val mono_tac: Proof.context -> int -> tactic
-
val add_partial_function: string -> (binding * typ option * mixfix) list ->
Attrib.binding * term -> local_theory -> local_theory
-
val add_partial_function_cmd: string -> (binding * string option * mixfix) list ->
Attrib.binding * string -> local_theory -> local_theory
end;
-
structure Partial_Function: PARTIAL_FUNCTION =
struct
(*** Context Data ***)
-datatype setup_data = Setup_Data of
+datatype setup_data = Setup_Data of
{fixp: term,
mono: term,
fixp_eq: thm,
fixp_induct: thm,
fixp_induct_user: thm option};
+fun transform_setup_data phi (Setup_Data {fixp, mono, fixp_eq, fixp_induct, fixp_induct_user}) =
+ let
+ val term = Morphism.term phi;
+ val thm = Morphism.thm phi;
+ in
+ Setup_Data
+ {fixp = term fixp, mono = term mono, fixp_eq = thm fixp_eq,
+ fixp_induct = thm fixp_induct, fixp_induct_user = Option.map thm fixp_induct_user}
+ end;
+
structure Modes = Generic_Data
(
type T = setup_data Symtab.table;
@@ -40,17 +46,18 @@
fun init mode fixp mono fixp_eq fixp_induct fixp_induct_user phi =
let
- val term = Morphism.term phi;
- val thm = Morphism.thm phi;
- val data' = Setup_Data
- {fixp=term fixp, mono=term mono, fixp_eq=thm fixp_eq,
- fixp_induct=thm fixp_induct, fixp_induct_user=Option.map thm fixp_induct_user};
- in
- Modes.map (Symtab.update (mode, data'))
- end
+ val data' =
+ Setup_Data
+ {fixp = fixp, mono = mono, fixp_eq = fixp_eq,
+ fixp_induct = fixp_induct, fixp_induct_user = fixp_induct_user}
+ |> transform_setup_data (phi $> Morphism.trim_context_morphism);
+ in Modes.map (Symtab.update (mode, data')) end;
val known_modes = Symtab.keys o Modes.get o Context.Proof;
-val lookup_mode = Symtab.lookup o Modes.get o Context.Proof;
+
+fun lookup_mode ctxt =
+ Symtab.lookup (Modes.get (Context.Proof ctxt))
+ #> Option.map (transform_setup_data (Morphism.transfer_morphism (Proof_Context.theory_of ctxt)));
(*** Automated monotonicity proofs ***)
@@ -159,7 +166,7 @@
let
val ([P], ctxt') = Variable.variant_fixes ["P"] ctxt
val P_inst = Abs ("f", fT_uc, Free (P, fT --> HOLogic.boolT) $ (curry $ Bound 0))
- in
+ in
(* FIXME ctxt vs. ctxt' (!?) *)
rule
|> infer_instantiate' ctxt
@@ -182,7 +189,7 @@
val split_paired_all_conv =
Conv.every_conv (replicate (length args - 1) (Conv.rewr_conv @{thm split_paired_all}))
- val split_params_conv =
+ val split_params_conv =
Conv.params_conv ~1 (fn ctxt' =>
Conv.implies_conv split_paired_all_conv Conv.all_conv)
@@ -207,7 +214,7 @@
in
inst_rule'
end;
-
+
(*** partial_function definition ***)
@@ -251,9 +258,11 @@
val inst_mono_thm = Thm.forall_elim (Thm.cterm_of lthy x_uc) mono_thm
val f_def_rhs = curry_n arity (apply_inst lthy fixp F_uc);
- val f_def_binding = Binding.concealed (Binding.name (Thm.def_name fname));
+ val f_def_binding =
+ if Config.get lthy Function_Lib.function_defs then (Binding.name (Thm.def_name fname), [])
+ else Attrib.empty_binding;
val ((f, (_, f_def)), lthy') = Local_Theory.define
- ((f_binding, mixfix), ((f_def_binding, []), f_def_rhs)) lthy;
+ ((f_binding, mixfix), (f_def_binding, f_def_rhs)) lthy;
val eqn = HOLogic.mk_eq (list_comb (f, args),
Term.betapplys (F, f :: args))
@@ -264,7 +273,7 @@
OF [inst_mono_thm, f_def])
|> Tactic.rule_by_tactic lthy' (Simplifier.simp_tac (put_simpset curry_uncurry_ss lthy') 1);
- val specialized_fixp_induct =
+ val specialized_fixp_induct =
specialize_fixp_induct lthy' args fT fT_uc F curry uncurry inst_mono_thm f_def fixp_induct
|> Drule.rename_bvars' (map SOME (fname :: fname :: argnames));
@@ -288,10 +297,10 @@
|-> (fn (_, rec') =>
Spec_Rules.add Spec_Rules.Equational ([f], rec')
#> Local_Theory.note ((Binding.qualify true fname (Binding.name "simps"), []), rec') #> snd)
- |> (Local_Theory.note ((Binding.qualify true fname (Binding.name "mono"), []), [mono_thm]) #> snd)
+ |> (Local_Theory.note ((Binding.qualify true fname (Binding.name "mono"), []), [mono_thm]) #> snd)
|> (case raw_induct of NONE => I | SOME thm =>
Local_Theory.note ((Binding.qualify true fname (Binding.name "raw_induct"), []), [thm]) #> snd)
- |> (Local_Theory.note ((Binding.qualify true fname (Binding.name "fixp_induct"), []), [specialized_fixp_induct]) #> snd)
+ |> (Local_Theory.note ((Binding.qualify true fname (Binding.name "fixp_induct"), []), [specialized_fixp_induct]) #> snd)
end;
val add_partial_function = gen_add_partial_function Specification.check_spec;
@@ -304,4 +313,4 @@
((mode -- (Parse.fixes -- (Parse.where_ |-- Parse_Spec.spec)))
>> (fn (mode, (fixes, spec)) => add_partial_function_cmd mode fixes spec));
-end
+end;
--- a/src/HOL/Tools/Nitpick/nitpick_hol.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML Fri Sep 18 16:42:19 2015 +0100
@@ -2287,7 +2287,7 @@
HOLogic.Collect_const tuple_T $ list_comb (Const base_x, outer_bounds)
val step_set =
HOLogic.Collect_const prod_T
- $ (Const (@{const_name case_prod}, curried_T --> uncurried_T)
+ $ (Const (@{const_name uncurry}, curried_T --> uncurried_T)
$ list_comb (Const step_x, outer_bounds))
val image_set =
image_const $ (rtrancl_const $ step_set) $ base_set
--- a/src/HOL/Tools/Old_Datatype/old_datatype.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Old_Datatype/old_datatype.ML Fri Sep 18 16:42:19 2015 +0100
@@ -186,7 +186,7 @@
|> Sign.parent_path
|> fold_map
(fn (((name, mx), tvs), c) =>
- Typedef.add_typedef_global false (name, tvs, mx)
+ Typedef.add_typedef_global (name, tvs, mx)
(Collect $ Const (c, UnivT')) NONE
(fn ctxt =>
resolve_tac ctxt [exI] 1 THEN
--- a/src/HOL/Tools/Predicate_Compile/mode_inference.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Predicate_Compile/mode_inference.ML Fri Sep 18 16:42:19 2015 +0100
@@ -53,7 +53,7 @@
struct
open Predicate_Compile_Aux;
-open Core_Data;
+
(* derivation trees for modes of premises *)
@@ -317,7 +317,7 @@
fun is_functional t mode =
case try (fst o dest_Const o fst o strip_comb) t of
NONE => false
- | SOME c => is_some (alternative_compilation_of ctxt c mode)
+ | SOME c => is_some (Core_Data.alternative_compilation_of ctxt c mode)
in
case (is_functional t1 (head_mode_of deriv1), is_functional t2 (head_mode_of deriv2)) of
(true, true) => EQUAL
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML Fri Sep 18 16:42:19 2015 +0100
@@ -72,7 +72,6 @@
type random_seed = Random_Engine.seed
open Predicate_Compile_Aux;
-open Core_Data;
open Mode_Inference;
open Predicate_Compile_Proof;
@@ -126,18 +125,19 @@
fun print_stored_rules ctxt =
let
- val preds = Graph.keys (PredData.get (Proof_Context.theory_of ctxt))
- fun print pred () = let
- val _ = writeln ("predicate: " ^ pred)
- val _ = writeln ("introrules: ")
- val _ = fold (fn thm => fn _ => writeln (Display.string_of_thm ctxt thm))
- (rev (intros_of ctxt pred)) ()
- in
- if (has_elim ctxt pred) then
- writeln ("elimrule: " ^ Display.string_of_thm ctxt (the_elim_of ctxt pred))
- else
- writeln ("no elimrule defined")
- end
+ val preds = Graph.keys (Core_Data.PredData.get (Proof_Context.theory_of ctxt))
+ fun print pred () =
+ let
+ val _ = writeln ("predicate: " ^ pred)
+ val _ = writeln ("introrules: ")
+ val _ = fold (fn thm => fn _ => writeln (Display.string_of_thm ctxt thm))
+ (rev (Core_Data.intros_of ctxt pred)) ()
+ in
+ if Core_Data.has_elim ctxt pred then
+ writeln ("elimrule: " ^ Display.string_of_thm ctxt (Core_Data.the_elim_of ctxt pred))
+ else
+ writeln ("no elimrule defined")
+ end
in
fold print preds ()
end;
@@ -151,7 +151,7 @@
val _ = writeln ("modes: " ^ (commas (map string_of_mode modes)))
in u end
in
- fold print (all_modes_of compilation ctxt) ()
+ fold print (Core_Data.all_modes_of compilation ctxt) ()
end
(* validity checks *)
@@ -670,10 +670,10 @@
SOME (compile_arg compilation_modifiers additional_arguments ctxt param_modes t)
| (_, Term Output) => NONE
| (Const (name, T), Context mode) =>
- (case alternative_compilation_of ctxt name mode of
+ (case Core_Data.alternative_compilation_of ctxt name mode of
SOME alt_comp => SOME (alt_comp compfuns T)
| NONE =>
- SOME (Const (function_name_of (Comp_Mod.compilation compilation_modifiers)
+ SOME (Const (Core_Data.function_name_of (Comp_Mod.compilation compilation_modifiers)
ctxt name mode,
Comp_Mod.funT_of compilation_modifiers mode T)))
| (Free (s, T), Context m) =>
@@ -1014,7 +1014,7 @@
foldr1 (mk_plus compfuns) cl_ts)
end
val fun_const =
- Const (function_name_of (Comp_Mod.compilation compilation_modifiers) ctxt s mode, funT)
+ Const (Core_Data.function_name_of (Comp_Mod.compilation compilation_modifiers) ctxt s mode, funT)
in
HOLogic.mk_Trueprop
(HOLogic.mk_eq (list_comb (fun_const, in_ts @ additional_arguments), compilation))
@@ -1023,7 +1023,7 @@
(* Definition of executable functions and their intro and elim rules *)
-fun strip_split_abs (Const (@{const_name case_prod}, _) $ t) = strip_split_abs t
+fun strip_split_abs (Const (@{const_name uncurry}, _) $ t) = strip_split_abs t
| strip_split_abs (Abs (_, _, t)) = strip_split_abs t
| strip_split_abs t = t
@@ -1132,7 +1132,7 @@
val mode_cname = create_constname_of_mode options thy "" name T mode
val mode_cbasename = Long_Name.base_name mode_cname
val funT = funT_of compfuns mode T
- val (args, _) = fold_map (mk_args true) ((strip_fun_mode mode) ~~ (binder_types T)) []
+ val (args, _) = fold_map (mk_args true) (strip_fun_mode mode ~~ binder_types T) []
fun strip_eval _ t =
let
val t' = strip_split_abs t
@@ -1152,13 +1152,13 @@
create_intro_elim_rule ctxt' mode definition mode_cname funT (Const (name, T))
in
thy'
- |> set_function_name Pred name mode mode_cname
- |> add_predfun_data name mode (definition, rules)
+ |> Core_Data.set_function_name Pred name mode mode_cname
+ |> Core_Data.add_predfun_data name mode (definition, rules)
|> Global_Theory.store_thm (Binding.name (mode_cbasename ^ "I"), intro) |> snd
|> Global_Theory.store_thm (Binding.name (mode_cbasename ^ "E"), elim) |> snd
end;
in
- thy |> defined_function_of Pred name |> fold create_definition modes
+ thy |> Core_Data.defined_function_of Pred name |> fold create_definition modes
end;
fun define_functions comp_modifiers _ options preds (name, modes) thy =
@@ -1171,11 +1171,11 @@
val funT = Comp_Mod.funT_of comp_modifiers mode T
in
thy |> Sign.add_consts [(Binding.name (Long_Name.base_name mode_cname), funT, NoSyn)]
- |> set_function_name (Comp_Mod.compilation comp_modifiers) name mode mode_cname
+ |> Core_Data.set_function_name (Comp_Mod.compilation comp_modifiers) name mode mode_cname
end;
in
thy
- |> defined_function_of (Comp_Mod.compilation comp_modifiers) name
+ |> Core_Data.defined_function_of (Comp_Mod.compilation comp_modifiers) name
|> fold create_definition modes
end;
@@ -1220,7 +1220,7 @@
Syntax.string_of_term ctxt (c $ t))
| Sidecond t => Sidecond (c $ t))
| (Const (s, _), _) =>
- if is_registered ctxt s then Prem t else Sidecond t
+ if Core_Data.is_registered ctxt s then Prem t else Sidecond t
| _ => Sidecond t)
fun prepare_intrs options ctxt prednames intros =
@@ -1334,18 +1334,18 @@
let
val full_mode = fold_rev (curry Fun) (map (K Input) (binder_types T)) Bool
in
- if member eq_mode (modes_of Pred ctxt predname) full_mode then
+ if member eq_mode (Core_Data.modes_of Pred ctxt predname) full_mode then
let
val Ts = binder_types T
val arg_names = Name.variant_list []
(map (fn i => "x" ^ string_of_int i) (1 upto length Ts))
val args = map2 (curry Free) arg_names Ts
- val predfun = Const (function_name_of Pred ctxt predname full_mode,
+ val predfun = Const (Core_Data.function_name_of Pred ctxt predname full_mode,
Ts ---> Predicate_Comp_Funs.mk_monadT @{typ unit})
val rhs = @{term Predicate.holds} $ (list_comb (predfun, args))
val eq_term = HOLogic.mk_Trueprop
(HOLogic.mk_eq (list_comb (Const (predname, T), args), rhs))
- val def = predfun_definition_of ctxt predname full_mode
+ val def = Core_Data.predfun_definition_of ctxt predname full_mode
val tac = fn _ => Simplifier.simp_tac
(put_simpset HOL_basic_ss ctxt addsimps [def, @{thm holds_eq}, @{thm eval_pred}]) 1
val eq = Goal.prove ctxt arg_names [] eq_term tac
@@ -1387,18 +1387,18 @@
(*val _ = map (check_format_of_intro_rule thy) (maps (intros_of thy) prednames)*)
val _ =
if show_intermediate_results options then
- tracing (commas (map (Display.string_of_thm ctxt) (maps (intros_of ctxt) prednames)))
+ tracing (commas (map (Display.string_of_thm ctxt) (maps (Core_Data.intros_of ctxt) prednames)))
else ()
val (preds, all_vs, param_vs, all_modes, clauses) =
- prepare_intrs options ctxt prednames (maps (intros_of ctxt) prednames)
+ prepare_intrs options ctxt prednames (maps (Core_Data.intros_of ctxt) prednames)
val _ = print_step options "Infering modes..."
- val (lookup_mode, lookup_neg_mode, needs_random) = (modes_of compilation ctxt,
- modes_of (negative_compilation_of compilation) ctxt, needs_random ctxt)
+ val (lookup_mode, lookup_neg_mode, needs_random) = (Core_Data.modes_of compilation ctxt,
+ Core_Data.modes_of (negative_compilation_of compilation) ctxt, Core_Data.needs_random ctxt)
val ((moded_clauses, needs_random), errors) =
cond_timeit (Config.get ctxt Quickcheck.timing) "Infering modes"
(fn _ => infer_modes mode_analysis_options
options (lookup_mode, lookup_neg_mode, needs_random) ctxt preds all_modes param_vs clauses)
- val thy' = fold (fn (s, ms) => set_needs_random s ms) needs_random thy
+ val thy' = fold (fn (s, ms) => Core_Data.set_needs_random s ms) needs_random thy
val modes = map (fn (p, mps) => (p, map fst mps)) moded_clauses
val _ = check_expected_modes options preds modes
val _ = check_proposed_modes options preds modes errors
@@ -1435,12 +1435,12 @@
fun gen_add_equations steps options names thy =
let
fun dest_steps (Steps s) = s
- val defined = defined_functions (Comp_Mod.compilation (#comp_modifiers (dest_steps steps)))
- val thy' = extend_intro_graph names thy;
+ val defined = Core_Data.defined_functions (Comp_Mod.compilation (#comp_modifiers (dest_steps steps)))
+ val thy' = Core_Data.extend_intro_graph names thy;
fun strong_conn_of gr keys =
Graph.strong_conn (Graph.restrict (member (op =) (Graph.all_succs gr keys)) gr)
- val scc = strong_conn_of (PredData.get thy') names
- val thy'' = fold preprocess_intros (flat scc) thy'
+ val scc = strong_conn_of (Core_Data.PredData.get thy') names
+ val thy'' = fold Core_Data.preprocess_intros (flat scc) thy'
val thy''' = fold_rev
(fn preds => fn thy =>
if not (forall (defined (Proof_Context.init_global thy)) preds) then
@@ -1601,7 +1601,7 @@
fun attrib' f opt_case_name =
Thm.declaration_attribute (fn thm => Context.mapping (f (opt_case_name, thm)) I);
-val code_pred_intro_attrib = attrib' add_intro NONE;
+val code_pred_intro_attrib = attrib' Core_Data.add_intro NONE;
(*FIXME
- Naming of auxiliary rules necessary?
@@ -1616,8 +1616,9 @@
val _ =
Theory.setup
- (PredData.put (Graph.empty) #>
- Attrib.setup @{binding code_pred_intro} (Scan.lift (Scan.option Args.name) >> attrib' add_intro)
+ (Core_Data.PredData.put (Graph.empty) #>
+ Attrib.setup @{binding code_pred_intro}
+ (Scan.lift (Scan.option Args.name) >> attrib' Core_Data.add_intro)
"adding alternative introduction rules for code generation of inductive predicates")
(* TODO: make Theory_Data to Generic_Data & remove duplication of local theory and theory *)
@@ -1626,15 +1627,16 @@
let
val thy = Proof_Context.theory_of lthy
val const = prep_const thy raw_const
- val lthy' = Local_Theory.background_theory (extend_intro_graph [const]) lthy
+ val lthy' = Local_Theory.background_theory (Core_Data.extend_intro_graph [const]) lthy
val thy' = Proof_Context.theory_of lthy'
val ctxt' = Proof_Context.init_global thy'
- val preds = Graph.all_succs (PredData.get thy') [const] |> filter_out (has_elim ctxt')
+ val preds =
+ Graph.all_succs (Core_Data.PredData.get thy') [const] |> filter_out (Core_Data.has_elim ctxt')
fun mk_cases const =
let
val T = Sign.the_const_type thy' const
val pred = Const (const, T)
- val intros = intros_of ctxt' const
+ val intros = Core_Data.intros_of ctxt' const
in mk_casesrule lthy' pred intros end
val cases_rules = map mk_cases preds
val cases =
@@ -1644,7 +1646,7 @@
assumes =
("that", tl (Logic.strip_imp_prems case_rule)) ::
map_filter (fn (fact_name, fact) => Option.map (fn a => (a, [fact])) fact_name)
- ((SOME "prems" :: names_of ctxt' pred_name) ~~ Logic.strip_imp_prems case_rule),
+ ((SOME "prems" :: Core_Data.names_of ctxt' pred_name) ~~ Logic.strip_imp_prems case_rule),
binds = [], cases = []}) preds cases_rules
val case_env = map2 (fn p => fn c => (Long_Name.base_name p, SOME c)) preds cases
val lthy'' = lthy'
@@ -1655,7 +1657,7 @@
val global_thms = Proof_Context.export goal_ctxt
(Proof_Context.init_global (Proof_Context.theory_of goal_ctxt)) (map the_single thms)
in
- goal_ctxt |> Local_Theory.background_theory (fold set_elim global_thms #>
+ goal_ctxt |> Local_Theory.background_theory (fold Core_Data.set_elim global_thms #>
((case compilation options of
Pred => add_equations
| DSeq => add_dseq_equations
@@ -1762,7 +1764,7 @@
(compilation, _) t_compr =
let
val compfuns = Comp_Mod.compfuns comp_modifiers
- val all_modes_of = all_modes_of compilation
+ val all_modes_of = Core_Data.all_modes_of compilation
val (((body, output), T_compr), output_names) =
(case try dest_special_compr t_compr of
SOME r => r
@@ -1772,7 +1774,7 @@
(Const (name, T), all_args) => (Const (name, T), all_args)
| (head, _) => error ("Not a constant: " ^ Syntax.string_of_term ctxt head))
in
- if defined_functions compilation ctxt name then
+ if Core_Data.defined_functions compilation ctxt name then
let
fun extract_mode (Const (@{const_name Pair}, _) $ t1 $ t2) =
Pair (extract_mode t1, extract_mode t2)
@@ -1878,7 +1880,6 @@
@{term natural_of_nat} $ (HOLogic.size_const T $ Bound 0)))) t
else
mk_map compfuns T HOLogic.termT (HOLogic.term_of_const T) t
- val thy = Proof_Context.theory_of ctxt
val time_limit = seconds (Config.get ctxt values_timeout)
val (ts, statistics) =
(case compilation of
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML Fri Sep 18 16:42:19 2015 +0100
@@ -12,14 +12,13 @@
-> (string * (term list * indprem list) list) list
-> (string * typ) list -> string -> bool * mode
-> (term list * (indprem * Mode_Inference.mode_derivation) list) list * term
- -> Thm.thm
+ -> thm
end;
structure Predicate_Compile_Proof : PREDICATE_COMPILE_PROOF =
struct
open Predicate_Compile_Aux;
-open Core_Data;
open Mode_Inference;
@@ -62,7 +61,7 @@
val f_tac =
(case f of
Const (name, _) => simp_tac (put_simpset HOL_basic_ss ctxt addsimps
- [@{thm eval_pred}, predfun_definition_of ctxt name mode,
+ [@{thm eval_pred}, Core_Data.predfun_definition_of ctxt name mode,
@{thm split_eta}, @{thm split_beta}, @{thm fst_conv},
@{thm snd_conv}, @{thm pair_collapse}, @{thm Product_Type.split_conv}]) 1
| Free _ =>
@@ -88,7 +87,7 @@
(Const (name, _), args) =>
let
val mode = head_mode_of deriv
- val introrule = predfun_intro_of ctxt name mode
+ val introrule = Core_Data.predfun_intro_of ctxt name mode
val param_derivations = param_derivations_of deriv
val ho_args = ho_args_of mode args
in
@@ -170,12 +169,12 @@
fun preds_of t nameTs =
(case strip_comb t of
(Const (name, T), args) =>
- if is_registered ctxt name then (name, T) :: nameTs
- else fold preds_of args nameTs
+ if Core_Data.is_registered ctxt name then (name, T) :: nameTs
+ else fold preds_of args nameTs
| _ => nameTs)
val preds = preds_of t []
val defs = map
- (fn (pred, T) => predfun_definition_of ctxt pred
+ (fn (pred, T) => Core_Data.predfun_definition_of ctxt pred
(all_input_of T))
preds
in
@@ -227,7 +226,7 @@
val name = (case strip_comb t of (Const (c, _), _) => SOME c | _ => NONE)
val neg_intro_rule =
Option.map (fn name =>
- the (predfun_neg_intro_of ctxt name mode)) name
+ the (Core_Data.predfun_neg_intro_of ctxt name mode)) name
val param_derivations = param_derivations_of deriv
val params = ho_args_of mode args
in
@@ -278,11 +277,11 @@
let
val T = the (AList.lookup (op =) preds pred)
val nargs = length (binder_types T)
- val pred_case_rule = the_elim_of ctxt pred
+ val pred_case_rule = Core_Data.the_elim_of ctxt pred
in
REPEAT_DETERM (CHANGED (rewrite_goals_tac ctxt @{thms split_paired_all}))
THEN trace_tac ctxt options "before applying elim rule"
- THEN eresolve_tac ctxt [predfun_elim_of ctxt pred mode] 1
+ THEN eresolve_tac ctxt [Core_Data.predfun_elim_of ctxt pred mode] 1
THEN eresolve_tac ctxt [pred_case_rule] 1
THEN trace_tac ctxt options "after applying elim rule"
THEN (EVERY (map
@@ -338,8 +337,8 @@
val f_tac =
(case f of
Const (name, _) => full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps
- (@{thm eval_pred}::(predfun_definition_of ctxt name mode)
- :: @{thm "Product_Type.split_conv"}::[])) 1
+ [@{thm eval_pred}, Core_Data.predfun_definition_of ctxt name mode,
+ @{thm Product_Type.split_conv}]) 1
| Free _ => all_tac
| _ => error "prove_param2: illegal parameter term")
in
@@ -360,7 +359,7 @@
eresolve_tac ctxt @{thms bindE} 1
THEN (REPEAT_DETERM (CHANGED (rewrite_goals_tac ctxt @{thms split_paired_all})))
THEN trace_tac ctxt options "prove_expr2-before"
- THEN eresolve_tac ctxt [predfun_elim_of ctxt name mode] 1
+ THEN eresolve_tac ctxt [Core_Data.predfun_elim_of ctxt name mode] 1
THEN trace_tac ctxt options "prove_expr2"
THEN (EVERY (map2 (prove_param2 options ctxt) ho_args param_derivations))
THEN trace_tac ctxt options "finished prove_expr2"
@@ -372,12 +371,12 @@
fun preds_of t nameTs =
(case strip_comb t of
(Const (name, T), args) =>
- if is_registered ctxt name then (name, T) :: nameTs
- else fold preds_of args nameTs
+ if Core_Data.is_registered ctxt name then (name, T) :: nameTs
+ else fold preds_of args nameTs
| _ => nameTs)
val preds = preds_of t []
val defs = map
- (fn (pred, T) => predfun_definition_of ctxt pred
+ (fn (pred, T) => Core_Data.predfun_definition_of ctxt pred
(all_input_of T))
preds
in
@@ -389,7 +388,7 @@
fun prove_clause2 options ctxt pred mode (ts, ps) i =
let
- val pred_intro_rule = nth (intros_of ctxt pred) (i - 1)
+ val pred_intro_rule = nth (Core_Data.intros_of ctxt pred) (i - 1)
val (in_ts, _) = split_mode mode ts;
val split_simpset =
put_simpset HOL_basic_ss' ctxt
@@ -441,9 +440,9 @@
THEN eresolve_tac ctxt @{thms bindE} 1
THEN (if is_some name then
full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps
- [predfun_definition_of ctxt (the name) mode]) 1
+ [Core_Data.predfun_definition_of ctxt (the name) mode]) 1
THEN eresolve_tac ctxt @{thms not_predE} 1
- THEN simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm not_False_eq_True}]) 1
+ THEN simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms not_False_eq_True}) 1
THEN (EVERY (map2 (prove_param2 options ctxt) ho_args param_derivations))
else
eresolve_tac ctxt @{thms not_predE'} 1)
@@ -478,7 +477,7 @@
in
(DETERM (TRY (resolve_tac ctxt @{thms unit.induct} 1)))
THEN (REPEAT_DETERM (CHANGED (rewrite_goals_tac ctxt @{thms split_paired_all})))
- THEN (resolve_tac ctxt [predfun_intro_of ctxt pred mode] 1)
+ THEN (resolve_tac ctxt [Core_Data.predfun_intro_of ctxt pred mode] 1)
THEN (REPEAT_DETERM (resolve_tac ctxt @{thms refl} 2))
THEN (
if null moded_clauses then eresolve_tac ctxt @{thms botE} 1
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML Fri Sep 18 16:42:19 2015 +0100
@@ -26,7 +26,7 @@
val put_cps_result : (unit -> Code_Numeral.natural -> (bool * term list) option) ->
Proof.context -> Proof.context
val test_goals : (Predicate_Compile_Aux.compilation * bool) ->
- Proof.context -> bool * bool -> (string * typ) list -> (term * term list) list ->
+ Proof.context -> bool -> (string * typ) list -> (term * term list) list ->
Quickcheck.result list
val nrandom : int Unsynchronized.ref
val debug : bool Unsynchronized.ref
--- a/src/HOL/Tools/Qelim/cooper.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Qelim/cooper.ML Fri Sep 18 16:42:19 2015 +0100
@@ -635,7 +635,7 @@
| fm_of_term ps vs (@{term "op = :: bool => _ "} $ t1 $ t2) =
Proc.Iff (fm_of_term ps vs t1, fm_of_term ps vs t2)
| fm_of_term ps vs (Const (@{const_name Not}, _) $ t') =
- Proc.Not (fm_of_term ps vs t')
+ Proc.NOT (fm_of_term ps vs t')
| fm_of_term ps vs (Const (@{const_name Ex}, _) $ Abs abs) =
Proc.E (uncurry (fm_of_term ps) (descend vs abs))
| fm_of_term ps vs (Const (@{const_name All}, _) $ Abs abs) =
@@ -663,7 +663,7 @@
@{term "op - :: int => _"} $ term_of_num vs t1 $ term_of_num vs t2
| term_of_num vs (Proc.Mul (i, t2)) =
@{term "op * :: int => _"} $ HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t2
- | term_of_num vs (Proc.Cn (n, i, t')) =
+ | term_of_num vs (Proc.CN (n, i, t')) =
term_of_num vs (Proc.Add (Proc.Mul (i, Proc.Bound n), t'));
fun term_of_fm ps vs Proc.T = @{term True}
@@ -672,18 +672,18 @@
| term_of_fm ps vs (Proc.Or (t1, t2)) = HOLogic.disj $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
| term_of_fm ps vs (Proc.Imp (t1, t2)) = HOLogic.imp $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
| term_of_fm ps vs (Proc.Iff (t1, t2)) = @{term "op = :: bool => _"} $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
- | term_of_fm ps vs (Proc.Not t') = HOLogic.Not $ term_of_fm ps vs t'
+ | term_of_fm ps vs (Proc.NOT t') = HOLogic.Not $ term_of_fm ps vs t'
| term_of_fm ps vs (Proc.Eq t') = @{term "op = :: int => _ "} $ term_of_num vs t'$ @{term "0::int"}
- | term_of_fm ps vs (Proc.NEq t') = term_of_fm ps vs (Proc.Not (Proc.Eq t'))
+ | term_of_fm ps vs (Proc.NEq t') = term_of_fm ps vs (Proc.NOT (Proc.Eq t'))
| term_of_fm ps vs (Proc.Lt t') = @{term "op < :: int => _ "} $ term_of_num vs t' $ @{term "0::int"}
| term_of_fm ps vs (Proc.Le t') = @{term "op <= :: int => _ "} $ term_of_num vs t' $ @{term "0::int"}
| term_of_fm ps vs (Proc.Gt t') = @{term "op < :: int => _ "} $ @{term "0::int"} $ term_of_num vs t'
| term_of_fm ps vs (Proc.Ge t') = @{term "op <= :: int => _ "} $ @{term "0::int"} $ term_of_num vs t'
| term_of_fm ps vs (Proc.Dvd (i, t')) = @{term "op dvd :: int => _ "} $
HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t'
- | term_of_fm ps vs (Proc.NDvd (i, t')) = term_of_fm ps vs (Proc.Not (Proc.Dvd (i, t')))
+ | term_of_fm ps vs (Proc.NDvd (i, t')) = term_of_fm ps vs (Proc.NOT (Proc.Dvd (i, t')))
| term_of_fm ps vs (Proc.Closed n) = nth ps (Proc.integer_of_nat n)
- | term_of_fm ps vs (Proc.NClosed n) = term_of_fm ps vs (Proc.Not (Proc.Closed n));
+ | term_of_fm ps vs (Proc.NClosed n) = term_of_fm ps vs (Proc.NOT (Proc.Closed n));
fun procedure t =
let
--- a/src/HOL/Tools/Qelim/cooper_procedure.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Qelim/cooper_procedure.ML Fri Sep 18 16:42:19 2015 +0100
@@ -5,11 +5,11 @@
val integer_of_int : inta -> int
type nat
val integer_of_nat : nat -> int
- datatype numa = C of inta | Bound of nat | Cn of nat * inta * numa |
+ datatype numa = C of inta | Bound of nat | CN of nat * inta * numa |
Neg of numa | Add of numa * numa | Sub of numa * numa | Mul of inta * numa
datatype fm = T | F | Lt of numa | Le of numa | Gt of numa | Ge of numa |
Eq of numa | NEq of numa | Dvd of inta * numa | NDvd of inta * numa |
- Not of fm | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm
+ NOT of fm | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm
| E of fm | A of fm | Closed of nat | NClosed of nat
val pa : fm -> fm
val nat_of_integer : int -> nat
@@ -48,26 +48,34 @@
val one_int = {one = one_inta} : inta one;
fun sgn_integer k =
- (if k = 0 then 0
- else (if k < 0 then (~1 : IntInf.int) else (1 : IntInf.int)));
+ (if k = (0 : IntInf.int) then (0 : IntInf.int)
+ else (if k < (0 : IntInf.int) then (~1 : IntInf.int)
+ else (1 : IntInf.int)));
-fun abs_integer k = (if k < 0 then ~ k else k);
+fun abs_integer k = (if k < (0 : IntInf.int) then ~ k else k);
fun apsnd f (x, y) = (x, f y);
fun divmod_integer k l =
- (if k = 0 then (0, 0)
- else (if l = 0 then (0, k)
+ (if k = (0 : IntInf.int) then ((0 : IntInf.int), (0 : IntInf.int))
+ else (if l = (0 : IntInf.int) then ((0 : IntInf.int), k)
else (apsnd o (fn a => fn b => a * b) o sgn_integer) l
(if sgn_integer k = sgn_integer l
then Integer.div_mod (abs k) (abs l)
else let
val (r, s) = Integer.div_mod (abs k) (abs l);
in
- (if s = 0 then (~ r, 0)
+ (if s = (0 : IntInf.int) then (~ r, (0 : IntInf.int))
else (~ r - (1 : IntInf.int), abs_integer l - s))
end)));
+fun fst (x1, x2) = x1;
+
+fun divide_integer k l = fst (divmod_integer k l);
+
+fun divide_inta k l =
+ Int_of_integer (divide_integer (integer_of_int k) (integer_of_int l));
+
fun snd (x1, x2) = x2;
fun mod_integer k l = snd (divmod_integer k l);
@@ -75,19 +83,19 @@
fun mod_int k l =
Int_of_integer (mod_integer (integer_of_int k) (integer_of_int l));
-fun fst (x1, x2) = x1;
-
-fun div_integer k l = fst (divmod_integer k l);
+type 'a divide = {divide : 'a -> 'a -> 'a};
+val divide = #divide : 'a divide -> 'a -> 'a -> 'a;
-fun div_inta k l =
- Int_of_integer (div_integer (integer_of_int k) (integer_of_int l));
-
-type 'a diva = {dvd_div : 'a dvd, diva : 'a -> 'a -> 'a, moda : 'a -> 'a -> 'a};
+type 'a diva =
+ {divide_div : 'a divide, dvd_div : 'a dvd, moda : 'a -> 'a -> 'a};
+val divide_div = #divide_div : 'a diva -> 'a divide;
val dvd_div = #dvd_div : 'a diva -> 'a dvd;
-val diva = #diva : 'a diva -> 'a -> 'a -> 'a;
val moda = #moda : 'a diva -> 'a -> 'a -> 'a;
-val div_int = {dvd_div = dvd_int, diva = div_inta, moda = mod_int} : inta diva;
+val divide_int = {divide = divide_inta} : inta divide;
+
+val div_int = {divide_div = divide_int, dvd_div = dvd_int, moda = mod_int} :
+ inta diva;
fun plus_inta k l = Int_of_integer (integer_of_int k + integer_of_int l);
@@ -96,7 +104,7 @@
val plus_int = {plus = plus_inta} : inta plus;
-val zero_inta : inta = Int_of_integer 0;
+val zero_inta : inta = Int_of_integer (0 : IntInf.int);
type 'a zero = {zero : 'a};
val zero = #zero : 'a zero -> 'a;
@@ -124,40 +132,17 @@
val power_int = {one_power = one_int, times_power = times_int} : inta power;
+fun minus_inta k l = Int_of_integer (integer_of_int k - integer_of_int l);
+
+type 'a minus = {minus : 'a -> 'a -> 'a};
+val minus = #minus : 'a minus -> 'a -> 'a -> 'a;
+
+val minus_int = {minus = minus_inta} : inta minus;
+
type 'a ab_semigroup_add = {semigroup_add_ab_semigroup_add : 'a semigroup_add};
val semigroup_add_ab_semigroup_add = #semigroup_add_ab_semigroup_add :
'a ab_semigroup_add -> 'a semigroup_add;
-type 'a semigroup_mult = {times_semigroup_mult : 'a times};
-val times_semigroup_mult = #times_semigroup_mult :
- 'a semigroup_mult -> 'a times;
-
-type 'a semiring =
- {ab_semigroup_add_semiring : 'a ab_semigroup_add,
- semigroup_mult_semiring : 'a semigroup_mult};
-val ab_semigroup_add_semiring = #ab_semigroup_add_semiring :
- 'a semiring -> 'a ab_semigroup_add;
-val semigroup_mult_semiring = #semigroup_mult_semiring :
- 'a semiring -> 'a semigroup_mult;
-
-val ab_semigroup_add_int = {semigroup_add_ab_semigroup_add = semigroup_add_int}
- : inta ab_semigroup_add;
-
-val semigroup_mult_int = {times_semigroup_mult = times_int} :
- inta semigroup_mult;
-
-val semiring_int =
- {ab_semigroup_add_semiring = ab_semigroup_add_int,
- semigroup_mult_semiring = semigroup_mult_int}
- : inta semiring;
-
-type 'a mult_zero = {times_mult_zero : 'a times, zero_mult_zero : 'a zero};
-val times_mult_zero = #times_mult_zero : 'a mult_zero -> 'a times;
-val zero_mult_zero = #zero_mult_zero : 'a mult_zero -> 'a zero;
-
-val mult_zero_int = {times_mult_zero = times_int, zero_mult_zero = zero_int} :
- inta mult_zero;
-
type 'a monoid_add =
{semigroup_add_monoid_add : 'a semigroup_add, zero_monoid_add : 'a zero};
val semigroup_add_monoid_add = #semigroup_add_monoid_add :
@@ -172,6 +157,22 @@
val monoid_add_comm_monoid_add = #monoid_add_comm_monoid_add :
'a comm_monoid_add -> 'a monoid_add;
+type 'a mult_zero = {times_mult_zero : 'a times, zero_mult_zero : 'a zero};
+val times_mult_zero = #times_mult_zero : 'a mult_zero -> 'a times;
+val zero_mult_zero = #zero_mult_zero : 'a mult_zero -> 'a zero;
+
+type 'a semigroup_mult = {times_semigroup_mult : 'a times};
+val times_semigroup_mult = #times_semigroup_mult :
+ 'a semigroup_mult -> 'a times;
+
+type 'a semiring =
+ {ab_semigroup_add_semiring : 'a ab_semigroup_add,
+ semigroup_mult_semiring : 'a semigroup_mult};
+val ab_semigroup_add_semiring = #ab_semigroup_add_semiring :
+ 'a semiring -> 'a ab_semigroup_add;
+val semigroup_mult_semiring = #semigroup_mult_semiring :
+ 'a semiring -> 'a semigroup_mult;
+
type 'a semiring_0 =
{comm_monoid_add_semiring_0 : 'a comm_monoid_add,
mult_zero_semiring_0 : 'a mult_zero, semiring_semiring_0 : 'a semiring};
@@ -181,19 +182,10 @@
'a semiring_0 -> 'a mult_zero;
val semiring_semiring_0 = #semiring_semiring_0 : 'a semiring_0 -> 'a semiring;
-val monoid_add_int =
- {semigroup_add_monoid_add = semigroup_add_int, zero_monoid_add = zero_int} :
- inta monoid_add;
-
-val comm_monoid_add_int =
- {ab_semigroup_add_comm_monoid_add = ab_semigroup_add_int,
- monoid_add_comm_monoid_add = monoid_add_int}
- : inta comm_monoid_add;
-
-val semiring_0_int =
- {comm_monoid_add_semiring_0 = comm_monoid_add_int,
- mult_zero_semiring_0 = mult_zero_int, semiring_semiring_0 = semiring_int}
- : inta semiring_0;
+type 'a semiring_no_zero_divisors =
+ {semiring_0_semiring_no_zero_divisors : 'a semiring_0};
+val semiring_0_semiring_no_zero_divisors = #semiring_0_semiring_no_zero_divisors
+ : 'a semiring_no_zero_divisors -> 'a semiring_0;
type 'a monoid_mult =
{semigroup_mult_monoid_mult : 'a semigroup_mult,
@@ -228,48 +220,16 @@
val zero_neq_one_semiring_1 = #zero_neq_one_semiring_1 :
'a semiring_1 -> 'a zero_neq_one;
-val monoid_mult_int =
- {semigroup_mult_monoid_mult = semigroup_mult_int,
- power_monoid_mult = power_int}
- : inta monoid_mult;
-
-val semiring_numeral_int =
- {monoid_mult_semiring_numeral = monoid_mult_int,
- numeral_semiring_numeral = numeral_int,
- semiring_semiring_numeral = semiring_int}
- : inta semiring_numeral;
-
-val zero_neq_one_int =
- {one_zero_neq_one = one_int, zero_zero_neq_one = zero_int} :
- inta zero_neq_one;
-
-val semiring_1_int =
- {semiring_numeral_semiring_1 = semiring_numeral_int,
- semiring_0_semiring_1 = semiring_0_int,
- zero_neq_one_semiring_1 = zero_neq_one_int}
- : inta semiring_1;
-
-type 'a ab_semigroup_mult =
- {semigroup_mult_ab_semigroup_mult : 'a semigroup_mult};
-val semigroup_mult_ab_semigroup_mult = #semigroup_mult_ab_semigroup_mult :
- 'a ab_semigroup_mult -> 'a semigroup_mult;
-
-type 'a comm_semiring =
- {ab_semigroup_mult_comm_semiring : 'a ab_semigroup_mult,
- semiring_comm_semiring : 'a semiring};
-val ab_semigroup_mult_comm_semiring = #ab_semigroup_mult_comm_semiring :
- 'a comm_semiring -> 'a ab_semigroup_mult;
-val semiring_comm_semiring = #semiring_comm_semiring :
- 'a comm_semiring -> 'a semiring;
-
-val ab_semigroup_mult_int =
- {semigroup_mult_ab_semigroup_mult = semigroup_mult_int} :
- inta ab_semigroup_mult;
-
-val comm_semiring_int =
- {ab_semigroup_mult_comm_semiring = ab_semigroup_mult_int,
- semiring_comm_semiring = semiring_int}
- : inta comm_semiring;
+type 'a semiring_1_no_zero_divisors =
+ {semiring_1_semiring_1_no_zero_divisors : 'a semiring_1,
+ semiring_no_zero_divisors_semiring_1_no_zero_divisors :
+ 'a semiring_no_zero_divisors};
+val semiring_1_semiring_1_no_zero_divisors =
+ #semiring_1_semiring_1_no_zero_divisors :
+ 'a semiring_1_no_zero_divisors -> 'a semiring_1;
+val semiring_no_zero_divisors_semiring_1_no_zero_divisors =
+ #semiring_no_zero_divisors_semiring_1_no_zero_divisors :
+ 'a semiring_1_no_zero_divisors -> 'a semiring_no_zero_divisors;
type 'a cancel_semigroup_add =
{semigroup_add_cancel_semigroup_add : 'a semigroup_add};
@@ -278,13 +238,16 @@
type 'a cancel_ab_semigroup_add =
{ab_semigroup_add_cancel_ab_semigroup_add : 'a ab_semigroup_add,
- cancel_semigroup_add_cancel_ab_semigroup_add : 'a cancel_semigroup_add};
+ cancel_semigroup_add_cancel_ab_semigroup_add : 'a cancel_semigroup_add,
+ minus_cancel_ab_semigroup_add : 'a minus};
val ab_semigroup_add_cancel_ab_semigroup_add =
#ab_semigroup_add_cancel_ab_semigroup_add :
'a cancel_ab_semigroup_add -> 'a ab_semigroup_add;
val cancel_semigroup_add_cancel_ab_semigroup_add =
#cancel_semigroup_add_cancel_ab_semigroup_add :
'a cancel_ab_semigroup_add -> 'a cancel_semigroup_add;
+val minus_cancel_ab_semigroup_add = #minus_cancel_ab_semigroup_add :
+ 'a cancel_ab_semigroup_add -> 'a minus;
type 'a cancel_comm_monoid_add =
{cancel_ab_semigroup_add_cancel_comm_monoid_add : 'a cancel_ab_semigroup_add,
@@ -305,6 +268,19 @@
val semiring_0_semiring_0_cancel = #semiring_0_semiring_0_cancel :
'a semiring_0_cancel -> 'a semiring_0;
+type 'a ab_semigroup_mult =
+ {semigroup_mult_ab_semigroup_mult : 'a semigroup_mult};
+val semigroup_mult_ab_semigroup_mult = #semigroup_mult_ab_semigroup_mult :
+ 'a ab_semigroup_mult -> 'a semigroup_mult;
+
+type 'a comm_semiring =
+ {ab_semigroup_mult_comm_semiring : 'a ab_semigroup_mult,
+ semiring_comm_semiring : 'a semiring};
+val ab_semigroup_mult_comm_semiring = #ab_semigroup_mult_comm_semiring :
+ 'a comm_semiring -> 'a ab_semigroup_mult;
+val semiring_comm_semiring = #semiring_comm_semiring :
+ 'a comm_semiring -> 'a semiring;
+
type 'a comm_semiring_0 =
{comm_semiring_comm_semiring_0 : 'a comm_semiring,
semiring_0_comm_semiring_0 : 'a semiring_0};
@@ -333,21 +309,23 @@
type 'a comm_monoid_mult =
{ab_semigroup_mult_comm_monoid_mult : 'a ab_semigroup_mult,
- monoid_mult_comm_monoid_mult : 'a monoid_mult};
+ monoid_mult_comm_monoid_mult : 'a monoid_mult,
+ dvd_comm_monoid_mult : 'a dvd};
val ab_semigroup_mult_comm_monoid_mult = #ab_semigroup_mult_comm_monoid_mult :
'a comm_monoid_mult -> 'a ab_semigroup_mult;
val monoid_mult_comm_monoid_mult = #monoid_mult_comm_monoid_mult :
'a comm_monoid_mult -> 'a monoid_mult;
+val dvd_comm_monoid_mult = #dvd_comm_monoid_mult :
+ 'a comm_monoid_mult -> 'a dvd;
type 'a comm_semiring_1 =
{comm_monoid_mult_comm_semiring_1 : 'a comm_monoid_mult,
comm_semiring_0_comm_semiring_1 : 'a comm_semiring_0,
- dvd_comm_semiring_1 : 'a dvd, semiring_1_comm_semiring_1 : 'a semiring_1};
+ semiring_1_comm_semiring_1 : 'a semiring_1};
val comm_monoid_mult_comm_semiring_1 = #comm_monoid_mult_comm_semiring_1 :
'a comm_semiring_1 -> 'a comm_monoid_mult;
val comm_semiring_0_comm_semiring_1 = #comm_semiring_0_comm_semiring_1 :
'a comm_semiring_1 -> 'a comm_semiring_0;
-val dvd_comm_semiring_1 = #dvd_comm_semiring_1 : 'a comm_semiring_1 -> 'a dvd;
val semiring_1_comm_semiring_1 = #semiring_1_comm_semiring_1 :
'a comm_semiring_1 -> 'a semiring_1;
@@ -365,22 +343,72 @@
#semiring_1_cancel_comm_semiring_1_cancel :
'a comm_semiring_1_cancel -> 'a semiring_1_cancel;
-type 'a no_zero_divisors =
- {times_no_zero_divisors : 'a times, zero_no_zero_divisors : 'a zero};
-val times_no_zero_divisors = #times_no_zero_divisors :
- 'a no_zero_divisors -> 'a times;
-val zero_no_zero_divisors = #zero_no_zero_divisors :
- 'a no_zero_divisors -> 'a zero;
+type 'a semidom =
+ {semiring_1_no_zero_divisors_semidom : 'a semiring_1_no_zero_divisors,
+ comm_semiring_1_cancel_semidom : 'a comm_semiring_1_cancel};
+val semiring_1_no_zero_divisors_semidom = #semiring_1_no_zero_divisors_semidom :
+ 'a semidom -> 'a semiring_1_no_zero_divisors;
+val comm_semiring_1_cancel_semidom = #comm_semiring_1_cancel_semidom :
+ 'a semidom -> 'a comm_semiring_1_cancel;
+
+val ab_semigroup_add_int = {semigroup_add_ab_semigroup_add = semigroup_add_int}
+ : inta ab_semigroup_add;
+
+val monoid_add_int =
+ {semigroup_add_monoid_add = semigroup_add_int, zero_monoid_add = zero_int} :
+ inta monoid_add;
+
+val comm_monoid_add_int =
+ {ab_semigroup_add_comm_monoid_add = ab_semigroup_add_int,
+ monoid_add_comm_monoid_add = monoid_add_int}
+ : inta comm_monoid_add;
+
+val mult_zero_int = {times_mult_zero = times_int, zero_mult_zero = zero_int} :
+ inta mult_zero;
+
+val semigroup_mult_int = {times_semigroup_mult = times_int} :
+ inta semigroup_mult;
+
+val semiring_int =
+ {ab_semigroup_add_semiring = ab_semigroup_add_int,
+ semigroup_mult_semiring = semigroup_mult_int}
+ : inta semiring;
-type 'a semiring_div =
- {div_semiring_div : 'a diva,
- comm_semiring_1_cancel_semiring_div : 'a comm_semiring_1_cancel,
- no_zero_divisors_semiring_div : 'a no_zero_divisors};
-val div_semiring_div = #div_semiring_div : 'a semiring_div -> 'a diva;
-val comm_semiring_1_cancel_semiring_div = #comm_semiring_1_cancel_semiring_div :
- 'a semiring_div -> 'a comm_semiring_1_cancel;
-val no_zero_divisors_semiring_div = #no_zero_divisors_semiring_div :
- 'a semiring_div -> 'a no_zero_divisors;
+val semiring_0_int =
+ {comm_monoid_add_semiring_0 = comm_monoid_add_int,
+ mult_zero_semiring_0 = mult_zero_int, semiring_semiring_0 = semiring_int}
+ : inta semiring_0;
+
+val semiring_no_zero_divisors_int =
+ {semiring_0_semiring_no_zero_divisors = semiring_0_int} :
+ inta semiring_no_zero_divisors;
+
+val monoid_mult_int =
+ {semigroup_mult_monoid_mult = semigroup_mult_int,
+ power_monoid_mult = power_int}
+ : inta monoid_mult;
+
+val semiring_numeral_int =
+ {monoid_mult_semiring_numeral = monoid_mult_int,
+ numeral_semiring_numeral = numeral_int,
+ semiring_semiring_numeral = semiring_int}
+ : inta semiring_numeral;
+
+val zero_neq_one_int =
+ {one_zero_neq_one = one_int, zero_zero_neq_one = zero_int} :
+ inta zero_neq_one;
+
+val semiring_1_int =
+ {semiring_numeral_semiring_1 = semiring_numeral_int,
+ semiring_0_semiring_1 = semiring_0_int,
+ zero_neq_one_semiring_1 = zero_neq_one_int}
+ : inta semiring_1;
+
+val semiring_1_no_zero_divisors_int =
+ {semiring_1_semiring_1_no_zero_divisors = semiring_1_int,
+ semiring_no_zero_divisors_semiring_1_no_zero_divisors =
+ semiring_no_zero_divisors_int}
+ : inta semiring_1_no_zero_divisors;
val cancel_semigroup_add_int =
{semigroup_add_cancel_semigroup_add = semigroup_add_int} :
@@ -388,7 +416,8 @@
val cancel_ab_semigroup_add_int =
{ab_semigroup_add_cancel_ab_semigroup_add = ab_semigroup_add_int,
- cancel_semigroup_add_cancel_ab_semigroup_add = cancel_semigroup_add_int}
+ cancel_semigroup_add_cancel_ab_semigroup_add = cancel_semigroup_add_int,
+ minus_cancel_ab_semigroup_add = minus_int}
: inta cancel_ab_semigroup_add;
val cancel_comm_monoid_add_int =
@@ -401,6 +430,15 @@
semiring_0_semiring_0_cancel = semiring_0_int}
: inta semiring_0_cancel;
+val ab_semigroup_mult_int =
+ {semigroup_mult_ab_semigroup_mult = semigroup_mult_int} :
+ inta ab_semigroup_mult;
+
+val comm_semiring_int =
+ {ab_semigroup_mult_comm_semiring = ab_semigroup_mult_int,
+ semiring_comm_semiring = semiring_int}
+ : inta comm_semiring;
+
val comm_semiring_0_int =
{comm_semiring_comm_semiring_0 = comm_semiring_int,
semiring_0_comm_semiring_0 = semiring_0_int}
@@ -418,13 +456,14 @@
val comm_monoid_mult_int =
{ab_semigroup_mult_comm_monoid_mult = ab_semigroup_mult_int,
- monoid_mult_comm_monoid_mult = monoid_mult_int}
+ monoid_mult_comm_monoid_mult = monoid_mult_int,
+ dvd_comm_monoid_mult = dvd_int}
: inta comm_monoid_mult;
val comm_semiring_1_int =
{comm_monoid_mult_comm_semiring_1 = comm_monoid_mult_int,
comm_semiring_0_comm_semiring_1 = comm_semiring_0_int,
- dvd_comm_semiring_1 = dvd_int, semiring_1_comm_semiring_1 = semiring_1_int}
+ semiring_1_comm_semiring_1 = semiring_1_int}
: inta comm_semiring_1;
val comm_semiring_1_cancel_int =
@@ -433,14 +472,60 @@
semiring_1_cancel_comm_semiring_1_cancel = semiring_1_cancel_int}
: inta comm_semiring_1_cancel;
-val no_zero_divisors_int =
- {times_no_zero_divisors = times_int, zero_no_zero_divisors = zero_int} :
- inta no_zero_divisors;
+val semidom_int =
+ {semiring_1_no_zero_divisors_semidom = semiring_1_no_zero_divisors_int,
+ comm_semiring_1_cancel_semidom = comm_semiring_1_cancel_int}
+ : inta semidom;
+
+type 'a semiring_no_zero_divisors_cancel =
+ {semiring_no_zero_divisors_semiring_no_zero_divisors_cancel :
+ 'a semiring_no_zero_divisors};
+val semiring_no_zero_divisors_semiring_no_zero_divisors_cancel =
+ #semiring_no_zero_divisors_semiring_no_zero_divisors_cancel :
+ 'a semiring_no_zero_divisors_cancel -> 'a semiring_no_zero_divisors;
+
+type 'a semidom_divide =
+ {divide_semidom_divide : 'a divide, semidom_semidom_divide : 'a semidom,
+ semiring_no_zero_divisors_cancel_semidom_divide :
+ 'a semiring_no_zero_divisors_cancel};
+val divide_semidom_divide = #divide_semidom_divide :
+ 'a semidom_divide -> 'a divide;
+val semidom_semidom_divide = #semidom_semidom_divide :
+ 'a semidom_divide -> 'a semidom;
+val semiring_no_zero_divisors_cancel_semidom_divide =
+ #semiring_no_zero_divisors_cancel_semidom_divide :
+ 'a semidom_divide -> 'a semiring_no_zero_divisors_cancel;
+
+type 'a algebraic_semidom =
+ {semidom_divide_algebraic_semidom : 'a semidom_divide};
+val semidom_divide_algebraic_semidom = #semidom_divide_algebraic_semidom :
+ 'a algebraic_semidom -> 'a semidom_divide;
+
+type 'a semiring_div =
+ {div_semiring_div : 'a diva,
+ algebraic_semidom_semiring_div : 'a algebraic_semidom};
+val div_semiring_div = #div_semiring_div : 'a semiring_div -> 'a diva;
+val algebraic_semidom_semiring_div = #algebraic_semidom_semiring_div :
+ 'a semiring_div -> 'a algebraic_semidom;
+
+val semiring_no_zero_divisors_cancel_int =
+ {semiring_no_zero_divisors_semiring_no_zero_divisors_cancel =
+ semiring_no_zero_divisors_int}
+ : inta semiring_no_zero_divisors_cancel;
+
+val semidom_divide_int =
+ {divide_semidom_divide = divide_int, semidom_semidom_divide = semidom_int,
+ semiring_no_zero_divisors_cancel_semidom_divide =
+ semiring_no_zero_divisors_cancel_int}
+ : inta semidom_divide;
+
+val algebraic_semidom_int =
+ {semidom_divide_algebraic_semidom = semidom_divide_int} :
+ inta algebraic_semidom;
val semiring_div_int =
{div_semiring_div = div_int,
- comm_semiring_1_cancel_semiring_div = comm_semiring_1_cancel_int,
- no_zero_divisors_semiring_div = no_zero_divisors_int}
+ algebraic_semidom_semiring_div = algebraic_semidom_int}
: inta semiring_div;
datatype nat = Nat of int;
@@ -449,63 +534,62 @@
fun equal_nat m n = integer_of_nat m = integer_of_nat n;
-datatype numa = C of inta | Bound of nat | Cn of nat * inta * numa | Neg of numa
+datatype numa = C of inta | Bound of nat | CN of nat * inta * numa | Neg of numa
| Add of numa * numa | Sub of numa * numa | Mul of inta * numa;
-fun equal_numa (Sub (num1, num2)) (Mul (inta, num)) = false
- | equal_numa (Mul (inta, num)) (Sub (num1, num2)) = false
- | equal_numa (Add (num1, num2)) (Mul (inta, num)) = false
- | equal_numa (Mul (inta, num)) (Add (num1, num2)) = false
- | equal_numa (Add (num1a, num2a)) (Sub (num1, num2)) = false
- | equal_numa (Sub (num1a, num2a)) (Add (num1, num2)) = false
- | equal_numa (Neg numa) (Mul (inta, num)) = false
- | equal_numa (Mul (inta, numa)) (Neg num) = false
- | equal_numa (Neg num) (Sub (num1, num2)) = false
- | equal_numa (Sub (num1, num2)) (Neg num) = false
- | equal_numa (Neg num) (Add (num1, num2)) = false
- | equal_numa (Add (num1, num2)) (Neg num) = false
- | equal_numa (Cn (nat, intaa, numa)) (Mul (inta, num)) = false
- | equal_numa (Mul (intaa, numa)) (Cn (nat, inta, num)) = false
- | equal_numa (Cn (nat, inta, num)) (Sub (num1, num2)) = false
- | equal_numa (Sub (num1, num2)) (Cn (nat, inta, num)) = false
- | equal_numa (Cn (nat, inta, num)) (Add (num1, num2)) = false
- | equal_numa (Add (num1, num2)) (Cn (nat, inta, num)) = false
- | equal_numa (Cn (nat, inta, numa)) (Neg num) = false
- | equal_numa (Neg numa) (Cn (nat, inta, num)) = false
- | equal_numa (Bound nat) (Mul (inta, num)) = false
- | equal_numa (Mul (inta, num)) (Bound nat) = false
- | equal_numa (Bound nat) (Sub (num1, num2)) = false
- | equal_numa (Sub (num1, num2)) (Bound nat) = false
- | equal_numa (Bound nat) (Add (num1, num2)) = false
- | equal_numa (Add (num1, num2)) (Bound nat) = false
- | equal_numa (Bound nat) (Neg num) = false
- | equal_numa (Neg num) (Bound nat) = false
- | equal_numa (Bound nata) (Cn (nat, inta, num)) = false
- | equal_numa (Cn (nata, inta, num)) (Bound nat) = false
- | equal_numa (C intaa) (Mul (inta, num)) = false
- | equal_numa (Mul (intaa, num)) (C inta) = false
- | equal_numa (C inta) (Sub (num1, num2)) = false
- | equal_numa (Sub (num1, num2)) (C inta) = false
- | equal_numa (C inta) (Add (num1, num2)) = false
- | equal_numa (Add (num1, num2)) (C inta) = false
- | equal_numa (C inta) (Neg num) = false
- | equal_numa (Neg num) (C inta) = false
- | equal_numa (C intaa) (Cn (nat, inta, num)) = false
- | equal_numa (Cn (nat, intaa, num)) (C inta) = false
- | equal_numa (C inta) (Bound nat) = false
- | equal_numa (Bound nat) (C inta) = false
- | equal_numa (Mul (intaa, numa)) (Mul (inta, num)) =
- equal_inta intaa inta andalso equal_numa numa num
- | equal_numa (Sub (num1a, num2a)) (Sub (num1, num2)) =
- equal_numa num1a num1 andalso equal_numa num2a num2
- | equal_numa (Add (num1a, num2a)) (Add (num1, num2)) =
- equal_numa num1a num1 andalso equal_numa num2a num2
- | equal_numa (Neg numa) (Neg num) = equal_numa numa num
- | equal_numa (Cn (nata, intaa, numa)) (Cn (nat, inta, num)) =
- equal_nat nata nat andalso
- (equal_inta intaa inta andalso equal_numa numa num)
- | equal_numa (Bound nata) (Bound nat) = equal_nat nata nat
- | equal_numa (C intaa) (C inta) = equal_inta intaa inta;
+fun equal_numa (Sub (x61, x62)) (Mul (x71, x72)) = false
+ | equal_numa (Mul (x71, x72)) (Sub (x61, x62)) = false
+ | equal_numa (Add (x51, x52)) (Mul (x71, x72)) = false
+ | equal_numa (Mul (x71, x72)) (Add (x51, x52)) = false
+ | equal_numa (Add (x51, x52)) (Sub (x61, x62)) = false
+ | equal_numa (Sub (x61, x62)) (Add (x51, x52)) = false
+ | equal_numa (Neg x4) (Mul (x71, x72)) = false
+ | equal_numa (Mul (x71, x72)) (Neg x4) = false
+ | equal_numa (Neg x4) (Sub (x61, x62)) = false
+ | equal_numa (Sub (x61, x62)) (Neg x4) = false
+ | equal_numa (Neg x4) (Add (x51, x52)) = false
+ | equal_numa (Add (x51, x52)) (Neg x4) = false
+ | equal_numa (CN (x31, x32, x33)) (Mul (x71, x72)) = false
+ | equal_numa (Mul (x71, x72)) (CN (x31, x32, x33)) = false
+ | equal_numa (CN (x31, x32, x33)) (Sub (x61, x62)) = false
+ | equal_numa (Sub (x61, x62)) (CN (x31, x32, x33)) = false
+ | equal_numa (CN (x31, x32, x33)) (Add (x51, x52)) = false
+ | equal_numa (Add (x51, x52)) (CN (x31, x32, x33)) = false
+ | equal_numa (CN (x31, x32, x33)) (Neg x4) = false
+ | equal_numa (Neg x4) (CN (x31, x32, x33)) = false
+ | equal_numa (Bound x2) (Mul (x71, x72)) = false
+ | equal_numa (Mul (x71, x72)) (Bound x2) = false
+ | equal_numa (Bound x2) (Sub (x61, x62)) = false
+ | equal_numa (Sub (x61, x62)) (Bound x2) = false
+ | equal_numa (Bound x2) (Add (x51, x52)) = false
+ | equal_numa (Add (x51, x52)) (Bound x2) = false
+ | equal_numa (Bound x2) (Neg x4) = false
+ | equal_numa (Neg x4) (Bound x2) = false
+ | equal_numa (Bound x2) (CN (x31, x32, x33)) = false
+ | equal_numa (CN (x31, x32, x33)) (Bound x2) = false
+ | equal_numa (C x1) (Mul (x71, x72)) = false
+ | equal_numa (Mul (x71, x72)) (C x1) = false
+ | equal_numa (C x1) (Sub (x61, x62)) = false
+ | equal_numa (Sub (x61, x62)) (C x1) = false
+ | equal_numa (C x1) (Add (x51, x52)) = false
+ | equal_numa (Add (x51, x52)) (C x1) = false
+ | equal_numa (C x1) (Neg x4) = false
+ | equal_numa (Neg x4) (C x1) = false
+ | equal_numa (C x1) (CN (x31, x32, x33)) = false
+ | equal_numa (CN (x31, x32, x33)) (C x1) = false
+ | equal_numa (C x1) (Bound x2) = false
+ | equal_numa (Bound x2) (C x1) = false
+ | equal_numa (Mul (x71, x72)) (Mul (y71, y72)) =
+ equal_inta x71 y71 andalso equal_numa x72 y72
+ | equal_numa (Sub (x61, x62)) (Sub (y61, y62)) =
+ equal_numa x61 y61 andalso equal_numa x62 y62
+ | equal_numa (Add (x51, x52)) (Add (y51, y52)) =
+ equal_numa x51 y51 andalso equal_numa x52 y52
+ | equal_numa (Neg x4) (Neg y4) = equal_numa x4 y4
+ | equal_numa (CN (x31, x32, x33)) (CN (y31, y32, y33)) =
+ equal_nat x31 y31 andalso (equal_inta x32 y32 andalso equal_numa x33 y33)
+ | equal_numa (Bound x2) (Bound y2) = equal_nat x2 y2
+ | equal_numa (C x1) (C y1) = equal_inta x1 y1;
val equal_num = {equal = equal_numa} : numa equal;
@@ -519,7 +603,7 @@
datatype fm = T | F | Lt of numa | Le of numa | Gt of numa | Ge of numa |
Eq of numa | NEq of numa | Dvd of inta * numa | NDvd of inta * numa |
- Not of fm | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm |
+ NOT of fm | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm |
E of fm | A of fm | Closed of nat | NClosed of nat;
fun id x = (fn xa => xa) x;
@@ -543,7 +627,7 @@
| disjuncts (NEq v) = [NEq v]
| disjuncts (Dvd (v, va)) = [Dvd (v, va)]
| disjuncts (NDvd (v, va)) = [NDvd (v, va)]
- | disjuncts (Not v) = [Not v]
+ | disjuncts (NOT v) = [NOT v]
| disjuncts (And (v, va)) = [And (v, va)]
| disjuncts (Imp (v, va)) = [Imp (v, va)]
| disjuncts (Iff (v, va)) = [Iff (v, va)]
@@ -555,371 +639,371 @@
fun foldr f [] = id
| foldr f (x :: xs) = f x o foldr f xs;
-fun equal_fm (Closed nata) (NClosed nat) = false
- | equal_fm (NClosed nata) (Closed nat) = false
- | equal_fm (A fm) (NClosed nat) = false
- | equal_fm (NClosed nat) (A fm) = false
- | equal_fm (A fm) (Closed nat) = false
- | equal_fm (Closed nat) (A fm) = false
- | equal_fm (E fm) (NClosed nat) = false
- | equal_fm (NClosed nat) (E fm) = false
- | equal_fm (E fm) (Closed nat) = false
- | equal_fm (Closed nat) (E fm) = false
- | equal_fm (E fma) (A fm) = false
- | equal_fm (A fma) (E fm) = false
- | equal_fm (Iff (fm1, fm2)) (NClosed nat) = false
- | equal_fm (NClosed nat) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Closed nat) = false
- | equal_fm (Closed nat) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (A fm) = false
- | equal_fm (A fm) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (E fm) = false
- | equal_fm (E fm) (Iff (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (NClosed nat) = false
- | equal_fm (NClosed nat) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Closed nat) = false
- | equal_fm (Closed nat) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (A fm) = false
- | equal_fm (A fm) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (E fm) = false
- | equal_fm (E fm) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1a, fm2a)) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1a, fm2a)) (Imp (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (NClosed nat) = false
- | equal_fm (NClosed nat) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Closed nat) = false
- | equal_fm (Closed nat) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (A fm) = false
- | equal_fm (A fm) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (E fm) = false
- | equal_fm (E fm) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1a, fm2a)) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1a, fm2a)) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1a, fm2a)) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1a, fm2a)) (Or (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (NClosed nat) = false
- | equal_fm (NClosed nat) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Closed nat) = false
- | equal_fm (Closed nat) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (A fm) = false
- | equal_fm (A fm) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (E fm) = false
- | equal_fm (E fm) (And (fm1, fm2)) = false
- | equal_fm (And (fm1a, fm2a)) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1a, fm2a)) (And (fm1, fm2)) = false
- | equal_fm (And (fm1a, fm2a)) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1a, fm2a)) (And (fm1, fm2)) = false
- | equal_fm (And (fm1a, fm2a)) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1a, fm2a)) (And (fm1, fm2)) = false
- | equal_fm (Not fm) (NClosed nat) = false
- | equal_fm (NClosed nat) (Not fm) = false
- | equal_fm (Not fm) (Closed nat) = false
- | equal_fm (Closed nat) (Not fm) = false
- | equal_fm (Not fma) (A fm) = false
- | equal_fm (A fma) (Not fm) = false
- | equal_fm (Not fma) (E fm) = false
- | equal_fm (E fma) (Not fm) = false
- | equal_fm (Not fm) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Not fm) = false
- | equal_fm (Not fm) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Not fm) = false
- | equal_fm (Not fm) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Not fm) = false
- | equal_fm (Not fm) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Not fm) = false
- | equal_fm (NDvd (inta, num)) (NClosed nat) = false
- | equal_fm (NClosed nat) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (Closed nat) = false
- | equal_fm (Closed nat) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (A fm) = false
- | equal_fm (A fm) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (E fm) = false
- | equal_fm (E fm) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) (Not fm) = false
- | equal_fm (Not fm) (NDvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (NClosed nat) = false
- | equal_fm (NClosed nat) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (Closed nat) = false
- | equal_fm (Closed nat) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (A fm) = false
- | equal_fm (A fm) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (E fm) = false
- | equal_fm (E fm) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) (Not fm) = false
- | equal_fm (Not fm) (Dvd (inta, num)) = false
- | equal_fm (Dvd (intaa, numa)) (NDvd (inta, num)) = false
- | equal_fm (NDvd (intaa, numa)) (Dvd (inta, num)) = false
- | equal_fm (NEq num) (NClosed nat) = false
- | equal_fm (NClosed nat) (NEq num) = false
- | equal_fm (NEq num) (Closed nat) = false
- | equal_fm (Closed nat) (NEq num) = false
- | equal_fm (NEq num) (A fm) = false
- | equal_fm (A fm) (NEq num) = false
- | equal_fm (NEq num) (E fm) = false
- | equal_fm (E fm) (NEq num) = false
- | equal_fm (NEq num) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (NEq num) = false
- | equal_fm (NEq num) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (NEq num) = false
- | equal_fm (NEq num) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (NEq num) = false
- | equal_fm (NEq num) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (NEq num) = false
- | equal_fm (NEq num) (Not fm) = false
- | equal_fm (Not fm) (NEq num) = false
- | equal_fm (NEq numa) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, numa)) (NEq num) = false
- | equal_fm (NEq numa) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, numa)) (NEq num) = false
- | equal_fm (Eq num) (NClosed nat) = false
- | equal_fm (NClosed nat) (Eq num) = false
- | equal_fm (Eq num) (Closed nat) = false
- | equal_fm (Closed nat) (Eq num) = false
- | equal_fm (Eq num) (A fm) = false
- | equal_fm (A fm) (Eq num) = false
- | equal_fm (Eq num) (E fm) = false
- | equal_fm (E fm) (Eq num) = false
- | equal_fm (Eq num) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Eq num) = false
- | equal_fm (Eq num) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Eq num) = false
- | equal_fm (Eq num) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Eq num) = false
- | equal_fm (Eq num) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Eq num) = false
- | equal_fm (Eq num) (Not fm) = false
- | equal_fm (Not fm) (Eq num) = false
- | equal_fm (Eq numa) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, numa)) (Eq num) = false
- | equal_fm (Eq numa) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, numa)) (Eq num) = false
- | equal_fm (Eq numa) (NEq num) = false
- | equal_fm (NEq numa) (Eq num) = false
- | equal_fm (Ge num) (NClosed nat) = false
- | equal_fm (NClosed nat) (Ge num) = false
- | equal_fm (Ge num) (Closed nat) = false
- | equal_fm (Closed nat) (Ge num) = false
- | equal_fm (Ge num) (A fm) = false
- | equal_fm (A fm) (Ge num) = false
- | equal_fm (Ge num) (E fm) = false
- | equal_fm (E fm) (Ge num) = false
- | equal_fm (Ge num) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Ge num) = false
- | equal_fm (Ge num) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Ge num) = false
- | equal_fm (Ge num) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Ge num) = false
- | equal_fm (Ge num) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Ge num) = false
- | equal_fm (Ge num) (Not fm) = false
- | equal_fm (Not fm) (Ge num) = false
- | equal_fm (Ge numa) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, numa)) (Ge num) = false
- | equal_fm (Ge numa) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, numa)) (Ge num) = false
- | equal_fm (Ge numa) (NEq num) = false
- | equal_fm (NEq numa) (Ge num) = false
- | equal_fm (Ge numa) (Eq num) = false
- | equal_fm (Eq numa) (Ge num) = false
- | equal_fm (Gt num) (NClosed nat) = false
- | equal_fm (NClosed nat) (Gt num) = false
- | equal_fm (Gt num) (Closed nat) = false
- | equal_fm (Closed nat) (Gt num) = false
- | equal_fm (Gt num) (A fm) = false
- | equal_fm (A fm) (Gt num) = false
- | equal_fm (Gt num) (E fm) = false
- | equal_fm (E fm) (Gt num) = false
- | equal_fm (Gt num) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Gt num) = false
- | equal_fm (Gt num) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Gt num) = false
- | equal_fm (Gt num) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Gt num) = false
- | equal_fm (Gt num) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Gt num) = false
- | equal_fm (Gt num) (Not fm) = false
- | equal_fm (Not fm) (Gt num) = false
- | equal_fm (Gt numa) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, numa)) (Gt num) = false
- | equal_fm (Gt numa) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, numa)) (Gt num) = false
- | equal_fm (Gt numa) (NEq num) = false
- | equal_fm (NEq numa) (Gt num) = false
- | equal_fm (Gt numa) (Eq num) = false
- | equal_fm (Eq numa) (Gt num) = false
- | equal_fm (Gt numa) (Ge num) = false
- | equal_fm (Ge numa) (Gt num) = false
- | equal_fm (Le num) (NClosed nat) = false
- | equal_fm (NClosed nat) (Le num) = false
- | equal_fm (Le num) (Closed nat) = false
- | equal_fm (Closed nat) (Le num) = false
- | equal_fm (Le num) (A fm) = false
- | equal_fm (A fm) (Le num) = false
- | equal_fm (Le num) (E fm) = false
- | equal_fm (E fm) (Le num) = false
- | equal_fm (Le num) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Le num) = false
- | equal_fm (Le num) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Le num) = false
- | equal_fm (Le num) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Le num) = false
- | equal_fm (Le num) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Le num) = false
- | equal_fm (Le num) (Not fm) = false
- | equal_fm (Not fm) (Le num) = false
- | equal_fm (Le numa) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, numa)) (Le num) = false
- | equal_fm (Le numa) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, numa)) (Le num) = false
- | equal_fm (Le numa) (NEq num) = false
- | equal_fm (NEq numa) (Le num) = false
- | equal_fm (Le numa) (Eq num) = false
- | equal_fm (Eq numa) (Le num) = false
- | equal_fm (Le numa) (Ge num) = false
- | equal_fm (Ge numa) (Le num) = false
- | equal_fm (Le numa) (Gt num) = false
- | equal_fm (Gt numa) (Le num) = false
- | equal_fm (Lt num) (NClosed nat) = false
- | equal_fm (NClosed nat) (Lt num) = false
- | equal_fm (Lt num) (Closed nat) = false
- | equal_fm (Closed nat) (Lt num) = false
- | equal_fm (Lt num) (A fm) = false
- | equal_fm (A fm) (Lt num) = false
- | equal_fm (Lt num) (E fm) = false
- | equal_fm (E fm) (Lt num) = false
- | equal_fm (Lt num) (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) (Lt num) = false
- | equal_fm (Lt num) (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) (Lt num) = false
- | equal_fm (Lt num) (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) (Lt num) = false
- | equal_fm (Lt num) (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) (Lt num) = false
- | equal_fm (Lt num) (Not fm) = false
- | equal_fm (Not fm) (Lt num) = false
- | equal_fm (Lt numa) (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, numa)) (Lt num) = false
- | equal_fm (Lt numa) (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, numa)) (Lt num) = false
- | equal_fm (Lt numa) (NEq num) = false
- | equal_fm (NEq numa) (Lt num) = false
- | equal_fm (Lt numa) (Eq num) = false
- | equal_fm (Eq numa) (Lt num) = false
- | equal_fm (Lt numa) (Ge num) = false
- | equal_fm (Ge numa) (Lt num) = false
- | equal_fm (Lt numa) (Gt num) = false
- | equal_fm (Gt numa) (Lt num) = false
- | equal_fm (Lt numa) (Le num) = false
- | equal_fm (Le numa) (Lt num) = false
- | equal_fm F (NClosed nat) = false
- | equal_fm (NClosed nat) F = false
- | equal_fm F (Closed nat) = false
- | equal_fm (Closed nat) F = false
- | equal_fm F (A fm) = false
- | equal_fm (A fm) F = false
- | equal_fm F (E fm) = false
- | equal_fm (E fm) F = false
- | equal_fm F (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) F = false
- | equal_fm F (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) F = false
- | equal_fm F (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) F = false
- | equal_fm F (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) F = false
- | equal_fm F (Not fm) = false
- | equal_fm (Not fm) F = false
- | equal_fm F (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) F = false
- | equal_fm F (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) F = false
- | equal_fm F (NEq num) = false
- | equal_fm (NEq num) F = false
- | equal_fm F (Eq num) = false
- | equal_fm (Eq num) F = false
- | equal_fm F (Ge num) = false
- | equal_fm (Ge num) F = false
- | equal_fm F (Gt num) = false
- | equal_fm (Gt num) F = false
- | equal_fm F (Le num) = false
- | equal_fm (Le num) F = false
- | equal_fm F (Lt num) = false
- | equal_fm (Lt num) F = false
- | equal_fm T (NClosed nat) = false
- | equal_fm (NClosed nat) T = false
- | equal_fm T (Closed nat) = false
- | equal_fm (Closed nat) T = false
- | equal_fm T (A fm) = false
- | equal_fm (A fm) T = false
- | equal_fm T (E fm) = false
- | equal_fm (E fm) T = false
- | equal_fm T (Iff (fm1, fm2)) = false
- | equal_fm (Iff (fm1, fm2)) T = false
- | equal_fm T (Imp (fm1, fm2)) = false
- | equal_fm (Imp (fm1, fm2)) T = false
- | equal_fm T (Or (fm1, fm2)) = false
- | equal_fm (Or (fm1, fm2)) T = false
- | equal_fm T (And (fm1, fm2)) = false
- | equal_fm (And (fm1, fm2)) T = false
- | equal_fm T (Not fm) = false
- | equal_fm (Not fm) T = false
- | equal_fm T (NDvd (inta, num)) = false
- | equal_fm (NDvd (inta, num)) T = false
- | equal_fm T (Dvd (inta, num)) = false
- | equal_fm (Dvd (inta, num)) T = false
- | equal_fm T (NEq num) = false
- | equal_fm (NEq num) T = false
- | equal_fm T (Eq num) = false
- | equal_fm (Eq num) T = false
- | equal_fm T (Ge num) = false
- | equal_fm (Ge num) T = false
- | equal_fm T (Gt num) = false
- | equal_fm (Gt num) T = false
- | equal_fm T (Le num) = false
- | equal_fm (Le num) T = false
- | equal_fm T (Lt num) = false
- | equal_fm (Lt num) T = false
+fun equal_fm (Closed x18) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Closed x18) = false
+ | equal_fm (A x17) (NClosed x19) = false
+ | equal_fm (NClosed x19) (A x17) = false
+ | equal_fm (A x17) (Closed x18) = false
+ | equal_fm (Closed x18) (A x17) = false
+ | equal_fm (E x16) (NClosed x19) = false
+ | equal_fm (NClosed x19) (E x16) = false
+ | equal_fm (E x16) (Closed x18) = false
+ | equal_fm (Closed x18) (E x16) = false
+ | equal_fm (E x16) (A x17) = false
+ | equal_fm (A x17) (E x16) = false
+ | equal_fm (Iff (x151, x152)) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Closed x18) = false
+ | equal_fm (Closed x18) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (A x17) = false
+ | equal_fm (A x17) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (E x16) = false
+ | equal_fm (E x16) (Iff (x151, x152)) = false
+ | equal_fm (Imp (x141, x142)) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Closed x18) = false
+ | equal_fm (Closed x18) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (A x17) = false
+ | equal_fm (A x17) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (E x16) = false
+ | equal_fm (E x16) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Imp (x141, x142)) = false
+ | equal_fm (Or (x131, x132)) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Closed x18) = false
+ | equal_fm (Closed x18) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (A x17) = false
+ | equal_fm (A x17) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (E x16) = false
+ | equal_fm (E x16) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Or (x131, x132)) = false
+ | equal_fm (And (x121, x122)) (NClosed x19) = false
+ | equal_fm (NClosed x19) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Closed x18) = false
+ | equal_fm (Closed x18) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (A x17) = false
+ | equal_fm (A x17) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (E x16) = false
+ | equal_fm (E x16) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (And (x121, x122)) = false
+ | equal_fm (NOT x11) (NClosed x19) = false
+ | equal_fm (NClosed x19) (NOT x11) = false
+ | equal_fm (NOT x11) (Closed x18) = false
+ | equal_fm (Closed x18) (NOT x11) = false
+ | equal_fm (NOT x11) (A x17) = false
+ | equal_fm (A x17) (NOT x11) = false
+ | equal_fm (NOT x11) (E x16) = false
+ | equal_fm (E x16) (NOT x11) = false
+ | equal_fm (NOT x11) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (NOT x11) = false
+ | equal_fm (NOT x11) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (NOT x11) = false
+ | equal_fm (NOT x11) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (NOT x11) = false
+ | equal_fm (NOT x11) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (NOT x11) = false
+ | equal_fm (NDvd (x101, x102)) (NClosed x19) = false
+ | equal_fm (NClosed x19) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Closed x18) = false
+ | equal_fm (Closed x18) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (A x17) = false
+ | equal_fm (A x17) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (E x16) = false
+ | equal_fm (E x16) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (NOT x11) = false
+ | equal_fm (NOT x11) (NDvd (x101, x102)) = false
+ | equal_fm (Dvd (x91, x92)) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Closed x18) = false
+ | equal_fm (Closed x18) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (A x17) = false
+ | equal_fm (A x17) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (E x16) = false
+ | equal_fm (E x16) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (NOT x11) = false
+ | equal_fm (NOT x11) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Dvd (x91, x92)) = false
+ | equal_fm (NEq x8) (NClosed x19) = false
+ | equal_fm (NClosed x19) (NEq x8) = false
+ | equal_fm (NEq x8) (Closed x18) = false
+ | equal_fm (Closed x18) (NEq x8) = false
+ | equal_fm (NEq x8) (A x17) = false
+ | equal_fm (A x17) (NEq x8) = false
+ | equal_fm (NEq x8) (E x16) = false
+ | equal_fm (E x16) (NEq x8) = false
+ | equal_fm (NEq x8) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (NEq x8) = false
+ | equal_fm (NEq x8) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (NEq x8) = false
+ | equal_fm (NEq x8) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (NEq x8) = false
+ | equal_fm (NEq x8) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (NEq x8) = false
+ | equal_fm (NEq x8) (NOT x11) = false
+ | equal_fm (NOT x11) (NEq x8) = false
+ | equal_fm (NEq x8) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (NEq x8) = false
+ | equal_fm (NEq x8) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (NEq x8) = false
+ | equal_fm (Eq x7) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Eq x7) = false
+ | equal_fm (Eq x7) (Closed x18) = false
+ | equal_fm (Closed x18) (Eq x7) = false
+ | equal_fm (Eq x7) (A x17) = false
+ | equal_fm (A x17) (Eq x7) = false
+ | equal_fm (Eq x7) (E x16) = false
+ | equal_fm (E x16) (Eq x7) = false
+ | equal_fm (Eq x7) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Eq x7) = false
+ | equal_fm (Eq x7) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Eq x7) = false
+ | equal_fm (Eq x7) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Eq x7) = false
+ | equal_fm (Eq x7) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Eq x7) = false
+ | equal_fm (Eq x7) (NOT x11) = false
+ | equal_fm (NOT x11) (Eq x7) = false
+ | equal_fm (Eq x7) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Eq x7) = false
+ | equal_fm (Eq x7) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Eq x7) = false
+ | equal_fm (Eq x7) (NEq x8) = false
+ | equal_fm (NEq x8) (Eq x7) = false
+ | equal_fm (Ge x6) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Ge x6) = false
+ | equal_fm (Ge x6) (Closed x18) = false
+ | equal_fm (Closed x18) (Ge x6) = false
+ | equal_fm (Ge x6) (A x17) = false
+ | equal_fm (A x17) (Ge x6) = false
+ | equal_fm (Ge x6) (E x16) = false
+ | equal_fm (E x16) (Ge x6) = false
+ | equal_fm (Ge x6) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Ge x6) = false
+ | equal_fm (Ge x6) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Ge x6) = false
+ | equal_fm (Ge x6) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Ge x6) = false
+ | equal_fm (Ge x6) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Ge x6) = false
+ | equal_fm (Ge x6) (NOT x11) = false
+ | equal_fm (NOT x11) (Ge x6) = false
+ | equal_fm (Ge x6) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Ge x6) = false
+ | equal_fm (Ge x6) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Ge x6) = false
+ | equal_fm (Ge x6) (NEq x8) = false
+ | equal_fm (NEq x8) (Ge x6) = false
+ | equal_fm (Ge x6) (Eq x7) = false
+ | equal_fm (Eq x7) (Ge x6) = false
+ | equal_fm (Gt x5) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Gt x5) = false
+ | equal_fm (Gt x5) (Closed x18) = false
+ | equal_fm (Closed x18) (Gt x5) = false
+ | equal_fm (Gt x5) (A x17) = false
+ | equal_fm (A x17) (Gt x5) = false
+ | equal_fm (Gt x5) (E x16) = false
+ | equal_fm (E x16) (Gt x5) = false
+ | equal_fm (Gt x5) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Gt x5) = false
+ | equal_fm (Gt x5) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Gt x5) = false
+ | equal_fm (Gt x5) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Gt x5) = false
+ | equal_fm (Gt x5) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Gt x5) = false
+ | equal_fm (Gt x5) (NOT x11) = false
+ | equal_fm (NOT x11) (Gt x5) = false
+ | equal_fm (Gt x5) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Gt x5) = false
+ | equal_fm (Gt x5) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Gt x5) = false
+ | equal_fm (Gt x5) (NEq x8) = false
+ | equal_fm (NEq x8) (Gt x5) = false
+ | equal_fm (Gt x5) (Eq x7) = false
+ | equal_fm (Eq x7) (Gt x5) = false
+ | equal_fm (Gt x5) (Ge x6) = false
+ | equal_fm (Ge x6) (Gt x5) = false
+ | equal_fm (Le x4) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Le x4) = false
+ | equal_fm (Le x4) (Closed x18) = false
+ | equal_fm (Closed x18) (Le x4) = false
+ | equal_fm (Le x4) (A x17) = false
+ | equal_fm (A x17) (Le x4) = false
+ | equal_fm (Le x4) (E x16) = false
+ | equal_fm (E x16) (Le x4) = false
+ | equal_fm (Le x4) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Le x4) = false
+ | equal_fm (Le x4) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Le x4) = false
+ | equal_fm (Le x4) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Le x4) = false
+ | equal_fm (Le x4) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Le x4) = false
+ | equal_fm (Le x4) (NOT x11) = false
+ | equal_fm (NOT x11) (Le x4) = false
+ | equal_fm (Le x4) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Le x4) = false
+ | equal_fm (Le x4) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Le x4) = false
+ | equal_fm (Le x4) (NEq x8) = false
+ | equal_fm (NEq x8) (Le x4) = false
+ | equal_fm (Le x4) (Eq x7) = false
+ | equal_fm (Eq x7) (Le x4) = false
+ | equal_fm (Le x4) (Ge x6) = false
+ | equal_fm (Ge x6) (Le x4) = false
+ | equal_fm (Le x4) (Gt x5) = false
+ | equal_fm (Gt x5) (Le x4) = false
+ | equal_fm (Lt x3) (NClosed x19) = false
+ | equal_fm (NClosed x19) (Lt x3) = false
+ | equal_fm (Lt x3) (Closed x18) = false
+ | equal_fm (Closed x18) (Lt x3) = false
+ | equal_fm (Lt x3) (A x17) = false
+ | equal_fm (A x17) (Lt x3) = false
+ | equal_fm (Lt x3) (E x16) = false
+ | equal_fm (E x16) (Lt x3) = false
+ | equal_fm (Lt x3) (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) (Lt x3) = false
+ | equal_fm (Lt x3) (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) (Lt x3) = false
+ | equal_fm (Lt x3) (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) (Lt x3) = false
+ | equal_fm (Lt x3) (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) (Lt x3) = false
+ | equal_fm (Lt x3) (NOT x11) = false
+ | equal_fm (NOT x11) (Lt x3) = false
+ | equal_fm (Lt x3) (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) (Lt x3) = false
+ | equal_fm (Lt x3) (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) (Lt x3) = false
+ | equal_fm (Lt x3) (NEq x8) = false
+ | equal_fm (NEq x8) (Lt x3) = false
+ | equal_fm (Lt x3) (Eq x7) = false
+ | equal_fm (Eq x7) (Lt x3) = false
+ | equal_fm (Lt x3) (Ge x6) = false
+ | equal_fm (Ge x6) (Lt x3) = false
+ | equal_fm (Lt x3) (Gt x5) = false
+ | equal_fm (Gt x5) (Lt x3) = false
+ | equal_fm (Lt x3) (Le x4) = false
+ | equal_fm (Le x4) (Lt x3) = false
+ | equal_fm F (NClosed x19) = false
+ | equal_fm (NClosed x19) F = false
+ | equal_fm F (Closed x18) = false
+ | equal_fm (Closed x18) F = false
+ | equal_fm F (A x17) = false
+ | equal_fm (A x17) F = false
+ | equal_fm F (E x16) = false
+ | equal_fm (E x16) F = false
+ | equal_fm F (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) F = false
+ | equal_fm F (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) F = false
+ | equal_fm F (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) F = false
+ | equal_fm F (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) F = false
+ | equal_fm F (NOT x11) = false
+ | equal_fm (NOT x11) F = false
+ | equal_fm F (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) F = false
+ | equal_fm F (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) F = false
+ | equal_fm F (NEq x8) = false
+ | equal_fm (NEq x8) F = false
+ | equal_fm F (Eq x7) = false
+ | equal_fm (Eq x7) F = false
+ | equal_fm F (Ge x6) = false
+ | equal_fm (Ge x6) F = false
+ | equal_fm F (Gt x5) = false
+ | equal_fm (Gt x5) F = false
+ | equal_fm F (Le x4) = false
+ | equal_fm (Le x4) F = false
+ | equal_fm F (Lt x3) = false
+ | equal_fm (Lt x3) F = false
+ | equal_fm T (NClosed x19) = false
+ | equal_fm (NClosed x19) T = false
+ | equal_fm T (Closed x18) = false
+ | equal_fm (Closed x18) T = false
+ | equal_fm T (A x17) = false
+ | equal_fm (A x17) T = false
+ | equal_fm T (E x16) = false
+ | equal_fm (E x16) T = false
+ | equal_fm T (Iff (x151, x152)) = false
+ | equal_fm (Iff (x151, x152)) T = false
+ | equal_fm T (Imp (x141, x142)) = false
+ | equal_fm (Imp (x141, x142)) T = false
+ | equal_fm T (Or (x131, x132)) = false
+ | equal_fm (Or (x131, x132)) T = false
+ | equal_fm T (And (x121, x122)) = false
+ | equal_fm (And (x121, x122)) T = false
+ | equal_fm T (NOT x11) = false
+ | equal_fm (NOT x11) T = false
+ | equal_fm T (NDvd (x101, x102)) = false
+ | equal_fm (NDvd (x101, x102)) T = false
+ | equal_fm T (Dvd (x91, x92)) = false
+ | equal_fm (Dvd (x91, x92)) T = false
+ | equal_fm T (NEq x8) = false
+ | equal_fm (NEq x8) T = false
+ | equal_fm T (Eq x7) = false
+ | equal_fm (Eq x7) T = false
+ | equal_fm T (Ge x6) = false
+ | equal_fm (Ge x6) T = false
+ | equal_fm T (Gt x5) = false
+ | equal_fm (Gt x5) T = false
+ | equal_fm T (Le x4) = false
+ | equal_fm (Le x4) T = false
+ | equal_fm T (Lt x3) = false
+ | equal_fm (Lt x3) T = false
| equal_fm T F = false
| equal_fm F T = false
- | equal_fm (NClosed nata) (NClosed nat) = equal_nat nata nat
- | equal_fm (Closed nata) (Closed nat) = equal_nat nata nat
- | equal_fm (A fma) (A fm) = equal_fm fma fm
- | equal_fm (E fma) (E fm) = equal_fm fma fm
- | equal_fm (Iff (fm1a, fm2a)) (Iff (fm1, fm2)) =
- equal_fm fm1a fm1 andalso equal_fm fm2a fm2
- | equal_fm (Imp (fm1a, fm2a)) (Imp (fm1, fm2)) =
- equal_fm fm1a fm1 andalso equal_fm fm2a fm2
- | equal_fm (Or (fm1a, fm2a)) (Or (fm1, fm2)) =
- equal_fm fm1a fm1 andalso equal_fm fm2a fm2
- | equal_fm (And (fm1a, fm2a)) (And (fm1, fm2)) =
- equal_fm fm1a fm1 andalso equal_fm fm2a fm2
- | equal_fm (Not fma) (Not fm) = equal_fm fma fm
- | equal_fm (NDvd (intaa, numa)) (NDvd (inta, num)) =
- equal_inta intaa inta andalso equal_numa numa num
- | equal_fm (Dvd (intaa, numa)) (Dvd (inta, num)) =
- equal_inta intaa inta andalso equal_numa numa num
- | equal_fm (NEq numa) (NEq num) = equal_numa numa num
- | equal_fm (Eq numa) (Eq num) = equal_numa numa num
- | equal_fm (Ge numa) (Ge num) = equal_numa numa num
- | equal_fm (Gt numa) (Gt num) = equal_numa numa num
- | equal_fm (Le numa) (Le num) = equal_numa numa num
- | equal_fm (Lt numa) (Lt num) = equal_numa numa num
+ | equal_fm (NClosed x19) (NClosed y19) = equal_nat x19 y19
+ | equal_fm (Closed x18) (Closed y18) = equal_nat x18 y18
+ | equal_fm (A x17) (A y17) = equal_fm x17 y17
+ | equal_fm (E x16) (E y16) = equal_fm x16 y16
+ | equal_fm (Iff (x151, x152)) (Iff (y151, y152)) =
+ equal_fm x151 y151 andalso equal_fm x152 y152
+ | equal_fm (Imp (x141, x142)) (Imp (y141, y142)) =
+ equal_fm x141 y141 andalso equal_fm x142 y142
+ | equal_fm (Or (x131, x132)) (Or (y131, y132)) =
+ equal_fm x131 y131 andalso equal_fm x132 y132
+ | equal_fm (And (x121, x122)) (And (y121, y122)) =
+ equal_fm x121 y121 andalso equal_fm x122 y122
+ | equal_fm (NOT x11) (NOT y11) = equal_fm x11 y11
+ | equal_fm (NDvd (x101, x102)) (NDvd (y101, y102)) =
+ equal_inta x101 y101 andalso equal_numa x102 y102
+ | equal_fm (Dvd (x91, x92)) (Dvd (y91, y92)) =
+ equal_inta x91 y91 andalso equal_numa x92 y92
+ | equal_fm (NEq x8) (NEq y8) = equal_numa x8 y8
+ | equal_fm (Eq x7) (Eq y7) = equal_numa x7 y7
+ | equal_fm (Ge x6) (Ge y6) = equal_numa x6 y6
+ | equal_fm (Gt x5) (Gt y5) = equal_numa x5 y5
+ | equal_fm (Le x4) (Le y4) = equal_numa x4 y4
+ | equal_fm (Lt x3) (Lt y3) = equal_numa x3 y3
| equal_fm F F = true
| equal_fm T T = true;
@@ -930,7 +1014,7 @@
| Le _ => Or (f p, q) | Gt _ => Or (f p, q)
| Ge _ => Or (f p, q) | Eq _ => Or (f p, q)
| NEq _ => Or (f p, q) | Dvd (_, _) => Or (f p, q)
- | NDvd (_, _) => Or (f p, q) | Not _ => Or (f p, q)
+ | NDvd (_, _) => Or (f p, q) | NOT _ => Or (f p, q)
| And (_, _) => Or (f p, q) | Or (_, _) => Or (f p, q)
| Imp (_, _) => Or (f p, q) | Iff (_, _) => Or (f p, q)
| E _ => Or (f p, q) | A _ => Or (f p, q)
@@ -943,9 +1027,9 @@
fun max A_ a b = (if less_eq A_ a b then b else a);
fun minus_nat m n =
- Nat (max ord_integer 0 (integer_of_nat m - integer_of_nat n));
+ Nat (max ord_integer (0 : IntInf.int) (integer_of_nat m - integer_of_nat n));
-val zero_nat : nat = Nat 0;
+val zero_nat : nat = Nat (0 : IntInf.int);
fun minusinf (And (p, q)) = And (minusinf p, minusinf q)
| minusinf (Or (p, q)) = Or (minusinf p, minusinf q)
@@ -989,34 +1073,34 @@
| minusinf (NEq (Mul (gy, gz))) = NEq (Mul (gy, gz))
| minusinf (Dvd (aa, ab)) = Dvd (aa, ab)
| minusinf (NDvd (ac, ad)) = NDvd (ac, ad)
- | minusinf (Not ae) = Not ae
+ | minusinf (NOT ae) = NOT ae
| minusinf (Imp (aj, ak)) = Imp (aj, ak)
| minusinf (Iff (al, am)) = Iff (al, am)
| minusinf (E an) = E an
| minusinf (A ao) = A ao
| minusinf (Closed ap) = Closed ap
| minusinf (NClosed aq) = NClosed aq
- | minusinf (Lt (Cn (cm, c, e))) =
+ | minusinf (Lt (CN (cm, c, e))) =
(if equal_nat cm zero_nat then T
- else Lt (Cn (suc (minus_nat cm one_nat), c, e)))
- | minusinf (Le (Cn (dm, c, e))) =
+ else Lt (CN (suc (minus_nat cm one_nat), c, e)))
+ | minusinf (Le (CN (dm, c, e))) =
(if equal_nat dm zero_nat then T
- else Le (Cn (suc (minus_nat dm one_nat), c, e)))
- | minusinf (Gt (Cn (em, c, e))) =
+ else Le (CN (suc (minus_nat dm one_nat), c, e)))
+ | minusinf (Gt (CN (em, c, e))) =
(if equal_nat em zero_nat then F
- else Gt (Cn (suc (minus_nat em one_nat), c, e)))
- | minusinf (Ge (Cn (fm, c, e))) =
+ else Gt (CN (suc (minus_nat em one_nat), c, e)))
+ | minusinf (Ge (CN (fm, c, e))) =
(if equal_nat fm zero_nat then F
- else Ge (Cn (suc (minus_nat fm one_nat), c, e)))
- | minusinf (Eq (Cn (gm, c, e))) =
+ else Ge (CN (suc (minus_nat fm one_nat), c, e)))
+ | minusinf (Eq (CN (gm, c, e))) =
(if equal_nat gm zero_nat then F
- else Eq (Cn (suc (minus_nat gm one_nat), c, e)))
- | minusinf (NEq (Cn (hm, c, e))) =
+ else Eq (CN (suc (minus_nat gm one_nat), c, e)))
+ | minusinf (NEq (CN (hm, c, e))) =
(if equal_nat hm zero_nat then T
- else NEq (Cn (suc (minus_nat hm one_nat), c, e)));
+ else NEq (CN (suc (minus_nat hm one_nat), c, e)));
-fun map fi [] = []
- | map fi (x21a :: x22a) = fi x21a :: map fi x22a;
+fun map f [] = []
+ | map f (x21 :: x22) = f x21 :: map f x22;
fun numsubst0 t (C c) = C c
| numsubst0 t (Bound n) = (if equal_nat n zero_nat then t else Bound n)
@@ -1024,9 +1108,9 @@
| numsubst0 t (Add (a, b)) = Add (numsubst0 t a, numsubst0 t b)
| numsubst0 t (Sub (a, b)) = Sub (numsubst0 t a, numsubst0 t b)
| numsubst0 t (Mul (i, a)) = Mul (i, numsubst0 t a)
- | numsubst0 t (Cn (v, i, a)) =
+ | numsubst0 t (CN (v, i, a)) =
(if equal_nat v zero_nat then Add (Mul (i, t), numsubst0 t a)
- else Cn (suc (minus_nat v one_nat), i, numsubst0 t a));
+ else CN (suc (minus_nat v one_nat), i, numsubst0 t a));
fun subst0 t T = T
| subst0 t F = F
@@ -1038,7 +1122,7 @@
| subst0 t (NEq a) = NEq (numsubst0 t a)
| subst0 t (Dvd (i, a)) = Dvd (i, numsubst0 t a)
| subst0 t (NDvd (i, a)) = NDvd (i, numsubst0 t a)
- | subst0 t (Not p) = Not (subst0 t p)
+ | subst0 t (NOT p) = NOT (subst0 t p)
| subst0 t (And (p, q)) = And (subst0 t p, subst0 t q)
| subst0 t (Or (p, q)) = Or (subst0 t p, subst0 t q)
| subst0 t (Imp (p, q)) = Imp (subst0 t p, subst0 t q)
@@ -1059,11 +1143,12 @@
(zero ((zero_mult_zero o mult_zero_semiring_0 o semiring_0_semiring_1 o
semiring_1_comm_semiring_1 o
comm_semiring_1_comm_semiring_1_cancel o
- comm_semiring_1_cancel_semiring_div)
+ comm_semiring_1_cancel_semidom o semidom_semidom_divide o
+ semidom_divide_algebraic_semidom o algebraic_semidom_semiring_div)
A1_));
fun nummul i (C j) = C (times_inta i j)
- | nummul i (Cn (n, c, t)) = Cn (n, times_inta c i, nummul i t)
+ | nummul i (CN (n, c, t)) = CN (n, times_inta c i, nummul i t)
| nummul i (Bound v) = Mul (i, Bound v)
| nummul i (Neg v) = Mul (i, Neg v)
| nummul i (Add (v, va)) = Mul (i, Add (v, va))
@@ -1074,35 +1159,35 @@
fun less_eq_nat m n = integer_of_nat m <= integer_of_nat n;
-fun numadd (Cn (n1, c1, r1), Cn (n2, c2, r2)) =
+fun numadd (CN (n1, c1, r1), CN (n2, c2, r2)) =
(if equal_nat n1 n2
then let
val c = plus_inta c1 c2;
in
(if equal_inta c zero_inta then numadd (r1, r2)
- else Cn (n1, c, numadd (r1, r2)))
+ else CN (n1, c, numadd (r1, r2)))
end
else (if less_eq_nat n1 n2
- then Cn (n1, c1, numadd (r1, Add (Mul (c2, Bound n2), r2)))
- else Cn (n2, c2, numadd (Add (Mul (c1, Bound n1), r1), r2))))
- | numadd (Cn (n1, c1, r1), C dd) = Cn (n1, c1, numadd (r1, C dd))
- | numadd (Cn (n1, c1, r1), Bound de) = Cn (n1, c1, numadd (r1, Bound de))
- | numadd (Cn (n1, c1, r1), Neg di) = Cn (n1, c1, numadd (r1, Neg di))
- | numadd (Cn (n1, c1, r1), Add (dj, dk)) =
- Cn (n1, c1, numadd (r1, Add (dj, dk)))
- | numadd (Cn (n1, c1, r1), Sub (dl, dm)) =
- Cn (n1, c1, numadd (r1, Sub (dl, dm)))
- | numadd (Cn (n1, c1, r1), Mul (dn, doa)) =
- Cn (n1, c1, numadd (r1, Mul (dn, doa)))
- | numadd (C w, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (C w, r2))
- | numadd (Bound x, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (Bound x, r2))
- | numadd (Neg ac, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (Neg ac, r2))
- | numadd (Add (ad, ae), Cn (n2, c2, r2)) =
- Cn (n2, c2, numadd (Add (ad, ae), r2))
- | numadd (Sub (af, ag), Cn (n2, c2, r2)) =
- Cn (n2, c2, numadd (Sub (af, ag), r2))
- | numadd (Mul (ah, ai), Cn (n2, c2, r2)) =
- Cn (n2, c2, numadd (Mul (ah, ai), r2))
+ then CN (n1, c1, numadd (r1, Add (Mul (c2, Bound n2), r2)))
+ else CN (n2, c2, numadd (Add (Mul (c1, Bound n1), r1), r2))))
+ | numadd (CN (n1, c1, r1), C dd) = CN (n1, c1, numadd (r1, C dd))
+ | numadd (CN (n1, c1, r1), Bound de) = CN (n1, c1, numadd (r1, Bound de))
+ | numadd (CN (n1, c1, r1), Neg di) = CN (n1, c1, numadd (r1, Neg di))
+ | numadd (CN (n1, c1, r1), Add (dj, dk)) =
+ CN (n1, c1, numadd (r1, Add (dj, dk)))
+ | numadd (CN (n1, c1, r1), Sub (dl, dm)) =
+ CN (n1, c1, numadd (r1, Sub (dl, dm)))
+ | numadd (CN (n1, c1, r1), Mul (dn, doa)) =
+ CN (n1, c1, numadd (r1, Mul (dn, doa)))
+ | numadd (C w, CN (n2, c2, r2)) = CN (n2, c2, numadd (C w, r2))
+ | numadd (Bound x, CN (n2, c2, r2)) = CN (n2, c2, numadd (Bound x, r2))
+ | numadd (Neg ac, CN (n2, c2, r2)) = CN (n2, c2, numadd (Neg ac, r2))
+ | numadd (Add (ad, ae), CN (n2, c2, r2)) =
+ CN (n2, c2, numadd (Add (ad, ae), r2))
+ | numadd (Sub (af, ag), CN (n2, c2, r2)) =
+ CN (n2, c2, numadd (Sub (af, ag), r2))
+ | numadd (Mul (ah, ai), CN (n2, c2, r2)) =
+ CN (n2, c2, numadd (Mul (ah, ai), r2))
| numadd (C b1, C b2) = C (plus_inta b1 b2)
| numadd (C aj, Bound bi) = Add (C aj, Bound bi)
| numadd (C aj, Neg bm) = Add (C aj, Neg bm)
@@ -1143,13 +1228,13 @@
fun numsub s t = (if equal_numa s t then C zero_inta else numadd (s, numneg t));
fun simpnum (C j) = C j
- | simpnum (Bound n) = Cn (n, Int_of_integer (1 : IntInf.int), C zero_inta)
+ | simpnum (Bound n) = CN (n, Int_of_integer (1 : IntInf.int), C zero_inta)
| simpnum (Neg t) = numneg (simpnum t)
| simpnum (Add (t, s)) = numadd (simpnum t, simpnum s)
| simpnum (Sub (t, s)) = numsub (simpnum t) (simpnum s)
| simpnum (Mul (i, t)) =
(if equal_inta i zero_inta then C zero_inta else nummul i (simpnum t))
- | simpnum (Cn (v, va, vb)) = Cn (v, va, vb);
+ | simpnum (CN (v, va, vb)) = CN (v, va, vb);
fun disj p q =
(if equal_fm p T orelse equal_fm q T then T
@@ -1160,25 +1245,25 @@
else (if equal_fm p T then q
else (if equal_fm q T then p else And (p, q))));
-fun nota (Not p) = p
+fun nota (NOT p) = p
| nota T = F
| nota F = T
- | nota (Lt v) = Not (Lt v)
- | nota (Le v) = Not (Le v)
- | nota (Gt v) = Not (Gt v)
- | nota (Ge v) = Not (Ge v)
- | nota (Eq v) = Not (Eq v)
- | nota (NEq v) = Not (NEq v)
- | nota (Dvd (v, va)) = Not (Dvd (v, va))
- | nota (NDvd (v, va)) = Not (NDvd (v, va))
- | nota (And (v, va)) = Not (And (v, va))
- | nota (Or (v, va)) = Not (Or (v, va))
- | nota (Imp (v, va)) = Not (Imp (v, va))
- | nota (Iff (v, va)) = Not (Iff (v, va))
- | nota (E v) = Not (E v)
- | nota (A v) = Not (A v)
- | nota (Closed v) = Not (Closed v)
- | nota (NClosed v) = Not (NClosed v);
+ | nota (Lt v) = NOT (Lt v)
+ | nota (Le v) = NOT (Le v)
+ | nota (Gt v) = NOT (Gt v)
+ | nota (Ge v) = NOT (Ge v)
+ | nota (Eq v) = NOT (Eq v)
+ | nota (NEq v) = NOT (NEq v)
+ | nota (Dvd (v, va)) = NOT (Dvd (v, va))
+ | nota (NDvd (v, va)) = NOT (NDvd (v, va))
+ | nota (And (v, va)) = NOT (And (v, va))
+ | nota (Or (v, va)) = NOT (Or (v, va))
+ | nota (Imp (v, va)) = NOT (Imp (v, va))
+ | nota (Iff (v, va)) = NOT (Iff (v, va))
+ | nota (E v) = NOT (E v)
+ | nota (A v) = NOT (A v)
+ | nota (Closed v) = NOT (Closed v)
+ | nota (NClosed v) = NOT (NClosed v);
fun imp p q =
(if equal_fm p F orelse equal_fm q T then T
@@ -1198,13 +1283,13 @@
| simpfm (Or (p, q)) = disj (simpfm p) (simpfm q)
| simpfm (Imp (p, q)) = imp (simpfm p) (simpfm q)
| simpfm (Iff (p, q)) = iff (simpfm p) (simpfm q)
- | simpfm (Not p) = nota (simpfm p)
+ | simpfm (NOT p) = nota (simpfm p)
| simpfm (Lt a) =
let
val aa = simpnum a;
in
(case aa of C v => (if less_int v zero_inta then T else F)
- | Bound _ => Lt aa | Cn (_, _, _) => Lt aa | Neg _ => Lt aa
+ | Bound _ => Lt aa | CN (_, _, _) => Lt aa | Neg _ => Lt aa
| Add (_, _) => Lt aa | Sub (_, _) => Lt aa | Mul (_, _) => Lt aa)
end
| simpfm (Le a) =
@@ -1212,7 +1297,7 @@
val aa = simpnum a;
in
(case aa of C v => (if less_eq_int v zero_inta then T else F)
- | Bound _ => Le aa | Cn (_, _, _) => Le aa | Neg _ => Le aa
+ | Bound _ => Le aa | CN (_, _, _) => Le aa | Neg _ => Le aa
| Add (_, _) => Le aa | Sub (_, _) => Le aa | Mul (_, _) => Le aa)
end
| simpfm (Gt a) =
@@ -1220,7 +1305,7 @@
val aa = simpnum a;
in
(case aa of C v => (if less_int zero_inta v then T else F)
- | Bound _ => Gt aa | Cn (_, _, _) => Gt aa | Neg _ => Gt aa
+ | Bound _ => Gt aa | CN (_, _, _) => Gt aa | Neg _ => Gt aa
| Add (_, _) => Gt aa | Sub (_, _) => Gt aa | Mul (_, _) => Gt aa)
end
| simpfm (Ge a) =
@@ -1228,7 +1313,7 @@
val aa = simpnum a;
in
(case aa of C v => (if less_eq_int zero_inta v then T else F)
- | Bound _ => Ge aa | Cn (_, _, _) => Ge aa | Neg _ => Ge aa
+ | Bound _ => Ge aa | CN (_, _, _) => Ge aa | Neg _ => Ge aa
| Add (_, _) => Ge aa | Sub (_, _) => Ge aa | Mul (_, _) => Ge aa)
end
| simpfm (Eq a) =
@@ -1236,7 +1321,7 @@
val aa = simpnum a;
in
(case aa of C v => (if equal_inta v zero_inta then T else F)
- | Bound _ => Eq aa | Cn (_, _, _) => Eq aa | Neg _ => Eq aa
+ | Bound _ => Eq aa | CN (_, _, _) => Eq aa | Neg _ => Eq aa
| Add (_, _) => Eq aa | Sub (_, _) => Eq aa | Mul (_, _) => Eq aa)
end
| simpfm (NEq a) =
@@ -1244,7 +1329,7 @@
val aa = simpnum a;
in
(case aa of C v => (if not (equal_inta v zero_inta) then T else F)
- | Bound _ => NEq aa | Cn (_, _, _) => NEq aa | Neg _ => NEq aa
+ | Bound _ => NEq aa | CN (_, _, _) => NEq aa | Neg _ => NEq aa
| Add (_, _) => NEq aa | Sub (_, _) => NEq aa | Mul (_, _) => NEq aa)
end
| simpfm (Dvd (i, a)) =
@@ -1256,7 +1341,7 @@
(case aa
of C v =>
(if dvd (semiring_div_int, equal_int) i v then T else F)
- | Bound _ => Dvd (i, aa) | Cn (_, _, _) => Dvd (i, aa)
+ | Bound _ => Dvd (i, aa) | CN (_, _, _) => Dvd (i, aa)
| Neg _ => Dvd (i, aa) | Add (_, _) => Dvd (i, aa)
| Sub (_, _) => Dvd (i, aa) | Mul (_, _) => Dvd (i, aa))
end))
@@ -1270,7 +1355,7 @@
of C v =>
(if not (dvd (semiring_div_int, equal_int) i v) then T
else F)
- | Bound _ => NDvd (i, aa) | Cn (_, _, _) => NDvd (i, aa)
+ | Bound _ => NDvd (i, aa) | CN (_, _, _) => NDvd (i, aa)
| Neg _ => NDvd (i, aa) | Add (_, _) => NDvd (i, aa)
| Sub (_, _) => NDvd (i, aa) | Mul (_, _) => NDvd (i, aa))
end))
@@ -1338,70 +1423,71 @@
| a_beta (NDvd (ac, Add (iu, iv))) = (fn _ => NDvd (ac, Add (iu, iv)))
| a_beta (NDvd (ac, Sub (iw, ix))) = (fn _ => NDvd (ac, Sub (iw, ix)))
| a_beta (NDvd (ac, Mul (iy, iz))) = (fn _ => NDvd (ac, Mul (iy, iz)))
- | a_beta (Not ae) = (fn _ => Not ae)
+ | a_beta (NOT ae) = (fn _ => NOT ae)
| a_beta (Imp (aj, ak)) = (fn _ => Imp (aj, ak))
| a_beta (Iff (al, am)) = (fn _ => Iff (al, am))
| a_beta (E an) = (fn _ => E an)
| a_beta (A ao) = (fn _ => A ao)
| a_beta (Closed ap) = (fn _ => Closed ap)
| a_beta (NClosed aq) = (fn _ => NClosed aq)
- | a_beta (Lt (Cn (cm, c, e))) =
+ | a_beta (Lt (CN (cm, c, e))) =
(if equal_nat cm zero_nat
then (fn k =>
- Lt (Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => Lt (Cn (suc (minus_nat cm one_nat), c, e))))
- | a_beta (Le (Cn (dm, c, e))) =
+ Lt (CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => Lt (CN (suc (minus_nat cm one_nat), c, e))))
+ | a_beta (Le (CN (dm, c, e))) =
(if equal_nat dm zero_nat
then (fn k =>
- Le (Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => Le (Cn (suc (minus_nat dm one_nat), c, e))))
- | a_beta (Gt (Cn (em, c, e))) =
+ Le (CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => Le (CN (suc (minus_nat dm one_nat), c, e))))
+ | a_beta (Gt (CN (em, c, e))) =
(if equal_nat em zero_nat
then (fn k =>
- Gt (Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => Gt (Cn (suc (minus_nat em one_nat), c, e))))
- | a_beta (Ge (Cn (fm, c, e))) =
+ Gt (CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => Gt (CN (suc (minus_nat em one_nat), c, e))))
+ | a_beta (Ge (CN (fm, c, e))) =
(if equal_nat fm zero_nat
then (fn k =>
- Ge (Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => Ge (Cn (suc (minus_nat fm one_nat), c, e))))
- | a_beta (Eq (Cn (gm, c, e))) =
+ Ge (CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => Ge (CN (suc (minus_nat fm one_nat), c, e))))
+ | a_beta (Eq (CN (gm, c, e))) =
(if equal_nat gm zero_nat
then (fn k =>
- Eq (Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => Eq (Cn (suc (minus_nat gm one_nat), c, e))))
- | a_beta (NEq (Cn (hm, c, e))) =
+ Eq (CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => Eq (CN (suc (minus_nat gm one_nat), c, e))))
+ | a_beta (NEq (CN (hm, c, e))) =
(if equal_nat hm zero_nat
then (fn k =>
- NEq (Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => NEq (Cn (suc (minus_nat hm one_nat), c, e))))
- | a_beta (Dvd (i, Cn (im, c, e))) =
+ NEq (CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => NEq (CN (suc (minus_nat hm one_nat), c, e))))
+ | a_beta (Dvd (i, CN (im, c, e))) =
(if equal_nat im zero_nat
then (fn k =>
- Dvd (times_inta (div_inta k c) i,
- Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => Dvd (i, Cn (suc (minus_nat im one_nat), c, e))))
- | a_beta (NDvd (i, Cn (jm, c, e))) =
+ Dvd (times_inta (divide_inta k c) i,
+ CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => Dvd (i, CN (suc (minus_nat im one_nat), c, e))))
+ | a_beta (NDvd (i, CN (jm, c, e))) =
(if equal_nat jm zero_nat
then (fn k =>
- NDvd (times_inta (div_inta k c) i,
- Cn (zero_nat, Int_of_integer (1 : IntInf.int),
- Mul (div_inta k c, e))))
- else (fn _ => NDvd (i, Cn (suc (minus_nat jm one_nat), c, e))));
+ NDvd (times_inta (divide_inta k c) i,
+ CN (zero_nat, Int_of_integer (1 : IntInf.int),
+ Mul (divide_inta k c, e))))
+ else (fn _ => NDvd (i, CN (suc (minus_nat jm one_nat), c, e))));
fun gcd_int k l =
abs_int
(if equal_inta l zero_inta then k
else gcd_int l (mod_int (abs_int k) (abs_int l)));
-fun lcm_int a b = div_inta (times_inta (abs_int a) (abs_int b)) (gcd_int a b);
+fun lcm_int a b =
+ divide_inta (times_inta (abs_int a) (abs_int b)) (gcd_int a b);
fun delta (And (p, q)) = lcm_int (delta p) (delta q)
| delta (Or (p, q)) = lcm_int (delta p) (delta q)
@@ -1425,16 +1511,16 @@
| delta (NDvd (ac, Add (cu, cv))) = Int_of_integer (1 : IntInf.int)
| delta (NDvd (ac, Sub (cw, cx))) = Int_of_integer (1 : IntInf.int)
| delta (NDvd (ac, Mul (cy, cz))) = Int_of_integer (1 : IntInf.int)
- | delta (Not ae) = Int_of_integer (1 : IntInf.int)
+ | delta (NOT ae) = Int_of_integer (1 : IntInf.int)
| delta (Imp (aj, ak)) = Int_of_integer (1 : IntInf.int)
| delta (Iff (al, am)) = Int_of_integer (1 : IntInf.int)
| delta (E an) = Int_of_integer (1 : IntInf.int)
| delta (A ao) = Int_of_integer (1 : IntInf.int)
| delta (Closed ap) = Int_of_integer (1 : IntInf.int)
| delta (NClosed aq) = Int_of_integer (1 : IntInf.int)
- | delta (Dvd (i, Cn (cm, c, e))) =
+ | delta (Dvd (i, CN (cm, c, e))) =
(if equal_nat cm zero_nat then i else Int_of_integer (1 : IntInf.int))
- | delta (NDvd (i, Cn (dm, c, e))) =
+ | delta (NDvd (i, CN (dm, c, e))) =
(if equal_nat dm zero_nat then i else Int_of_integer (1 : IntInf.int));
fun alpha (And (p, q)) = alpha p @ alpha q
@@ -1479,23 +1565,23 @@
| alpha (NEq (Mul (gy, gz))) = []
| alpha (Dvd (aa, ab)) = []
| alpha (NDvd (ac, ad)) = []
- | alpha (Not ae) = []
+ | alpha (NOT ae) = []
| alpha (Imp (aj, ak)) = []
| alpha (Iff (al, am)) = []
| alpha (E an) = []
| alpha (A ao) = []
| alpha (Closed ap) = []
| alpha (NClosed aq) = []
- | alpha (Lt (Cn (cm, c, e))) = (if equal_nat cm zero_nat then [e] else [])
- | alpha (Le (Cn (dm, c, e))) =
+ | alpha (Lt (CN (cm, c, e))) = (if equal_nat cm zero_nat then [e] else [])
+ | alpha (Le (CN (dm, c, e))) =
(if equal_nat dm zero_nat
then [Add (C (uminus_int (Int_of_integer (1 : IntInf.int))), e)] else [])
- | alpha (Gt (Cn (em, c, e))) = (if equal_nat em zero_nat then [] else [])
- | alpha (Ge (Cn (fm, c, e))) = (if equal_nat fm zero_nat then [] else [])
- | alpha (Eq (Cn (gm, c, e))) =
+ | alpha (Gt (CN (em, c, e))) = (if equal_nat em zero_nat then [] else [])
+ | alpha (Ge (CN (fm, c, e))) = (if equal_nat fm zero_nat then [] else [])
+ | alpha (Eq (CN (gm, c, e))) =
(if equal_nat gm zero_nat
then [Add (C (uminus_int (Int_of_integer (1 : IntInf.int))), e)] else [])
- | alpha (NEq (Cn (hm, c, e))) = (if equal_nat hm zero_nat then [e] else []);
+ | alpha (NEq (CN (hm, c, e))) = (if equal_nat hm zero_nat then [e] else []);
fun zeta (And (p, q)) = lcm_int (zeta p) (zeta q)
| zeta (Or (p, q)) = lcm_int (zeta p) (zeta q)
@@ -1549,28 +1635,28 @@
| zeta (NDvd (ac, Add (iu, iv))) = Int_of_integer (1 : IntInf.int)
| zeta (NDvd (ac, Sub (iw, ix))) = Int_of_integer (1 : IntInf.int)
| zeta (NDvd (ac, Mul (iy, iz))) = Int_of_integer (1 : IntInf.int)
- | zeta (Not ae) = Int_of_integer (1 : IntInf.int)
+ | zeta (NOT ae) = Int_of_integer (1 : IntInf.int)
| zeta (Imp (aj, ak)) = Int_of_integer (1 : IntInf.int)
| zeta (Iff (al, am)) = Int_of_integer (1 : IntInf.int)
| zeta (E an) = Int_of_integer (1 : IntInf.int)
| zeta (A ao) = Int_of_integer (1 : IntInf.int)
| zeta (Closed ap) = Int_of_integer (1 : IntInf.int)
| zeta (NClosed aq) = Int_of_integer (1 : IntInf.int)
- | zeta (Lt (Cn (cm, c, e))) =
+ | zeta (Lt (CN (cm, c, e))) =
(if equal_nat cm zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (Le (Cn (dm, c, e))) =
+ | zeta (Le (CN (dm, c, e))) =
(if equal_nat dm zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (Gt (Cn (em, c, e))) =
+ | zeta (Gt (CN (em, c, e))) =
(if equal_nat em zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (Ge (Cn (fm, c, e))) =
+ | zeta (Ge (CN (fm, c, e))) =
(if equal_nat fm zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (Eq (Cn (gm, c, e))) =
+ | zeta (Eq (CN (gm, c, e))) =
(if equal_nat gm zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (NEq (Cn (hm, c, e))) =
+ | zeta (NEq (CN (hm, c, e))) =
(if equal_nat hm zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (Dvd (i, Cn (im, c, e))) =
+ | zeta (Dvd (i, CN (im, c, e))) =
(if equal_nat im zero_nat then c else Int_of_integer (1 : IntInf.int))
- | zeta (NDvd (i, Cn (jm, c, e))) =
+ | zeta (NDvd (i, CN (jm, c, e))) =
(if equal_nat jm zero_nat then c else Int_of_integer (1 : IntInf.int));
fun beta (And (p, q)) = beta p @ beta q
@@ -1615,23 +1701,23 @@
| beta (NEq (Mul (gy, gz))) = []
| beta (Dvd (aa, ab)) = []
| beta (NDvd (ac, ad)) = []
- | beta (Not ae) = []
+ | beta (NOT ae) = []
| beta (Imp (aj, ak)) = []
| beta (Iff (al, am)) = []
| beta (E an) = []
| beta (A ao) = []
| beta (Closed ap) = []
| beta (NClosed aq) = []
- | beta (Lt (Cn (cm, c, e))) = (if equal_nat cm zero_nat then [] else [])
- | beta (Le (Cn (dm, c, e))) = (if equal_nat dm zero_nat then [] else [])
- | beta (Gt (Cn (em, c, e))) = (if equal_nat em zero_nat then [Neg e] else [])
- | beta (Ge (Cn (fm, c, e))) =
+ | beta (Lt (CN (cm, c, e))) = (if equal_nat cm zero_nat then [] else [])
+ | beta (Le (CN (dm, c, e))) = (if equal_nat dm zero_nat then [] else [])
+ | beta (Gt (CN (em, c, e))) = (if equal_nat em zero_nat then [Neg e] else [])
+ | beta (Ge (CN (fm, c, e))) =
(if equal_nat fm zero_nat
then [Sub (C (uminus_int (Int_of_integer (1 : IntInf.int))), e)] else [])
- | beta (Eq (Cn (gm, c, e))) =
+ | beta (Eq (CN (gm, c, e))) =
(if equal_nat gm zero_nat
then [Sub (C (uminus_int (Int_of_integer (1 : IntInf.int))), e)] else [])
- | beta (NEq (Cn (hm, c, e))) =
+ | beta (NEq (CN (hm, c, e))) =
(if equal_nat hm zero_nat then [Neg e] else []);
fun mirror (And (p, q)) = And (mirror p, mirror q)
@@ -1686,37 +1772,37 @@
| mirror (NDvd (ac, Add (iu, iv))) = NDvd (ac, Add (iu, iv))
| mirror (NDvd (ac, Sub (iw, ix))) = NDvd (ac, Sub (iw, ix))
| mirror (NDvd (ac, Mul (iy, iz))) = NDvd (ac, Mul (iy, iz))
- | mirror (Not ae) = Not ae
+ | mirror (NOT ae) = NOT ae
| mirror (Imp (aj, ak)) = Imp (aj, ak)
| mirror (Iff (al, am)) = Iff (al, am)
| mirror (E an) = E an
| mirror (A ao) = A ao
| mirror (Closed ap) = Closed ap
| mirror (NClosed aq) = NClosed aq
- | mirror (Lt (Cn (cm, c, e))) =
- (if equal_nat cm zero_nat then Gt (Cn (zero_nat, c, Neg e))
- else Lt (Cn (suc (minus_nat cm one_nat), c, e)))
- | mirror (Le (Cn (dm, c, e))) =
- (if equal_nat dm zero_nat then Ge (Cn (zero_nat, c, Neg e))
- else Le (Cn (suc (minus_nat dm one_nat), c, e)))
- | mirror (Gt (Cn (em, c, e))) =
- (if equal_nat em zero_nat then Lt (Cn (zero_nat, c, Neg e))
- else Gt (Cn (suc (minus_nat em one_nat), c, e)))
- | mirror (Ge (Cn (fm, c, e))) =
- (if equal_nat fm zero_nat then Le (Cn (zero_nat, c, Neg e))
- else Ge (Cn (suc (minus_nat fm one_nat), c, e)))
- | mirror (Eq (Cn (gm, c, e))) =
- (if equal_nat gm zero_nat then Eq (Cn (zero_nat, c, Neg e))
- else Eq (Cn (suc (minus_nat gm one_nat), c, e)))
- | mirror (NEq (Cn (hm, c, e))) =
- (if equal_nat hm zero_nat then NEq (Cn (zero_nat, c, Neg e))
- else NEq (Cn (suc (minus_nat hm one_nat), c, e)))
- | mirror (Dvd (i, Cn (im, c, e))) =
- (if equal_nat im zero_nat then Dvd (i, Cn (zero_nat, c, Neg e))
- else Dvd (i, Cn (suc (minus_nat im one_nat), c, e)))
- | mirror (NDvd (i, Cn (jm, c, e))) =
- (if equal_nat jm zero_nat then NDvd (i, Cn (zero_nat, c, Neg e))
- else NDvd (i, Cn (suc (minus_nat jm one_nat), c, e)));
+ | mirror (Lt (CN (cm, c, e))) =
+ (if equal_nat cm zero_nat then Gt (CN (zero_nat, c, Neg e))
+ else Lt (CN (suc (minus_nat cm one_nat), c, e)))
+ | mirror (Le (CN (dm, c, e))) =
+ (if equal_nat dm zero_nat then Ge (CN (zero_nat, c, Neg e))
+ else Le (CN (suc (minus_nat dm one_nat), c, e)))
+ | mirror (Gt (CN (em, c, e))) =
+ (if equal_nat em zero_nat then Lt (CN (zero_nat, c, Neg e))
+ else Gt (CN (suc (minus_nat em one_nat), c, e)))
+ | mirror (Ge (CN (fm, c, e))) =
+ (if equal_nat fm zero_nat then Le (CN (zero_nat, c, Neg e))
+ else Ge (CN (suc (minus_nat fm one_nat), c, e)))
+ | mirror (Eq (CN (gm, c, e))) =
+ (if equal_nat gm zero_nat then Eq (CN (zero_nat, c, Neg e))
+ else Eq (CN (suc (minus_nat gm one_nat), c, e)))
+ | mirror (NEq (CN (hm, c, e))) =
+ (if equal_nat hm zero_nat then NEq (CN (zero_nat, c, Neg e))
+ else NEq (CN (suc (minus_nat hm one_nat), c, e)))
+ | mirror (Dvd (i, CN (im, c, e))) =
+ (if equal_nat im zero_nat then Dvd (i, CN (zero_nat, c, Neg e))
+ else Dvd (i, CN (suc (minus_nat im one_nat), c, e)))
+ | mirror (NDvd (i, CN (jm, c, e))) =
+ (if equal_nat jm zero_nat then NDvd (i, CN (zero_nat, c, Neg e))
+ else NDvd (i, CN (suc (minus_nat jm one_nat), c, e)));
fun member A_ [] y = false
| member A_ (x :: xs) y = eq A_ x y orelse member A_ xs y;
@@ -1725,97 +1811,103 @@
| remdups A_ (x :: xs) =
(if member A_ xs x then remdups A_ xs else x :: remdups A_ xs);
-fun minus_int k l = Int_of_integer (integer_of_int k - integer_of_int l);
-
fun zsplit0 (C c) = (zero_inta, C c)
| zsplit0 (Bound n) =
(if equal_nat n zero_nat then (Int_of_integer (1 : IntInf.int), C zero_inta)
else (zero_inta, Bound n))
- | zsplit0 (Cn (n, i, a)) =
+ | zsplit0 (CN (n, i, a)) =
let
- val (ia, aa) = zsplit0 a;
+ val aa = zsplit0 a;
+ val (ia, ab) = aa;
in
- (if equal_nat n zero_nat then (plus_inta i ia, aa)
- else (ia, Cn (n, i, aa)))
+ (if equal_nat n zero_nat then (plus_inta i ia, ab)
+ else (ia, CN (n, i, ab)))
end
- | zsplit0 (Neg a) = let
- val (i, aa) = zsplit0 a;
- in
- (uminus_int i, Neg aa)
- end
+ | zsplit0 (Neg a) =
+ let
+ val aa = zsplit0 a;
+ val (i, ab) = aa;
+ in
+ (uminus_int i, Neg ab)
+ end
| zsplit0 (Add (a, b)) =
let
- val (ia, aa) = zsplit0 a;
- val (ib, ba) = zsplit0 b;
+ val aa = zsplit0 a;
+ val (ia, ab) = aa;
+ val ba = zsplit0 b;
+ val (ib, bb) = ba;
in
- (plus_inta ia ib, Add (aa, ba))
+ (plus_inta ia ib, Add (ab, bb))
end
| zsplit0 (Sub (a, b)) =
let
- val (ia, aa) = zsplit0 a;
- val (ib, ba) = zsplit0 b;
+ val aa = zsplit0 a;
+ val (ia, ab) = aa;
+ val ba = zsplit0 b;
+ val (ib, bb) = ba;
in
- (minus_int ia ib, Sub (aa, ba))
+ (minus_inta ia ib, Sub (ab, bb))
end
| zsplit0 (Mul (i, a)) =
let
- val (ia, aa) = zsplit0 a;
+ val aa = zsplit0 a;
+ val (ia, ab) = aa;
in
- (times_inta i ia, Mul (i, aa))
+ (times_inta i ia, Mul (i, ab))
end;
fun zlfm (And (p, q)) = And (zlfm p, zlfm q)
| zlfm (Or (p, q)) = Or (zlfm p, zlfm q)
- | zlfm (Imp (p, q)) = Or (zlfm (Not p), zlfm q)
+ | zlfm (Imp (p, q)) = Or (zlfm (NOT p), zlfm q)
| zlfm (Iff (p, q)) =
- Or (And (zlfm p, zlfm q), And (zlfm (Not p), zlfm (Not q)))
+ Or (And (zlfm p, zlfm q), And (zlfm (NOT p), zlfm (NOT q)))
| zlfm (Lt a) =
let
val (c, r) = zsplit0 a;
in
(if equal_inta c zero_inta then Lt r
- else (if less_int zero_inta c then Lt (Cn (zero_nat, c, r))
- else Gt (Cn (zero_nat, uminus_int c, Neg r))))
+ else (if less_int zero_inta c then Lt (CN (zero_nat, c, r))
+ else Gt (CN (zero_nat, uminus_int c, Neg r))))
end
| zlfm (Le a) =
let
val (c, r) = zsplit0 a;
in
(if equal_inta c zero_inta then Le r
- else (if less_int zero_inta c then Le (Cn (zero_nat, c, r))
- else Ge (Cn (zero_nat, uminus_int c, Neg r))))
+ else (if less_int zero_inta c then Le (CN (zero_nat, c, r))
+ else Ge (CN (zero_nat, uminus_int c, Neg r))))
end
| zlfm (Gt a) =
let
val (c, r) = zsplit0 a;
in
(if equal_inta c zero_inta then Gt r
- else (if less_int zero_inta c then Gt (Cn (zero_nat, c, r))
- else Lt (Cn (zero_nat, uminus_int c, Neg r))))
+ else (if less_int zero_inta c then Gt (CN (zero_nat, c, r))
+ else Lt (CN (zero_nat, uminus_int c, Neg r))))
end
| zlfm (Ge a) =
let
val (c, r) = zsplit0 a;
in
(if equal_inta c zero_inta then Ge r
- else (if less_int zero_inta c then Ge (Cn (zero_nat, c, r))
- else Le (Cn (zero_nat, uminus_int c, Neg r))))
+ else (if less_int zero_inta c then Ge (CN (zero_nat, c, r))
+ else Le (CN (zero_nat, uminus_int c, Neg r))))
end
| zlfm (Eq a) =
let
val (c, r) = zsplit0 a;
in
(if equal_inta c zero_inta then Eq r
- else (if less_int zero_inta c then Eq (Cn (zero_nat, c, r))
- else Eq (Cn (zero_nat, uminus_int c, Neg r))))
+ else (if less_int zero_inta c then Eq (CN (zero_nat, c, r))
+ else Eq (CN (zero_nat, uminus_int c, Neg r))))
end
| zlfm (NEq a) =
let
val (c, r) = zsplit0 a;
in
(if equal_inta c zero_inta then NEq r
- else (if less_int zero_inta c then NEq (Cn (zero_nat, c, r))
- else NEq (Cn (zero_nat, uminus_int c, Neg r))))
+ else (if less_int zero_inta c then NEq (CN (zero_nat, c, r))
+ else NEq (CN (zero_nat, uminus_int c, Neg r))))
end
| zlfm (Dvd (i, a)) =
(if equal_inta i zero_inta then zlfm (Eq a)
@@ -1824,8 +1916,8 @@
in
(if equal_inta c zero_inta then Dvd (abs_int i, r)
else (if less_int zero_inta c
- then Dvd (abs_int i, Cn (zero_nat, c, r))
- else Dvd (abs_int i, Cn (zero_nat, uminus_int c, Neg r))))
+ then Dvd (abs_int i, CN (zero_nat, c, r))
+ else Dvd (abs_int i, CN (zero_nat, uminus_int c, Neg r))))
end)
| zlfm (NDvd (i, a)) =
(if equal_inta i zero_inta then zlfm (NEq a)
@@ -1834,32 +1926,32 @@
in
(if equal_inta c zero_inta then NDvd (abs_int i, r)
else (if less_int zero_inta c
- then NDvd (abs_int i, Cn (zero_nat, c, r))
+ then NDvd (abs_int i, CN (zero_nat, c, r))
else NDvd (abs_int i,
- Cn (zero_nat, uminus_int c, Neg r))))
+ CN (zero_nat, uminus_int c, Neg r))))
end)
- | zlfm (Not (And (p, q))) = Or (zlfm (Not p), zlfm (Not q))
- | zlfm (Not (Or (p, q))) = And (zlfm (Not p), zlfm (Not q))
- | zlfm (Not (Imp (p, q))) = And (zlfm p, zlfm (Not q))
- | zlfm (Not (Iff (p, q))) =
- Or (And (zlfm p, zlfm (Not q)), And (zlfm (Not p), zlfm q))
- | zlfm (Not (Not p)) = zlfm p
- | zlfm (Not T) = F
- | zlfm (Not F) = T
- | zlfm (Not (Lt a)) = zlfm (Ge a)
- | zlfm (Not (Le a)) = zlfm (Gt a)
- | zlfm (Not (Gt a)) = zlfm (Le a)
- | zlfm (Not (Ge a)) = zlfm (Lt a)
- | zlfm (Not (Eq a)) = zlfm (NEq a)
- | zlfm (Not (NEq a)) = zlfm (Eq a)
- | zlfm (Not (Dvd (i, a))) = zlfm (NDvd (i, a))
- | zlfm (Not (NDvd (i, a))) = zlfm (Dvd (i, a))
- | zlfm (Not (Closed p)) = NClosed p
- | zlfm (Not (NClosed p)) = Closed p
+ | zlfm (NOT (And (p, q))) = Or (zlfm (NOT p), zlfm (NOT q))
+ | zlfm (NOT (Or (p, q))) = And (zlfm (NOT p), zlfm (NOT q))
+ | zlfm (NOT (Imp (p, q))) = And (zlfm p, zlfm (NOT q))
+ | zlfm (NOT (Iff (p, q))) =
+ Or (And (zlfm p, zlfm (NOT q)), And (zlfm (NOT p), zlfm q))
+ | zlfm (NOT (NOT p)) = zlfm p
+ | zlfm (NOT T) = F
+ | zlfm (NOT F) = T
+ | zlfm (NOT (Lt a)) = zlfm (Ge a)
+ | zlfm (NOT (Le a)) = zlfm (Gt a)
+ | zlfm (NOT (Gt a)) = zlfm (Le a)
+ | zlfm (NOT (Ge a)) = zlfm (Lt a)
+ | zlfm (NOT (Eq a)) = zlfm (NEq a)
+ | zlfm (NOT (NEq a)) = zlfm (Eq a)
+ | zlfm (NOT (Dvd (i, a))) = zlfm (NDvd (i, a))
+ | zlfm (NOT (NDvd (i, a))) = zlfm (Dvd (i, a))
+ | zlfm (NOT (Closed p)) = NClosed p
+ | zlfm (NOT (NClosed p)) = Closed p
| zlfm T = T
| zlfm F = F
- | zlfm (Not (E ci)) = Not (E ci)
- | zlfm (Not (A cj)) = Not (A cj)
+ | zlfm (NOT (E ci)) = NOT (E ci)
+ | zlfm (NOT (A cj)) = NOT (A cj)
| zlfm (E ao) = E ao
| zlfm (A ap) = A ap
| zlfm (Closed aq) = Closed aq
@@ -1870,7 +1962,7 @@
val pa = zlfm p;
val l = zeta pa;
val q =
- And (Dvd (l, Cn (zero_nat, Int_of_integer (1 : IntInf.int), C zero_inta)),
+ And (Dvd (l, CN (zero_nat, Int_of_integer (1 : IntInf.int), C zero_inta)),
a_beta pa l);
val d = delta q;
val b = remdups equal_num (map simpnum (beta q));
@@ -1885,7 +1977,7 @@
| decrnum (Add (a, b)) = Add (decrnum a, decrnum b)
| decrnum (Sub (a, b)) = Sub (decrnum a, decrnum b)
| decrnum (Mul (c, a)) = Mul (c, decrnum a)
- | decrnum (Cn (n, i, a)) = Cn (minus_nat n one_nat, i, decrnum a)
+ | decrnum (CN (n, i, a)) = CN (minus_nat n one_nat, i, decrnum a)
| decrnum (C v) = C v;
fun decr (Lt a) = Lt (decrnum a)
@@ -1896,7 +1988,7 @@
| decr (NEq a) = NEq (decrnum a)
| decr (Dvd (i, a)) = Dvd (i, decrnum a)
| decr (NDvd (i, a)) = NDvd (i, decrnum a)
- | decr (Not p) = Not (decr p)
+ | decr (NOT p) = NOT (decr p)
| decr (And (p, q)) = And (decr p, decr q)
| decr (Or (p, q)) = Or (decr p, decr q)
| decr (Imp (p, q)) = Imp (decr p, decr q)
@@ -1910,7 +2002,7 @@
fun upto_aux i j js =
(if less_int j i then js
- else upto_aux i (minus_int j (Int_of_integer (1 : IntInf.int))) (j :: js));
+ else upto_aux i (minus_inta j (Int_of_integer (1 : IntInf.int))) (j :: js));
fun uptoa i j = upto_aux i j [];
@@ -1935,8 +2027,8 @@
end;
fun qelim (E p) = (fn qe => dj qe (qelim p qe))
- | qelim (A p) = (fn qe => nota (qe (qelim (Not p) qe)))
- | qelim (Not p) = (fn qe => nota (qelim p qe))
+ | qelim (A p) = (fn qe => nota (qe (qelim (NOT p) qe)))
+ | qelim (NOT p) = (fn qe => nota (qelim p qe))
| qelim (And (p, q)) = (fn qe => conj (qelim p qe) (qelim q qe))
| qelim (Or (p, q)) = (fn qe => disj (qelim p qe) (qelim q qe))
| qelim (Imp (p, q)) = (fn qe => imp (qelim p qe) (qelim q qe))
@@ -1957,13 +2049,13 @@
fun prep (E T) = T
| prep (E F) = F
| prep (E (Or (p, q))) = Or (prep (E p), prep (E q))
- | prep (E (Imp (p, q))) = Or (prep (E (Not p)), prep (E q))
+ | prep (E (Imp (p, q))) = Or (prep (E (NOT p)), prep (E q))
| prep (E (Iff (p, q))) =
- Or (prep (E (And (p, q))), prep (E (And (Not p, Not q))))
- | prep (E (Not (And (p, q)))) = Or (prep (E (Not p)), prep (E (Not q)))
- | prep (E (Not (Imp (p, q)))) = prep (E (And (p, Not q)))
- | prep (E (Not (Iff (p, q)))) =
- Or (prep (E (And (p, Not q))), prep (E (And (Not p, q))))
+ Or (prep (E (And (p, q))), prep (E (And (NOT p, NOT q))))
+ | prep (E (NOT (And (p, q)))) = Or (prep (E (NOT p)), prep (E (NOT q)))
+ | prep (E (NOT (Imp (p, q)))) = prep (E (And (p, NOT q)))
+ | prep (E (NOT (Iff (p, q)))) =
+ Or (prep (E (And (p, NOT q))), prep (E (And (NOT p, q))))
| prep (E (Lt ef)) = E (prep (Lt ef))
| prep (E (Le eg)) = E (prep (Le eg))
| prep (E (Gt eh)) = E (prep (Gt eh))
@@ -1972,69 +2064,69 @@
| prep (E (NEq ek)) = E (prep (NEq ek))
| prep (E (Dvd (el, em))) = E (prep (Dvd (el, em)))
| prep (E (NDvd (en, eo))) = E (prep (NDvd (en, eo)))
- | prep (E (Not T)) = E (prep (Not T))
- | prep (E (Not F)) = E (prep (Not F))
- | prep (E (Not (Lt gw))) = E (prep (Not (Lt gw)))
- | prep (E (Not (Le gx))) = E (prep (Not (Le gx)))
- | prep (E (Not (Gt gy))) = E (prep (Not (Gt gy)))
- | prep (E (Not (Ge gz))) = E (prep (Not (Ge gz)))
- | prep (E (Not (Eq ha))) = E (prep (Not (Eq ha)))
- | prep (E (Not (NEq hb))) = E (prep (Not (NEq hb)))
- | prep (E (Not (Dvd (hc, hd)))) = E (prep (Not (Dvd (hc, hd))))
- | prep (E (Not (NDvd (he, hf)))) = E (prep (Not (NDvd (he, hf))))
- | prep (E (Not (Not hg))) = E (prep (Not (Not hg)))
- | prep (E (Not (Or (hj, hk)))) = E (prep (Not (Or (hj, hk))))
- | prep (E (Not (E hp))) = E (prep (Not (E hp)))
- | prep (E (Not (A hq))) = E (prep (Not (A hq)))
- | prep (E (Not (Closed hr))) = E (prep (Not (Closed hr)))
- | prep (E (Not (NClosed hs))) = E (prep (Not (NClosed hs)))
+ | prep (E (NOT T)) = E (prep (NOT T))
+ | prep (E (NOT F)) = E (prep (NOT F))
+ | prep (E (NOT (Lt gw))) = E (prep (NOT (Lt gw)))
+ | prep (E (NOT (Le gx))) = E (prep (NOT (Le gx)))
+ | prep (E (NOT (Gt gy))) = E (prep (NOT (Gt gy)))
+ | prep (E (NOT (Ge gz))) = E (prep (NOT (Ge gz)))
+ | prep (E (NOT (Eq ha))) = E (prep (NOT (Eq ha)))
+ | prep (E (NOT (NEq hb))) = E (prep (NOT (NEq hb)))
+ | prep (E (NOT (Dvd (hc, hd)))) = E (prep (NOT (Dvd (hc, hd))))
+ | prep (E (NOT (NDvd (he, hf)))) = E (prep (NOT (NDvd (he, hf))))
+ | prep (E (NOT (NOT hg))) = E (prep (NOT (NOT hg)))
+ | prep (E (NOT (Or (hj, hk)))) = E (prep (NOT (Or (hj, hk))))
+ | prep (E (NOT (E hp))) = E (prep (NOT (E hp)))
+ | prep (E (NOT (A hq))) = E (prep (NOT (A hq)))
+ | prep (E (NOT (Closed hr))) = E (prep (NOT (Closed hr)))
+ | prep (E (NOT (NClosed hs))) = E (prep (NOT (NClosed hs)))
| prep (E (And (eq, er))) = E (prep (And (eq, er)))
| prep (E (E ey)) = E (prep (E ey))
| prep (E (A ez)) = E (prep (A ez))
| prep (E (Closed fa)) = E (prep (Closed fa))
| prep (E (NClosed fb)) = E (prep (NClosed fb))
| prep (A (And (p, q))) = And (prep (A p), prep (A q))
- | prep (A T) = prep (Not (E (Not T)))
- | prep (A F) = prep (Not (E (Not F)))
- | prep (A (Lt jn)) = prep (Not (E (Not (Lt jn))))
- | prep (A (Le jo)) = prep (Not (E (Not (Le jo))))
- | prep (A (Gt jp)) = prep (Not (E (Not (Gt jp))))
- | prep (A (Ge jq)) = prep (Not (E (Not (Ge jq))))
- | prep (A (Eq jr)) = prep (Not (E (Not (Eq jr))))
- | prep (A (NEq js)) = prep (Not (E (Not (NEq js))))
- | prep (A (Dvd (jt, ju))) = prep (Not (E (Not (Dvd (jt, ju)))))
- | prep (A (NDvd (jv, jw))) = prep (Not (E (Not (NDvd (jv, jw)))))
- | prep (A (Not jx)) = prep (Not (E (Not (Not jx))))
- | prep (A (Or (ka, kb))) = prep (Not (E (Not (Or (ka, kb)))))
- | prep (A (Imp (kc, kd))) = prep (Not (E (Not (Imp (kc, kd)))))
- | prep (A (Iff (ke, kf))) = prep (Not (E (Not (Iff (ke, kf)))))
- | prep (A (E kg)) = prep (Not (E (Not (E kg))))
- | prep (A (A kh)) = prep (Not (E (Not (A kh))))
- | prep (A (Closed ki)) = prep (Not (E (Not (Closed ki))))
- | prep (A (NClosed kj)) = prep (Not (E (Not (NClosed kj))))
- | prep (Not (Not p)) = prep p
- | prep (Not (And (p, q))) = Or (prep (Not p), prep (Not q))
- | prep (Not (A p)) = prep (E (Not p))
- | prep (Not (Or (p, q))) = And (prep (Not p), prep (Not q))
- | prep (Not (Imp (p, q))) = And (prep p, prep (Not q))
- | prep (Not (Iff (p, q))) = Or (prep (And (p, Not q)), prep (And (Not p, q)))
- | prep (Not T) = Not (prep T)
- | prep (Not F) = Not (prep F)
- | prep (Not (Lt bo)) = Not (prep (Lt bo))
- | prep (Not (Le bp)) = Not (prep (Le bp))
- | prep (Not (Gt bq)) = Not (prep (Gt bq))
- | prep (Not (Ge br)) = Not (prep (Ge br))
- | prep (Not (Eq bs)) = Not (prep (Eq bs))
- | prep (Not (NEq bt)) = Not (prep (NEq bt))
- | prep (Not (Dvd (bu, bv))) = Not (prep (Dvd (bu, bv)))
- | prep (Not (NDvd (bw, bx))) = Not (prep (NDvd (bw, bx)))
- | prep (Not (E ch)) = Not (prep (E ch))
- | prep (Not (Closed cj)) = Not (prep (Closed cj))
- | prep (Not (NClosed ck)) = Not (prep (NClosed ck))
+ | prep (A T) = prep (NOT (E (NOT T)))
+ | prep (A F) = prep (NOT (E (NOT F)))
+ | prep (A (Lt jn)) = prep (NOT (E (NOT (Lt jn))))
+ | prep (A (Le jo)) = prep (NOT (E (NOT (Le jo))))
+ | prep (A (Gt jp)) = prep (NOT (E (NOT (Gt jp))))
+ | prep (A (Ge jq)) = prep (NOT (E (NOT (Ge jq))))
+ | prep (A (Eq jr)) = prep (NOT (E (NOT (Eq jr))))
+ | prep (A (NEq js)) = prep (NOT (E (NOT (NEq js))))
+ | prep (A (Dvd (jt, ju))) = prep (NOT (E (NOT (Dvd (jt, ju)))))
+ | prep (A (NDvd (jv, jw))) = prep (NOT (E (NOT (NDvd (jv, jw)))))
+ | prep (A (NOT jx)) = prep (NOT (E (NOT (NOT jx))))
+ | prep (A (Or (ka, kb))) = prep (NOT (E (NOT (Or (ka, kb)))))
+ | prep (A (Imp (kc, kd))) = prep (NOT (E (NOT (Imp (kc, kd)))))
+ | prep (A (Iff (ke, kf))) = prep (NOT (E (NOT (Iff (ke, kf)))))
+ | prep (A (E kg)) = prep (NOT (E (NOT (E kg))))
+ | prep (A (A kh)) = prep (NOT (E (NOT (A kh))))
+ | prep (A (Closed ki)) = prep (NOT (E (NOT (Closed ki))))
+ | prep (A (NClosed kj)) = prep (NOT (E (NOT (NClosed kj))))
+ | prep (NOT (NOT p)) = prep p
+ | prep (NOT (And (p, q))) = Or (prep (NOT p), prep (NOT q))
+ | prep (NOT (A p)) = prep (E (NOT p))
+ | prep (NOT (Or (p, q))) = And (prep (NOT p), prep (NOT q))
+ | prep (NOT (Imp (p, q))) = And (prep p, prep (NOT q))
+ | prep (NOT (Iff (p, q))) = Or (prep (And (p, NOT q)), prep (And (NOT p, q)))
+ | prep (NOT T) = NOT (prep T)
+ | prep (NOT F) = NOT (prep F)
+ | prep (NOT (Lt bo)) = NOT (prep (Lt bo))
+ | prep (NOT (Le bp)) = NOT (prep (Le bp))
+ | prep (NOT (Gt bq)) = NOT (prep (Gt bq))
+ | prep (NOT (Ge br)) = NOT (prep (Ge br))
+ | prep (NOT (Eq bs)) = NOT (prep (Eq bs))
+ | prep (NOT (NEq bt)) = NOT (prep (NEq bt))
+ | prep (NOT (Dvd (bu, bv))) = NOT (prep (Dvd (bu, bv)))
+ | prep (NOT (NDvd (bw, bx))) = NOT (prep (NDvd (bw, bx)))
+ | prep (NOT (E ch)) = NOT (prep (E ch))
+ | prep (NOT (Closed cj)) = NOT (prep (Closed cj))
+ | prep (NOT (NClosed ck)) = NOT (prep (NClosed ck))
| prep (Or (p, q)) = Or (prep p, prep q)
| prep (And (p, q)) = And (prep p, prep q)
- | prep (Imp (p, q)) = prep (Or (Not p, q))
- | prep (Iff (p, q)) = Or (prep (And (p, q)), prep (And (Not p, Not q)))
+ | prep (Imp (p, q)) = prep (Or (NOT p, q))
+ | prep (Iff (p, q)) = Or (prep (And (p, q)), prep (And (NOT p, NOT q)))
| prep T = T
| prep F = F
| prep (Lt u) = Lt u
@@ -2050,6 +2142,6 @@
fun pa p = qelim (prep p) cooper;
-fun nat_of_integer k = Nat (max ord_integer 0 k);
+fun nat_of_integer k = Nat (max ord_integer (0 : IntInf.int) k);
end; (*struct Cooper_Procedure*)
--- a/src/HOL/Tools/Quickcheck/random_generators.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Quickcheck/random_generators.ML Fri Sep 18 16:42:19 2015 +0100
@@ -316,7 +316,7 @@
fun mk_scomp T1 T2 sT f g = Const (@{const_name scomp},
liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
fun mk_split T = Sign.mk_const thy
- (@{const_name case_prod}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
+ (@{const_name uncurry}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
fun mk_scomp_split T t t' =
mk_scomp (mk_termtyp T) resultT @{typ Random.seed} t
(mk_split T $ Abs ("", T, Abs ("", @{typ "unit => term"}, t')));
@@ -362,7 +362,7 @@
fun mk_scomp T1 T2 sT f g = Const (@{const_name scomp},
liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
fun mk_split T = Sign.mk_const thy
- (@{const_name case_prod}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
+ (@{const_name uncurry}, [T, @{typ "unit => term"}, liftT resultT @{typ Random.seed}]);
fun mk_scomp_split T t t' =
mk_scomp (mk_termtyp T) resultT @{typ Random.seed} t
(mk_split T $ Abs ("", T, Abs ("", @{typ "unit => term"}, t')));
--- a/src/HOL/Tools/Quotient/quotient_tacs.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Quotient/quotient_tacs.ML Fri Sep 18 16:42:19 2015 +0100
@@ -102,13 +102,13 @@
(case try (Thm.instantiate' ty_inst trm_inst) ball_bex_thm of
NONE => NONE
| SOME thm' =>
- (case try (get_match_inst thy (get_lhs thm')) redex of
+ (case try (get_match_inst thy (get_lhs thm')) (Thm.term_of redex) of
NONE => NONE
| SOME inst2 => try (Drule.instantiate_normalize inst2) thm'))
end
fun ball_bex_range_simproc ctxt redex =
- case redex of
+ (case Thm.term_of redex of
(Const (@{const_name "Ball"}, _) $ (Const (@{const_name "Respects"}, _) $
(Const (@{const_name "rel_fun"}, _) $ R1 $ R2)) $ _) =>
calculate_inst ctxt @{thm ball_reg_eqv_range[THEN eq_reflection]} redex R1 R2
@@ -117,7 +117,7 @@
(Const (@{const_name "rel_fun"}, _) $ R1 $ R2)) $ _) =>
calculate_inst ctxt @{thm bex_reg_eqv_range[THEN eq_reflection]} redex R1 R2
- | _ => NONE
+ | _ => NONE)
(* Regularize works as follows:
@@ -147,17 +147,19 @@
fun eq_imp_rel_get ctxt =
map (OF1 eq_imp_rel) (rev (Named_Theorems.get ctxt @{named_theorems quot_equiv}))
+val regularize_simproc =
+ Simplifier.make_simproc @{context} "regularize"
+ {lhss = [@{term "Ball (Respects (R1 ===> R2)) P"}, @{term "Bex (Respects (R1 ===> R2)) P"}],
+ proc = K ball_bex_range_simproc,
+ identifier = []};
+
fun regularize_tac ctxt =
let
val thy = Proof_Context.theory_of ctxt
- val ball_pat = @{term "Ball (Respects (R1 ===> R2)) P"}
- val bex_pat = @{term "Bex (Respects (R1 ===> R2)) P"}
- val simproc =
- Simplifier.simproc_global_i thy "" [ball_pat, bex_pat] ball_bex_range_simproc
val simpset =
mk_minimal_simpset ctxt
addsimps @{thms ball_reg_eqv bex_reg_eqv babs_reg_eqv babs_simp}
- addsimprocs [simproc]
+ addsimprocs [regularize_simproc]
addSolver equiv_solver addSolver quotient_solver
val eq_eqvs = eq_imp_rel_get ctxt
in
--- a/src/HOL/Tools/Quotient/quotient_term.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Quotient/quotient_term.ML Fri Sep 18 16:42:19 2015 +0100
@@ -634,12 +634,12 @@
end
end
- | (((t1 as Const (@{const_name case_prod}, _)) $ Abs (v1, ty, Abs(v1', ty', s1))),
- ((t2 as Const (@{const_name case_prod}, _)) $ Abs (v2, _ , Abs(v2', _ , s2)))) =>
+ | (((t1 as Const (@{const_name uncurry}, _)) $ Abs (v1, ty, Abs(v1', ty', s1))),
+ ((t2 as Const (@{const_name uncurry}, _)) $ Abs (v2, _ , Abs(v2', _ , s2)))) =>
regularize_trm ctxt (t1, t2) $ Abs (v1, ty, Abs (v1', ty', regularize_trm ctxt (s1, s2)))
- | (((t1 as Const (@{const_name case_prod}, _)) $ Abs (v1, ty, s1)),
- ((t2 as Const (@{const_name case_prod}, _)) $ Abs (v2, _ , s2))) =>
+ | (((t1 as Const (@{const_name uncurry}, _)) $ Abs (v1, ty, s1)),
+ ((t2 as Const (@{const_name uncurry}, _)) $ Abs (v2, _ , s2))) =>
regularize_trm ctxt (t1, t2) $ Abs (v1, ty, regularize_trm ctxt (s1, s2))
| (t1 $ t2, t1' $ t2') =>
--- a/src/HOL/Tools/Quotient/quotient_type.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/Quotient/quotient_type.ML Fri Sep 18 16:42:19 2015 +0100
@@ -45,7 +45,7 @@
fun typedef_tac ctxt =
EVERY1 (map (resolve_tac ctxt o single) [@{thm part_equivp_typedef}, equiv_thm])
in
- Typedef.add_typedef false (qty_name, map (rpair dummyS) vs, mx)
+ Typedef.add_typedef (qty_name, map (rpair dummyS) vs, mx)
(typedef_term rel rty lthy) NONE typedef_tac lthy
end
--- a/src/HOL/Tools/SMT/smt_real.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/SMT/smt_real.ML Fri Sep 18 16:42:19 2015 +0100
@@ -98,8 +98,10 @@
(* Z3 proof replay *)
-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/Tools/SMT/z3_replay_util.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/SMT/z3_replay_util.ML Fri Sep 18 16:42:19 2015 +0100
@@ -91,9 +91,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
@@ -105,9 +105,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
@@ -124,11 +124,15 @@
addsimps @{thms field_simps times_divide_eq_right times_divide_eq_left arith_special
arith_simps rel_simps array_rules z3div_def z3mod_def NO_MATCH_def}
addsimprocs [@{simproc numeral_divmod},
- 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
(
--- a/src/HOL/Tools/groebner.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/groebner.ML Fri Sep 18 16:42:19 2015 +0100
@@ -778,17 +778,20 @@
in Conv.fconv_rule (Conv.arg_conv (Conv.arg1_conv ring_normalize_conv))
(Thm.instantiate' [] [SOME a, SOME b] idl_sub)
end
- val poly_eq_simproc =
+
+val poly_eq_simproc =
let
- fun proc phi ctxt t =
- let val th = poly_eq_conv t
- in if Thm.is_reflexive th then NONE else SOME th
- end
- in make_simproc {lhss = [Thm.lhs_of idl_sub],
- name = "poly_eq_simproc", proc = proc, identifier = []}
- end;
- val poly_eq_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ fun proc ct =
+ let val th = poly_eq_conv ct
+ in if Thm.is_reflexive th then NONE else SOME th end
+ in
+ Simplifier.cert_simproc (Thm.theory_of_thm idl_sub) "poly_eq_simproc"
+ {lhss = [Thm.term_of (Thm.lhs_of idl_sub)],
+ proc = fn _ => fn _ => proc, identifier = []}
+ end;
+
+val poly_eq_ss =
+ simpset_of (put_simpset HOL_basic_ss @{context}
addsimps @{thms simp_thms}
addsimprocs [poly_eq_simproc])
--- a/src/HOL/Tools/hologic.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/hologic.ML Fri Sep 18 16:42:19 2015 +0100
@@ -349,12 +349,12 @@
end;
fun split_const (A, B, C) =
- Const ("Product_Type.prod.case_prod", (A --> B --> C) --> mk_prodT (A, B) --> C);
+ Const ("Product_Type.prod.uncurry", (A --> B --> C) --> mk_prodT (A, B) --> C);
fun mk_split t =
(case Term.fastype_of t of
T as (Type ("fun", [A, Type ("fun", [B, C])])) =>
- Const ("Product_Type.prod.case_prod", T --> mk_prodT (A, B) --> C) $ t
+ Const ("Product_Type.prod.uncurry", T --> mk_prodT (A, B) --> C) $ t
| _ => raise TERM ("mk_split: bad body type", [t]));
(*Maps the type T1 * ... * Tn to [T1, ..., Tn], however nested*)
@@ -470,7 +470,7 @@
val strip_psplits =
let
fun strip [] qs Ts t = (t, rev Ts, qs)
- | strip (p :: ps) qs Ts (Const ("Product_Type.prod.case_prod", _) $ t) =
+ | strip (p :: ps) qs Ts (Const ("Product_Type.prod.uncurry", _) $ t) =
strip ((1 :: p) :: (2 :: p) :: ps) (p :: qs) Ts t
| strip (p :: ps) qs Ts (Abs (s, T, t)) = strip ps qs (T :: Ts) t
| strip (p :: ps) qs Ts t = strip ps qs
--- a/src/HOL/Tools/inductive_set.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/inductive_set.ML Fri Sep 18 16:42:19 2015 +0100
@@ -38,65 +38,68 @@
val anyt = Free ("t", TFree ("'t", []));
fun strong_ind_simproc tab =
- Simplifier.simproc_global_i @{theory HOL} "strong_ind" [anyt] (fn ctxt => fn t =>
- let
- fun close p t f =
- let val vs = Term.add_vars t []
- in Thm.instantiate' [] (rev (map (SOME o Thm.cterm_of ctxt o Var) vs))
- (p (fold (Logic.all o Var) vs t) f)
- end;
- fun mkop @{const_name HOL.conj} T x =
- SOME (Const (@{const_name Lattices.inf}, T --> T --> T), x)
- | mkop @{const_name HOL.disj} T x =
- SOME (Const (@{const_name Lattices.sup}, T --> T --> T), x)
- | mkop _ _ _ = NONE;
- fun mk_collect p T t =
- let val U = HOLogic.dest_setT T
- in HOLogic.Collect_const U $
- HOLogic.mk_psplits (HOLogic.flat_tuple_paths p) U HOLogic.boolT t
- end;
- fun decomp (Const (s, _) $ ((m as Const (@{const_name Set.member},
- Type (_, [_, Type (_, [T, _])]))) $ p $ S) $ u) =
- mkop s T (m, p, S, mk_collect p T (head_of u))
- | decomp (Const (s, _) $ u $ ((m as Const (@{const_name Set.member},
- Type (_, [_, Type (_, [T, _])]))) $ p $ S)) =
- mkop s T (m, p, mk_collect p T (head_of u), S)
- | decomp _ = NONE;
- val simp =
- full_simp_tac
- (put_simpset HOL_basic_ss ctxt addsimps [mem_Collect_eq, @{thm split_conv}]) 1;
- fun mk_rew t = (case strip_abs_vars t of
- [] => NONE
- | xs => (case decomp (strip_abs_body t) of
- NONE => NONE
- | SOME (bop, (m, p, S, S')) =>
- SOME (close (Goal.prove ctxt [] [])
- (Logic.mk_equals (t, fold_rev Term.abs xs (m $ p $ (bop $ S $ S'))))
- (K (EVERY
- [resolve_tac ctxt [eq_reflection] 1,
- REPEAT (resolve_tac ctxt @{thms ext} 1),
- resolve_tac ctxt [iffI] 1,
- EVERY [eresolve_tac ctxt [conjE] 1, resolve_tac ctxt [IntI] 1, simp, simp,
- eresolve_tac ctxt [IntE] 1, resolve_tac ctxt [conjI] 1, simp, simp] ORELSE
- EVERY [eresolve_tac ctxt [disjE] 1, resolve_tac ctxt [UnI1] 1, simp,
- resolve_tac ctxt [UnI2] 1, simp,
- eresolve_tac ctxt [UnE] 1, resolve_tac ctxt [disjI1] 1, simp,
- resolve_tac ctxt [disjI2] 1, simp]])))
- handle ERROR _ => NONE))
- in
- case strip_comb t of
- (h as Const (name, _), ts) => (case Symtab.lookup tab name of
- SOME _ =>
- let val rews = map mk_rew ts
- in
- if forall is_none rews then NONE
- else SOME (fold (fn th1 => fn th2 => Thm.combination th2 th1)
- (map2 (fn SOME r => K r | NONE => Thm.reflexive o Thm.cterm_of ctxt)
- rews ts) (Thm.reflexive (Thm.cterm_of ctxt h)))
- end
- | NONE => NONE)
- | _ => NONE
- end);
+ Simplifier.make_simproc @{context} "strong_ind"
+ {lhss = [@{term "x::'a::{}"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ let
+ fun close p t f =
+ let val vs = Term.add_vars t []
+ in Thm.instantiate' [] (rev (map (SOME o Thm.cterm_of ctxt o Var) vs))
+ (p (fold (Logic.all o Var) vs t) f)
+ end;
+ fun mkop @{const_name HOL.conj} T x =
+ SOME (Const (@{const_name Lattices.inf}, T --> T --> T), x)
+ | mkop @{const_name HOL.disj} T x =
+ SOME (Const (@{const_name Lattices.sup}, T --> T --> T), x)
+ | mkop _ _ _ = NONE;
+ fun mk_collect p T t =
+ let val U = HOLogic.dest_setT T
+ in HOLogic.Collect_const U $
+ HOLogic.mk_psplits (HOLogic.flat_tuple_paths p) U HOLogic.boolT t
+ end;
+ fun decomp (Const (s, _) $ ((m as Const (@{const_name Set.member},
+ Type (_, [_, Type (_, [T, _])]))) $ p $ S) $ u) =
+ mkop s T (m, p, S, mk_collect p T (head_of u))
+ | decomp (Const (s, _) $ u $ ((m as Const (@{const_name Set.member},
+ Type (_, [_, Type (_, [T, _])]))) $ p $ S)) =
+ mkop s T (m, p, mk_collect p T (head_of u), S)
+ | decomp _ = NONE;
+ val simp =
+ full_simp_tac
+ (put_simpset HOL_basic_ss ctxt addsimps [mem_Collect_eq, @{thm split_conv}]) 1;
+ fun mk_rew t = (case strip_abs_vars t of
+ [] => NONE
+ | xs => (case decomp (strip_abs_body t) of
+ NONE => NONE
+ | SOME (bop, (m, p, S, S')) =>
+ SOME (close (Goal.prove ctxt [] [])
+ (Logic.mk_equals (t, fold_rev Term.abs xs (m $ p $ (bop $ S $ S'))))
+ (K (EVERY
+ [resolve_tac ctxt [eq_reflection] 1,
+ REPEAT (resolve_tac ctxt @{thms ext} 1),
+ resolve_tac ctxt [iffI] 1,
+ EVERY [eresolve_tac ctxt [conjE] 1, resolve_tac ctxt [IntI] 1, simp, simp,
+ eresolve_tac ctxt [IntE] 1, resolve_tac ctxt [conjI] 1, simp, simp] ORELSE
+ EVERY [eresolve_tac ctxt [disjE] 1, resolve_tac ctxt [UnI1] 1, simp,
+ resolve_tac ctxt [UnI2] 1, simp,
+ eresolve_tac ctxt [UnE] 1, resolve_tac ctxt [disjI1] 1, simp,
+ resolve_tac ctxt [disjI2] 1, simp]])))
+ handle ERROR _ => NONE))
+ in
+ (case strip_comb (Thm.term_of ct) of
+ (h as Const (name, _), ts) =>
+ if Symtab.defined tab name then
+ let val rews = map mk_rew ts
+ in
+ if forall is_none rews then NONE
+ else SOME (fold (fn th1 => fn th2 => Thm.combination th2 th1)
+ (map2 (fn SOME r => K r | NONE => Thm.reflexive o Thm.cterm_of ctxt)
+ rews ts) (Thm.reflexive (Thm.cterm_of ctxt h)))
+ end
+ else NONE
+ | _ => NONE)
+ end,
+ identifier = []};
(* only eta contract terms occurring as arguments of functions satisfying p *)
fun eta_contract p =
@@ -312,9 +315,12 @@
fun to_pred_simproc rules =
let val rules' = map mk_meta_eq rules
in
- Simplifier.simproc_global_i @{theory HOL} "to_pred" [anyt]
- (fn ctxt =>
- lookup_rule (Proof_Context.theory_of ctxt) (Thm.prop_of #> Logic.dest_equals) rules')
+ Simplifier.make_simproc @{context} "to_pred"
+ {lhss = [anyt],
+ proc = fn _ => fn ctxt => fn ct =>
+ lookup_rule (Proof_Context.theory_of ctxt)
+ (Thm.prop_of #> Logic.dest_equals) rules' (Thm.term_of ct),
+ identifier = []}
end;
fun to_pred_proc thy rules t =
@@ -463,13 +469,11 @@
(* define inductive sets using previously defined predicates *)
val (defs, lthy2) = lthy1
- |> Proof_Context.concealed (* FIXME ?? *)
|> fold_map Local_Theory.define
(map (fn (((c, syn), (fs, U, _)), p) => ((c, syn), ((Thm.def_binding c, []),
fold_rev lambda params (HOLogic.Collect_const U $
HOLogic.mk_psplits fs U HOLogic.boolT (list_comb (p, params3))))))
- (cnames_syn ~~ cs_info ~~ preds))
- ||> Proof_Context.restore_naming lthy1;
+ (cnames_syn ~~ cs_info ~~ preds));
(* prove theorems for converting predicate to set notation *)
val lthy3 = fold
--- a/src/HOL/Tools/int_arith.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/int_arith.ML Fri Sep 18 16:42:19 2015 +0100
@@ -20,33 +20,29 @@
That is, m and n consist only of 1s combined with "+", "-" and "*".
*)
-val zeroth = (Thm.symmetric o mk_meta_eq) @{thm of_int_0};
-
-val lhss0 = [@{cpat "0::?'a::ring"}];
-
-fun proc0 phi ctxt ct =
- let val T = Thm.ctyp_of_cterm ct
- in if Thm.typ_of T = @{typ int} then NONE else
- SOME (Thm.instantiate' [SOME T] [] zeroth)
- end;
+val zeroth = Thm.symmetric (mk_meta_eq @{thm of_int_0});
val zero_to_of_int_zero_simproc =
- make_simproc {lhss = lhss0, name = "zero_to_of_int_zero_simproc",
- proc = proc0, identifier = []};
-
-val oneth = (Thm.symmetric o mk_meta_eq) @{thm of_int_1};
+ Simplifier.make_simproc @{context} "zero_to_of_int_zero_simproc"
+ {lhss = [@{term "0::'a::ring"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ let val T = Thm.ctyp_of_cterm ct in
+ if Thm.typ_of T = @{typ int} then NONE
+ else SOME (Thm.instantiate' [SOME T] [] zeroth)
+ end,
+ identifier = []};
-val lhss1 = [@{cpat "1::?'a::ring_1"}];
-
-fun proc1 phi ctxt ct =
- let val T = Thm.ctyp_of_cterm ct
- in if Thm.typ_of T = @{typ int} then NONE else
- SOME (Thm.instantiate' [SOME T] [] oneth)
- end;
+val oneth = Thm.symmetric (mk_meta_eq @{thm of_int_1});
val one_to_of_int_one_simproc =
- make_simproc {lhss = lhss1, name = "one_to_of_int_one_simproc",
- proc = proc1, identifier = []};
+ Simplifier.make_simproc @{context} "one_to_of_int_one_simproc"
+ {lhss = [@{term "1::'a::ring_1"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ let val T = Thm.ctyp_of_cterm ct in
+ if Thm.typ_of T = @{typ int} then NONE
+ else SOME (Thm.instantiate' [SOME T] [] oneth)
+ end,
+ identifier = []};
fun check (Const (@{const_name Groups.one}, @{typ int})) = false
| check (Const (@{const_name Groups.one}, _)) = true
@@ -66,18 +62,18 @@
[@{thm of_int_less_iff}, @{thm of_int_le_iff}, @{thm of_int_eq_iff}])
addsimprocs [zero_to_of_int_zero_simproc,one_to_of_int_one_simproc]);
-fun sproc phi ctxt ct =
- if check (Thm.term_of ct) then SOME (Simplifier.rewrite (put_simpset conv_ss ctxt) ct)
- else NONE;
+val zero_one_idom_simproc =
+ Simplifier.make_simproc @{context} "zero_one_idom_simproc"
+ {lhss =
+ [@{term "(x::'a::ring_char_0) = y"},
+ @{term "(x::'a::linordered_idom) < y"},
+ @{term "(x::'a::linordered_idom) \<le> y"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ if check (Thm.term_of ct)
+ then SOME (Simplifier.rewrite (put_simpset conv_ss ctxt) ct)
+ else NONE,
+ identifier = []};
-val lhss' =
- [@{cpat "(?x::?'a::ring_char_0) = (?y::?'a)"},
- @{cpat "(?x::?'a::linordered_idom) < (?y::?'a)"},
- @{cpat "(?x::?'a::linordered_idom) <= (?y::?'a)"}]
-
-val zero_one_idom_simproc =
- make_simproc {lhss = lhss' , name = "zero_one_idom_simproc",
- proc = sproc, identifier = []}
fun number_of ctxt T n =
if not (Sign.of_sort (Proof_Context.theory_of ctxt) (T, @{sort numeral}))
--- a/src/HOL/Tools/lin_arith.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/lin_arith.ML Fri Sep 18 16:42:19 2015 +0100
@@ -9,7 +9,7 @@
val pre_tac: Proof.context -> int -> tactic
val simple_tac: Proof.context -> int -> tactic
val tac: Proof.context -> int -> tactic
- val simproc: Proof.context -> term -> thm option
+ val simproc: Proof.context -> cterm -> thm option
val add_inj_thms: thm list -> Context.generic -> Context.generic
val add_lessD: thm -> Context.generic -> Context.generic
val add_simps: thm list -> Context.generic -> Context.generic
--- a/src/HOL/Tools/nat_numeral_simprocs.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/nat_numeral_simprocs.ML Fri Sep 18 16:42:19 2015 +0100
@@ -216,10 +216,10 @@
val bal_add2 = @{thm nat_diff_add_eq2} RS trans
);
-fun eq_cancel_numerals ctxt ct = EqCancelNumerals.proc ctxt (Thm.term_of ct)
-fun less_cancel_numerals ctxt ct = LessCancelNumerals.proc ctxt (Thm.term_of ct)
-fun le_cancel_numerals ctxt ct = LeCancelNumerals.proc ctxt (Thm.term_of ct)
-fun diff_cancel_numerals ctxt ct = DiffCancelNumerals.proc ctxt (Thm.term_of ct)
+val eq_cancel_numerals = EqCancelNumerals.proc
+val less_cancel_numerals = LessCancelNumerals.proc
+val le_cancel_numerals = LeCancelNumerals.proc
+val diff_cancel_numerals = DiffCancelNumerals.proc
(*** Applying CombineNumeralsFun ***)
@@ -257,7 +257,7 @@
structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
-fun combine_numerals ctxt ct = CombineNumerals.proc ctxt (Thm.term_of ct)
+val combine_numerals = CombineNumerals.proc
(*** Applying CancelNumeralFactorFun ***)
@@ -311,7 +311,8 @@
);
structure LessCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
+(
+ open CancelNumeralFactorCommon
val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
val cancel = @{thm nat_mult_less_cancel1} RS trans
@@ -319,18 +320,19 @@
);
structure LeCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
+(
+ open CancelNumeralFactorCommon
val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
val cancel = @{thm nat_mult_le_cancel1} RS trans
val neg_exchanges = true
)
-fun eq_cancel_numeral_factor ctxt ct = EqCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun less_cancel_numeral_factor ctxt ct = LessCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun le_cancel_numeral_factor ctxt ct = LeCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun div_cancel_numeral_factor ctxt ct = DivCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun dvd_cancel_numeral_factor ctxt ct = DvdCancelNumeralFactor.proc ctxt (Thm.term_of ct)
+val eq_cancel_numeral_factor = EqCancelNumeralFactor.proc
+val less_cancel_numeral_factor = LessCancelNumeralFactor.proc
+val le_cancel_numeral_factor = LeCancelNumeralFactor.proc
+val div_cancel_numeral_factor = DivCancelNumeralFactor.proc
+val dvd_cancel_numeral_factor = DvdCancelNumeralFactor.proc
(*** Applying ExtractCommonTermFun ***)
--- a/src/HOL/Tools/numeral.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/numeral.ML Fri Sep 18 16:42:19 2015 +0100
@@ -37,27 +37,33 @@
local
-val zero = @{cpat "0"};
-val zeroT = Thm.ctyp_of_cterm zero;
+val cterm_of = Thm.cterm_of @{context};
+fun tvar S = (("'a", 0), S);
-val one = @{cpat "1"};
-val oneT = Thm.ctyp_of_cterm one;
+val zero_tvar = tvar @{sort zero};
+val zero = cterm_of (Const (@{const_name zero_class.zero}, TVar zero_tvar));
-val numeral = @{cpat "numeral"};
-val numeralT = Thm.ctyp_of @{context} (Term.range_type (Thm.typ_of_cterm numeral));
+val one_tvar = tvar @{sort one};
+val one = cterm_of (Const (@{const_name one_class.one}, TVar one_tvar));
-val uminus = @{cpat "uminus"};
-val uminusT = Thm.ctyp_of @{context} (Term.range_type (Thm.typ_of_cterm uminus));
+val numeral_tvar = tvar @{sort numeral};
+val numeral = cterm_of (Const (@{const_name numeral}, @{typ num} --> TVar numeral_tvar));
-fun instT T V = Thm.instantiate_cterm ([(dest_TVar (Thm.typ_of V), T)], []);
+val uminus_tvar = tvar @{sort uminus};
+val uminus = cterm_of (Const (@{const_name uminus}, TVar uminus_tvar --> TVar uminus_tvar));
+
+fun instT T v = Thm.instantiate_cterm ([(v, T)], []);
in
-fun mk_cnumber T 0 = instT T zeroT zero
- | mk_cnumber T 1 = instT T oneT one
+fun mk_cnumber T 0 = instT T zero_tvar zero
+ | mk_cnumber T 1 = instT T one_tvar one
| mk_cnumber T i =
- if i > 0 then Thm.apply (instT T numeralT numeral) (mk_cnumeral i)
- else Thm.apply (instT T uminusT uminus) (Thm.apply (instT T numeralT numeral) (mk_cnumeral (~i)));
+ if i > 0 then
+ Thm.apply (instT T numeral_tvar numeral) (mk_cnumeral i)
+ else
+ Thm.apply (instT T uminus_tvar uminus)
+ (Thm.apply (instT T numeral_tvar numeral) (mk_cnumeral (~ i)));
end;
--- a/src/HOL/Tools/numeral_simprocs.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/numeral_simprocs.ML Fri Sep 18 16:42:19 2015 +0100
@@ -16,8 +16,6 @@
signature NUMERAL_SIMPROCS =
sig
- val prep_simproc: theory -> string * string list * (Proof.context -> term -> thm option)
- -> simproc
val trans_tac: Proof.context -> thm option -> tactic
val assoc_fold: Proof.context -> cterm -> thm option
val combine_numerals: Proof.context -> cterm -> thm option
@@ -37,7 +35,7 @@
val div_cancel_numeral_factor: Proof.context -> cterm -> thm option
val divide_cancel_numeral_factor: Proof.context -> cterm -> thm option
val field_combine_numerals: Proof.context -> cterm -> thm option
- val field_divide_cancel_numeral_factor: simproc list
+ val field_divide_cancel_numeral_factor: simproc
val num_ss: simpset
val field_comp_conv: Proof.context -> conv
end;
@@ -45,9 +43,6 @@
structure Numeral_Simprocs : NUMERAL_SIMPROCS =
struct
-fun prep_simproc thy (name, pats, proc) =
- Simplifier.simproc_global thy name pats proc;
-
fun trans_tac _ NONE = all_tac
| trans_tac ctxt (SOME th) = ALLGOALS (resolve_tac ctxt [th RS trans]);
@@ -65,7 +60,7 @@
which is not required for cancellation of common factors in divisions.
UPDATE: this reasoning no longer applies (number_ring is gone)
*)
-fun mk_prod T =
+fun mk_prod T =
let val one = one_of T
fun mk [] = one
| mk [t] = t
@@ -141,7 +136,7 @@
ordering is not well-founded.*)
fun num_ord (i,j) =
(case int_ord (abs i, abs j) of
- EQUAL => int_ord (Int.sign i, Int.sign j)
+ EQUAL => int_ord (Int.sign i, Int.sign j)
| ord => ord);
(*This resembles Term_Ord.term_ord, but it puts binary numerals before other
@@ -190,7 +185,7 @@
val field_post_simps =
post_simps @ [@{thm divide_zero_left}, @{thm divide_1}]
-
+
(*Simplify inverse Numeral1*)
val inverse_1s = [@{thm inverse_numeral_1}];
@@ -202,7 +197,7 @@
@{thms add_neg_numeral_left} @
@{thms mult_numeral_left} @
@{thms arith_simps} @ @{thms rel_simps};
-
+
(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
during re-arrangement*)
val non_add_simps =
@@ -288,9 +283,9 @@
val bal_add2 = @{thm le_add_iff2} RS trans
);
-fun eq_cancel_numerals ctxt ct = EqCancelNumerals.proc ctxt (Thm.term_of ct)
-fun less_cancel_numerals ctxt ct = LessCancelNumerals.proc ctxt (Thm.term_of ct)
-fun le_cancel_numerals ctxt ct = LeCancelNumerals.proc ctxt (Thm.term_of ct)
+val eq_cancel_numerals = EqCancelNumerals.proc
+val less_cancel_numerals = LessCancelNumerals.proc
+val le_cancel_numerals = LeCancelNumerals.proc
structure CombineNumeralsData =
struct
@@ -350,9 +345,9 @@
structure FieldCombineNumerals = CombineNumeralsFun(FieldCombineNumeralsData);
-fun combine_numerals ctxt ct = CombineNumerals.proc ctxt (Thm.term_of ct)
+val combine_numerals = CombineNumerals.proc
-fun field_combine_numerals ctxt ct = FieldCombineNumerals.proc ctxt (Thm.term_of ct)
+val field_combine_numerals = FieldCombineNumerals.proc
(** Constant folding for multiplication in semirings **)
@@ -433,37 +428,40 @@
)
structure LeCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
+(
+ open CancelNumeralFactorCommon
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} dummyT
val cancel = @{thm mult_le_cancel_left} RS trans
val neg_exchanges = true
)
-fun eq_cancel_numeral_factor ctxt ct = EqCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun less_cancel_numeral_factor ctxt ct = LessCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun le_cancel_numeral_factor ctxt ct = LeCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun div_cancel_numeral_factor ctxt ct = DivCancelNumeralFactor.proc ctxt (Thm.term_of ct)
-fun divide_cancel_numeral_factor ctxt ct = DivideCancelNumeralFactor.proc ctxt (Thm.term_of ct)
+val eq_cancel_numeral_factor = EqCancelNumeralFactor.proc
+val less_cancel_numeral_factor = LessCancelNumeralFactor.proc
+val le_cancel_numeral_factor = LeCancelNumeralFactor.proc
+val div_cancel_numeral_factor = DivCancelNumeralFactor.proc
+val divide_cancel_numeral_factor = DivideCancelNumeralFactor.proc
val field_divide_cancel_numeral_factor =
- [prep_simproc @{theory}
- ("field_divide_cancel_numeral_factor",
- ["((l::'a::field) * m) / n",
- "(l::'a::field) / (m * n)",
- "((numeral v)::'a::field) / (numeral w)",
- "((numeral v)::'a::field) / (- numeral w)",
- "((- numeral v)::'a::field) / (numeral w)",
- "((- numeral v)::'a::field) / (- numeral w)"],
- DivideCancelNumeralFactor.proc)];
+ Simplifier.make_simproc @{context} "field_divide_cancel_numeral_factor"
+ {lhss =
+ [@{term "((l::'a::field) * m) / n"},
+ @{term "(l::'a::field) / (m * n)"},
+ @{term "((numeral v)::'a::field) / (numeral w)"},
+ @{term "((numeral v)::'a::field) / (- numeral w)"},
+ @{term "((- numeral v)::'a::field) / (numeral w)"},
+ @{term "((- numeral v)::'a::field) / (- numeral w)"}],
+ proc = K DivideCancelNumeralFactor.proc,
+ identifier = []}
val field_cancel_numeral_factors =
- prep_simproc @{theory}
- ("field_eq_cancel_numeral_factor",
- ["(l::'a::field) * m = n",
- "(l::'a::field) = m * n"],
- EqCancelNumeralFactor.proc)
- :: field_divide_cancel_numeral_factor;
+ [Simplifier.make_simproc @{context} "field_eq_cancel_numeral_factor"
+ {lhss =
+ [@{term "(l::'a::field) * m = n"},
+ @{term "(l::'a::field) = m * n"}],
+ proc = K EqCancelNumeralFactor.proc,
+ identifier = []},
+ field_divide_cancel_numeral_factor]
(** Declarations for ExtractCommonTerm **)
@@ -476,7 +474,7 @@
handle TERM _ => find_first_t (t::past) u terms;
(** Final simplification for the CancelFactor simprocs **)
-val simplify_one = Arith_Data.simplify_meta_eq
+val simplify_one = Arith_Data.simplify_meta_eq
[@{thm mult_1_left}, @{thm mult_1_right}, @{thm div_by_1}, @{thm numeral_1_eq_1}];
fun cancel_simplify_meta_eq ctxt cancel_th th =
@@ -484,7 +482,7 @@
local
val Tp_Eq = Thm.reflexive (Thm.cterm_of @{theory_context HOL} HOLogic.Trueprop)
- fun Eq_True_elim Eq =
+ fun Eq_True_elim Eq =
Thm.equal_elim (Thm.combination Tp_Eq (Thm.symmetric Eq)) @{thm TrueI}
in
fun sign_conv pos_th neg_th ctxt t =
@@ -515,7 +513,7 @@
simpset_of (put_simpset HOL_basic_ss @{context} addsimps mult_1s @ @{thms ac_simps minus_mult_commute})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
- val simplify_meta_eq = cancel_simplify_meta_eq
+ val simplify_meta_eq = cancel_simplify_meta_eq
fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
end;
@@ -585,25 +583,31 @@
fun divide_cancel_factor ctxt ct = DivideCancelFactor.proc ctxt (Thm.term_of ct)
local
- val zr = @{cpat "0"}
- val zT = Thm.ctyp_of_cterm zr
- val geq = @{cpat HOL.eq}
- val eqT = Thm.dest_ctyp (Thm.ctyp_of_cterm geq) |> hd
- val add_frac_eq = mk_meta_eq @{thm "add_frac_eq"}
- val add_frac_num = mk_meta_eq @{thm "add_frac_num"}
- val add_num_frac = mk_meta_eq @{thm "add_num_frac"}
+
+val cterm_of = Thm.cterm_of @{context};
+fun tvar S = (("'a", 0), S);
+
+val zero_tvar = tvar @{sort zero};
+val zero = cterm_of (Const (@{const_name zero_class.zero}, TVar zero_tvar));
+
+val type_tvar = tvar @{sort type};
+val geq = cterm_of (Const (@{const_name HOL.eq}, TVar type_tvar --> TVar type_tvar --> @{typ bool}));
- fun prove_nz ctxt T t =
- let
- val z = Thm.instantiate_cterm ([(dest_TVar (Thm.typ_of zT), T)],[]) zr
- val eq = Thm.instantiate_cterm ([(dest_TVar (Thm.typ_of eqT), T)],[]) geq
- val th = Simplifier.rewrite (ctxt addsimps @{thms simp_thms})
- (Thm.apply @{cterm "Trueprop"} (Thm.apply @{cterm "Not"}
- (Thm.apply (Thm.apply eq t) z)))
- in Thm.equal_elim (Thm.symmetric th) TrueI
- end
+val add_frac_eq = mk_meta_eq @{thm "add_frac_eq"}
+val add_frac_num = mk_meta_eq @{thm "add_frac_num"}
+val add_num_frac = mk_meta_eq @{thm "add_num_frac"}
- fun proc phi ctxt ct =
+fun prove_nz ctxt T t =
+ let
+ val z = Thm.instantiate_cterm ([(zero_tvar, T)], []) zero
+ val eq = Thm.instantiate_cterm ([(type_tvar, T)], []) geq
+ val th =
+ Simplifier.rewrite (ctxt addsimps @{thms simp_thms})
+ (Thm.apply @{cterm "Trueprop"} (Thm.apply @{cterm "Not"}
+ (Thm.apply (Thm.apply eq t) z)))
+ in Thm.equal_elim (Thm.symmetric th) TrueI end
+
+fun proc ctxt ct =
let
val ((x,y),(w,z)) =
(Thm.dest_binop #> (fn (a,b) => (Thm.dest_binop a, Thm.dest_binop b))) ct
@@ -611,11 +615,10 @@
val T = Thm.ctyp_of_cterm x
val [y_nz, z_nz] = map (prove_nz ctxt T) [y, z]
val th = Thm.instantiate' [SOME T] (map SOME [y,z,x,w]) add_frac_eq
- in SOME (Thm.implies_elim (Thm.implies_elim th y_nz) z_nz)
- end
+ in SOME (Thm.implies_elim (Thm.implies_elim th y_nz) z_nz) end
handle CTERM _ => NONE | TERM _ => NONE | THM _ => NONE
- fun proc2 phi ctxt ct =
+fun proc2 ctxt ct =
let
val (l,r) = Thm.dest_binop ct
val T = Thm.ctyp_of_cterm l
@@ -636,12 +639,12 @@
end
handle CTERM _ => NONE | TERM _ => NONE | THM _ => NONE
- fun is_number (Const(@{const_name Rings.divide},_)$a$b) = is_number a andalso is_number b
- | is_number t = can HOLogic.dest_number t
+fun is_number (Const(@{const_name Rings.divide},_)$a$b) = is_number a andalso is_number b
+ | is_number t = can HOLogic.dest_number t
- val is_number = is_number o Thm.term_of
+val is_number = is_number o Thm.term_of
- fun proc3 phi ctxt ct =
+fun proc3 ctxt ct =
(case Thm.term_of ct of
Const(@{const_name Orderings.less},_)$(Const(@{const_name Rings.divide},_)$_$_)$_ =>
let
@@ -685,41 +688,42 @@
val T = Thm.ctyp_of_cterm c
val th = Thm.instantiate' [SOME T] (map SOME [a,b,c]) @{thm "eq_divide_eq"}
in SOME (mk_meta_eq th) end
- | _ => NONE)
- handle TERM _ => NONE | CTERM _ => NONE | THM _ => NONE
+ | _ => NONE) handle TERM _ => NONE | CTERM _ => NONE | THM _ => NONE
val add_frac_frac_simproc =
- make_simproc {lhss = [@{cpat "(?x::?'a::field)/?y + (?w::?'a::field)/?z"}],
- name = "add_frac_frac_simproc",
- proc = proc, identifier = []}
+ Simplifier.make_simproc @{context} "add_frac_frac_simproc"
+ {lhss = [@{term "(x::'a::field) / y + (w::'a::field) / z"}],
+ proc = K proc, identifier = []}
val add_frac_num_simproc =
- make_simproc {lhss = [@{cpat "(?x::?'a::field)/?y + ?z"}, @{cpat "?z + (?x::?'a::field)/?y"}],
- name = "add_frac_num_simproc",
- proc = proc2, identifier = []}
+ Simplifier.make_simproc @{context} "add_frac_num_simproc"
+ {lhss = [@{term "(x::'a::field) / y + z"}, @{term "z + (x::'a::field) / y"}],
+ proc = K proc2, identifier = []}
val ord_frac_simproc =
- make_simproc
- {lhss = [@{cpat "(?a::(?'a::{field, ord}))/?b < ?c"},
- @{cpat "(?a::(?'a::{field, ord}))/?b <= ?c"},
- @{cpat "?c < (?a::(?'a::{field, ord}))/?b"},
- @{cpat "?c <= (?a::(?'a::{field, ord}))/?b"},
- @{cpat "?c = ((?a::(?'a::{field, ord}))/?b)"},
- @{cpat "((?a::(?'a::{field, ord}))/ ?b) = ?c"}],
- name = "ord_frac_simproc", proc = proc3, identifier = []}
+ Simplifier.make_simproc @{context} "ord_frac_simproc"
+ {lhss =
+ [@{term "(a::'a::{field,ord}) / b < c"},
+ @{term "(a::'a::{field,ord}) / b \<le> c"},
+ @{term "c < (a::'a::{field,ord}) / b"},
+ @{term "c \<le> (a::'a::{field,ord}) / b"},
+ @{term "c = (a::'a::{field,ord}) / b"},
+ @{term "(a::'a::{field, ord}) / b = c"}],
+ proc = K proc3, identifier = []}
-val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"},
- @{thm "divide_numeral_1"},
- @{thm "divide_zero"}, @{thm divide_zero_left},
- @{thm "divide_divide_eq_left"},
- @{thm "times_divide_eq_left"}, @{thm "times_divide_eq_right"},
- @{thm "times_divide_times_eq"},
- @{thm "divide_divide_eq_right"},
- @{thm diff_conv_add_uminus}, @{thm "minus_divide_left"},
- @{thm "add_divide_distrib"} RS sym,
- @{thm Fields.field_divide_inverse} RS sym, @{thm inverse_divide},
- Conv.fconv_rule (Conv.arg_conv (Conv.arg1_conv (Conv.rewr_conv (mk_meta_eq @{thm mult.commute}))))
- (@{thm Fields.field_divide_inverse} RS sym)]
+val ths =
+ [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"},
+ @{thm "divide_numeral_1"},
+ @{thm "divide_zero"}, @{thm divide_zero_left},
+ @{thm "divide_divide_eq_left"},
+ @{thm "times_divide_eq_left"}, @{thm "times_divide_eq_right"},
+ @{thm "times_divide_times_eq"},
+ @{thm "divide_divide_eq_right"},
+ @{thm diff_conv_add_uminus}, @{thm "minus_divide_left"},
+ @{thm "add_divide_distrib"} RS sym,
+ @{thm Fields.field_divide_inverse} RS sym, @{thm inverse_divide},
+ Conv.fconv_rule (Conv.arg_conv (Conv.arg1_conv (Conv.rewr_conv (mk_meta_eq @{thm mult.commute}))))
+ (@{thm Fields.field_divide_inverse} RS sym)]
val field_comp_ss =
simpset_of
@@ -740,4 +744,3 @@
end
end;
-
--- a/src/HOL/Tools/record.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/record.ML Fri Sep 18 16:42:19 2015 +0100
@@ -99,7 +99,7 @@
val vs = map (Proof_Context.check_tfree ctxt) raw_vs;
in
thy
- |> Typedef.add_typedef_global false (raw_tyco, vs, NoSyn)
+ |> Typedef.add_typedef_global (raw_tyco, vs, NoSyn)
(HOLogic.mk_UNIV repT) NONE (fn ctxt' => resolve_tac ctxt' [UNIV_witness] 1)
|-> (fn (tyco, info) => get_typedef_info tyco vs info)
end;
@@ -1059,9 +1059,13 @@
subrecord.
*)
val simproc =
- Simplifier.simproc_global @{theory HOL} "record" ["x"]
- (fn ctxt => fn t =>
- let val thy = Proof_Context.theory_of ctxt in
+ Simplifier.make_simproc @{context} "record"
+ {lhss = [@{term "x"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ let
+ val thy = Proof_Context.theory_of ctxt;
+ val t = Thm.term_of ct;
+ in
(case t of
(sel as Const (s, Type (_, [_, rangeS]))) $
((upd as Const (u, Type (_, [_, Type (_, [rT, _])]))) $ k $ r) =>
@@ -1109,7 +1113,8 @@
end
else NONE
| _ => NONE)
- end);
+ end,
+ identifier = []};
fun get_upd_acc_cong_thm upd acc thy ss =
let
@@ -1139,10 +1144,12 @@
we omit considering further updates if doing so would introduce
both a more update and an update to a field within it.*)
val upd_simproc =
- Simplifier.simproc_global @{theory HOL} "record_upd" ["x"]
- (fn ctxt => fn t =>
+ Simplifier.make_simproc @{context} "record_upd"
+ {lhss = [@{term "x"}],
+ proc = fn _ => fn ctxt => fn ct =>
let
val thy = Proof_Context.theory_of ctxt;
+ val t = Thm.term_of ct;
(*We can use more-updators with other updators as long
as none of the other updators go deeper than any more
updator. min here is the depth of the deepest other
@@ -1240,7 +1247,8 @@
(prove_unfold_defs thy noops' [simproc]
(Logic.list_all (vars, Logic.mk_equals (lhs, rhs))))
else NONE
- end);
+ end,
+ identifier = []};
end;
@@ -1260,16 +1268,19 @@
Complexity: #components * #updates #updates
*)
val eq_simproc =
- Simplifier.simproc_global @{theory HOL} "record_eq" ["r = s"]
- (fn ctxt => fn t =>
- (case t of Const (@{const_name HOL.eq}, Type (_, [T, _])) $ _ $ _ =>
- (case rec_id ~1 T of
- "" => NONE
- | name =>
- (case get_equalities (Proof_Context.theory_of ctxt) name of
- NONE => NONE
- | SOME thm => SOME (thm RS @{thm Eq_TrueI})))
- | _ => NONE));
+ Simplifier.make_simproc @{context} "record_eq"
+ {lhss = [@{term "r = s"}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of
+ Const (@{const_name HOL.eq}, Type (_, [T, _])) $ _ $ _ =>
+ (case rec_id ~1 T of
+ "" => NONE
+ | name =>
+ (case get_equalities (Proof_Context.theory_of ctxt) name of
+ NONE => NONE
+ | SOME thm => SOME (thm RS @{thm Eq_TrueI})))
+ | _ => NONE),
+ identifier = []};
(* split_simproc *)
@@ -1280,9 +1291,10 @@
P t = ~1: completely split
P t > 0: split up to given bound of record extensions.*)
fun split_simproc P =
- Simplifier.simproc_global @{theory HOL} "record_split" ["x"]
- (fn ctxt => fn t =>
- (case t of
+ Simplifier.make_simproc @{context} "record_split"
+ {lhss = [@{term x}],
+ proc = fn _ => fn ctxt => fn ct =>
+ (case Thm.term_of ct of
Const (quantifier, Type (_, [Type (_, [T, _]), _])) $ _ =>
if quantifier = @{const_name Pure.all} orelse
quantifier = @{const_name All} orelse
@@ -1291,7 +1303,7 @@
(case rec_id ~1 T of
"" => NONE
| _ =>
- let val split = P t in
+ let val split = P (Thm.term_of ct) in
if split <> 0 then
(case get_splits (Proof_Context.theory_of ctxt) (rec_id split T) of
NONE => NONE
@@ -1305,13 +1317,16 @@
else NONE
end)
else NONE
- | _ => NONE));
+ | _ => NONE),
+ identifier = []};
val ex_sel_eq_simproc =
- Simplifier.simproc_global @{theory HOL} "ex_sel_eq" ["Ex t"]
- (fn ctxt => fn t =>
+ Simplifier.make_simproc @{context} "ex_sel_eq"
+ {lhss = [@{term "Ex t"}],
+ proc = fn _ => fn ctxt => fn ct =>
let
val thy = Proof_Context.theory_of ctxt;
+ val t = Thm.term_of ct;
fun mkeq (lr, Teq, (sel, Tsel), x) i =
if is_selector thy sel then
let
@@ -1344,7 +1359,8 @@
addsimps @{thms simp_thms} addsimprocs [split_simproc (K ~1)]) 1))
end handle TERM _ => NONE)
| _ => NONE)
- end);
+ end,
+ identifier = []};
(* split_simp_tac *)
--- a/src/HOL/Tools/semiring_normalizer.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/semiring_normalizer.ML Fri Sep 18 16:42:19 2015 +0100
@@ -4,7 +4,7 @@
Normalization of expressions in semirings.
*)
-signature SEMIRING_NORMALIZER =
+signature SEMIRING_NORMALIZER =
sig
type entry
val match: Proof.context -> cterm -> entry option
@@ -13,8 +13,9 @@
val the_field: Proof.context -> thm -> cterm list * thm list
val the_idom: Proof.context -> thm -> thm list
val the_ideal: Proof.context -> thm -> thm list
- val declare: thm -> {semiring: cterm list * thm list, ring: cterm list * thm list,
- field: cterm list * thm list, idom: thm list, ideal: thm list} -> declaration
+ val declare: thm -> {semiring: term list * thm list, ring: term list * thm list,
+ field: term list * thm list, idom: thm list, ideal: thm list} ->
+ local_theory -> local_theory
val semiring_normalize_conv: Proof.context -> conv
val semiring_normalize_ord_conv: Proof.context -> (cterm -> cterm -> bool) -> conv
@@ -40,7 +41,7 @@
sub: Proof.context -> conv}
end
-structure Semiring_Normalizer: SEMIRING_NORMALIZER =
+structure Semiring_Normalizer: SEMIRING_NORMALIZER =
struct
(** data **)
@@ -76,7 +77,7 @@
fun match ctxt tm =
let
fun match_inst
- ({vars, semiring = (sr_ops, sr_rules),
+ ({vars, semiring = (sr_ops, sr_rules),
ring = (r_ops, r_rules), field = (f_ops, f_rules), idom, ideal},
fns) pat =
let
@@ -92,7 +93,7 @@
val idom' = map substT idom;
val ideal' = map substT ideal;
- val result = ({vars = vars', semiring = semiring',
+ val result = ({vars = vars', semiring = semiring',
ring = ring', field = field', idom = idom', ideal = ideal'}, fns);
in SOME result end
in (case try Thm.match (pat, tm) of
@@ -105,7 +106,7 @@
get_first (match_inst entry) (sr_ops @ r_ops @ f_ops);
in get_first match_struct (Data.get (Context.Proof ctxt)) end;
-
+
(* extra-logical functions *)
val semiring_norm_ss =
@@ -137,9 +138,9 @@
fun dest_const ct = ((case Thm.term_of ct of
Const (@{const_name Rings.divide},_) $ a $ b=>
Rat.rat_of_quotient (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b))
- | Const (@{const_name Fields.inverse},_)$t =>
+ | Const (@{const_name Fields.inverse},_)$t =>
Rat.inv (Rat.rat_of_int (snd (HOLogic.dest_number t)))
- | t => Rat.rat_of_int (snd (HOLogic.dest_number t)))
+ | t => Rat.rat_of_int (snd (HOLogic.dest_number t)))
handle TERM _ => error "ring_dest_const")
fun mk_const cT x =
let val (a, b) = Rat.quotient_of_rat x
@@ -165,62 +166,71 @@
val idomN = "idom";
fun declare raw_key
- {semiring = raw_semiring, ring = raw_ring, field = raw_field, idom = raw_idom, ideal = raw_ideal}
- phi context =
+ {semiring = raw_semiring0, ring = raw_ring0, field = raw_field0, idom = raw_idom, ideal = raw_ideal}
+ lthy =
let
- val ctxt = Context.proof_of context;
- val key = Morphism.thm phi raw_key;
- fun morphism_ops_rules (ops, rules) = (map (Morphism.cterm phi) ops, Morphism.fact phi rules);
- val (sr_ops, sr_rules) = morphism_ops_rules raw_semiring;
- val (r_ops, r_rules) = morphism_ops_rules raw_ring;
- val (f_ops, f_rules) = morphism_ops_rules raw_field;
- val idom = Morphism.fact phi raw_idom;
- val ideal = Morphism.fact phi raw_ideal;
-
- fun check kind name xs n =
- null xs orelse length xs = n orelse
- error ("Expected " ^ string_of_int n ^ " " ^ kind ^ " for " ^ name);
- val check_ops = check "operations";
- val check_rules = check "rules";
- val _ =
- check_ops semiringN sr_ops 5 andalso
- check_rules semiringN sr_rules 36 andalso
- check_ops ringN r_ops 2 andalso
- check_rules ringN r_rules 2 andalso
- check_ops fieldN f_ops 2 andalso
- check_rules fieldN f_rules 2 andalso
- check_rules idomN idom 2;
+ val ctxt' = fold Variable.auto_fixes (fst raw_semiring0 @ fst raw_ring0 @ fst raw_field0) lthy;
+ val prepare_ops = apfst (Variable.export_terms ctxt' lthy #> map (Thm.cterm_of lthy));
+ val raw_semiring = prepare_ops raw_semiring0;
+ val raw_ring = prepare_ops raw_ring0;
+ val raw_field = prepare_ops raw_field0;
+ in
+ lthy |> Local_Theory.declaration {syntax = false, pervasive = false} (fn phi => fn context =>
+ let
+ val ctxt = Context.proof_of context;
+ val key = Morphism.thm phi raw_key;
+ fun transform_ops_rules (ops, rules) =
+ (map (Morphism.cterm phi) ops, Morphism.fact phi rules);
+ val (sr_ops, sr_rules) = transform_ops_rules raw_semiring;
+ val (r_ops, r_rules) = transform_ops_rules raw_ring;
+ val (f_ops, f_rules) = transform_ops_rules raw_field;
+ val idom = Morphism.fact phi raw_idom;
+ val ideal = Morphism.fact phi raw_ideal;
- val mk_meta = Local_Defs.meta_rewrite_rule ctxt;
- val sr_rules' = map mk_meta sr_rules;
- val r_rules' = map mk_meta r_rules;
- val f_rules' = map mk_meta f_rules;
+ fun check kind name xs n =
+ null xs orelse length xs = n orelse
+ error ("Expected " ^ string_of_int n ^ " " ^ kind ^ " for " ^ name);
+ val check_ops = check "operations";
+ val check_rules = check "rules";
+ val _ =
+ check_ops semiringN sr_ops 5 andalso
+ check_rules semiringN sr_rules 36 andalso
+ check_ops ringN r_ops 2 andalso
+ check_rules ringN r_rules 2 andalso
+ check_ops fieldN f_ops 2 andalso
+ check_rules fieldN f_rules 2 andalso
+ check_rules idomN idom 2;
+
+ val mk_meta = Local_Defs.meta_rewrite_rule ctxt;
+ val sr_rules' = map mk_meta sr_rules;
+ val r_rules' = map mk_meta r_rules;
+ val f_rules' = map mk_meta f_rules;
+
+ fun rule i = nth sr_rules' (i - 1);
- fun rule i = nth sr_rules' (i - 1);
-
- val (cx, cy) = Thm.dest_binop (hd sr_ops);
- val cz = rule 34 |> Thm.rhs_of |> Thm.dest_arg |> Thm.dest_arg;
- val cn = rule 36 |> Thm.rhs_of |> Thm.dest_arg |> Thm.dest_arg;
- val ((clx, crx), (cly, cry)) =
- rule 13 |> Thm.rhs_of |> Thm.dest_binop |> apply2 Thm.dest_binop;
- val ((ca, cb), (cc, cd)) =
- rule 20 |> Thm.lhs_of |> Thm.dest_binop |> apply2 Thm.dest_binop;
- val cm = rule 1 |> Thm.rhs_of |> Thm.dest_arg;
- val (cp, cq) = rule 26 |> Thm.lhs_of |> Thm.dest_binop |> apply2 Thm.dest_arg;
+ val (cx, cy) = Thm.dest_binop (hd sr_ops);
+ val cz = rule 34 |> Thm.rhs_of |> Thm.dest_arg |> Thm.dest_arg;
+ val cn = rule 36 |> Thm.rhs_of |> Thm.dest_arg |> Thm.dest_arg;
+ val ((clx, crx), (cly, cry)) =
+ rule 13 |> Thm.rhs_of |> Thm.dest_binop |> apply2 Thm.dest_binop;
+ val ((ca, cb), (cc, cd)) =
+ rule 20 |> Thm.lhs_of |> Thm.dest_binop |> apply2 Thm.dest_binop;
+ val cm = rule 1 |> Thm.rhs_of |> Thm.dest_arg;
+ val (cp, cq) = rule 26 |> Thm.lhs_of |> Thm.dest_binop |> apply2 Thm.dest_arg;
+
+ val vars = [ca, cb, cc, cd, cm, cn, cp, cq, cx, cy, cz, clx, crx, cly, cry];
- val vars = [ca, cb, cc, cd, cm, cn, cp, cq, cx, cy, cz, clx, crx, cly, cry];
-
- val semiring = (sr_ops, sr_rules');
- val ring = (r_ops, r_rules');
- val field = (f_ops, f_rules');
- val ideal' = map (Thm.symmetric o mk_meta) ideal
-
- in
- context
- |> Data.map (AList.update Thm.eq_thm (key,
- ({vars = vars, semiring = semiring, ring = ring, field = field, idom = idom, ideal = ideal'},
- (if null f_ops then semiring_funs else field_funs))))
- end
+ val semiring = (sr_ops, sr_rules');
+ val ring = (r_ops, r_rules');
+ val field = (f_ops, f_rules');
+ val ideal' = map (Thm.symmetric o mk_meta) ideal
+ in
+ context
+ |> Data.map (AList.update Thm.eq_thm (key,
+ ({vars = vars, semiring = semiring, ring = ring, field = field, idom = idom, ideal = ideal'},
+ (if null f_ops then semiring_funs else field_funs))))
+ end)
+ end;
(** auxiliary **)
@@ -255,7 +265,7 @@
fun zerone_conv ctxt cv =
zero1_numeral_conv ctxt then_conv cv then_conv numeral01_conv ctxt;
-val nat_add_ss = simpset_of
+val nat_add_ss = simpset_of
(put_simpset HOL_basic_ss @{context}
addsimps @{thms arith_simps} @ @{thms diff_nat_numeral} @ @{thms rel_simps}
@ @{thms if_False if_True Nat.add_0 add_Suc add_numeral_left Suc_eq_plus1}
@@ -308,9 +318,9 @@
end
| _ => (TrueI, TrueI, true_tm, true_tm, (fn t => (t,t)), true_tm, true_tm));
-val (divide_inverse, divide_tm, inverse_tm) =
- (case (f_ops, f_rules) of
- ([divide_pat, inverse_pat], [div_inv, _]) =>
+val (divide_inverse, divide_tm, inverse_tm) =
+ (case (f_ops, f_rules) of
+ ([divide_pat, inverse_pat], [div_inv, _]) =>
let val div_tm = funpow 2 Thm.dest_fun divide_pat
val inv_tm = Thm.dest_fun inverse_pat
in (div_inv, div_tm, inv_tm)
@@ -420,7 +430,7 @@
else
((let val (lopr,r) = Thm.dest_comb tm
val (opr,l) = Thm.dest_comb lopr
- in if opr aconvc pow_tm andalso is_number r then l
+ in if opr aconvc pow_tm andalso is_number r then l
else raise CTERM ("monomial_mul_conv",[tm]) end)
handle CTERM _ => tm) (* FIXME !? *)
fun vorder x y =
@@ -803,9 +813,9 @@
let val th1 = Drule.fun_cong_rule (Drule.arg_cong_rule opr (polynomial_conv ctxt l)) r
in Thm.transitive th1 (polynomial_pow_conv ctxt (concl th1))
end
- else if opr aconvc divide_tm
+ else if opr aconvc divide_tm
then
- let val th1 = Thm.combination (Drule.arg_cong_rule opr (polynomial_conv ctxt l))
+ let val th1 = Thm.combination (Drule.arg_cong_rule opr (polynomial_conv ctxt l))
(polynomial_conv ctxt r)
val th2 = (Conv.rewr_conv divide_inverse then_conv polynomial_mul_conv ctxt)
(Thm.rhs_of th1)
@@ -846,7 +856,7 @@
(* various normalizing conversions *)
-fun semiring_normalizers_ord_wrapper ctxt ({vars, semiring, ring, field, idom, ideal},
+fun semiring_normalizers_ord_wrapper ctxt ({vars, semiring, ring, field, idom, ideal},
{conv, dest_const, mk_const, is_const}) ord =
let
val pow_conv =
@@ -862,14 +872,14 @@
({vars = vars, semiring = semiring, ring = ring, field = field, idom = idom, ideal = ideal},
{conv = conv, dest_const = dest_const, mk_const = mk_const, is_const = is_const}) ord) ctxt;
-fun semiring_normalize_wrapper ctxt data =
+fun semiring_normalize_wrapper ctxt data =
semiring_normalize_ord_wrapper ctxt data simple_cterm_ord;
fun semiring_normalize_ord_conv ctxt ord tm =
(case match ctxt tm of
NONE => Thm.reflexive tm
| SOME res => semiring_normalize_ord_wrapper ctxt res ord tm);
-
+
fun semiring_normalize_conv ctxt = semiring_normalize_ord_conv ctxt simple_cterm_ord;
end;
--- a/src/HOL/Tools/set_comprehension_pointfree.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/set_comprehension_pointfree.ML Fri Sep 18 16:42:19 2015 +0100
@@ -92,7 +92,7 @@
val strip_psplits =
let
fun strip [] qs vs t = (t, rev vs, qs)
- | strip (p :: ps) qs vs (Const (@{const_name Product_Type.prod.case_prod}, _) $ t) =
+ | strip (p :: ps) qs vs (Const (@{const_name uncurry}, _) $ t) =
strip ((1 :: p) :: (2 :: p) :: ps) (p :: qs) vs t
| strip (_ :: ps) qs vs (Abs (s, T, t)) = strip ps qs ((s, T) :: vs) t
| strip (_ :: ps) qs vs t = strip ps qs
@@ -305,7 +305,7 @@
(* proof tactic *)
-val case_prod_distrib = @{lemma "(case_prod g x) z = case_prod (% x y. (g x y) z) x" by (simp add: case_prod_beta)}
+val case_prod_distrib = @{lemma "(uncurry g x) z = uncurry (\<lambda>x y. (g x y) z) x" by (simp add: case_prod_beta)}
val vimageI2' = @{lemma "f a \<notin> A ==> a \<notin> f -` A" by simp}
val vimageE' =
--- a/src/HOL/Tools/typedef.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Tools/typedef.ML Fri Sep 18 16:42:19 2015 +0100
@@ -16,16 +16,20 @@
val get_info: Proof.context -> string -> info list
val get_info_global: theory -> string -> info list
val interpretation: (string -> local_theory -> local_theory) -> theory -> theory
- val add_typedef: bool -> binding * (string * sort) list * mixfix ->
- term -> (binding * binding) option -> (Proof.context -> tactic) -> local_theory ->
+ type bindings = {Rep_name: binding, Abs_name: binding, type_definition_name: binding}
+ val default_bindings: binding -> bindings
+ val make_bindings: binding -> bindings option -> bindings
+ val make_morphisms: binding -> (binding * binding) option -> bindings
+ val add_typedef: binding * (string * sort) list * mixfix ->
+ term -> bindings option -> (Proof.context -> tactic) -> local_theory ->
(string * info) * local_theory
- val add_typedef_global: bool -> binding * (string * sort) list * mixfix ->
- term -> (binding * binding) option -> (Proof.context -> tactic) -> theory ->
+ val add_typedef_global: binding * (string * sort) list * mixfix ->
+ term -> bindings option -> (Proof.context -> tactic) -> theory ->
(string * info) * theory
- val typedef: (binding * (string * sort) list * mixfix) * term *
- (binding * binding) option -> local_theory -> Proof.state
- val typedef_cmd: (binding * (string * string option) list * mixfix) * string *
- (binding * binding) option -> local_theory -> Proof.state
+ val typedef: binding * (string * sort) list * mixfix -> term -> bindings option ->
+ local_theory -> Proof.state
+ val typedef_cmd: binding * (string * string option) list * mixfix -> string -> bindings option ->
+ local_theory -> Proof.state
end;
structure Typedef: TYPEDEF =
@@ -105,7 +109,7 @@
(newT --> oldT) --> (oldT --> newT) --> HOLogic.mk_setT oldT --> HOLogic.boolT);
in Logic.mk_implies (mk_inhabited A, HOLogic.mk_Trueprop (typedefC $ RepC $ AbsC $ A)) end;
-fun primitive_typedef typedef_name newT oldT Rep_name Abs_name A lthy =
+fun primitive_typedef type_definition_name newT oldT Rep_name Abs_name A lthy =
let
(* errors *)
@@ -133,18 +137,35 @@
val ((axiom_name, axiom), axiom_lthy) = consts_lthy
|> Local_Theory.background_theory_result
- (Thm.add_axiom consts_lthy (typedef_name, mk_typedef newT oldT RepC AbsC A) ##>
+ (Thm.add_axiom consts_lthy (type_definition_name, mk_typedef newT oldT RepC AbsC A) ##>
Theory.add_deps consts_lthy "" (dest_Const RepC) typedef_deps ##>
Theory.add_deps consts_lthy "" (dest_Const AbsC) typedef_deps);
in ((RepC, AbsC, axiom_name, axiom), axiom_lthy) end;
+(* derived bindings *)
+
+type bindings = {Rep_name: binding, Abs_name: binding, type_definition_name: binding};
+
+fun default_bindings name =
+ {Rep_name = Binding.prefix_name "Rep_" name,
+ Abs_name = Binding.prefix_name "Abs_" name,
+ type_definition_name = Binding.prefix_name "type_definition_" name};
+
+fun make_bindings name NONE = default_bindings name
+ | make_bindings _ (SOME bindings) = bindings;
+
+fun make_morphisms name NONE = default_bindings name
+ | make_morphisms name (SOME (Rep_name, Abs_name)) =
+ {Rep_name = Rep_name, Abs_name = Abs_name,
+ type_definition_name = #type_definition_name (default_bindings name)};
+
+
(* prepare_typedef *)
-fun prepare_typedef concealed prep_term (name, raw_args, mx) raw_set opt_morphs lthy =
+fun prepare_typedef prep_term (name, raw_args, mx) raw_set opt_bindings lthy =
let
- val concealed_name = name |> concealed ? Binding.concealed;
val bname = Binding.name_of name;
@@ -174,16 +195,10 @@
(* axiomatization *)
- val (Rep_name, Abs_name) =
- (case opt_morphs of
- NONE => (Binding.prefix_name "Rep_" concealed_name,
- Binding.prefix_name "Abs_" concealed_name)
- | SOME morphs => morphs);
-
- val typedef_name = Binding.prefix_name "type_definition_" concealed_name;
+ val {Rep_name, Abs_name, type_definition_name} = make_bindings name opt_bindings;
val ((RepC, AbsC, axiom_name, typedef), typedef_lthy) = typedecl_lthy
- |> primitive_typedef typedef_name newT oldT Rep_name Abs_name set;
+ |> primitive_typedef type_definition_name newT oldT Rep_name Abs_name set;
val alias_lthy = typedef_lthy
|> Local_Theory.const_alias Rep_name (#1 (Term.dest_Const RepC))
@@ -202,7 +217,7 @@
fun make th = Goal.norm_result lthy1 (typedef' RS th);
val (((((((((((_, [type_definition]), Rep), Rep_inverse), Abs_inverse), Rep_inject),
Abs_inject), Rep_cases), Abs_cases), Rep_induct), Abs_induct), lthy2) = lthy1
- |> Local_Theory.note ((typedef_name, []), [typedef'])
+ |> Local_Theory.note ((type_definition_name, []), [typedef'])
||>> note_qualify ((Rep_name, []), make @{thm type_definition.Rep})
||>> note_qualify ((Binding.suffix_name "_inverse" Rep_name, []),
make @{thm type_definition.Rep_inverse})
@@ -247,18 +262,18 @@
(* add_typedef: tactic interface *)
-fun add_typedef concealed typ set opt_morphs tac lthy =
+fun add_typedef typ set opt_bindings tac lthy =
let
val ((goal, _, typedef_result), lthy') =
- prepare_typedef concealed Syntax.check_term typ set opt_morphs lthy;
+ prepare_typedef Syntax.check_term typ set opt_bindings lthy;
val inhabited =
Goal.prove lthy' [] [] goal (tac o #context)
|> Goal.norm_result lthy' |> Thm.close_derivation;
in typedef_result inhabited lthy' end;
-fun add_typedef_global concealed typ set opt_morphs tac =
+fun add_typedef_global typ set opt_bindings tac =
Named_Target.theory_init
- #> add_typedef concealed typ set opt_morphs tac
+ #> add_typedef typ set opt_bindings tac
#> Local_Theory.exit_result_global (apsnd o transform_info);
@@ -266,11 +281,11 @@
local
-fun gen_typedef prep_term prep_constraint ((b, raw_args, mx), set, opt_morphs) lthy =
+fun gen_typedef prep_term prep_constraint (b, raw_args, mx) set opt_bindings lthy =
let
val args = map (apsnd (prep_constraint lthy)) raw_args;
val ((goal, goal_pat, typedef_result), lthy') =
- prepare_typedef false prep_term (b, args, mx) set opt_morphs lthy;
+ prepare_typedef prep_term (b, args, mx) set opt_bindings lthy;
fun after_qed [[th]] = snd o typedef_result th;
in Proof.theorem NONE after_qed [[(goal, [goal_pat])]] lthy' end;
@@ -291,6 +306,7 @@
(Parse.type_args_constrained -- Parse.binding -- Parse.opt_mixfix --
(@{keyword "="} |-- Parse.term) --
Scan.option (@{keyword "morphisms"} |-- Parse.!!! (Parse.binding -- Parse.binding))
- >> (fn ((((vs, t), mx), A), morphs) => fn lthy => typedef_cmd ((t, vs, mx), A, morphs) lthy));
+ >> (fn ((((vs, t), mx), A), opt_morphs) => fn lthy =>
+ typedef_cmd (t, vs, mx) A (SOME (make_morphisms t opt_morphs)) lthy));
end;
--- a/src/HOL/Topological_Spaces.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Topological_Spaces.thy Fri Sep 18 16:42:19 2015 +0100
@@ -212,7 +212,7 @@
lemma topological_space_generate_topology:
"class.topological_space (generate_topology S)"
- by default (auto intro: generate_topology.intros)
+ by standard (auto intro: generate_topology.intros)
subsection \<open>Order topologies\<close>
--- a/src/HOL/UNITY/Follows.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/UNITY/Follows.thy Fri Sep 18 16:42:19 2015 +0100
@@ -179,7 +179,7 @@
"(M'::'a multiset) \<le> M \<longleftrightarrow> M' #<=# M"
instance
- by default (auto simp add: less_eq_multiset_def less_multiset_def multiset_order.less_le_not_le add.commute multiset_order.add_right_mono)
+ by standard (auto simp add: less_eq_multiset_def less_multiset_def multiset_order.less_le_not_le add.commute multiset_order.add_right_mono)
end
lemma increasing_union:
--- a/src/HOL/UNITY/Guar.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/UNITY/Guar.thy Fri Sep 18 16:42:19 2015 +0100
@@ -17,7 +17,7 @@
begin
instance program :: (type) order
- by default (auto simp add: program_less_le dest: component_antisym intro: component_trans)
+ by standard (auto simp add: program_less_le dest: component_antisym intro: component_trans)
text{*Existential and Universal properties. I formalize the two-program
case, proving equivalence with Chandy and Sanders's n-ary definitions*}
--- a/src/HOL/Word/Word.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Word/Word.thy Fri Sep 18 16:42:19 2015 +0100
@@ -313,7 +313,7 @@
word_mod_def: "a mod b = word_of_int (uint a mod uint b)"
instance
- by default (transfer, simp add: algebra_simps)+
+ by standard (transfer, simp add: algebra_simps)+
end
@@ -384,7 +384,7 @@
word_less_def: "a < b \<longleftrightarrow> uint a < uint b"
instance
- by default (auto simp: word_less_def word_le_def)
+ by standard (auto simp: word_less_def word_le_def)
end
@@ -1194,7 +1194,7 @@
by (fact word_less_def)
lemma signed_linorder: "class.linorder word_sle word_sless"
- by default (unfold word_sle_def word_sless_def, auto)
+ by standard (unfold word_sle_def word_sless_def, auto)
interpretation signed: linorder "word_sle" "word_sless"
by (rule signed_linorder)
@@ -2215,7 +2215,7 @@
subsection {* Cardinality, finiteness of set of words *}
instance word :: (len0) finite
- by (default, simp add: type_definition.univ [OF type_definition_word])
+ by standard (simp add: type_definition.univ [OF type_definition_word])
lemma card_word: "CARD('a::len0 word) = 2 ^ len_of TYPE('a)"
by (simp add: type_definition.card [OF type_definition_word] nat_power_eq)
--- a/src/HOL/Word/WordBitwise.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/Word/WordBitwise.thy Fri Sep 18 16:42:19 2015 +0100
@@ -497,8 +497,8 @@
text {* Tactic definition *}
ML {*
-
-structure Word_Bitwise_Tac = struct
+structure Word_Bitwise_Tac =
+struct
val word_ss = simpset_of @{theory_context Word};
@@ -523,10 +523,9 @@
end
| _ => NONE;
-val expand_upt_simproc = Simplifier.make_simproc
- {lhss = [@{cpat "upt _ _"}],
- name = "expand_upt", identifier = [],
- proc = K upt_conv};
+val expand_upt_simproc =
+ Simplifier.make_simproc @{context} "expand_upt"
+ {lhss = [@{term "upt x y"}], proc = K upt_conv, identifier = []};
fun word_len_simproc_fn ctxt ct =
case Thm.term_of ct of
@@ -540,10 +539,9 @@
handle TERM _ => NONE | TYPE _ => NONE)
| _ => NONE;
-val word_len_simproc = Simplifier.make_simproc
- {lhss = [@{cpat "len_of _"}],
- name = "word_len", identifier = [],
- proc = K word_len_simproc_fn};
+val word_len_simproc =
+ Simplifier.make_simproc @{context} "word_len"
+ {lhss = [@{term "len_of x"}], proc = K word_len_simproc_fn, identifier = []};
(* convert 5 or nat 5 to Suc 4 when n_sucs = 1, Suc (Suc 4) when n_sucs = 2,
or just 5 (discarding nat) when n_sucs = 0 *)
@@ -567,10 +565,10 @@
|> mk_meta_eq |> SOME end
handle TERM _ => NONE;
-fun nat_get_Suc_simproc n_sucs cts = Simplifier.make_simproc
- {lhss = map (fn t => Thm.apply t @{cpat "?n :: nat"}) cts,
- name = "nat_get_Suc", identifier = [],
- proc = K (nat_get_Suc_simproc_fn n_sucs)};
+fun nat_get_Suc_simproc n_sucs ts =
+ Simplifier.make_simproc @{context} "nat_get_Suc"
+ {lhss = map (fn t => t $ @{term "n :: nat"}) ts,
+ proc = K (nat_get_Suc_simproc_fn n_sucs), identifier = []};
val no_split_ss =
simpset_of (put_simpset HOL_ss @{context}
@@ -601,10 +599,10 @@
rev_bl_order_simps}
addsimprocs [expand_upt_simproc,
nat_get_Suc_simproc 4
- [@{cpat replicate}, @{cpat "takefill ?x"},
- @{cpat drop}, @{cpat "bin_to_bl"},
- @{cpat "takefill_last ?x"},
- @{cpat "drop_nonempty ?x"}]],
+ [@{term replicate}, @{term "takefill x"},
+ @{term drop}, @{term "bin_to_bl"},
+ @{term "takefill_last x"},
+ @{term "drop_nonempty x"}]],
put_simpset no_split_ss @{context} addsimps @{thms xor3_simps carry_simps if_bool_simps}
])
--- a/src/HOL/ZF/Games.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ZF/Games.thy Fri Sep 18 16:42:19 2015 +0100
@@ -418,7 +418,7 @@
proof (induct x rule: wf_induct[OF wf_option_of])
case (1 "g")
show ?case
- proof (auto, goals)
+ proof (auto, goal_cases)
{case prems: (1 y)
from prems have "(y, g) \<in> option_of" by (auto)
with 1 have "ge_game (y, y)" by auto
@@ -462,7 +462,7 @@
proof (induct a rule: induct_game)
case (1 a)
show ?case
- proof ((rule allI | rule impI)+, goals)
+ proof ((rule allI | rule impI)+, goal_cases)
case prems: (1 x y z)
show ?case
proof -
@@ -543,7 +543,7 @@
lemma plus_game_zero_right[simp]: "plus_game G zero_game = G"
proof -
have "H = zero_game \<longrightarrow> plus_game G H = G " for G H
- proof (induct G H rule: plus_game.induct, rule impI, goals)
+ proof (induct G H rule: plus_game.induct, rule impI, goal_cases)
case prems: (1 G H)
note induct_hyp = this[simplified prems, simplified] and this
show ?case
@@ -583,7 +583,7 @@
lemma plus_game_assoc: "plus_game (plus_game F G) H = plus_game F (plus_game G H)"
proof -
have "\<forall>F G H. a = [F, G, H] \<longrightarrow> plus_game (plus_game F G) H = plus_game F (plus_game G H)" for a
- proof (induct a rule: induct_game, (rule impI | rule allI)+, goals)
+ proof (induct a rule: induct_game, (rule impI | rule allI)+, goal_cases)
case prems: (1 x F G H)
let ?L = "plus_game (plus_game F G) H"
let ?R = "plus_game F (plus_game G H)"
@@ -626,7 +626,7 @@
qed
lemma eq_game_plus_inverse: "eq_game (plus_game x (neg_game x)) zero_game"
-proof (induct x rule: wf_induct[OF wf_option_of], goals)
+proof (induct x rule: wf_induct[OF wf_option_of], goal_cases)
case prems: (1 x)
then have ihyp: "eq_game (plus_game y (neg_game y)) zero_game" if "zin y (options x)" for y
using that by (auto simp add: prems)
@@ -670,7 +670,7 @@
lemma ge_plus_game_left: "ge_game (y,z) = ge_game (plus_game x y, plus_game x z)"
proof -
have "\<forall>x y z. a = [x,y,z] \<longrightarrow> ge_game (y,z) = ge_game (plus_game x y, plus_game x z)" for a
- proof (induct a rule: induct_game, (rule impI | rule allI)+, goals)
+ proof (induct a rule: induct_game, (rule impI | rule allI)+, goal_cases)
case prems: (1 a x y z)
note induct_hyp = prems(1)[rule_format, simplified prems(2)]
{
@@ -780,7 +780,7 @@
lemma ge_neg_game: "ge_game (neg_game x, neg_game y) = ge_game (y, x)"
proof -
have "\<forall>x y. a = [x, y] \<longrightarrow> ge_game (neg_game x, neg_game y) = ge_game (y, x)" for a
- proof (induct a rule: induct_game, (rule impI | rule allI)+, goals)
+ proof (induct a rule: induct_game, (rule impI | rule allI)+, goal_cases)
case prems: (1 a x y)
note ihyp = prems(1)[rule_format, simplified prems(2)]
{ fix xl
--- a/src/HOL/ex/Adhoc_Overloading_Examples.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ex/Adhoc_Overloading_Examples.thy Fri Sep 18 16:42:19 2015 +0100
@@ -88,7 +88,7 @@
"perms = {f. bij f \<and> finite {x. f x \<noteq> x}}"
typedef 'a perm = "perms :: ('a \<Rightarrow> 'a) set"
- by (default) (auto simp: perms_def)
+ by standard (auto simp: perms_def)
text {*First we need some auxiliary lemmas.*}
lemma permsI [Pure.intro]:
@@ -153,13 +153,14 @@
unfolding uminus_perm_def by (simp add: Abs_perm_inverse perms_inv Rep_perm)
instance
- apply default
+ apply standard
unfolding Rep_perm_inject [symmetric]
unfolding minus_perm_def
unfolding Rep_perm_add
unfolding Rep_perm_uminus
unfolding Rep_perm_0
- by (simp_all add: o_assoc inv_o_cancel [OF bij_is_inj [OF bij_Rep_perm]])
+ apply (simp_all add: o_assoc inv_o_cancel [OF bij_is_inj [OF bij_Rep_perm]])
+ done
end
@@ -198,7 +199,7 @@
PERMUTE permute_atom
interpretation atom_permute: permute permute_atom
- by (default) (simp add: permute_atom_def Rep_perm_simps)+
+ by standard (simp_all add: permute_atom_def Rep_perm_simps)
text {*Permuting permutations.*}
definition permute_perm :: "'a perm \<Rightarrow> 'a perm \<Rightarrow> 'a perm" where
@@ -208,7 +209,7 @@
PERMUTE permute_perm
interpretation perm_permute: permute permute_perm
- apply default
+ apply standard
unfolding permute_perm_def
apply simp
apply (simp only: diff_conv_add_uminus minus_add add.assoc)
--- a/src/HOL/ex/Dedekind_Real.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ex/Dedekind_Real.thy Fri Sep 18 16:42:19 2015 +0100
@@ -1567,7 +1567,7 @@
"(sup :: real \<Rightarrow> real \<Rightarrow> real) = max"
instance
- by default (auto simp add: inf_real_def sup_real_def max_min_distrib2)
+ by standard (auto simp add: inf_real_def sup_real_def max_min_distrib2)
end
--- a/src/HOL/ex/SOS.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ex/SOS.thy Fri Sep 18 16:42:19 2015 +0100
@@ -12,119 +12,131 @@
lemma "(3::real) * x + 7 * a < 4 & 3 < 2 * x \<Longrightarrow> a < 0"
by sos
-lemma "a1 >= 0 & a2 >= 0 \<and> (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + 2) \<and> (a1 * b1 + a2 * b2 = 0) --> a1 * a2 - b1 * b2 >= (0::real)"
+lemma "a1 \<ge> 0 \<and> a2 \<ge> 0 \<and> (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + 2) \<and> (a1 * b1 + a2 * b2 = 0) \<longrightarrow>
+ a1 * a2 - b1 * b2 \<ge> (0::real)"
by sos
-lemma "(3::real) * x + 7 * a < 4 & 3 < 2 * x --> a < 0"
+lemma "(3::real) * x + 7 * a < 4 & 3 < 2 * x \<longrightarrow> a < 0"
by sos
-lemma "(0::real) <= x & x <= 1 & 0 <= y & y <= 1 --> x^2 + y^2 < 1 |(x - 1)^2 + y^2 < 1 | x^2 + (y - 1)^2 < 1 | (x - 1)^2 + (y - 1)^2 < 1"
+lemma "(0::real) \<le> x \<and> x \<le> 1 \<and> 0 \<le> y \<and> y \<le> 1 \<longrightarrow>
+ x\<^sup>2 + y\<^sup>2 < 1 \<or> (x - 1)\<^sup>2 + y\<^sup>2 < 1 \<or> x\<^sup>2 + (y - 1)\<^sup>2 < 1 \<or> (x - 1)\<^sup>2 + (y - 1)\<^sup>2 < 1"
by sos
-lemma "(0::real) <= x & 0 <= y & 0 <= z & x + y + z <= 3 --> x * y + x * z + y * z >= 3 * x * y * z"
+lemma "(0::real) \<le> x \<and> 0 \<le> y \<and> 0 \<le> z \<and> x + y + z \<le> 3 \<longrightarrow> x * y + x * z + y * z \<ge> 3 * x * y * z"
by sos
-lemma "((x::real)^2 + y^2 + z^2 = 1) --> (x + y + z)^2 <= 3"
+lemma "(x::real)\<^sup>2 + y\<^sup>2 + z\<^sup>2 = 1 \<longrightarrow> (x + y + z)\<^sup>2 \<le> 3"
by sos
-lemma "(w^2 + x^2 + y^2 + z^2 = 1) --> (w + x + y + z)^2 <= (4::real)"
+lemma "w\<^sup>2 + x\<^sup>2 + y\<^sup>2 + z\<^sup>2 = 1 \<longrightarrow> (w + x + y + z)\<^sup>2 \<le> (4::real)"
by sos
-lemma "(x::real) >= 1 & y >= 1 --> x * y >= x + y - 1"
+lemma "(x::real) \<ge> 1 \<and> y \<ge> 1 \<longrightarrow> x * y \<ge> x + y - 1"
by sos
-lemma "(x::real) > 1 & y > 1 --> x * y > x + y - 1"
+lemma "(x::real) > 1 \<and> y > 1 \<longrightarrow> x * y > x + y - 1"
by sos
-lemma "abs(x) <= 1 --> abs(64 * x^7 - 112 * x^5 + 56 * x^3 - 7 * x) <= (1::real)"
+lemma "\<bar>x\<bar> \<le> 1 \<longrightarrow> \<bar>64 * x^7 - 112 * x^5 + 56 * x^3 - 7 * x\<bar> \<le> (1::real)"
by sos
text \<open>One component of denominator in dodecahedral example.\<close>
-lemma "2 <= x & x <= 125841 / 50000 & 2 <= y & y <= 125841 / 50000 & 2 <= z & z <= 125841 / 50000 --> 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) >= (0::real)"
+lemma "2 \<le> x \<and> x \<le> 125841 / 50000 \<and> 2 \<le> y \<and> y \<le> 125841 / 50000 \<and> 2 \<le> z \<and> z \<le> 125841 / 50000 \<longrightarrow>
+ 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) \<ge> (0::real)"
by sos
text \<open>Over a larger but simpler interval.\<close>
-lemma "(2::real) <= x & x <= 4 & 2 <= y & y <= 4 & 2 <= z & z <= 4 --> 0 <= 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
+lemma "(2::real) \<le> x \<and> x \<le> 4 \<and> 2 \<le> y \<and> y \<le> 4 \<and> 2 \<le> z \<and> z \<le> 4 \<longrightarrow>
+ 0 \<le> 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
by sos
text \<open>We can do 12. I think 12 is a sharp bound; see PP's certificate.\<close>
-lemma "2 <= (x::real) & x <= 4 & 2 <= y & y <= 4 & 2 <= z & z <= 4 --> 12 <= 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
+lemma "2 \<le> (x::real) \<and> x \<le> 4 \<and> 2 \<le> y \<and> y \<le> 4 \<and> 2 \<le> z \<and> z \<le> 4 \<longrightarrow>
+ 12 \<le> 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
by sos
text \<open>Inequality from sci.math (see "Leon-Sotelo, por favor").\<close>
-lemma "0 <= (x::real) & 0 <= y & (x * y = 1) --> x + y <= x^2 + y^2"
+lemma "0 \<le> (x::real) \<and> 0 \<le> y \<and> x * y = 1 \<longrightarrow> x + y \<le> x\<^sup>2 + y\<^sup>2"
by sos
-lemma "0 <= (x::real) & 0 <= y & (x * y = 1) --> x * y * (x + y) <= x^2 + y^2"
+lemma "0 \<le> (x::real) \<and> 0 \<le> y \<and> x * y = 1 \<longrightarrow> x * y * (x + y) \<le> x\<^sup>2 + y\<^sup>2"
by sos
-lemma "0 <= (x::real) & 0 <= y --> x * y * (x + y)^2 <= (x^2 + y^2)^2"
+lemma "0 \<le> (x::real) \<and> 0 \<le> y \<longrightarrow> x * y * (x + y)\<^sup>2 \<le> (x\<^sup>2 + y\<^sup>2)\<^sup>2"
by sos
-lemma "(0::real) <= a & 0 <= b & 0 <= c & c * (2 * a + b)^3/ 27 <= x \<longrightarrow> c * a^2 * b <= x"
+lemma "(0::real) \<le> a \<and> 0 \<le> b \<and> 0 \<le> c \<and> c * (2 * a + b)^3 / 27 \<le> x \<longrightarrow> c * a\<^sup>2 * b \<le> x"
by sos
-lemma "(0::real) < x --> 0 < 1 + x + x^2"
+lemma "(0::real) < x \<longrightarrow> 0 < 1 + x + x\<^sup>2"
by sos
-lemma "(0::real) <= x --> 0 < 1 + x + x^2"
+lemma "(0::real) \<le> x \<longrightarrow> 0 < 1 + x + x\<^sup>2"
by sos
-lemma "(0::real) < 1 + x^2"
+lemma "(0::real) < 1 + x\<^sup>2"
by sos
-lemma "(0::real) <= 1 + 2 * x + x^2"
+lemma "(0::real) \<le> 1 + 2 * x + x\<^sup>2"
by sos
-lemma "(0::real) < 1 + abs x"
+lemma "(0::real) < 1 + \<bar>x\<bar>"
by sos
-lemma "(0::real) < 1 + (1 + x)^2 * (abs x)"
+lemma "(0::real) < 1 + (1 + x)\<^sup>2 * \<bar>x\<bar>"
by sos
-lemma "abs ((1::real) + x^2) = (1::real) + x^2"
+lemma "\<bar>(1::real) + x\<^sup>2\<bar> = (1::real) + x\<^sup>2"
by sos
+
lemma "(3::real) * x + 7 * a < 4 \<and> 3 < 2 * x \<longrightarrow> a < 0"
by sos
-lemma "(0::real) < x --> 1 < y --> y * x <= z --> x < z"
+lemma "(0::real) < x \<longrightarrow> 1 < y \<longrightarrow> y * x \<le> z \<longrightarrow> x < z"
by sos
-lemma "(1::real) < x --> x^2 < y --> 1 < y"
+
+lemma "(1::real) < x \<longrightarrow> x\<^sup>2 < y \<longrightarrow> 1 < y"
by sos
-lemma "(b::real)^2 < 4 * a * c --> ~(a * x^2 + b * x + c = 0)"
+
+lemma "(b::real)\<^sup>2 < 4 * a * c \<longrightarrow> a * x\<^sup>2 + b * x + c \<noteq> 0"
by sos
-lemma "(b::real)^2 < 4 * a * c --> ~(a * x^2 + b * x + c = 0)"
- by sos
-lemma "((a::real) * x^2 + b * x + c = 0) --> b^2 >= 4 * a * c"
+
+lemma "(b::real)\<^sup>2 < 4 * a * c \<longrightarrow> a * x\<^sup>2 + b * x + c \<noteq> 0"
by sos
-lemma "(0::real) <= b & 0 <= c & 0 <= x & 0 <= y & (x^2 = c) & (y^2 = a^2 * c + b) --> a * c <= y * x"
+
+lemma "(a::real) * x\<^sup>2 + b * x + c = 0 \<longrightarrow> b\<^sup>2 \<ge> 4 * a * c"
by sos
-lemma "abs(x - z) <= e & abs(y - z) <= e & 0 <= u & 0 <= v & (u + v = 1) --> abs((u * x + v * y) - z) <= (e::real)"
+
+lemma "(0::real) \<le> b \<and> 0 \<le> c \<and> 0 \<le> x \<and> 0 \<le> y \<and> x\<^sup>2 = c \<and> y\<^sup>2 = a\<^sup>2 * c + b \<longrightarrow> a * c \<le> y * x"
by sos
+lemma "\<bar>x - z\<bar> \<le> e \<and> \<bar>y - z\<bar> \<le> e \<and> 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1 --> \<bar>(u * x + v * y) - z\<bar> \<le> (e::real)"
+ by sos
-(* lemma "((x::real) - y - 2 * x^4 = 0) & 0 <= x & x <= 2 & 0 <= y & y <= 3 --> y^2 - 7 * y - 12 * x + 17 >= 0" by sos *) (* Too hard?*)
+lemma "(x::real) - y - 2 * x^4 = 0 \<and> 0 \<le> x \<and> x \<le> 2 \<and> 0 \<le> y \<and> y \<le> 3 \<longrightarrow> y\<^sup>2 - 7 * y - 12 * x + 17 \<ge> 0"
+ oops (*Too hard?*)
-lemma "(0::real) <= x --> (1 + x + x^2)/(1 + x^2) <= 1 + x"
+lemma "(0::real) \<le> x \<longrightarrow> (1 + x + x\<^sup>2) / (1 + x\<^sup>2) \<le> 1 + x"
by sos
-lemma "(0::real) <= x --> 1 - x <= 1 / (1 + x + x^2)"
+lemma "(0::real) \<le> x \<longrightarrow> 1 - x \<le> 1 / (1 + x + x\<^sup>2)"
by sos
-lemma "(x::real) <= 1 / 2 --> - x - 2 * x^2 <= - x / (1 - x)"
+lemma "(x::real) \<le> 1 / 2 \<longrightarrow> - x - 2 * x\<^sup>2 \<le> - x / (1 - x)"
by sos
-lemma "4*r^2 = p^2 - 4*q & r >= (0::real) & x^2 + p*x + q = 0 --> 2*(x::real) = - p + 2*r | 2*x = -p - 2*r"
+lemma "4 * r\<^sup>2 = p\<^sup>2 - 4 * q \<and> r \<ge> (0::real) \<and> x\<^sup>2 + p * x + q = 0 \<longrightarrow>
+ 2 * (x::real) = - p + 2 * r \<or> 2 * x = - p - 2 * r"
by sos
end
-
--- a/src/HOL/ex/SOS_Cert.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ex/SOS_Cert.thy Fri Sep 18 16:42:19 2015 +0100
@@ -9,122 +9,134 @@
imports "~~/src/HOL/Library/Sum_of_Squares"
begin
-lemma "(3::real) * x + 7 * a < 4 & 3 < 2 * x \<Longrightarrow> a < 0"
+lemma "(3::real) * x + 7 * a < 4 \<and> 3 < 2 * x \<Longrightarrow> a < 0"
by (sos "((R<1 + (((A<1 * R<1) * (R<2 * [1]^2)) + (((A<0 * R<1) * (R<3 * [1]^2)) + ((A<=0 * R<1) * (R<14 * [1]^2))))))")
-lemma "a1 >= 0 & a2 >= 0 \<and> (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + 2) \<and> (a1 * b1 + a2 * b2 = 0) --> a1 * a2 - b1 * b2 >= (0::real)"
+lemma "a1 \<ge> 0 \<and> a2 \<ge> 0 \<and> (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + 2) \<and> (a1 * b1 + a2 * b2 = 0) \<longrightarrow>
+ a1 * a2 - b1 * b2 \<ge> (0::real)"
by (sos "(((A<0 * R<1) + (([~1/2*a1*b2 + ~1/2*a2*b1] * A=0) + (([~1/2*a1*a2 + 1/2*b1*b2] * A=1) + (((A<0 * R<1) * ((R<1/2 * [b2]^2) + (R<1/2 * [b1]^2))) + ((A<=0 * (A<=1 * R<1)) * ((R<1/2 * [b2]^2) + ((R<1/2 * [b1]^2) + ((R<1/2 * [a2]^2) + (R<1/2 * [a1]^2))))))))))")
-lemma "(3::real) * x + 7 * a < 4 & 3 < 2 * x --> a < 0"
+lemma "(3::real) * x + 7 * a < 4 \<and> 3 < 2 * x \<longrightarrow> a < 0"
by (sos "((R<1 + (((A<1 * R<1) * (R<2 * [1]^2)) + (((A<0 * R<1) * (R<3 * [1]^2)) + ((A<=0 * R<1) * (R<14 * [1]^2))))))")
-lemma "(0::real) <= x & x <= 1 & 0 <= y & y <= 1 --> x^2 + y^2 < 1 |(x - 1)^2 + y^2 < 1 | x^2 + (y - 1)^2 < 1 | (x - 1)^2 + (y - 1)^2 < 1"
+lemma "(0::real) \<le> x \<and> x \<le> 1 \<and> 0 \<le> y \<and> y \<le> 1 \<longrightarrow>
+ x\<^sup>2 + y\<^sup>2 < 1 \<or> (x - 1)\<^sup>2 + y\<^sup>2 < 1 \<or> x\<^sup>2 + (y - 1)\<^sup>2 < 1 \<or> (x - 1)\<^sup>2 + (y - 1)\<^sup>2 < 1"
by (sos "((R<1 + (((A<=3 * (A<=4 * R<1)) * (R<1 * [1]^2)) + (((A<=2 * (A<=7 * R<1)) * (R<1 * [1]^2)) + (((A<=1 * (A<=6 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=5 * R<1)) * (R<1 * [1]^2)))))))")
-lemma "(0::real) <= x & 0 <= y & 0 <= z & x + y + z <= 3 --> x * y + x * z + y * z >= 3 * x * y * z"
+lemma "(0::real) \<le> x \<and> 0 \<le> y \<and> 0 \<le> z \<and> x + y + z \<le> 3 \<longrightarrow> x * y + x * z + y * z \<ge> 3 * x * y * z"
by (sos "(((A<0 * R<1) + (((A<0 * R<1) * (R<1/2 * [1]^2)) + (((A<=2 * R<1) * (R<1/2 * [~1*x + y]^2)) + (((A<=1 * R<1) * (R<1/2 * [~1*x + z]^2)) + (((A<=1 * (A<=2 * (A<=3 * R<1))) * (R<1/2 * [1]^2)) + (((A<=0 * R<1) * (R<1/2 * [~1*y + z]^2)) + (((A<=0 * (A<=2 * (A<=3 * R<1))) * (R<1/2 * [1]^2)) + ((A<=0 * (A<=1 * (A<=3 * R<1))) * (R<1/2 * [1]^2))))))))))")
-lemma "((x::real)^2 + y^2 + z^2 = 1) --> (x + y + z)^2 <= 3"
+lemma "(x::real)\<^sup>2 + y\<^sup>2 + z\<^sup>2 = 1 \<longrightarrow> (x + y + z)\<^sup>2 \<le> 3"
by (sos "(((A<0 * R<1) + (([~3] * A=0) + (R<1 * ((R<2 * [~1/2*x + ~1/2*y + z]^2) + (R<3/2 * [~1*x + y]^2))))))")
-lemma "(w^2 + x^2 + y^2 + z^2 = 1) --> (w + x + y + z)^2 <= (4::real)"
+lemma "w\<^sup>2 + x\<^sup>2 + y\<^sup>2 + z\<^sup>2 = 1 \<longrightarrow> (w + x + y + z)\<^sup>2 \<le> (4::real)"
by (sos "(((A<0 * R<1) + (([~4] * A=0) + (R<1 * ((R<3 * [~1/3*w + ~1/3*x + ~1/3*y + z]^2) + ((R<8/3 * [~1/2*w + ~1/2*x + y]^2) + (R<2 * [~1*w + x]^2)))))))")
-lemma "(x::real) >= 1 & y >= 1 --> x * y >= x + y - 1"
+lemma "(x::real) \<ge> 1 \<and> y \<ge> 1 \<longrightarrow> x * y \<ge> x + y - 1"
by (sos "(((A<0 * R<1) + ((A<=0 * (A<=1 * R<1)) * (R<1 * [1]^2))))")
-lemma "(x::real) > 1 & y > 1 --> x * y > x + y - 1"
+lemma "(x::real) > 1 \<and> y > 1 \<longrightarrow> x * y > x + y - 1"
by (sos "((((A<0 * A<1) * R<1) + ((A<=0 * R<1) * (R<1 * [1]^2))))")
-lemma "abs(x) <= 1 --> abs(64 * x^7 - 112 * x^5 + 56 * x^3 - 7 * x) <= (1::real)"
+lemma "\<bar>x\<bar> \<le> 1 \<longrightarrow> \<bar>64 * x^7 - 112 * x^5 + 56 * x^3 - 7 * x\<bar> \<le> (1::real)"
by (sos "((((A<0 * R<1) + ((A<=1 * R<1) * (R<1 * [~8*x^3 + ~4*x^2 + 4*x + 1]^2)))) & ((((A<0 * A<1) * R<1) + ((A<=1 * (A<0 * R<1)) * (R<1 * [8*x^3 + ~4*x^2 + ~4*x + 1]^2)))))")
text \<open>One component of denominator in dodecahedral example.\<close>
-lemma "2 <= x & x <= 125841 / 50000 & 2 <= y & y <= 125841 / 50000 & 2 <= z & z <= 125841 / 50000 --> 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) >= (0::real)"
+lemma "2 \<le> x \<and> x \<le> 125841 / 50000 \<and> 2 \<le> y \<and> y \<le> 125841 / 50000 \<and> 2 \<le> z \<and> z \<le> 125841 / 50000 \<longrightarrow>
+ 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) \<ge> (0::real)"
by (sos "(((A<0 * R<1) + ((R<1 * ((R<5749028157/5000000000 * [~25000/222477*x + ~25000/222477*y + ~25000/222477*z + 1]^2) + ((R<864067/1779816 * [419113/864067*x + 419113/864067*y + z]^2) + ((R<320795/864067 * [419113/1283180*x + y]^2) + (R<1702293/5132720 * [x]^2))))) + (((A<=4 * (A<=5 * R<1)) * (R<3/2 * [1]^2)) + (((A<=3 * (A<=5 * R<1)) * (R<1/2 * [1]^2)) + (((A<=2 * (A<=4 * R<1)) * (R<1 * [1]^2)) + (((A<=2 * (A<=3 * R<1)) * (R<3/2 * [1]^2)) + (((A<=1 * (A<=5 * R<1)) * (R<1/2 * [1]^2)) + (((A<=1 * (A<=3 * R<1)) * (R<1/2 * [1]^2)) + (((A<=0 * (A<=4 * R<1)) * (R<1 * [1]^2)) + (((A<=0 * (A<=2 * R<1)) * (R<1 * [1]^2)) + ((A<=0 * (A<=1 * R<1)) * (R<3/2 * [1]^2)))))))))))))")
text \<open>Over a larger but simpler interval.\<close>
-lemma "(2::real) <= x & x <= 4 & 2 <= y & y <= 4 & 2 <= z & z <= 4 --> 0 <= 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
+lemma "(2::real) \<le> x \<and> x \<le> 4 \<and> 2 \<le> y \<and> y \<le> 4 \<and> 2 \<le> z \<and> z \<le> 4 \<longrightarrow>
+ 0 \<le> 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
by (sos "((R<1 + ((R<1 * ((R<1 * [~1/6*x + ~1/6*y + ~1/6*z + 1]^2) + ((R<1/18 * [~1/2*x + ~1/2*y + z]^2) + (R<1/24 * [~1*x + y]^2)))) + (((A<0 * R<1) * (R<1/12 * [1]^2)) + (((A<=4 * (A<=5 * R<1)) * (R<1/6 * [1]^2)) + (((A<=2 * (A<=4 * R<1)) * (R<1/6 * [1]^2)) + (((A<=2 * (A<=3 * R<1)) * (R<1/6 * [1]^2)) + (((A<=0 * (A<=4 * R<1)) * (R<1/6 * [1]^2)) + (((A<=0 * (A<=2 * R<1)) * (R<1/6 * [1]^2)) + ((A<=0 * (A<=1 * R<1)) * (R<1/6 * [1]^2)))))))))))")
text \<open>We can do 12. I think 12 is a sharp bound; see PP's certificate.\<close>
-lemma "2 <= (x::real) & x <= 4 & 2 <= y & y <= 4 & 2 <= z & z <= 4 --> 12 <= 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
+lemma "2 \<le> (x::real) \<and> x \<le> 4 \<and> 2 \<le> y \<and> y \<le> 4 \<and> 2 \<le> z \<and> z \<le> 4 \<longrightarrow>
+ 12 \<le> 2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)"
by (sos "(((A<0 * R<1) + (((A<=4 * R<1) * (R<2/3 * [1]^2)) + (((A<=4 * (A<=5 * R<1)) * (R<1 * [1]^2)) + (((A<=3 * (A<=4 * R<1)) * (R<1/3 * [1]^2)) + (((A<=2 * R<1) * (R<2/3 * [1]^2)) + (((A<=2 * (A<=5 * R<1)) * (R<1/3 * [1]^2)) + (((A<=2 * (A<=4 * R<1)) * (R<8/3 * [1]^2)) + (((A<=2 * (A<=3 * R<1)) * (R<1 * [1]^2)) + (((A<=1 * (A<=4 * R<1)) * (R<1/3 * [1]^2)) + (((A<=1 * (A<=2 * R<1)) * (R<1/3 * [1]^2)) + (((A<=0 * R<1) * (R<2/3 * [1]^2)) + (((A<=0 * (A<=5 * R<1)) * (R<1/3 * [1]^2)) + (((A<=0 * (A<=4 * R<1)) * (R<8/3 * [1]^2)) + (((A<=0 * (A<=3 * R<1)) * (R<1/3 * [1]^2)) + (((A<=0 * (A<=2 * R<1)) * (R<8/3 * [1]^2)) + ((A<=0 * (A<=1 * R<1)) * (R<1 * [1]^2))))))))))))))))))")
text \<open>Inequality from sci.math (see "Leon-Sotelo, por favor").\<close>
-lemma "0 <= (x::real) & 0 <= y & (x * y = 1) --> x + y <= x^2 + y^2"
+lemma "0 \<le> (x::real) \<and> 0 \<le> y \<and> x * y = 1 \<longrightarrow> x + y \<le> x\<^sup>2 + y\<^sup>2"
by (sos "(((A<0 * R<1) + (([1] * A=0) + (R<1 * ((R<1 * [~1/2*x + ~1/2*y + 1]^2) + (R<3/4 * [~1*x + y]^2))))))")
-lemma "0 <= (x::real) & 0 <= y & (x * y = 1) --> x * y * (x + y) <= x^2 + y^2"
+lemma "0 \<le> (x::real) \<and> 0 \<le> y \<and> x * y = 1 \<longrightarrow> x * y * (x + y) \<le> x\<^sup>2 + y\<^sup>2"
by (sos "(((A<0 * R<1) + (([~1*x + ~1*y + 1] * A=0) + (R<1 * ((R<1 * [~1/2*x + ~1/2*y + 1]^2) + (R<3/4 * [~1*x + y]^2))))))")
-lemma "0 <= (x::real) & 0 <= y --> x * y * (x + y)^2 <= (x^2 + y^2)^2"
+lemma "0 \<le> (x::real) \<and> 0 \<le> y \<longrightarrow> x * y * (x + y)\<^sup>2 \<le> (x\<^sup>2 + y\<^sup>2)\<^sup>2"
by (sos "(((A<0 * R<1) + (R<1 * ((R<1 * [~1/2*x^2 + y^2 + ~1/2*x*y]^2) + (R<3/4 * [~1*x^2 + x*y]^2)))))")
-lemma "(0::real) <= a & 0 <= b & 0 <= c & c * (2 * a + b)^3/ 27 <= x \<longrightarrow> c * a^2 * b <= x"
+lemma "(0::real) \<le> a \<and> 0 \<le> b \<and> 0 \<le> c \<and> c * (2 * a + b)^3 / 27 \<le> x \<longrightarrow> c * a\<^sup>2 * b \<le> x"
by (sos "(((A<0 * R<1) + (((A<=3 * R<1) * (R<1 * [1]^2)) + (((A<=1 * (A<=2 * R<1)) * (R<1/27 * [~1*a + b]^2)) + ((A<=0 * (A<=2 * R<1)) * (R<8/27 * [~1*a + b]^2))))))")
-lemma "(0::real) < x --> 0 < 1 + x + x^2"
+lemma "(0::real) < x \<longrightarrow> 0 < 1 + x + x\<^sup>2"
by (sos "((R<1 + ((R<1 * (R<1 * [x]^2)) + (((A<0 * R<1) * (R<1 * [1]^2)) + ((A<=0 * R<1) * (R<1 * [1]^2))))))")
-lemma "(0::real) <= x --> 0 < 1 + x + x^2"
+lemma "(0::real) \<le> x \<longrightarrow> 0 < 1 + x + x\<^sup>2"
by (sos "((R<1 + ((R<1 * (R<1 * [x]^2)) + (((A<=1 * R<1) * (R<1 * [1]^2)) + ((A<=0 * R<1) * (R<1 * [1]^2))))))")
-lemma "(0::real) < 1 + x^2"
+lemma "(0::real) < 1 + x\<^sup>2"
by (sos "((R<1 + ((R<1 * (R<1 * [x]^2)) + ((A<=0 * R<1) * (R<1 * [1]^2)))))")
-lemma "(0::real) <= 1 + 2 * x + x^2"
+lemma "(0::real) \<le> 1 + 2 * x + x\<^sup>2"
by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [x + 1]^2))))")
-lemma "(0::real) < 1 + abs x"
+lemma "(0::real) < 1 + \<bar>x\<bar>"
by (sos "((R<1 + (((A<=1 * R<1) * (R<1/2 * [1]^2)) + ((A<=0 * R<1) * (R<1/2 * [1]^2)))))")
-lemma "(0::real) < 1 + (1 + x)^2 * (abs x)"
+lemma "(0::real) < 1 + (1 + x)\<^sup>2 * \<bar>x\<bar>"
by (sos "(((R<1 + (((A<=1 * R<1) * (R<1 * [1]^2)) + ((A<=0 * R<1) * (R<1 * [x + 1]^2))))) & ((R<1 + (((A<0 * R<1) * (R<1 * [x + 1]^2)) + ((A<=0 * R<1) * (R<1 * [1]^2))))))")
-lemma "abs ((1::real) + x^2) = (1::real) + x^2"
+lemma "\<bar>(1::real) + x\<^sup>2\<bar> = (1::real) + x\<^sup>2"
by (sos "(() & (((R<1 + ((R<1 * (R<1 * [x]^2)) + ((A<1 * R<1) * (R<1/2 * [1]^2))))) & ((R<1 + ((R<1 * (R<1 * [x]^2)) + ((A<0 * R<1) * (R<1 * [1]^2)))))))")
+
lemma "(3::real) * x + 7 * a < 4 \<and> 3 < 2 * x \<longrightarrow> a < 0"
by (sos "((R<1 + (((A<1 * R<1) * (R<2 * [1]^2)) + (((A<0 * R<1) * (R<3 * [1]^2)) + ((A<=0 * R<1) * (R<14 * [1]^2))))))")
-lemma "(0::real) < x --> 1 < y --> y * x <= z --> x < z"
+lemma "(0::real) < x \<longrightarrow> 1 < y \<longrightarrow> y * x \<le> z \<longrightarrow> x < z"
by (sos "((((A<0 * A<1) * R<1) + (((A<=1 * R<1) * (R<1 * [1]^2)) + ((A<=0 * R<1) * (R<1 * [1]^2)))))")
-lemma "(1::real) < x --> x^2 < y --> 1 < y"
+
+lemma "(1::real) < x \<longrightarrow> x\<^sup>2 < y \<longrightarrow> 1 < y"
by (sos "((((A<0 * A<1) * R<1) + ((R<1 * ((R<1/10 * [~2*x + y + 1]^2) + (R<1/10 * [~1*x + y]^2))) + (((A<1 * R<1) * (R<1/2 * [1]^2)) + (((A<0 * R<1) * (R<1 * [x]^2)) + (((A<=0 * R<1) * ((R<1/10 * [x + 1]^2) + (R<1/10 * [x]^2))) + (((A<=0 * (A<1 * R<1)) * (R<1/5 * [1]^2)) + ((A<=0 * (A<0 * R<1)) * (R<1/5 * [1]^2)))))))))")
-lemma "(b::real)^2 < 4 * a * c --> ~(a * x^2 + b * x + c = 0)"
+
+lemma "(b::real)\<^sup>2 < 4 * a * c \<longrightarrow> a * x\<^sup>2 + b * x + c \<noteq> 0"
by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [2*a*x + b]^2))))")
-lemma "(b::real)^2 < 4 * a * c --> ~(a * x^2 + b * x + c = 0)"
+
+lemma "(b::real)\<^sup>2 < 4 * a * c \<longrightarrow> a * x^2 + b * x + c \<noteq> 0"
by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [2*a*x + b]^2))))")
-lemma "((a::real) * x^2 + b * x + c = 0) --> b^2 >= 4 * a * c"
+
+lemma "(a::real) * x\<^sup>2 + b * x + c = 0 \<longrightarrow> b\<^sup>2 \<ge> 4 * a * c"
by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [2*a*x + b]^2))))")
-lemma "(0::real) <= b & 0 <= c & 0 <= x & 0 <= y & (x^2 = c) & (y^2 = a^2 * c + b) --> a * c <= y * x"
+
+lemma "(0::real) \<le> b \<and> 0 \<le> c \<and> 0 \<le> x \<and> 0 \<le> y \<and> x\<^sup>2 = c \<and> y\<^sup>2 = a\<^sup>2 * c + b \<longrightarrow> a * c \<le> y * x"
by (sos "(((A<0 * (A<0 * R<1)) + (((A<=2 * (A<=3 * (A<0 * R<1))) * (R<2 * [1]^2)) + ((A<=0 * (A<=1 * R<1)) * (R<1 * [1]^2)))))")
-lemma "abs(x - z) <= e & abs(y - z) <= e & 0 <= u & 0 <= v & (u + v = 1) --> abs((u * x + v * y) - z) <= (e::real)"
+
+lemma "\<bar>x - z\<bar> \<le> e \<and> \<bar>y - z\<bar> \<le> e \<and> 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1 \<longrightarrow> \<bar>(u * x + v * y) - z\<bar> \<le> (e::real)"
by (sos "((((A<0 * R<1) + (((A<=3 * (A<=6 * R<1)) * (R<1 * [1]^2)) + ((A<=1 * (A<=5 * R<1)) * (R<1 * [1]^2))))) & ((((A<0 * A<1) * R<1) + (((A<=3 * (A<=5 * (A<0 * R<1))) * (R<1 * [1]^2)) + ((A<=1 * (A<=4 * (A<0 * R<1))) * (R<1 * [1]^2))))))")
-(* lemma "((x::real) - y - 2 * x^4 = 0) & 0 <= x & x <= 2 & 0 <= y & y <= 3 --> y^2 - 7 * y - 12 * x + 17 >= 0" by sos *) (* Too hard?*)
+lemma "(x::real) - y - 2 * x^4 = 0 \<and> 0 \<le> x \<and> x \<le> 2 \<and> 0 \<le> y \<and> y \<le> 3 \<longrightarrow> y\<^sup>2 - 7 * y - 12 * x + 17 \<ge> 0"
+ oops (*Too hard?*)
-lemma "(0::real) <= x --> (1 + x + x^2)/(1 + x^2) <= 1 + x"
+lemma "(0::real) \<le> x \<longrightarrow> (1 + x + x\<^sup>2) / (1 + x\<^sup>2) \<le> 1 + x"
by (sos "(((((A<0 * A<1) * R<1) + ((A<=0 * (A<0 * R<1)) * (R<1 * [x]^2)))) & ((R<1 + ((R<1 * (R<1 * [x]^2)) + ((A<0 * R<1) * (R<1 * [1]^2))))))")
-lemma "(0::real) <= x --> 1 - x <= 1 / (1 + x + x^2)"
+lemma "(0::real) \<le> x \<longrightarrow> 1 - x \<le> 1 / (1 + x + x\<^sup>2)"
by (sos "(((R<1 + (([~4/3] * A=0) + ((R<1 * ((R<1/3 * [3/2*x + 1]^2) + (R<7/12 * [x]^2))) + ((A<=0 * R<1) * (R<1/3 * [1]^2)))))) & (((((A<0 * A<1) * R<1) + ((A<=0 * (A<0 * R<1)) * (R<1 * [x]^2)))) & ((R<1 + ((R<1 * (R<1 * [x]^2)) + (((A<0 * R<1) * (R<1 * [1]^2)) + ((A<=0 * R<1) * (R<1 * [1]^2))))))))")
-lemma "(x::real) <= 1 / 2 --> - x - 2 * x^2 <= - x / (1 - x)"
+lemma "(x::real) \<le> 1 / 2 \<longrightarrow> - x - 2 * x\<^sup>2 \<le> - x / (1 - x)"
by (sos "((((A<0 * A<1) * R<1) + ((A<=0 * (A<0 * R<1)) * (R<1 * [x]^2))))")
-lemma "4*r^2 = p^2 - 4*q & r >= (0::real) & x^2 + p*x + q = 0 --> 2*(x::real) = - p + 2*r | 2*x = -p - 2*r"
+lemma "4 * r\<^sup>2 = p\<^sup>2 - 4 * q \<and> r \<ge> (0::real) \<and> x\<^sup>2 + p * x + q = 0 \<longrightarrow> 2 * (x::real) = - p + 2 * r \<or> 2 * x = - p - 2 * r"
by (sos "((((((A<0 * A<1) * R<1) + ([~4] * A=0))) & ((((A<0 * A<1) * R<1) + ([4] * A=0)))) & (((((A<0 * A<1) * R<1) + ([4] * A=0))) & ((((A<0 * A<1) * R<1) + ([~4] * A=0)))))")
end
-
--- a/src/HOL/ex/Tree23.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/HOL/ex/Tree23.thy Fri Sep 18 16:42:19 2015 +0100
@@ -377,7 +377,7 @@
done
} note B = this
show "full (Suc n) t \<Longrightarrow> dfull n (del k t)"
- proof (induct k t arbitrary: n rule: del.induct, goals)
+ proof (induct k t arbitrary: n rule: del.induct, goal_cases)
case (1 k n)
thus "dfull n (del (Some k) Empty)" by simp
next
--- a/src/Provers/Arith/cancel_numeral_factor.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Provers/Arith/cancel_numeral_factor.ML Fri Sep 18 16:42:19 2015 +0100
@@ -37,16 +37,14 @@
functor CancelNumeralFactorFun(Data: CANCEL_NUMERAL_FACTOR_DATA):
- sig
- val proc: Proof.context -> term -> thm option
- end
-=
+ sig val proc: Proof.context -> cterm -> thm option end =
struct
(*the simplification procedure*)
-fun proc ctxt t =
+fun proc ctxt ct =
let
val prems = Simplifier.prems_of ctxt;
+ val t = Thm.term_of ct;
val ([t'], ctxt') = Variable.import_terms true [t] ctxt
val export = singleton (Variable.export ctxt' ctxt)
(* FIXME ctxt vs. ctxt' *)
--- a/src/Provers/Arith/cancel_numerals.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Provers/Arith/cancel_numerals.ML Fri Sep 18 16:42:19 2015 +0100
@@ -44,7 +44,7 @@
signature CANCEL_NUMERALS =
sig
- val proc: Proof.context -> term -> thm option
+ val proc: Proof.context -> cterm -> thm option
end;
functor CancelNumeralsFun(Data: CANCEL_NUMERALS_DATA): CANCEL_NUMERALS =
@@ -65,9 +65,10 @@
in seek terms1 end;
(*the simplification procedure*)
-fun proc ctxt t =
+fun proc ctxt ct =
let
val prems = Simplifier.prems_of ctxt
+ val t = Thm.term_of ct
val ([t'], ctxt') = Variable.import_terms true [t] ctxt
val export = singleton (Variable.export ctxt' ctxt)
(* FIXME ctxt vs. ctxt' (!?) *)
--- a/src/Provers/Arith/combine_numerals.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Provers/Arith/combine_numerals.ML Fri Sep 18 16:42:19 2015 +0100
@@ -38,7 +38,7 @@
functor CombineNumeralsFun(Data: COMBINE_NUMERALS_DATA):
sig
- val proc: Proof.context -> term -> thm option
+ val proc: Proof.context -> cterm -> thm option
end
=
struct
@@ -65,8 +65,9 @@
| NONE => find_repeated (tab, t::past, terms);
(*the simplification procedure*)
-fun proc ctxt t =
+fun proc ctxt ct =
let
+ val t = Thm.term_of ct
val ([t'], ctxt') = Variable.import_terms true [t] ctxt
val export = singleton (Variable.export ctxt' ctxt)
(* FIXME ctxt vs. ctxt' (!?) *)
--- a/src/Provers/Arith/fast_lin_arith.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Provers/Arith/fast_lin_arith.ML Fri Sep 18 16:42:19 2015 +0100
@@ -87,7 +87,7 @@
sig
val prems_lin_arith_tac: Proof.context -> int -> tactic
val lin_arith_tac: Proof.context -> int -> tactic
- val lin_arith_simproc: Proof.context -> term -> thm option
+ val lin_arith_simproc: Proof.context -> cterm -> thm option
val map_data:
({add_mono_thms: thm list, mult_mono_thms: thm list, inj_thms: thm list,
lessD: thm list, neqE: thm list, simpset: simpset,
@@ -775,7 +775,7 @@
let
val thms = maps LA_Logic.atomize (Simplifier.prems_of ctxt)
val Hs = map Thm.prop_of thms
- val Tconcl = LA_Logic.mk_Trueprop concl
+ val Tconcl = LA_Logic.mk_Trueprop (Thm.term_of concl)
in
case prove ctxt [] false Hs Tconcl of (* concl provable? *)
(split_neq, SOME js) => prover ctxt thms Tconcl js split_neq true
--- a/src/Pure/Concurrent/time_limit.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Concurrent/time_limit.ML Fri Sep 18 16:42:19 2015 +0100
@@ -36,4 +36,3 @@
end);
end;
-
--- a/src/Pure/General/graphics_file.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/General/graphics_file.scala Fri Sep 18 16:42:19 2015 +0100
@@ -15,6 +15,8 @@
import org.jfree.chart.JFreeChart
+import com.lowagie.text.pdf.{PdfWriter, BaseFont, FontMapper, DefaultFontMapper}
+
object Graphics_File
{
@@ -39,10 +41,24 @@
/* PDF */
- def write_pdf(file: JFile, paint: Graphics2D => Unit, width: Int, height: Int)
+ private def font_mapper(): FontMapper =
+ {
+ val mapper = new DefaultFontMapper
+ for {
+ font <- Path.split(Isabelle_System.getenv_strict("ISABELLE_FONTS"))
+ name <- Library.try_unsuffix(".ttf", font.base.implode)
+ } {
+ val parameters = new DefaultFontMapper.BaseFontParameters(File.platform_path(font))
+ parameters.encoding = BaseFont.IDENTITY_H
+ mapper.putName(name, parameters)
+ }
+ mapper
+ }
+
+ def write_pdf(
+ file: JFile, paint: Graphics2D => Unit, width: Int, height: Int)
{
import com.lowagie.text.{Document, Rectangle}
- import com.lowagie.text.pdf.PdfWriter
val out = new BufferedOutputStream(new FileOutputStream(file))
try {
@@ -54,7 +70,7 @@
val cb = writer.getDirectContent()
val tp = cb.createTemplate(width, height)
- val gfx = tp.createGraphics(width, height)
+ val gfx = tp.createGraphics(width, height, font_mapper())
paint(gfx)
gfx.dispose
@@ -78,4 +94,3 @@
def write_pdf(path: Path, chart: JFreeChart, width: Int, height: Int): Unit =
write_pdf(path.file, chart, width, height)
}
-
--- a/src/Pure/General/symbol.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/General/symbol.scala Fri Sep 18 16:42:19 2015 +0100
@@ -289,7 +289,7 @@
props match {
case Nil => Nil
case _ :: Nil => err()
- case Key(x) :: y :: rest => (x -> y) :: read_props(rest)
+ case Key(x) :: y :: rest => (x -> y.replace('\u2423', ' ')) :: read_props(rest)
case _ => err()
}
}
--- a/src/Pure/Isar/isar_cmd.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Isar/isar_cmd.ML Fri Sep 18 16:42:19 2015 +0100
@@ -168,8 +168,9 @@
ML_Lex.read_source false source
|> ML_Context.expression (Input.range_of source) "proc"
"Morphism.morphism -> Proof.context -> cterm -> thm option"
- ("Context.map_proof (Simplifier.def_simproc_cmd {name = " ^ ML_Syntax.make_binding name ^ ", \
- \lhss = " ^ ML_Syntax.print_strings lhss ^ ", proc = proc, \
+ ("Context.map_proof (Simplifier.define_simproc_cmd " ^
+ ML_Syntax.atomic (ML_Syntax.make_binding name) ^
+ "{lhss = " ^ ML_Syntax.print_strings lhss ^ ", proc = proc, \
\identifier = Library.maps ML_Context.thms " ^ ML_Syntax.print_strings identifier ^ "})")
|> Context.proof_map;
--- a/src/Pure/Isar/local_theory.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Isar/local_theory.ML Fri Sep 18 16:42:19 2015 +0100
@@ -368,10 +368,11 @@
fun init_target background_naming operations after_close lthy =
let
val _ = assert lthy;
+ val after_close' = Proof_Context.restore_naming lthy #> after_close;
val (scope, target) = Proof_Context.new_scope lthy;
val lthy' =
target
- |> Data.map (cons (make_lthy (background_naming, operations, after_close, true, target)));
+ |> Data.map (cons (make_lthy (background_naming, operations, after_close', true, target)));
in (scope, lthy') end;
fun open_target lthy =
--- a/src/Pure/Isar/method.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Isar/method.ML Fri Sep 18 16:42:19 2015 +0100
@@ -17,7 +17,7 @@
val SIMPLE_METHOD: tactic -> method
val SIMPLE_METHOD': (int -> tactic) -> method
val SIMPLE_METHOD'': ((int -> tactic) -> tactic) -> (int -> tactic) -> method
- val goals_tac: Proof.context -> string list -> cases_tactic
+ val goal_cases_tac: Proof.context -> string list -> cases_tactic
val cheating: Proof.context -> bool -> method
val intro: Proof.context -> thm list -> method
val elim: Proof.context -> thm list -> method
@@ -130,7 +130,7 @@
(* goals as cases *)
-fun goals_tac ctxt case_names st =
+fun goal_cases_tac ctxt case_names st =
let
val cases =
(if null case_names then map string_of_int (1 upto Thm.nprems_of st) else case_names)
@@ -693,21 +693,20 @@
"succeed after delay (in seconds)" #>
setup @{binding "-"} (Scan.succeed (K insert_facts))
"insert current facts, nothing else" #>
- setup @{binding goals} (Scan.lift (Scan.repeat Args.name_token) >> (fn names => fn ctxt =>
- METHOD_CASES (fn facts =>
- Seq.THEN (ALLGOALS (insert_tac facts), fn st =>
- let
- val _ =
- (case drop (Thm.nprems_of st) names of
- [] => ()
- | bad =>
- if detect_closure_state st then ()
- else
- (* FIXME Seq.Error *)
- error ("Excessive case names: " ^ commas_quote (map Token.content_of bad) ^
- Position.here (Position.set_range (Token.range_of bad))));
- in goals_tac ctxt (map Token.content_of names) st end))))
- "insert facts and bind cases for goals" #>
+ setup @{binding goal_cases} (Scan.lift (Scan.repeat Args.name_token) >> (fn names => fn ctxt =>
+ METHOD_CASES (fn facts => fn st =>
+ let
+ val _ =
+ (case drop (Thm.nprems_of st) names of
+ [] => ()
+ | bad =>
+ if detect_closure_state st then ()
+ else
+ (* FIXME Seq.Error *)
+ error ("Excessive case names: " ^ commas_quote (map Token.content_of bad) ^
+ Position.here (Position.set_range (Token.range_of bad))));
+ in goal_cases_tac ctxt (map Token.content_of names) st end)))
+ "bind cases for goals" #>
setup @{binding insert} (Attrib.thms >> (K o insert))
"insert theorems, ignoring facts" #>
setup @{binding intro} (Attrib.thms >> (fn ths => fn ctxt => intro ctxt ths))
--- a/src/Pure/Isar/proof.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Isar/proof.ML Fri Sep 18 16:42:19 2015 +0100
@@ -1083,8 +1083,9 @@
val goal_ctxt = ctxt
|> (fold o fold) Variable.auto_fixes propss
|> fold Variable.bind_term binds;
- fun after_qed' (result_ctxt, results) ctxt' =
- after_qed (burrow (Proof_Context.export result_ctxt ctxt') results) ctxt';
+ fun after_qed' (result_ctxt, results) ctxt' = ctxt'
+ |> Proof_Context.restore_naming ctxt
+ |> after_qed (burrow (Proof_Context.export result_ctxt ctxt') results);
in
ctxt
|> init
--- a/src/Pure/Isar/proof_context.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Isar/proof_context.ML Fri Sep 18 16:42:19 2015 +0100
@@ -1249,7 +1249,7 @@
val _ =
if legacy then
legacy_feature ("Bad case " ^ quote name ^ Position.here pos ^
- " -- use proof method \"goals\" instead")
+ " -- use proof method \"goal_cases\" instead")
else ();
val _ = List.app (fn NONE => () | SOME b => ignore (check_var internal b)) param_specs;
--- a/src/Pure/ML-Systems/windows_path.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/ML-Systems/windows_path.ML Fri Sep 18 16:42:19 2015 +0100
@@ -13,11 +13,10 @@
(case Char.fromString drive of
NONE => drive ^ ":"
| SOME d => String.str (Char.toUpper d) ^ ":");
- in OS.Path.toString {vol = vol, arcs = arcs, isAbs = true} end
+ in String.concatWith "\\" (vol :: arcs) end
| arcs =>
(case OS.Process.getEnv "CYGWIN_ROOT" of
- SOME root =>
- OS.Path.concat (root, OS.Path.toString {vol = "", arcs = arcs, isAbs = false})
+ SOME root => OS.Path.concat (root, String.concatWith "\\" arcs)
| NONE => raise Fail "Unknown environment variable CYGWIN_ROOT"))
else String.translate (fn #"/" => "\\" | c => String.str c) path;
--- a/src/Pure/ML/exn_properties_polyml.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/ML/exn_properties_polyml.ML Fri Sep 18 16:42:19 2015 +0100
@@ -21,7 +21,7 @@
[] => []
| [XML.Text file] =>
if file = "Standard Basis" then []
- else [(Markup.fileN, file)]
+ else [(Markup.fileN, ml_standard_path file)]
| body => XML.Decode.properties body);
fun position_of loc =
--- a/src/Pure/ML/ml_antiquotations.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/ML/ml_antiquotations.ML Fri Sep 18 16:42:19 2015 +0100
@@ -77,12 +77,7 @@
"Thm.cterm_of ML_context " ^ ML_Syntax.atomic (ML_Syntax.print_term t))) #>
ML_Antiquotation.value @{binding cprop} (Args.prop >> (fn t =>
- "Thm.cterm_of ML_context " ^ ML_Syntax.atomic (ML_Syntax.print_term t))) #>
-
- ML_Antiquotation.value @{binding cpat}
- (Args.context --
- Scan.lift Args.name_inner_syntax >> uncurry Proof_Context.read_term_pattern >> (fn t =>
- "Thm.cterm_of ML_context " ^ ML_Syntax.atomic (ML_Syntax.print_term t))));
+ "Thm.cterm_of ML_context " ^ ML_Syntax.atomic (ML_Syntax.print_term t))));
(* type classes *)
--- a/src/Pure/Tools/doc.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Tools/doc.scala Fri Sep 18 16:42:19 2015 +0100
@@ -58,19 +58,24 @@
})
def contents(): List[Entry] =
- (for {
- (dir, line) <- contents_lines()
- entry <-
- line match {
- case Section_Entry(text) =>
- Library.try_unsuffix("!", text) match {
- case None => Some(Section(text, false))
- case Some(txt) => Some(Section(txt, true))
- }
- case Doc_Entry(name, title) => Some(Doc(name, title, dir + Path.basic(name)))
- case _ => None
- }
- } yield entry) ::: release_notes() ::: examples()
+ {
+ val main_contents =
+ for {
+ (dir, line) <- contents_lines()
+ entry <-
+ line match {
+ case Section_Entry(text) =>
+ Library.try_unsuffix("!", text) match {
+ case None => Some(Section(text, false))
+ case Some(txt) => Some(Section(txt, true))
+ }
+ case Doc_Entry(name, title) => Some(Doc(name, title, dir + Path.basic(name)))
+ case _ => None
+ }
+ } yield entry
+
+ examples() ::: release_notes() ::: main_contents
+ }
/* view */
@@ -104,4 +109,3 @@
}
}
}
-
--- a/src/Pure/Tools/main.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/Tools/main.scala Fri Sep 18 16:42:19 2015 +0100
@@ -29,7 +29,7 @@
system_dialog.join_exit
}
- def build
+ def build()
{
try {
GUI.init_laf()
@@ -74,7 +74,7 @@
catch { case exn: Throwable => exit_error(exn) }
}
- def start
+ def start()
{
val do_start =
{
@@ -161,9 +161,9 @@
}
}
- build
+ build()
val rc = system_dialog.join
- if (rc == 0) start else sys.exit(rc)
+ if (rc == 0) start() else sys.exit(rc)
}
--- a/src/Pure/pure_thy.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/pure_thy.ML Fri Sep 18 16:42:19 2015 +0100
@@ -176,11 +176,6 @@
#> Sign.add_syntax (Symbol.xsymbolsN, true)
[(tycon "fun", typ "type => type => type", Mixfix ("(_/ \\<Rightarrow> _)", [1, 0], 0)),
("_bracket", typ "types => type => type", Mixfix ("([_]/ \\<Rightarrow> _)", [0, 0], 0)),
- ("_ofsort", typ "tid_position => sort => type", Mixfix ("_\\<Colon>_", [1000, 0], 1000)),
- ("_constrain", typ "logic => type => logic", Mixfix ("_\\<Colon>_", [4, 0], 3)),
- ("_constrain", typ "prop' => type => prop'", Mixfix ("_\\<Colon>_", [4, 0], 3)),
- ("_idtyp", typ "id_position => type => idt", Mixfix ("_\\<Colon>_", [], 0)),
- ("_idtypdummy", typ "type => idt", Mixfix ("'_()\\<Colon>_", [], 0)),
("_lambda", typ "pttrns => 'a => logic", Mixfix ("(3\\<lambda>_./ _)", [0, 3], 3)),
(const "Pure.eq", typ "'a => 'a => prop", Infix ("\\<equiv>", 2)),
(const "Pure.all_binder", typ "idts => prop => prop", Mixfix ("(3\\<And>_./ _)", [0, 0], 0)),
--- a/src/Pure/raw_simplifier.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/raw_simplifier.ML Fri Sep 18 16:42:19 2015 +0100
@@ -35,10 +35,10 @@
safe_solvers: string list}
type simproc
val eq_simproc: simproc * simproc -> bool
+ val cert_simproc: theory -> string ->
+ {lhss: term list, proc: morphism -> Proof.context -> cterm -> thm option, identifier: thm list}
+ -> simproc
val transform_simproc: morphism -> simproc -> simproc
- val make_simproc: {name: string, lhss: cterm list,
- proc: morphism -> Proof.context -> cterm -> thm option, identifier: thm list} -> simproc
- val mk_simproc: string -> cterm list -> (Proof.context -> term -> thm option) -> simproc
val simpset_of: Proof.context -> simpset
val put_simpset: simpset -> Proof.context -> Proof.context
val simpset_map: Proof.context -> (Proof.context -> Proof.context) -> simpset -> simpset
@@ -105,10 +105,6 @@
val solver: Proof.context -> solver -> int -> tactic
val simp_depth_limit_raw: Config.raw
val default_mk_sym: Proof.context -> thm -> thm option
- val simproc_global_i: theory -> string -> term list ->
- (Proof.context -> term -> thm option) -> simproc
- val simproc_global: theory -> string -> string list ->
- (Proof.context -> term -> thm option) -> simproc
val simp_trace_depth_limit_raw: Config.raw
val simp_trace_raw: Config.raw
val simp_debug_raw: Config.raw
@@ -675,6 +671,10 @@
fun eq_simproc (Simproc {id = id1, ...}, Simproc {id = id2, ...}) = eq_procid (id1, id2);
+fun cert_simproc thy name {lhss, proc, identifier} =
+ Simproc {name = name, lhss = map (Sign.cert_term thy) lhss, proc = proc,
+ id = (stamp (), map Thm.trim_context identifier)};
+
fun transform_simproc phi (Simproc {name, lhss, proc, id = (s, ths)}) =
Simproc
{name = name,
@@ -682,19 +682,6 @@
proc = Morphism.transform phi proc,
id = (s, Morphism.fact phi ths)};
-fun make_simproc {name, lhss, proc, identifier} =
- Simproc {name = name, lhss = map Thm.term_of lhss, proc = proc,
- id = (stamp (), map Thm.trim_context identifier)};
-
-fun mk_simproc name lhss proc =
- make_simproc {name = name, lhss = lhss, proc = fn _ => fn ctxt => fn ct =>
- proc ctxt (Thm.term_of ct), identifier = []};
-
-(* FIXME avoid global thy and Logic.varify_global *)
-fun simproc_global_i thy name = mk_simproc name o map (Thm.global_cterm_of thy o Logic.varify_global);
-fun simproc_global thy name = simproc_global_i thy name o map (Syntax.read_term_global thy);
-
-
local
fun add_proc (proc as Proc {name, lhs, ...}) ctxt =
--- a/src/Pure/simplifier.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Pure/simplifier.ML Fri Sep 18 16:42:19 2015 +0100
@@ -36,12 +36,11 @@
val cong_del: attribute
val check_simproc: Proof.context -> xstring * Position.T -> string
val the_simproc: Proof.context -> string -> simproc
- val def_simproc: {name: binding, lhss: term list,
- proc: morphism -> Proof.context -> cterm -> thm option, identifier: thm list} ->
- local_theory -> local_theory
- val def_simproc_cmd: {name: binding, lhss: string list,
- proc: morphism -> Proof.context -> cterm -> thm option, identifier: thm list} ->
- local_theory -> local_theory
+ type 'a simproc_spec =
+ {lhss: 'a list, proc: morphism -> Proof.context -> cterm -> thm option, identifier: thm list}
+ val make_simproc: Proof.context -> string -> term simproc_spec -> simproc
+ val define_simproc: binding -> term simproc_spec -> local_theory -> local_theory
+ val define_simproc_cmd: binding -> string simproc_spec -> local_theory -> local_theory
val pretty_simpset: bool -> Proof.context -> Pretty.T
val default_mk_sym: Proof.context -> thm -> thm option
val prems_of: Proof.context -> thm list
@@ -61,10 +60,6 @@
val set_subgoaler: (Proof.context -> int -> tactic) -> Proof.context -> Proof.context
type trace_ops
val set_trace_ops: trace_ops -> theory -> theory
- val simproc_global_i: theory -> string -> term list ->
- (Proof.context -> term -> thm option) -> simproc
- val simproc_global: theory -> string -> string list ->
- (Proof.context -> term -> thm option) -> simproc
val rewrite: Proof.context -> conv
val asm_rewrite: Proof.context -> conv
val full_rewrite: Proof.context -> conv
@@ -122,21 +117,27 @@
(* define simprocs *)
+type 'a simproc_spec =
+ {lhss: 'a list, proc: morphism -> Proof.context -> cterm -> thm option, identifier: thm list};
+
+fun make_simproc ctxt name {lhss, proc, identifier} =
+ let
+ val ctxt' = fold Variable.auto_fixes lhss ctxt;
+ val lhss' = Variable.export_terms ctxt' ctxt lhss;
+ in
+ cert_simproc (Proof_Context.theory_of ctxt) name
+ {lhss = lhss', proc = proc, identifier = identifier}
+ end;
+
local
-fun gen_simproc prep {name = b, lhss, proc, identifier} lthy =
+fun def_simproc prep b {lhss, proc, identifier} lthy =
let
- val simproc = make_simproc
- {name = Local_Theory.full_name lthy b,
- lhss =
- let
- val lhss' = prep lthy lhss;
- val ctxt' = fold Variable.auto_fixes lhss' lthy;
- in Variable.export_terms ctxt' lthy lhss' end |> map (Thm.cterm_of lthy),
- proc = proc,
- identifier = identifier};
+ val simproc =
+ make_simproc lthy (Local_Theory.full_name lthy b)
+ {lhss = prep lthy lhss, proc = proc, identifier = identifier};
in
- lthy |> Local_Theory.declaration {syntax = false, pervasive = true} (fn phi => fn context =>
+ lthy |> Local_Theory.declaration {syntax = false, pervasive = false} (fn phi => fn context =>
let
val b' = Morphism.binding phi b;
val simproc' = transform_simproc phi simproc;
@@ -149,8 +150,8 @@
in
-val def_simproc = gen_simproc Syntax.check_terms;
-val def_simproc_cmd = gen_simproc Syntax.read_terms;
+val define_simproc = def_simproc Syntax.check_terms;
+val define_simproc_cmd = def_simproc Syntax.read_terms;
end;
--- a/src/Tools/Code/code_ml.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/Code/code_ml.ML Fri Sep 18 16:42:19 2015 +0100
@@ -454,8 +454,7 @@
[str "let", p, str "=", print_term is_pseudo_fun some_thm vars NOBR t, str "in"])
val (ps, vars') = fold_map print_let binds vars;
in
- brackify_block fxy (Pretty.chunks ps) []
- (print_term is_pseudo_fun some_thm vars' NOBR body)
+ brackets [Pretty.chunks ps, print_term is_pseudo_fun some_thm vars' NOBR body]
end
| print_case is_pseudo_fun some_thm vars fxy { term = t, typ = ty, clauses = clause :: clauses, ... } =
let
--- a/src/Tools/Code/code_scala.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/Code/code_scala.ML Fri Sep 18 16:42:19 2015 +0100
@@ -63,15 +63,13 @@
(print_term tyvars is_pat some_thm vars BR t1) [t2])
| print_term tyvars is_pat some_thm vars fxy (IVar v) =
print_var vars v
- | print_term tyvars is_pat some_thm vars fxy ((v, ty) `|=> t) =
+ | print_term tyvars is_pat some_thm vars fxy (t as _ `|=> _) =
let
- val vars' = intro_vars (the_list v) vars;
+ val (vs_tys, body) = Code_Thingol.unfold_abs t;
+ val (ps, vars') = fold_map (print_abs_head tyvars) vs_tys vars;
+ val vars' = intro_vars (map_filter fst vs_tys) vars;
in
- concat [
- enclose "(" ")" [constraint (print_var vars' v) (print_typ tyvars NOBR ty)],
- str "=>",
- print_term tyvars false some_thm vars' NOBR t
- ]
+ brackets (ps @| print_term tyvars false some_thm vars' NOBR body)
end
| print_term tyvars is_pat some_thm vars fxy (ICase case_expr) =
(case Code_Thingol.unfold_const_app (#primitive case_expr)
@@ -80,6 +78,15 @@
then print_case tyvars some_thm vars fxy case_expr
else print_app tyvars is_pat some_thm vars fxy app
| NONE => print_case tyvars some_thm vars fxy case_expr)
+ and print_abs_head tyvars (some_v, ty) vars =
+ let
+ val vars' = intro_vars (the_list some_v) vars;
+ in
+ (concat [
+ enclose "(" ")" [constraint (print_var vars' some_v) (print_typ tyvars NOBR ty)],
+ str "=>"
+ ], vars')
+ end
and print_app tyvars is_pat some_thm vars fxy
(app as ({ sym, typargs, dom, ... }, ts)) =
let
--- a/src/Tools/Graphview/graph_file.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/Graphview/graph_file.scala Fri Sep 18 16:42:19 2015 +0100
@@ -23,7 +23,7 @@
def paint(gfx: Graphics2D)
{
- gfx.setColor(Color.WHITE)
+ gfx.setColor(graphview.background_color)
gfx.fillRect(0, 0, w, h)
gfx.translate(- box.x, - box.y)
graphview.paint(gfx)
--- a/src/Tools/Graphview/graph_panel.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/Graphview/graph_panel.scala Fri Sep 18 16:42:19 2015 +0100
@@ -331,12 +331,22 @@
tooltip = "Regenerate graph layout according to built-in algorithm"
}
+ private val editor_style = new CheckBox() {
+ selected = graphview.editor_style
+ action = Action("Editor style") {
+ graphview.editor_style = selected
+ graphview.update_layout()
+ refresh()
+ }
+ tooltip = "Use editor font and colors for painting"
+ }
+
private val colorations = new Button { action = Action("Colorations") { color_dialog.open } }
private val filters = new Button { action = Action("Filters") { mutator_dialog.open } }
private val controls =
new Wrap_Panel(Wrap_Panel.Alignment.Right)(show_content, show_arrow_heads, show_dummies,
- save_image, zoom, fit_window, update_layout) // FIXME colorations, filters
+ save_image, zoom, fit_window, update_layout, editor_style) // FIXME colorations, filters
--- a/src/Tools/Graphview/graphview.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/Graphview/graphview.scala Fri Sep 18 16:42:19 2015 +0100
@@ -94,8 +94,8 @@
def foreground_color: Color = Color.BLACK
def background_color: Color = Color.WHITE
- def selection_color: Color = Color.GREEN
- def highlight_color: Color = Color.YELLOW
+ def selection_color: Color = new Color(204, 204, 255)
+ def highlight_color: Color = new Color(255, 255, 224)
def error_color: Color = Color.RED
def dummy_color: Color = Color.GRAY
@@ -116,6 +116,7 @@
var show_content = false
var show_arrow_heads = false
var show_dummies = false
+ var editor_style = false
object Colors
{
--- a/src/Tools/induct.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/induct.ML Fri Sep 18 16:42:19 2015 +0100
@@ -158,8 +158,10 @@
| SOME (i, k, j) => SOME (swap_params_conv ctxt k j (K (swap_prems_conv i)) ct));
val rearrange_eqs_simproc =
- Simplifier.simproc_global Pure.thy "rearrange_eqs" ["Pure.all t"]
- (fn ctxt => fn t => mk_swap_rrule ctxt (Thm.cterm_of ctxt t));
+ Simplifier.make_simproc @{context} "rearrange_eqs"
+ {lhss = [@{term "Pure.all(t)"}],
+ proc = fn _ => fn ctxt => fn ct => mk_swap_rrule ctxt ct,
+ identifier = []};
(* rotate k premises to the left by j, skipping over first j premises *)
--- a/src/Tools/jEdit/etc/options Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/jEdit/etc/options Fri Sep 18 16:42:19 2015 +0100
@@ -9,7 +9,7 @@
public option jedit_auto_load : bool = false
-- "load all required files automatically to resolve theory imports"
-public option jedit_auto_resolve : bool = true
+public option jedit_auto_resolve : bool = false
-- "automatically resolve auxiliary files within the editor"
public option jedit_reset_font_size : int = 18
--- a/src/Tools/jEdit/etc/settings Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/jEdit/etc/settings Fri Sep 18 16:42:19 2015 +0100
@@ -4,10 +4,10 @@
JEDIT_SETTINGS="$ISABELLE_HOME_USER/jedit"
JEDIT_OPTIONS="-reuseview -noserver -nobackground -log=9"
-#JEDIT_JAVA_OPTIONS="-Xms128m -Xmx512m -Xss1m"
-JEDIT_JAVA_OPTIONS="-Xms128m -Xmx1024m -Xss4m"
-#JEDIT_JAVA_OPTIONS="-Xms512m -Xmx4096m -Xss8m"
-JEDIT_SYSTEM_OPTIONS="-Duser.language=en -Dawt.useSystemAAFontSettings=on -Dswing.aatext=true -Dapple.laf.useScreenMenuBar=true -Dapple.awt.application.name=Isabelle"
+
+JEDIT_JAVA_OPTIONS32="-Xms128m -Xmx1024m -Xss4m"
+JEDIT_JAVA_OPTIONS64="-Xms512m -Xmx2560m -Xss8m"
+JEDIT_JAVA_SYSTEM_OPTIONS="-Duser.language=en -Dawt.useSystemAAFontSettings=on -Dswing.aatext=true -Dapple.laf.useScreenMenuBar=true -Dapple.awt.application.name=Isabelle"
ISABELLE_JEDIT_OPTIONS=""
--- a/src/Tools/jEdit/lib/Tools/jedit Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/jEdit/lib/Tools/jedit Fri Sep 18 16:42:19 2015 +0100
@@ -5,6 +5,18 @@
# DESCRIPTION: Isabelle/jEdit interface wrapper
+## settings
+
+case "$ISABELLE_JAVA_PLATFORM" in
+ x86_64-*)
+ JEDIT_JAVA_OPTIONS="$JEDIT_JAVA_OPTIONS64"
+ ;;
+ *)
+ JEDIT_JAVA_OPTIONS="$JEDIT_JAVA_OPTIONS32"
+ ;;
+esac
+
+
## sources
declare -a SOURCES=(
@@ -81,8 +93,7 @@
echo "Usage: isabelle $PRG [OPTIONS] [FILES ...]"
echo
echo " Options are:"
- echo " -J OPTION add JVM runtime option"
- echo " (default JEDIT_JAVA_OPTIONS=$JEDIT_JAVA_OPTIONS)"
+ echo " -J OPTION add JVM runtime option (default $JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS)"
echo " -b build only"
echo " -d DIR include session directory"
echo " -f fresh build"
@@ -93,7 +104,7 @@
echo " -n no build of session image on startup"
echo " -s system build mode for session image"
echo
- echo " Start jEdit with Isabelle plugin setup and open theory FILES"
+ echo " Start jEdit with Isabelle plugin setup and open FILES"
echo " (default \"$USER_HOME/Scratch.thy\")."
echo
exit 1
@@ -170,7 +181,7 @@
done
}
-declare -a JAVA_ARGS; eval "JAVA_ARGS=($JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS)"
+declare -a JAVA_ARGS; eval "JAVA_ARGS=($JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS)"
declare -a ARGS=()
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Tools/jEdit/lib/Tools/jedit_client Fri Sep 18 16:42:19 2015 +0100
@@ -0,0 +1,115 @@
+#!/usr/bin/env bash
+#
+# Author: Makarius
+#
+# DESCRIPTION: Isabelle/jEdit client for already running application
+
+## settings
+
+SERVER_NAME="${ISABELLE_IDENTIFIER:-Isabelle}"
+
+case "$ISABELLE_JAVA_PLATFORM" in
+ x86_64-*)
+ JEDIT_JAVA_OPTIONS="$JEDIT_JAVA_OPTIONS64"
+ ;;
+ *)
+ JEDIT_JAVA_OPTIONS="$JEDIT_JAVA_OPTIONS32"
+ ;;
+esac
+
+declare -a JAVA_ARGS; eval "JAVA_ARGS=($JEDIT_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS)"
+
+
+## diagnostics
+
+PRG="$(basename "$0")"
+
+function usage()
+{
+ echo
+ echo "Usage: isabelle $PRG [OPTIONS] [FILES ...]"
+ echo
+ echo " Options are:"
+ echo " -c only check presence of server"
+ echo " -n only report server name"
+ echo " -s NAME server name (default $SERVER_NAME)"
+ echo
+ echo " Connect to already running Isabelle/jEdit instance and open FILES"
+ echo
+ exit 1
+}
+
+function fail()
+{
+ echo "$1" >&2
+ exit 2
+}
+
+function failed()
+{
+ fail "Failed!"
+}
+
+
+## process command line
+
+# options
+
+CHECK_ONLY="false"
+NAME_ONLY="false"
+
+while getopts "cns:" OPT
+do
+ case "$OPT" in
+ c)
+ CHECK_ONLY="true"
+ ;;
+ n)
+ NAME_ONLY="true"
+ ;;
+ s)
+ SERVER_NAME="$OPTARG"
+ ;;
+ \?)
+ usage
+ ;;
+ esac
+done
+
+shift $(($OPTIND - 1))
+
+
+# args
+
+declare -a ARGS=()
+
+while [ "$#" -gt 0 ]
+do
+ ARGS["${#ARGS[@]}"]="$(jvmpath "$1")"
+ shift
+done
+
+
+## main
+
+if [ "$CHECK_ONLY" = true ]
+then
+ [ -f "$JEDIT_SETTINGS/$SERVER_NAME" ]
+ exit $?
+fi
+
+if [ "$NAME_ONLY" = true ]
+then
+ echo "$SERVER_NAME"
+ exit
+fi
+
+"$ISABELLE_TOOL" jedit -b || exit $?
+
+if [ -f "$JEDIT_SETTINGS/$SERVER_NAME" ]
+then
+ exec "$ISABELLE_TOOL" java "${JAVA_ARGS[@]}" -jar "$JEDIT_HOME/dist/jedit.jar" \
+ "-settings=$(jvmpath "$JEDIT_SETTINGS")" -server="$SERVER_NAME" -reuseview "${ARGS[@]}"
+else
+ fail "Isabelle/jEdit server \"$SERVER_NAME\" not active"
+fi
--- a/src/Tools/jEdit/src/graphview_dockable.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/jEdit/src/graphview_dockable.scala Fri Sep 18 16:42:19 2015 +0100
@@ -76,14 +76,31 @@
}
override def make_font(): Font =
- GUI.imitate_font(Font_Info.main().font,
- options.string("graphview_font_family"),
- options.real("graphview_font_scale"))
+ if (editor_style) Font_Info.main(PIDE.options.real("graphview_font_scale")).font
+ else
+ GUI.imitate_font(Font_Info.main().font,
+ options.string("graphview_font_family"),
+ options.real("graphview_font_scale"))
+
+ override def foreground_color =
+ if (editor_style) view.getTextArea.getPainter.getForeground
+ else super.foreground_color
- override def foreground_color = view.getTextArea.getPainter.getForeground
- override def selection_color = view.getTextArea.getPainter.getSelectionColor
- override def highlight_color = view.getTextArea.getPainter.getLineHighlightColor
+ override def background_color =
+ if (editor_style) view.getTextArea.getPainter.getBackground
+ else super.background_color
+
+ override def selection_color =
+ if (editor_style) view.getTextArea.getPainter.getSelectionColor
+ else super.selection_color
+
+ override def highlight_color =
+ if (editor_style) view.getTextArea.getPainter.getLineHighlightColor
+ else super.highlight_color
+
override def error_color = PIDE.options.color_value("error_color")
+
+ editor_style = true
}
new isabelle.graphview.Main_Panel(graphview)
case Exn.Exn(exn) => new TextArea(Exn.message(exn))
--- a/src/Tools/jEdit/src/rendering.scala Fri Sep 18 16:27:37 2015 +0100
+++ b/src/Tools/jEdit/src/rendering.scala Fri Sep 18 16:42:19 2015 +0100
@@ -14,7 +14,7 @@
import javax.swing.Icon
import org.gjt.sp.jedit.syntax.{Token => JEditToken}
-import org.gjt.sp.jedit.{jEdit, View}
+import org.gjt.sp.jedit.jEdit
import scala.collection.immutable.SortedMap
@@ -719,6 +719,8 @@
/* text color */
+ val foreground_color = jEdit.getColorProperty("view.fgColor")
+
private lazy val text_colors: Map[String, Color] = Map(
Markup.KEYWORD1 -> keyword1_color,
Markup.KEYWORD2 -> keyword2_color,
@@ -726,12 +728,12 @@
Markup.QUASI_KEYWORD -> quasi_keyword_color,
Markup.IMPROPER -> improper_color,
Markup.OPERATOR -> operator_color,
- Markup.STRING -> Color.BLACK,
- Markup.ALT_STRING -> Color.BLACK,
- Markup.VERBATIM -> Color.BLACK,
- Markup.CARTOUCHE -> Color.BLACK,
+ Markup.STRING -> foreground_color,
+ Markup.ALT_STRING -> foreground_color,
+ Markup.VERBATIM -> foreground_color,
+ Markup.CARTOUCHE -> foreground_color,
Markup.LITERAL -> keyword1_color,
- Markup.DELIMITER -> Color.BLACK,
+ Markup.DELIMITER -> foreground_color,
Markup.TFREE -> tfree_color,
Markup.TVAR -> tvar_color,
Markup.FREE -> free_color,
@@ -746,7 +748,7 @@
Markup.ML_KEYWORD1 -> keyword1_color,
Markup.ML_KEYWORD2 -> keyword2_color,
Markup.ML_KEYWORD3 -> keyword3_color,
- Markup.ML_DELIMITER -> Color.BLACK,
+ Markup.ML_DELIMITER -> foreground_color,
Markup.ML_NUMERAL -> inner_numeral_color,
Markup.ML_CHAR -> inner_quoted_color,
Markup.ML_STRING -> inner_quoted_color,
--- a/src/ZF/Datatype_ZF.thy Fri Sep 18 16:27:37 2015 +0100
+++ b/src/ZF/Datatype_ZF.thy Fri Sep 18 16:42:19 2015 +0100
@@ -70,8 +70,9 @@
val datatype_ss = simpset_of @{context};
- fun proc ctxt old =
- let val thy = Proof_Context.theory_of ctxt
+ fun proc ctxt ct =
+ let val old = Thm.term_of ct
+ val thy = Proof_Context.theory_of ctxt
val _ =
if !trace then writeln ("data_free: OLD = " ^ Syntax.string_of_term ctxt old)
else ()
@@ -104,7 +105,9 @@
handle Match => NONE;
- val conv = Simplifier.simproc_global @{theory} "data_free" ["(x::i) = y"] proc;
+ val conv =
+ Simplifier.make_simproc @{context} "data_free"
+ {lhss = [@{term "(x::i) = y"}], proc = K proc, identifier = []};
end;
\<close>
--- a/src/ZF/arith_data.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/ZF/arith_data.ML Fri Sep 18 16:42:19 2015 +0100
@@ -76,9 +76,6 @@
(warning (msg ^ "\nCancellation failed: no typing information? (" ^ name ^ ")"); NONE)
end;
-fun prep_simproc thy (name, pats, proc) =
- Simplifier.simproc_global thy name pats proc;
-
(*** Use CancelNumerals simproc without binary numerals,
just for cancellation ***)
@@ -202,22 +199,24 @@
val nat_cancel =
- map (prep_simproc @{theory})
- [("nateq_cancel_numerals",
- ["l #+ m = n", "l = m #+ n",
- "l #* m = n", "l = m #* n",
- "succ(m) = n", "m = succ(n)"],
- EqCancelNumerals.proc),
- ("natless_cancel_numerals",
- ["l #+ m < n", "l < m #+ n",
- "l #* m < n", "l < m #* n",
- "succ(m) < n", "m < succ(n)"],
- LessCancelNumerals.proc),
- ("natdiff_cancel_numerals",
- ["(l #+ m) #- n", "l #- (m #+ n)",
- "(l #* m) #- n", "l #- (m #* n)",
- "succ(m) #- n", "m #- succ(n)"],
- DiffCancelNumerals.proc)];
+ [Simplifier.make_simproc @{context} "nateq_cancel_numerals"
+ {lhss =
+ [@{term "l #+ m = n"}, @{term "l = m #+ n"},
+ @{term "l #* m = n"}, @{term "l = m #* n"},
+ @{term "succ(m) = n"}, @{term "m = succ(n)"}],
+ proc = K EqCancelNumerals.proc, identifier = []},
+ Simplifier.make_simproc @{context} "natless_cancel_numerals"
+ {lhss =
+ [@{term "l #+ m < n"}, @{term "l < m #+ n"},
+ @{term "l #* m < n"}, @{term "l < m #* n"},
+ @{term "succ(m) < n"}, @{term "m < succ(n)"}],
+ proc = K LessCancelNumerals.proc, identifier = []},
+ Simplifier.make_simproc @{context} "natdiff_cancel_numerals"
+ {lhss =
+ [@{term "(l #+ m) #- n"}, @{term "l #- (m #+ n)"},
+ @{term "(l #* m) #- n"}, @{term "l #- (m #* n)"},
+ @{term "succ(m) #- n"}, @{term "m #- succ(n)"}],
+ proc = K DiffCancelNumerals.proc, identifier = []}];
end;
--- a/src/ZF/int_arith.ML Fri Sep 18 16:27:37 2015 +0100
+++ b/src/ZF/int_arith.ML Fri Sep 18 16:42:19 2015 +0100
@@ -146,9 +146,6 @@
val int_mult_minus_simps =
[@{thm zmult_assoc}, @{thm zmult_zminus} RS @{thm sym}, int_minus_mult_eq_1_to_2];
-fun prep_simproc thy (name, pats, proc) =
- Simplifier.simproc_global thy name pats proc;
-
structure CancelNumeralsCommon =
struct
val mk_sum = (fn _ : typ => mk_sum)
@@ -210,22 +207,24 @@
);
val cancel_numerals =
- map (prep_simproc @{theory})
- [("inteq_cancel_numerals",
- ["l $+ m = n", "l = m $+ n",
- "l $- m = n", "l = m $- n",
- "l $* m = n", "l = m $* n"],
- EqCancelNumerals.proc),
- ("intless_cancel_numerals",
- ["l $+ m $< n", "l $< m $+ n",
- "l $- m $< n", "l $< m $- n",
- "l $* m $< n", "l $< m $* n"],
- LessCancelNumerals.proc),
- ("intle_cancel_numerals",
- ["l $+ m $<= n", "l $<= m $+ n",
- "l $- m $<= n", "l $<= m $- n",
- "l $* m $<= n", "l $<= m $* n"],
- LeCancelNumerals.proc)];
+ [Simplifier.make_simproc @{context} "inteq_cancel_numerals"
+ {lhss =
+ [@{term "l $+ m = n"}, @{term "l = m $+ n"},
+ @{term "l $- m = n"}, @{term "l = m $- n"},
+ @{term "l $* m = n"}, @{term "l = m $* n"}],
+ proc = K EqCancelNumerals.proc, identifier = []},
+ Simplifier.make_simproc @{context} "intless_cancel_numerals"
+ {lhss =
+ [@{term "l $+ m $< n"}, @{term "l $< m $+ n"},
+ @{term "l $- m $< n"}, @{term "l $< m $- n"},
+ @{term "l $* m $< n"}, @{term "l $< m $* n"}],
+ proc = K LessCancelNumerals.proc, identifier = []},
+ Simplifier.make_simproc @{context} "intle_cancel_numerals"
+ {lhss =
+ [@{term "l $+ m $<= n"}, @{term "l $<= m $+ n"},
+ @{term "l $- m $<= n"}, @{term "l $<= m $- n"},
+ @{term "l $* m $<= n"}, @{term "l $<= m $* n"}],
+ proc = K LeCancelNumerals.proc, identifier = []}];
(*version without the hyps argument*)
@@ -268,8 +267,9 @@
structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
val combine_numerals =
- prep_simproc @{theory}
- ("int_combine_numerals", ["i $+ j", "i $- j"], CombineNumerals.proc);
+ Simplifier.make_simproc @{context} "int_combine_numerals"
+ {lhss = [@{term "i $+ j"}, @{term "i $- j"}],
+ proc = K CombineNumerals.proc, identifier = []};
@@ -314,8 +314,8 @@
structure CombineNumeralsProd = CombineNumeralsFun(CombineNumeralsProdData);
val combine_numerals_prod =
- prep_simproc @{theory}
- ("int_combine_numerals_prod", ["i $* j"], CombineNumeralsProd.proc);
+ Simplifier.make_simproc @{context} "int_combine_numerals_prod"
+ {lhss = [@{term "i $* j"}], proc = K CombineNumeralsProd.proc, identifier = []};
end;