--- a/Admin/Release/build Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/Release/build Thu Sep 03 15:50:40 2015 +0200
@@ -115,7 +115,7 @@
# make bundles
-for PLATFORM_FAMILY in linux windows macos
+for PLATFORM_FAMILY in linux windows windows64 macos
do
echo
@@ -139,8 +139,9 @@
<body>
<h1>${DISTNAME}</h1>
<ul>
-<li><a href="${DISTNAME}_linux.tar.gz">Linux</a></li>
-<li><a href="${DISTNAME}.exe">Windows</a></li>
+<li><a href="${DISTNAME}_app.tar.gz">Linux</a></li>
+<li><a href="${DISTNAME}-win32.exe">Windows</a></li>
+<li><a href="${DISTNAME}-win64.exe">Windows (64bit)</a></li>
<li><a href="${DISTNAME}.dmg">Mac OS X</a></li>
</ul>
</body>
--- a/Admin/Windows/Cygwin/isabelle/rebaseall Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/Windows/Cygwin/isabelle/rebaseall Thu Sep 03 15:50:40 2015 +0200
@@ -1,15 +1,4 @@
#!/bin/dash
export PATH=/bin
-
-FILE_LIST="$(mktemp)"
-
-for DIR in contrib/polyml*
-do
- find "$DIR" -name "*.dll" >> "$FILE_LIST"
-done
-
-dash /bin/rebaseall -T "$FILE_LIST"
-
-rm -f "$FILE_LIST"
-
+dash /bin/rebaseall
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/Windows/launch4j/README Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,4 @@
+Java application wrapper for Windows
+====================================
+
+* http://launch4j.sourceforge.net
Binary file Admin/Windows/launch4j/isabelle.bmp has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/Windows/launch4j/isabelle.xml Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,35 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<launch4jConfig>
+ <dontWrapJar>true</dontWrapJar>
+ <headerType>gui</headerType>
+ <jar></jar>
+ <outfile>{OUTFILE}</outfile>
+ <errTitle></errTitle>
+ <cmdLine></cmdLine>
+ <chdir></chdir>
+ <priority>normal</priority>
+ <downloadUrl></downloadUrl>
+ <supportUrl></supportUrl>
+ <stayAlive>false</stayAlive>
+ <restartOnCrash>false</restartOnCrash>
+ <manifest></manifest>
+ <icon>{ICON}</icon>
+ <classPath>
+ <mainClass>isabelle.Main</mainClass>
+{CLASSPATH}
+ </classPath>
+ <jre>
+ <path>%EXEDIR%\contrib\jdk\{PLATFORM}\jre</path>
+ <bundledJre64Bit>{PLATFORM_IS_64}</bundledJre64Bit>
+ <bundledJreAsFallback>false</bundledJreAsFallback>
+ <minVersion></minVersion>
+ <maxVersion></maxVersion>
+ <jdkPreference>jdkOnly</jdkPreference>
+ <runtimeBits>{PLATFORM_BITS}</runtimeBits>
+ <opt>-Disabelle.home="%EXEDIR%" -Dcygwin.root="%EXEDIR%\\contrib\\cygwin"</opt>
+ </jre>
+ <splash>
+ <file>{SPLASH}</file>
+ <waitForWindow>true</waitForWindow>
+ </splash>
+</launch4jConfig>
\ No newline at end of file
Binary file Admin/Windows/launch4j/isabelle_transparent.ico has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/Windows/launch4j/manifest.xml Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,9 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3" >
+ <asmv3:application>
+ <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
+ <dpiAware>true</dpiAware>
+ </asmv3:windowsSettings>
+ </asmv3:application>
+</assembly>
+
--- a/Admin/components/bundled-windows Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/components/bundled-windows Thu Sep 03 15:50:40 2015 +0200
@@ -1,3 +1,3 @@
#additional components to be bundled for release
cygwin-20150410
-windows_app-20131201
+windows_app-20150821
--- a/Admin/components/components.sha1 Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/components/components.sha1 Thu Sep 03 15:50:40 2015 +0200
@@ -48,6 +48,7 @@
44ffeeae219782d40ce6822b580e608e72fd4c76 jdk-8u31.tar.gz
4132cf52d5025bf330d53b96a5c6466fef432377 jdk-8u51.tar.gz
c95ebf7777beb3e7ef10c0cf3f734cb78f9828e4 jdk-8u5.tar.gz
+74df343671deba03be7caa49de217d78b693f817 jdk-8u60.tar.gz
44775a22f42a9d665696bfb49e53c79371c394b0 jedit_build-20111217.tar.gz
a242a688810f2bccf24587b0062ce8027bf77fa2 jedit_build-20120304.tar.gz
4c948dee53f74361c097c08f49a1a5ff9b17bd1d jedit_build-20120307.tar.gz
@@ -91,6 +92,7 @@
4b690390946f7bfb777b89eb16d6f08987cca12f polyml-5.5.2-2.tar.gz
5b31ad8556e41dfd6d5e85f407818be399aa3d2a polyml-5.5.2-3.tar.gz
532f6e8814752aeb406c62fabcfd2cc05f8a7ca8 polyml-5.5.2.tar.gz
+1c53f699d35c0db6c7cf4ea51f2310adbd1d0dc5 polyml-5.5.3-20150820.tar.gz
8ee375cfc38972f080dbc78f07b68dac03efe968 ProofGeneral-3.7.1.1.tar.gz
847b52c0676b5eb0fbf0476f64fc08c2d72afd0c ProofGeneral-4.1.tar.gz
8e0b2b432755ef11d964e20637d1bc567d1c0477 ProofGeneral-4.2-1.tar.gz
@@ -124,6 +126,7 @@
d273abdc7387462f77a127fa43095eed78332b5c windows_app-20130909.tar.gz
c368908584e2bca38b3bcb20431d0c69399fc2f0 windows_app-20131130.tar.gz
c3f5285481a95fde3c1961595b4dd0311ee7ac1f windows_app-20131201.tar.gz
+14807afcf69e50d49663d5b48f4b103f30ae842b windows_app-20150821.tar.gz
1c36a840320dfa9bac8af25fc289a4df5ea3eccb xz-java-1.2-1.tar.gz
2ae13aa17d0dc95ce254a52f1dba10929763a10d xz-java-1.2.tar.gz
4530a1aa6f4498ee3d78d6000fa71a3f63bd077f yices-1.0.28.tar.gz
--- a/Admin/components/main Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/components/main Thu Sep 03 15:50:40 2015 +0200
@@ -4,12 +4,12 @@
e-1.8
exec_process-1.0.3
Haskabelle-2015
-jdk-8u51
+jdk-8u60
jedit_build-20150228
jfreechart-1.0.14-1
jortho-1.0-2
kodkodi-1.5.2
-polyml-5.5.2-3
+polyml-5.5.3-20150820
scala-2.11.7
spass-3.8ds
xz-java-1.2-1
--- a/Admin/isatest/isatest-stats Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/isatest/isatest-stats Thu Sep 03 15:50:40 2015 +0200
@@ -17,6 +17,7 @@
HOL-Codegenerator_Test
HOL-Datatype_Examples
HOL-Decision_Procs
+ HOL-Eisbach
HOL-Hahn_Banach
HOL-Hoare
HOL-Hoare_Parallel
@@ -35,6 +36,7 @@
HOL-Mirabelle
HOL-Mirabelle-ex
HOL-Multivariate_Analysis
+ HOL-Multivariate_Analysis-ex
HOL-Mutabelle
HOL-NSA
HOL-NSA-Examples
@@ -105,6 +107,7 @@
Abstract-Rewriting
Abstract_Completeness
Affine_Arithmetic
+ Akra_Bazzi
Amortized_Complexity
ArrowImpossibilityGS
AutoFocus-Stream
@@ -118,9 +121,14 @@
Bounded_Deducibility_Security
BytecodeLogicJmlTypes
CAVA_Automata
+ CAVA_Base
CAVA_LTL_Modelchecker
+ CAVA_buildchain1
+ CAVA_buildchain3
CCS
CISC-Kernel
+ Call_Arity
+ Case_Labeling
Category
Category2
Cauchy
@@ -132,22 +140,33 @@
Coinductive
Coinductive_Languages
Collections
+ Collections_Examples
Compiling-Exceptions-Correctly
Completeness
ComponentDependencies
+ ConcurrentGC
+ ConcurrentIMP
+ Consensus_Refined
Containers
+ Containers-Benchmarks
CoreC++
CryptoBasedCompositionalProperties
DPT-SAT-Solver
DataRefinementIBP
Datatype_Order_Generator
Decreasing-Diagrams
+ Decreasing-Diagrams-II
Density_Compiler
Depth-First-Search
+ Derangements
+ Deriving
Dijkstra_Shortest_Path
Discrete_Summation
DiskPaxos
+ Dynamic_Tables
+ Echelon_Form
Efficient-Mergesort
+ Encodability_Process_Calculi
Example-Submission
FFT
FOL-Fitting
@@ -157,8 +176,11 @@
FileRefinement
FinFun
Finger-Trees
+ Finite_Automata_HF
Flyspeck-Tame
FocusStreamsCaseStudies
+ Formula_Derivatives
+ Formula_Derivatives-Examples
Free-Boolean-Algebra
Free-Groups
FunWithFunctions
@@ -175,9 +197,12 @@
GraphMarkingIBP
Graph_Theory
Group-Ring-Module
+ HOLCF-HOL-Library
+ HOLCF-Nominal2
HRB-Slicing
Heard_Of
HereditarilyFinite
+ Hermite
HotelKeyCards
Huffman
HyperCTL
@@ -187,17 +212,24 @@
Incompleteness
Inductive_Confidentiality
InformationFlowSlicing
+ InformationFlowSlicing_Inter
+ InformationFlowSlicing_Intra
Integration
+ JNF-AFP-Lib
+ JNF-HOL-Lib
Jinja
JinjaThreads
JiveDataStoreModel
Jordan_Hoelder
+ Jordan_Normal_Form
KAT_and_DRA
KBPs
Kleene_Algebra
Koenigsberg_Friendship
+ Koenigsberg_Friendship_Base
LTL_to_GBA
Lam-ml-Normalization
+ Landau_Symbols
LatticeProperties
Launchbury
Lazy-Lists-II
@@ -207,8 +239,10 @@
LinearQuantifierElim
List-Index
List-Infinite
+ List_Interleaving
Locally-Nameless-Sigma
Lower_Semicontinuous
+ MSO_Examples
MSO_Regex_Equivalence
Markov_Models
Marriage
@@ -217,13 +251,18 @@
MiniML
MonoBoolTranAlgebra
MuchAdoAboutTwo
+ Multirelations
Myhill-Nerode
Nat-Interval-Logic
Native_Word
Network_Security_Policy_Verification
Nominal2
Noninterference_CSP
+ Noninterference_Generic_Unwinding
+ Noninterference_Inductive_Unwinding
+ Noninterference_Ipurge_Unwinding
NormByEval
+ Old_Datatype_Show
Open_Induction
Ordinal
Ordinals_and_Cardinals
@@ -240,10 +279,14 @@
Presburger-Automata
Priority_Queue_Braun
Probabilistic_Noninterference
+ Probabilistic_System_Zoo
+ Probabilistic_System_Zoo-BNFs
+ Probabilistic_System_Zoo-Non_BNFs
Program-Conflict-Analysis
Promela
PseudoHoops
Psi_Calculi
+ QR_Decomposition
RIPEMD-160-SPARK
RSAPSS
Ramsey-Infinite
@@ -254,9 +297,12 @@
Refine_Monadic
RefinementReactive
Regex_Equivalence
+ Regex_Equivalence_Examples
Regular-Sets
Regular_Algebras
Relation_Algebra
+ Rep_Fin_Groups
+ Residuated_Lattices
Ribbon_Proofs
Robbins-Conjecture
Roy_Floyd_Warshall
@@ -294,11 +340,14 @@
Transitive-Closure
Transitive-Closure-II
Tree-Automata
+ Trie
Tycon
UPF
+ UpDown_Scheme
Valuation
VectorSpace
Verified-Prover
+ Vickrey_Clarke_Groves
VolpanoSmith
WHATandWHERE_Security
Well_Quasi_Orders
--- a/Admin/java/build Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/java/build Thu Sep 03 15:50:40 2015 +0200
@@ -1,5 +1,8 @@
#!/usr/bin/env bash
+THIS="$(cd "$(dirname "$0")"; pwd)"
+
+
## diagnostics
function fail()
@@ -11,13 +14,14 @@
## parameters
-VERSION="8u51"
-FULL_VERSION="1.8.0_51"
+VERSION="8u60"
+FULL_VERSION="1.8.0_60"
ARCHIVE_LINUX32="jdk-${VERSION}-linux-i586.tar.gz"
ARCHIVE_LINUX64="jdk-${VERSION}-linux-x64.tar.gz"
+ARCHIVE_WINDOWS32="jdk${FULL_VERSION}-w32.tar.gz"
+ARCHIVE_WINDOWS64="jdk${FULL_VERSION}-w64.tar.gz"
ARCHIVE_DARWIN="jdk${FULL_VERSION}.jdk.tar.gz"
-ARCHIVE_WINDOWS="jdk${FULL_VERSION}.tar.gz"
## main
@@ -35,7 +39,7 @@
for the original downloads, which are covered by the Oracle Binary
Code License Agreement for Java SE.
-Linux, Windows Mac OS X, work uniformly, depending on certain
+Linux, Windows, Mac OS X all work uniformly, depending on certain
platform-specific subdirectories.
EOF
@@ -43,21 +47,7 @@
# settings
mkdir "$DIR/etc"
-cat >> "$DIR/etc/settings" << EOF
-# -*- shell-script -*- :mode=shellscript:
-
-case "\${ISABELLE_PLATFORM64:-\$ISABELLE_PLATFORM32}" in
- x86-darwin)
- echo "### Java unavailable on 32bit Macintosh!" >&2
- ;;
- x86_64-darwin)
- ISABELLE_JDK_HOME="\$COMPONENT/\$ISABELLE_PLATFORM64/Contents/Home"
- ;;
- *)
- ISABELLE_JDK_HOME="\$COMPONENT/\${ISABELLE_PLATFORM64:-\$ISABELLE_PLATFORM32}"
- ;;
-esac
-EOF
+cp "$THIS/settings" "$DIR/etc/settings"
# content
@@ -67,16 +57,17 @@
function tar() { /usr/bin/gnutar "$@"; }
fi
-mkdir "$DIR/x86-linux" "$DIR/x86_64-linux" "$DIR/x86_64-darwin" "$DIR/x86-cygwin"
+mkdir "$DIR/x86-linux" "$DIR/x86_64-linux" "$DIR/x86-windows" "$DIR/x86_64-windows" "$DIR/x86_64-darwin"
tar -C "$DIR/x86-linux" -xf "$ARCHIVE_LINUX32"
tar -C "$DIR/x86_64-linux" -xf "$ARCHIVE_LINUX64"
+tar -C "$DIR/x86-windows" -xf "$ARCHIVE_WINDOWS32"
+tar -C "$DIR/x86_64-windows" -xf "$ARCHIVE_WINDOWS64"
tar -C "$DIR/x86_64-darwin" -xf "$ARCHIVE_DARWIN"
-tar -C "$DIR/x86-cygwin" -xf "$ARCHIVE_WINDOWS"
(
cd "$DIR"
- for PLATFORM in x86-linux x86_64-linux x86-cygwin
+ for PLATFORM in x86-linux x86_64-linux x86-windows x86_64-windows
do
mv "$PLATFORM/jdk${FULL_VERSION}"/* "$PLATFORM"/.
rmdir "$PLATFORM/jdk${FULL_VERSION}"
@@ -99,8 +90,9 @@
do
for OTHER in \
"../x86_64-linux/$FILE" \
- "../x86_64-darwin/Contents/Home/$FILE" \
- "../x86-cygwin/$FILE"
+ "../x86-windows/$FILE" \
+ "../x86_64-windows/$FILE" \
+ "../x86_64-darwin/Contents/Home/$FILE"
do
if cmp -s "$FILE" "$OTHER"
then
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/java/settings Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,26 @@
+# -*- shell-script -*- :mode=shellscript:
+
+case "$ISABELLE_PLATFORM_FAMILY" in
+ linux)
+ ISABELLE_JAVA_PLATFORM="${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}"
+ ISABELLE_JDK_HOME="$COMPONENT/$ISABELLE_JAVA_PLATFORM"
+ ;;
+ windows)
+ if [ ! -e "$COMPONENT/x86_64-windows" ]; then
+ ISABELLE_JAVA_PLATFORM="x86-windows"
+ elif "$COMPONENT/x86_64-windows/jre/bin/java" -version > /dev/null 2> /dev/null; then
+ ISABELLE_JAVA_PLATFORM="x86_64-windows"
+ else
+ ISABELLE_JAVA_PLATFORM="x86-windows"
+ fi
+ ISABELLE_JDK_HOME="$COMPONENT/$ISABELLE_JAVA_PLATFORM"
+ ;;
+ macos)
+ if [ -z "$ISABELLE_PLATFORM64" ]; then
+ echo "### Java unavailable on 32bit Mac OS X" >&2
+ else
+ ISABELLE_JAVA_PLATFORM="$ISABELLE_PLATFORM64"
+ ISABELLE_JDK_HOME="$COMPONENT/$ISABELLE_JAVA_PLATFORM/Contents/Home"
+ fi
+ ;;
+esac
--- a/Admin/lib/Tools/makedist_bundle Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/lib/Tools/makedist_bundle Thu Sep 03 15:50:40 2015 +0200
@@ -11,8 +11,8 @@
echo
echo "Usage: isabelle $PRG ARCHIVE PLATFORM_FAMILY"
echo
- echo " Re-package Isabelle source distribution with add-on components"
- echo " and post-hoc patches for platform family linux, macos, windows."
+ echo " Re-package Isabelle source distribution with add-on components and"
+ echo " post-hoc patches for platform family linux, windows, windows64, macos."
echo
echo " Add-on components are that of the running Isabelle version!"
echo
@@ -33,6 +33,12 @@
ARCHIVE="$1"; shift
PLATFORM_FAMILY="$1"; shift
+if [ "$PLATFORM_FAMILY" = windows64 ]; then
+ PLATFORM_FAM="windows"
+else
+ PLATFORM_FAM="$PLATFORM_FAMILY"
+fi
+
[ -f "$ARCHIVE" ] || fail "Bad source archive: $ARCHIVE"
ARCHIVE_DIR="$(cd $(dirname "$ARCHIVE"); echo "$PWD")"
@@ -81,7 +87,7 @@
echo "#bundled components" >> "$ISABELLE_TARGET/etc/components"
-for CATALOG in main "$PLATFORM_FAMILY" bundled "bundled-$PLATFORM_FAMILY"
+for CATALOG in main "$PLATFORM_FAM" bundled "bundled-$PLATFORM_FAM"
do
CATALOG_FILE="$ISABELLE_HOME/Admin/components/$CATALOG"
if [ -f "$CATALOG_FILE" ]
@@ -132,11 +138,11 @@
# purge other platforms
-function purge_contrib
+function purge_target
{
(
cd "$ISABELLE_TARGET"
- for DIR in $(eval find contrib "$@" | sort)
+ for DIR in $(eval find "$@" | sort)
do
echo "removing $DIR"
rm -rf "$DIR"
@@ -175,9 +181,9 @@
perl -pi -e "s,view.title=Isabelle/jEdit,view.title=${ISABELLE_NAME},g;" \
"$ISABELLE_TARGET/src/Tools/jEdit/dist/properties/jEdit.props"
-case "$PLATFORM_FAMILY" in
+case "$PLATFORM_FAM" in
linux)
- purge_contrib '-name "x86*-darwin" -o -name "x86*-cygwin" -o -name "x86*-windows"'
+ purge_target 'contrib -name "x86*-darwin" -o -name "x86*-cygwin" -o -name "x86*-windows"'
purge_jdk "x86-linux"
purge_jdk "x86_64-linux"
@@ -199,7 +205,7 @@
cp "$TMP/linux_app/Isabelle" "$ISABELLE_TARGET/$ISABELLE_NAME"
;;
macos)
- purge_contrib '-name "x86*-linux" -o -name "x86*-cygwin" -o -name "x86*-windows"'
+ purge_target 'contrib -name "x86*-linux" -o -name "x86*-cygwin" -o -name "x86*-windows"'
purge_jdk "x86_64-darwin/Contents/Home"
mv "$ISABELLE_TARGET/contrib/macos_app" "$TMP/."
@@ -212,8 +218,20 @@
"$ISABELLE_TARGET/src/Tools/jEdit/dist/properties/jEdit.props"
;;
windows)
- purge_contrib '-name "x86*-linux" -o -name "x86*-darwin"'
- purge_jdk "x86-cygwin"
+ if [ "$PLATFORM_FAMILY" = windows ]; then
+ purge_target 'contrib -name x86_64-windows -o -name "x86*-linux" -o -name "x86*-darwin"'
+ PLATFORM="x86-windows"
+ PLATFORM_IS_64="false"
+ PLATFORM_BITS="32"
+ else
+ purge_target 'contrib -name "x86*-linux" -o -name "x86*-darwin"'
+ purge_target 'contrib/jdk -name "x86-windows"'
+ PLATFORM="x86_64-windows"
+ PLATFORM_IS_64="true"
+ PLATFORM_BITS="64"
+ fi
+ purge_jdk "$PLATFORM"
+
mv "$ISABELLE_TARGET/contrib/windows_app" "$TMP/."
perl -pi \
@@ -222,34 +240,50 @@
"$ISABELLE_TARGET/src/Tools/jEdit/dist/properties/jEdit.props"
(
- cat "$ISABELLE_HOME/Admin/Windows/WinRun4J/Isabelle.ini"
-
+ echo -e "# Java runtime options\r"
declare -a JAVA_ARGS=()
eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS)"
- A=2
for ARG in "${JAVA_ARGS[@]}"
do
- echo -e "vmarg.$A=$ARG\r"
- A=$[ $A + 1 ]
+ echo -e "$ARG\r"
done
+ ) > "$ISABELLE_TARGET/${ISABELLE_NAME}.l4j.ini"
+
+ (
+ cd "$TMP"
+
+ APP_TEMPLATE="$ISABELLE_HOME/Admin/Windows/launch4j"
- A=1
- for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
- do
- ENTRY=$(echo "$ENTRY" | perl -p -e 's,/,\\\\,g;')
- echo -e "classpath.$A=$ENTRY\r"
- A=$[ $A + 1 ]
- done
- ) > "$ISABELLE_TARGET/${ISABELLE_NAME}.ini"
+ (
+ for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
+ do
+ ENTRY=$(echo "$ENTRY" | perl -p -e 's,/,\\\\,g;')
+ echo " <cp>%EXEDIR%\\\\$ENTRY</cp>"
+ done
+ ) > exe_classpath
+ EXE_CLASSPATH="$(cat exe_classpath)"
- cp "$TMP/windows_app/Isabelle.exe" "$ISABELLE_TARGET/${ISABELLE_NAME}.exe"
- cp "$ISABELLE_HOME/Admin/Windows/WinRun4J/manifest.xml" "$ISABELLE_TARGET/${ISABELLE_NAME}.exe.manifest"
- cp "$ISABELLE_HOME/Admin/Windows/Cygwin/Cygwin-Setup.bat" \
- "$ISABELLE_HOME/Admin/Windows/Cygwin/Cygwin-Terminal.bat" "$ISABELLE_TARGET"
+ perl -p \
+ -e "s,{OUTFILE},$ISABELLE_TARGET/${ISABELLE_NAME}.exe,g;" \
+ -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,{PLATFORM},$PLATFORM,g;" \
+ -e "s,{PLATFORM_IS_64},$PLATFORM_IS_64,g;" \
+ -e "s,{PLATFORM_BITS},$PLATFORM_BITS,g;" \
+ "$APP_TEMPLATE/isabelle.xml" > isabelle.xml
+
+ "windows_app/launch4j-${ISABELLE_PLATFORM_FAMILY}/launch4j" isabelle.xml
+
+ cp "$APP_TEMPLATE/manifest.xml" "$ISABELLE_TARGET/${ISABELLE_NAME}.exe.manifest"
+ )
(
cd "$ISABELLE_TARGET"
+ cp "$ISABELLE_HOME/Admin/Windows/Cygwin/Cygwin-Setup.bat" \
+ "$ISABELLE_HOME/Admin/Windows/Cygwin/Cygwin-Terminal.bat" .
+
for NAME in postinstall rebaseall
do
cp -a "$ISABELLE_HOME/Admin/Windows/Cygwin/isabelle/$NAME" \
@@ -270,19 +304,15 @@
esac
-# archive
-
-BUNDLE_ARCHIVE="${ARCHIVE_DIR}/${ISABELLE_NAME}_${PLATFORM_FAMILY}.tar.gz"
-
-echo "packaging $(basename "$BUNDLE_ARCHIVE")"
-tar -C "$TMP" -c -z -f "$BUNDLE_ARCHIVE" "$ISABELLE_NAME" || exit 2
-
-
# platform-specific setup (outside archive)
if [ "$ISABELLE_PLATFORM_FAMILY" = linux -a "$PLATFORM_FAMILY" != macos -o "$ISABELLE_PLATFORM_FAMILY" = macos ]
then
- case "$PLATFORM_FAMILY" in
+ case "$PLATFORM_FAM" in
+ linux)
+ echo "application for $PLATFORM_FAMILY"
+ tar -C "$TMP" -c -z -f "${ARCHIVE_DIR}/${ISABELLE_NAME}_app.tar.gz" "$ISABELLE_NAME"
+ ;;
macos)
echo "application for $PLATFORM_FAMILY"
(
@@ -339,6 +369,12 @@
;;
windows)
(
+ if [ "$PLATFORM_FAMILY" = windows ]; then
+ PLATFORM_SUFFIX="-win32"
+ else
+ PLATFORM_SUFFIX="-win64"
+ fi
+
cd "$TMP"
rm -f "${ARCHIVE_DIR}/${ISABELLE_NAME}.7z"
7z -y -bd a "$TMP/${ISABELLE_NAME}.7z" "$ISABELLE_NAME" || exit 2
@@ -349,8 +385,8 @@
cat "$ISABELLE_HOME/Admin/Windows/Installer/sfx.txt" | \
perl -p -e "s,{ISABELLE_NAME},${ISABELLE_NAME},g;"
cat "$TMP/${ISABELLE_NAME}.7z"
- ) > "${ARCHIVE_DIR}/${ISABELLE_NAME}.exe"
- chmod +x "${ARCHIVE_DIR}/${ISABELLE_NAME}.exe"
+ ) > "${ARCHIVE_DIR}/${ISABELLE_NAME}${PLATFORM_SUFFIX}.exe"
+ chmod +x "${ARCHIVE_DIR}/${ISABELLE_NAME}${PLATFORM_SUFFIX}.exe"
)
;;
*)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/polyml/INSTALL-MinGW Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,31 @@
+MinGW for native Windows support
+================================
+
+- always "Run as administrator ..."
+
+- http://sourceforge.net/projects/msys2
+
+ target c:\msys32 or c:\msys64
+
+- http://sourceforge.net/projects/mingw-w64
+
+ mingw-w64-install.exe
+
+ i686-4.9.3-win32-dwarf-rt_v4-rev0
+ x86_64-4.9.3-win32-seh-rt_v4-rev0
+
+ target c:\msys32 or c:\msys64
+
+- within msys shell:
+
+ pacman --needed -Sy bash pacman pacman-mirrors msys2-runtime
+
+ after restart of msys shell:
+
+ pacman -Su
+ pacman -S make diffutils texinfo gmp-devel mingw-w64-i686-gmp mingw-w64-x86_64-gmp
+
+- build (as regular user) e.g. on vmbroy9
+
+ isabelle/repos/Admin/polyml/build polyml-git x86-windows --build=i686-pc-msys --with-gmp
+ isabelle/repos/Admin/polyml/build polyml-git x86_64-windows --build=x86_64-pc-msys --with-gmp
--- a/Admin/polyml/README Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/polyml/README Thu Sep 03 15:50:40 2015 +0200
@@ -1,12 +1,8 @@
Poly/ML for Isabelle
====================
-This compilation of Poly/ML 5.5.2 is based on
-http://sourceforge.net/p/polyml/code/HEAD/tree/fixes-5.5.2 version
-2009. See also fixes-5.5.2.diff for the differences to the official
-source distribution polyml.5.5.2.tar.gz from
-http://sourceforge.net/projects/polyml/.
-
+This is a preview of Poly/ML 5.5.3, based on
+https://github.com/polyml/polyml/
The included build script is used like this:
@@ -14,11 +10,12 @@
./build src x86_64-linux --with-gmp
./build src x86-darwin --without-gmp
./build src x86_64-darwin --without-gmp
- ./build src x86-cygwin --with-gmp
+ ./build src x86-windows --with-gmp
+ ./build src x86_64-windows --with-gmp
Also note that the separate "sha1" library module is required for
efficient digesting of strings according to SHA-1.
Makarius
- 22-Apr-2015
+ 31-Aug-2015
--- a/Admin/polyml/build Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/polyml/build Thu Sep 03 15:50:40 2015 +0200
@@ -64,10 +64,12 @@
OPTIONS=()
;;
x86-windows)
- OPTIONS=()
+ OPTIONS=(--host=i686-w32-mingw32 CPPFLAGS='-I/mingw32/include')
+ PATH="/mingw32/bin:$PATH"
;;
x86_64-windows)
- OPTIONS=()
+ OPTIONS=(--host=x86_64-w64-mingw32 CPPFLAGS='-I/mingw64/include')
+ PATH="/mingw64/bin:$PATH"
;;
*)
fail "Bad platform identifier: \"$TARGET\""
@@ -90,6 +92,20 @@
rmdir "$SOURCE/$TARGET/bin" "$SOURCE/$TARGET/lib"
rm -rf "$SOURCE/$TARGET/share"
-if [ "$TARGET" = x86-cygwin ]; then
- peflags -x8192000 -z500 "$TARGET/poly.exe"
-fi
+case "$TARGET" in
+ x86-cygwin)
+ peflags -x8192000 -z500 "$TARGET/poly.exe"
+ ;;
+ x86-windows)
+ for X in libgcc_s_dw2-1.dll libgmp-10.dll libstdc++-6.dll
+ do
+ cp "/mingw32/bin/$X" "$TARGET/."
+ done
+ ;;
+ x86_64-windows)
+ for X in libgcc_s_seh-1.dll libgmp-10.dll libstdc++-6.dll
+ do
+ cp "/mingw64/bin/$X" "$TARGET/."
+ done
+ ;;
+esac
--- a/Admin/polyml/polyml Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/polyml/polyml Thu Sep 03 15:50:40 2015 +0200
@@ -8,4 +8,3 @@
export DYLD_LIBRARY_PATH="$THIS:$DYLD_LIBRARY_PATH"
exec "$THIS/poly" "$@"
-
--- a/Admin/polyml/settings Thu Sep 03 15:50:24 2015 +0200
+++ b/Admin/polyml/settings Thu Sep 03 15:50:40 2015 +0200
@@ -3,9 +3,9 @@
POLYML_HOME="$COMPONENT"
-# basic settings
+# simple settings (example)
-#ML_SYSTEM=polyml-5.5.2
+#ML_SYSTEM=polyml-5.5.3
#ML_PLATFORM="$ISABELLE_PLATFORM32"
#ML_HOME="$POLYML_HOME/$ML_PLATFORM"
#ML_OPTIONS="-H 500"
@@ -14,7 +14,7 @@
# smart settings
-ML_SYSTEM=polyml-5.5.2
+ML_SYSTEM=polyml-5.5.3
case "$ISABELLE_PLATFORM" in
*-linux)
@@ -31,6 +31,9 @@
fi
fi
;;
+ x86-cygwin)
+ ML_PLATFORM="x86-windows"
+ ;;
*)
ML_PLATFORM="$ISABELLE_PLATFORM32"
;;
@@ -47,4 +50,3 @@
ML_HOME="$POLYML_HOME/$ML_PLATFORM"
ML_SOURCES="$POLYML_HOME/src"
-
--- a/NEWS Thu Sep 03 15:50:24 2015 +0200
+++ b/NEWS Thu Sep 03 15:50:40 2015 +0200
@@ -12,6 +12,15 @@
* Improved scheduling for urgent print tasks (e.g. command state output,
interactive queries) wrt. long-running background tasks.
+* IDE support for the source-level debugger of Poly/ML, to work with
+Isabelle/ML and official Standard ML. Configuration option "ML_debugger"
+and commands 'ML_file_debug', 'ML_file_no_debug', 'SML_file_debug',
+'SML_file_no_debug' control compilation of sources with debugging
+information. The Debugger panel allows to set breakpoints (via context
+menu), step through stopped threads, evaluate local ML expressions etc.
+At least one Debugger view needs to be active to have any effect on the
+running ML program.
+
*** Isar ***
@@ -172,6 +181,14 @@
*** HOL ***
+* 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
+simplify porting old theories:
+
+ type_notation Map.map (infixr "~=>" 0)
+ notation Map.map_comp (infixl "o'_m" 55)
+
* Theory Map: lemma map_of_is_SomeD was a clone of map_of_SomeD and has
been removed. INCOMPATIBILITY.
@@ -183,7 +200,9 @@
- Proof reconstruction has been improved, to minimize the incidence of
cases where Sledgehammer gives a proof that does not work.
- Auto Sledgehammer now minimizes and preplays the results.
- - The URL for remote provers on SystemOnTPTP has been updated.
+ - Handle Vampire 4.0 proof output without raising exception.
+ - Eliminated "MASH" environment variable. Use the "MaSh" option in
+ Isabelle/jEdit instead. INCOMPATIBILITY.
* Nitpick:
- Removed "check_potential" and "check_genuine" options.
@@ -286,6 +305,15 @@
the proof context discipline.
+*** System ***
+
+* 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.
+
+
New in Isabelle2015 (May 2015)
------------------------------
--- a/etc/settings Thu Sep 03 15:50:24 2015 +0200
+++ b/etc/settings Thu Sep 03 15:50:40 2015 +0200
@@ -14,7 +14,7 @@
ISABELLE_SCALA_BUILD_OPTIONS="-encoding UTF-8 -nowarn -target:jvm-1.7 -Xmax-classfile-name 130"
-ISABELLE_JAVA_SYSTEM_OPTIONS="-server -Dfile.encoding=UTF-8 -Disabelle.threads=0"
+ISABELLE_JAVA_SYSTEM_OPTIONS="-server -XX:+UseG1GC -XX:+UseStringDeduplication -Dfile.encoding=UTF-8 -Disabelle.threads=0"
classpath "$ISABELLE_HOME/lib/classes/Pure.jar"
--- a/lib/scripts/run-polyml-5.5.3 Thu Sep 03 15:50:24 2015 +0200
+++ b/lib/scripts/run-polyml-5.5.3 Thu Sep 03 15:50:40 2015 +0200
@@ -40,12 +40,30 @@
## prepare databases
+case "$ML_PLATFORM" in
+ *-windows)
+ PLATFORM_INFILE="$(jvmpath -m "$INFILE")"
+ PLATFORM_OUTFILE="$(jvmpath -m "$OUTFILE")"
+ ;;
+ *)
+ PLATFORM_INFILE="$INFILE"
+ PLATFORM_OUTFILE="$OUTFILE"
+ ;;
+esac
+
if [ -z "$INFILE" ]; then
INIT=""
- EXIT="fun exit rc = Posix.Process.exit (Word8.fromInt rc);"
+ case "$ML_PLATFORM" in
+ *-windows)
+ EXIT="fun exit 0 = OS.Process.exit OS.Process.success | exit 1 = OS.Process.exit OS.Process.failure | exit rc = OS.Process.exit (RunCall.unsafeCast (Word8.fromInt rc));"
+ ;;
+ *)
+ EXIT="fun exit rc = Posix.Process.exit (Word8.fromInt rc);"
+ ;;
+ esac
else
check_file "$INFILE"
- INIT="(Signal.signal (2, Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ())); PolyML.SaveState.loadState \"$INFILE\" handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn ^ \": $INFILE\\n\"); Posix.Process.exit 0w1));"
+ INIT="(Signal.signal (2, Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ())); PolyML.SaveState.loadState \"$PLATFORM_INFILE\" handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn ^ \": $INFILE\\n\"); OS.Process.exit OS.Process.success));"
EXIT=""
fi
@@ -53,7 +71,7 @@
MLEXIT=""
else
if [ -z "$INFILE" ]; then
- MLEXIT="(PolyML.shareCommonData PolyML.rootFunction; TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.SaveState.saveState \"$OUTFILE\"; true) handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn ^ \": $OUTFILE\\n\"); Posix.Process.exit 0w1);"
+ MLEXIT="(PolyML.shareCommonData PolyML.rootFunction; TextIO.output (TextIO.stdOut, \"Exporting $OUTFILE\n\"); PolyML.SaveState.saveState \"$PLATFORM_OUTFILE\"; true) handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn ^ \": $OUTFILE\\n\"); OS.Process.exit OS.Process.success);"
else
MLEXIT="Session.save \"$OUTFILE\";"
fi
--- a/lib/scripts/timestop.bash Thu Sep 03 15:50:24 2015 +0200
+++ b/lib/scripts/timestop.bash Thu Sep 03 15:50:40 2015 +0200
@@ -34,10 +34,12 @@
[ "$KIND" = 2 ] && KIND_NAME="cpu time"
local RESULT="${HOURS}:${MINUTES}:${SECS} ${KIND_NAME}"
- if [ -z "$TIMES_REPORT" ]; then
- TIMES_REPORT="$RESULT"
- else
- TIMES_REPORT="$TIMES_REPORT, $RESULT"
+ if [ ${KIND} -eq 1 -o ${TIME} -ge 5 ]; then
+ if [ -z "$TIMES_REPORT" ]; then
+ TIMES_REPORT="$RESULT"
+ else
+ TIMES_REPORT="$TIMES_REPORT, $RESULT"
+ fi
fi
done
if let "$TIME1 >= 5 && $TIME2 >= 5"
--- a/src/Doc/Classes/Classes.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Classes/Classes.thy Thu Sep 03 15:50:40 2015 +0200
@@ -10,7 +10,7 @@
of overloading\footnote{throughout this tutorial, we are referring
to classical Haskell 1.0 type classes, not considering later
additions in expressiveness}. As a canonical example, a polymorphic
- equality function @{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} which is overloaded on
+ equality function @{text "eq :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} which is overloaded on
different types for @{text "\<alpha>"}, which is achieved by splitting
introduction of the @{text eq} function from its overloaded
definitions by means of @{text class} and @{text instance}
@@ -20,20 +20,20 @@
\begin{quote}
\noindent@{text "class eq where"} \\
- \hspace*{2ex}@{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"}
+ \hspace*{2ex}@{text "eq :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"}
- \medskip\noindent@{text "instance nat \<Colon> eq where"} \\
+ \medskip\noindent@{text "instance nat :: eq where"} \\
\hspace*{2ex}@{text "eq 0 0 = True"} \\
\hspace*{2ex}@{text "eq 0 _ = False"} \\
\hspace*{2ex}@{text "eq _ 0 = False"} \\
\hspace*{2ex}@{text "eq (Suc n) (Suc m) = eq n m"}
- \medskip\noindent@{text "instance (\<alpha>\<Colon>eq, \<beta>\<Colon>eq) pair \<Colon> eq where"} \\
+ \medskip\noindent@{text "instance (\<alpha>::eq, \<beta>::eq) pair :: eq where"} \\
\hspace*{2ex}@{text "eq (x1, y1) (x2, y2) = eq x1 x2 \<and> eq y1 y2"}
\medskip\noindent@{text "class ord extends eq where"} \\
- \hspace*{2ex}@{text "less_eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} \\
- \hspace*{2ex}@{text "less \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"}
+ \hspace*{2ex}@{text "less_eq :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} \\
+ \hspace*{2ex}@{text "less :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"}
\end{quote}
@@ -57,7 +57,7 @@
\begin{quote}
\noindent@{text "class eq where"} \\
- \hspace*{2ex}@{text "eq \<Colon> \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} \\
+ \hspace*{2ex}@{text "eq :: \<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool"} \\
@{text "satisfying"} \\
\hspace*{2ex}@{text "refl: eq x x"} \\
\hspace*{2ex}@{text "sym: eq x y \<longleftrightarrow> eq x y"} \\
@@ -111,9 +111,9 @@
"fixes"}), the \qn{logical} part specifies properties on them
(@{element "assumes"}). The local @{element "fixes"} and @{element
"assumes"} are lifted to the theory toplevel, yielding the global
- parameter @{term [source] "mult \<Colon> \<alpha>\<Colon>semigroup \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>"} and the
- global theorem @{fact "semigroup.assoc:"}~@{prop [source] "\<And>x y z \<Colon>
- \<alpha>\<Colon>semigroup. (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"}.
+ parameter @{term [source] "mult :: \<alpha>::semigroup \<Rightarrow> \<alpha> \<Rightarrow> \<alpha>"} and the
+ global theorem @{fact "semigroup.assoc:"}~@{prop [source] "\<And>x y z ::
+ \<alpha>::semigroup. (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"}.
*}
@@ -130,7 +130,7 @@
begin
definition %quote
- mult_int_def: "i \<otimes> j = i + (j\<Colon>int)"
+ mult_int_def: "i \<otimes> j = i + (j::int)"
instance %quote proof
fix i j k :: int have "(i + j) + k = i + (j + k)" by simp
@@ -163,7 +163,7 @@
begin
primrec %quote mult_nat where
- "(0\<Colon>nat) \<otimes> n = n"
+ "(0::nat) \<otimes> n = n"
| "Suc m \<otimes> n = Suc (m \<otimes> n)"
instance %quote proof
@@ -197,7 +197,7 @@
mult_prod_def: "p\<^sub>1 \<otimes> p\<^sub>2 = (fst p\<^sub>1 \<otimes> fst p\<^sub>2, snd p\<^sub>1 \<otimes> snd p\<^sub>2)"
instance %quote proof
- fix p\<^sub>1 p\<^sub>2 p\<^sub>3 :: "\<alpha>\<Colon>semigroup \<times> \<beta>\<Colon>semigroup"
+ fix p\<^sub>1 p\<^sub>2 p\<^sub>3 :: "\<alpha>::semigroup \<times> \<beta>::semigroup"
show "p\<^sub>1 \<otimes> p\<^sub>2 \<otimes> p\<^sub>3 = p\<^sub>1 \<otimes> (p\<^sub>2 \<otimes> p\<^sub>3)"
unfolding mult_prod_def by (simp add: assoc)
qed
@@ -237,10 +237,10 @@
begin
definition %quote
- neutral_nat_def: "\<one> = (0\<Colon>nat)"
+ neutral_nat_def: "\<one> = (0::nat)"
definition %quote
- neutral_int_def: "\<one> = (0\<Colon>int)"
+ neutral_int_def: "\<one> = (0::int)"
instance %quote proof
fix n :: nat
@@ -261,7 +261,7 @@
neutral_prod_def: "\<one> = (\<one>, \<one>)"
instance %quote proof
- fix p :: "\<alpha>\<Colon>monoidl \<times> \<beta>\<Colon>monoidl"
+ fix p :: "\<alpha>::monoidl \<times> \<beta>::monoidl"
show "\<one> \<otimes> p = p"
unfolding neutral_prod_def mult_prod_def by (simp add: neutl)
qed
@@ -295,7 +295,7 @@
begin
instance %quote proof
- fix p :: "\<alpha>\<Colon>monoid \<times> \<beta>\<Colon>monoid"
+ fix p :: "\<alpha>::monoid \<times> \<beta>::monoid"
show "p \<otimes> \<one> = p"
unfolding neutral_prod_def mult_prod_def by (simp add: neutr)
qed
@@ -315,7 +315,7 @@
begin
definition %quote
- inverse_int_def: "i\<div> = - (i\<Colon>int)"
+ inverse_int_def: "i\<div> = - (i::int)"
instance %quote proof
fix i :: int
@@ -361,7 +361,7 @@
*}
interpretation %quote idem_class:
- idem "f \<Colon> (\<alpha>\<Colon>idem) \<Rightarrow> \<alpha>"
+ idem "f :: (\<alpha>::idem) \<Rightarrow> \<alpha>"
(*<*)sorry(*>*)
text {*
@@ -394,10 +394,10 @@
\noindent Here the \qt{@{keyword "in"} @{class group}} target
specification indicates that the result is recorded within that
context for later use. This local theorem is also lifted to the
- global one @{fact "group.left_cancel:"} @{prop [source] "\<And>x y z \<Colon>
- \<alpha>\<Colon>group. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y = z"}. Since type @{text "int"} has been
+ global one @{fact "group.left_cancel:"} @{prop [source] "\<And>x y z ::
+ \<alpha>::group. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y = z"}. Since type @{text "int"} has been
made an instance of @{text "group"} before, we may refer to that
- fact as well: @{prop [source] "\<And>x y z \<Colon> int. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y =
+ fact as well: @{prop [source] "\<And>x y z :: int. x \<otimes> y = x \<otimes> z \<longleftrightarrow> y =
z"}.
*}
@@ -415,7 +415,7 @@
text {*
\noindent If the locale @{text group} is also a class, this local
definition is propagated onto a global definition of @{term [source]
- "pow_nat \<Colon> nat \<Rightarrow> \<alpha>\<Colon>monoid \<Rightarrow> \<alpha>\<Colon>monoid"} with corresponding theorems
+ "pow_nat :: nat \<Rightarrow> \<alpha>::monoid \<Rightarrow> \<alpha>::monoid"} with corresponding theorems
@{thm pow_nat.simps [no_vars]}.
@@ -542,8 +542,8 @@
else (pow_nat (nat (- k)) x)\<div>)"
text {*
- \noindent yields the global definition of @{term [source] "pow_int \<Colon>
- int \<Rightarrow> \<alpha>\<Colon>group \<Rightarrow> \<alpha>\<Colon>group"} with the corresponding theorem @{thm
+ \noindent yields the global definition of @{term [source] "pow_int ::
+ int \<Rightarrow> \<alpha>::group \<Rightarrow> \<alpha>::group"} with the corresponding theorem @{thm
pow_int_def [no_vars]}.
*}
@@ -559,7 +559,7 @@
begin
term %quote "x \<otimes> y" -- {* example 1 *}
-term %quote "(x\<Colon>nat) \<otimes> y" -- {* example 2 *}
+term %quote "(x::nat) \<otimes> y" -- {* example 2 *}
end %quote
@@ -570,7 +570,7 @@
operation @{text "mult [\<alpha>]"}, whereas in example 2 the type
constraint enforces the global class operation @{text "mult [nat]"}.
In the global context in example 3, the reference is to the
- polymorphic global class operation @{text "mult [?\<alpha> \<Colon> semigroup]"}.
+ polymorphic global class operation @{text "mult [?\<alpha> :: semigroup]"}.
*}
section {* Further issues *}
--- a/src/Doc/Classes/Setup.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Classes/Setup.thy Thu Sep 03 15:50:40 2015 +0200
@@ -9,9 +9,9 @@
syntax
"_alpha" :: "type" ("\<alpha>")
- "_alpha_ofsort" :: "sort \<Rightarrow> type" ("\<alpha>()\<Colon>_" [0] 1000)
+ "_alpha_ofsort" :: "sort \<Rightarrow> type" ("\<alpha>()::_" [0] 1000)
"_beta" :: "type" ("\<beta>")
- "_beta_ofsort" :: "sort \<Rightarrow> type" ("\<beta>()\<Colon>_" [0] 1000)
+ "_beta_ofsort" :: "sort \<Rightarrow> type" ("\<beta>()::_" [0] 1000)
parse_ast_translation {*
let
--- a/src/Doc/Codegen/Adaptation.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Codegen/Adaptation.thy Thu Sep 03 15:50:40 2015 +0200
@@ -174,12 +174,12 @@
\item[@{text "Code_Binary_Nat"}] implements type
@{typ nat} using a binary rather than a linear representation,
which yields a considerable speedup for computations.
- Pattern matching with @{term "0\<Colon>nat"} / @{const "Suc"} is eliminated
+ Pattern matching with @{term "0::nat"} / @{const "Suc"} is eliminated
by a preprocessor.\label{abstract_nat}
\item[@{text "Code_Target_Nat"}] implements type @{typ nat}
by @{typ integer} and thus by target-language built-in integers.
- Pattern matching with @{term "0\<Colon>nat"} / @{const "Suc"} is eliminated
+ Pattern matching with @{term "0::nat"} / @{const "Suc"} is eliminated
by a preprocessor.
\item[@{text "Code_Target_Numeral"}] is a convenience theory
@@ -344,7 +344,7 @@
instantiation %quote bar :: equal
begin
-definition %quote "HOL.equal (x\<Colon>bar) y \<longleftrightarrow> x = y"
+definition %quote "HOL.equal (x::bar) y \<longleftrightarrow> x = y"
instance %quote by default (simp add: equal_bar_def)
--- a/src/Doc/Codegen/Foundations.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Codegen/Foundations.thy Thu Sep 03 15:50:40 2015 +0200
@@ -144,7 +144,7 @@
\emph{Function transformers} provide a very general
interface, transforming a list of function theorems to another list
of function theorems, provided that neither the heading constant nor
- its type change. The @{term "0\<Colon>nat"} / @{const Suc} pattern
+ its type change. The @{term "0::nat"} / @{const Suc} pattern
used in theory @{text Code_Abstract_Nat} (see \secref{abstract_nat})
uses this interface.
--- a/src/Doc/Codegen/Introduction.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Codegen/Introduction.thy Thu Sep 03 15:50:40 2015 +0200
@@ -127,7 +127,7 @@
begin
primrec %quote mult_nat where
- "0 \<otimes> n = (0\<Colon>nat)"
+ "0 \<otimes> n = (0::nat)"
| "Suc m \<otimes> n = n + m \<otimes> n"
definition %quote neutral_nat where
--- a/src/Doc/Datatypes/Datatypes.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Datatypes/Datatypes.thy Thu Sep 03 15:50:40 2015 +0200
@@ -192,8 +192,8 @@
text {*
\noindent
-The constructors are @{text "None \<Colon> 'a option"} and
-@{text "Some \<Colon> 'a \<Rightarrow> 'a option"}.
+The constructors are @{text "None :: 'a option"} and
+@{text "Some :: 'a \<Rightarrow> 'a option"}.
The next example has three type parameters:
*}
@@ -203,7 +203,7 @@
text {*
\noindent
The constructor is
-@{text "Triple \<Colon> 'a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> ('a, 'b, 'c) triple"}.
+@{text "Triple :: 'a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> ('a, 'b, 'c) triple"}.
Unlike in Standard ML, curried constructors are supported. The uncurried variant
is also possible:
*}
@@ -381,21 +381,21 @@
\begin{tabular}{@ {}ll@ {}}
Constructors: &
- @{text "Nil \<Colon> 'a list"} \\
+ @{text "Nil :: 'a list"} \\
&
- @{text "Cons \<Colon> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list"} \\
+ @{text "Cons :: 'a \<Rightarrow> 'a list \<Rightarrow> 'a list"} \\
Discriminator: &
- @{text "null \<Colon> 'a list \<Rightarrow> bool"} \\
+ @{text "null :: 'a list \<Rightarrow> bool"} \\
Selectors: &
- @{text "hd \<Colon> 'a list \<Rightarrow> 'a"} \\
+ @{text "hd :: 'a list \<Rightarrow> 'a"} \\
&
- @{text "tl \<Colon> 'a list \<Rightarrow> 'a list"} \\
+ @{text "tl :: 'a list \<Rightarrow> 'a list"} \\
Set function: &
- @{text "set \<Colon> 'a list \<Rightarrow> 'a set"} \\
+ @{text "set :: 'a list \<Rightarrow> 'a set"} \\
Map function: &
- @{text "map \<Colon> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list"} \\
+ @{text "map :: ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list"} \\
Relator: &
- @{text "list_all2 \<Colon> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> bool"}
+ @{text "list_all2 :: ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> bool"}
\end{tabular}
\medskip
@@ -1327,7 +1327,7 @@
map function @{const map_option}:
*}
- primrec (*<*)(in early) (*>*)sum_btree :: "('a\<Colon>{zero,plus}) btree \<Rightarrow> 'a" where
+ primrec (*<*)(in early) (*>*)sum_btree :: "('a::{zero,plus}) btree \<Rightarrow> 'a" where
"sum_btree (BNode a lt rt) =
a + the_default 0 (map_option sum_btree lt) +
the_default 0 (map_option sum_btree rt)"
@@ -1427,7 +1427,7 @@
*}
primrec
- sum_btree :: "('a\<Colon>{zero,plus}) btree \<Rightarrow> 'a" and
+ sum_btree :: "('a::{zero,plus}) btree \<Rightarrow> 'a" and
sum_btree_option :: "'a btree option \<Rightarrow> 'a"
where
"sum_btree (BNode a lt rt) =
@@ -1590,7 +1590,7 @@
\setlength{\itemsep}{0pt}
\item
-Introduce a fully unspecified constant @{text "un_D\<^sub>0 \<Colon> 'a"} using
+Introduce a fully unspecified constant @{text "un_D\<^sub>0 :: 'a"} using
@{command consts}.
\item
@@ -1627,7 +1627,7 @@
text {* \blankline *}
overloading
- termi\<^sub>0 \<equiv> "termi\<^sub>0 \<Colon> ('a, 'b) tlist \<Rightarrow> 'b"
+ termi\<^sub>0 \<equiv> "termi\<^sub>0 :: ('a, 'b) tlist \<Rightarrow> 'b"
begin
primrec termi\<^sub>0 :: "('a, 'b) tlist \<Rightarrow> 'b" where
"termi\<^sub>0 (TNil y) = y" |
@@ -2322,12 +2322,12 @@
text {*
\noindent
Since there is no sequentiality, we can apply the equation for @{const Choice}
-without having first to discharge @{term "n mod (4\<Colon>int) \<noteq> 0"},
-@{term "n mod (4\<Colon>int) \<noteq> 1"}, and
-@{term "n mod (4\<Colon>int) \<noteq> 2"}.
+without having first to discharge @{term "n mod (4::int) \<noteq> 0"},
+@{term "n mod (4::int) \<noteq> 1"}, and
+@{term "n mod (4::int) \<noteq> 2"}.
The price to pay for this elegance is that we must discharge exclusiveness proof
obligations, one for each pair of conditions
-@{term "(n mod (4\<Colon>int) = i, n mod (4\<Colon>int) = j)"}
+@{term "(n mod (4::int) = i, n mod (4::int) = j)"}
with @{term "i < j"}. If we prefer not to discharge any obligations, we can
enable the @{text "sequential"} option. This pushes the problem to the users of
the generated properties.
@@ -2649,7 +2649,7 @@
(functorial action), $n$ set functions (natural transformations),
and an infinite cardinal bound that satisfy certain properties.
For example, @{typ "'a llist"} is a unary BNF.
-Its relator @{text "llist_all2 \<Colon>
+Its relator @{text "llist_all2 ::
('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow>
'a llist \<Rightarrow> 'b llist \<Rightarrow> bool"}
extends binary predicates over elements to binary predicates over parallel
@@ -2680,7 +2680,7 @@
set function, and relator.
*}
- typedef ('d, 'a) fn = "UNIV \<Colon> ('d \<Rightarrow> 'a) set"
+ typedef ('d, 'a) fn = "UNIV :: ('d \<Rightarrow> 'a) set"
by simp
text {* \blankline *}
@@ -2723,22 +2723,22 @@
show "set_fn \<circ> map_fn f = op ` f \<circ> set_fn"
by transfer (auto simp add: comp_def)
next
- show "card_order (natLeq +c |UNIV \<Colon> 'd set| )"
+ show "card_order (natLeq +c |UNIV :: 'd set| )"
apply (rule card_order_csum)
apply (rule natLeq_card_order)
by (rule card_of_card_order_on)
next
- show "cinfinite (natLeq +c |UNIV \<Colon> 'd set| )"
+ show "cinfinite (natLeq +c |UNIV :: 'd set| )"
apply (rule cinfinite_csum)
apply (rule disjI1)
by (rule natLeq_cinfinite)
next
fix F :: "('d, 'a) fn"
- have "|set_fn F| \<le>o |UNIV \<Colon> 'd set|" (is "_ \<le>o ?U")
+ have "|set_fn F| \<le>o |UNIV :: 'd set|" (is "_ \<le>o ?U")
by transfer (rule card_of_image)
also have "?U \<le>o natLeq +c ?U"
by (rule ordLeq_csum2) (rule card_of_Card_order)
- finally show "|set_fn F| \<le>o natLeq +c |UNIV \<Colon> 'd set|" .
+ finally show "|set_fn F| \<le>o natLeq +c |UNIV :: 'd set|" .
next
fix R :: "'a \<Rightarrow> 'b \<Rightarrow> bool" and S :: "'b \<Rightarrow> 'c \<Rightarrow> bool"
show "rel_fn R OO rel_fn S \<le> rel_fn (R OO S)"
@@ -3122,7 +3122,7 @@
text {*
For each datatype, the \hthm{size} plugin generates a generic size
function @{text "t.size_t"} as well as a specific instance
-@{text "size \<Colon> t \<Rightarrow> nat"} belonging to the @{text size} type
+@{text "size :: t \<Rightarrow> nat"} belonging to the @{text size} type
class. The \keyw{fun} command relies on @{const size} to prove termination of
recursive functions on datatypes.
--- a/src/Doc/Implementation/Logic.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Implementation/Logic.thy Thu Sep 03 15:50:40 2015 +0200
@@ -643,7 +643,7 @@
@{index_ML Thm.cterm_of: "Proof.context -> term -> cterm"} \\
@{index_ML Thm.apply: "cterm -> cterm -> cterm"} \\
@{index_ML Thm.lambda: "cterm -> cterm -> cterm"} \\
- @{index_ML Thm.all: "cterm -> cterm -> cterm"} \\
+ @{index_ML Thm.all: "Proof.context -> cterm -> cterm -> cterm"} \\
@{index_ML Drule.mk_implies: "cterm * cterm -> cterm"} \\
\end{mldecls}
\begin{mldecls}
--- a/src/Doc/Implementation/Prelim.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Implementation/Prelim.thy Thu Sep 03 15:50:40 2015 +0200
@@ -80,13 +80,9 @@
ancestor theories. To this end, the system maintains a set of
symbolic ``identification stamps'' within each theory.
- The @{text "merge"} operation produces the least upper bound of two
- theories, which actually degenerates into absorption of one theory
- into the other (according to the nominal sub-theory relation).
-
- The @{text "begin"} operation starts a new theory by importing
- several parent theories and entering a special mode of nameless
- incremental updates, until the final @{text "end"} operation is
+ The @{text "begin"} operation starts a new theory by importing several
+ parent theories (with merged contents) and entering a special mode of
+ nameless incremental updates, until the final @{text "end"} operation is
performed.
\medskip The example in \figref{fig:ex-theory} below shows a theory
@@ -121,9 +117,8 @@
text %mlref \<open>
\begin{mldecls}
@{index_ML_type theory} \\
- @{index_ML Theory.eq_thy: "theory * theory -> bool"} \\
- @{index_ML Theory.subthy: "theory * theory -> bool"} \\
- @{index_ML Theory.merge: "theory * theory -> theory"} \\
+ @{index_ML Context.eq_thy: "theory * theory -> bool"} \\
+ @{index_ML Context.subthy: "theory * theory -> bool"} \\
@{index_ML Theory.begin_theory: "string * Position.T -> theory list -> theory"} \\
@{index_ML Theory.parents_of: "theory -> theory list"} \\
@{index_ML Theory.ancestors_of: "theory -> theory list"} \\
@@ -133,19 +128,15 @@
\item Type @{ML_type theory} represents theory contexts.
- \item @{ML "Theory.eq_thy"}~@{text "(thy\<^sub>1, thy\<^sub>2)"} check strict
+ \item @{ML "Context.eq_thy"}~@{text "(thy\<^sub>1, thy\<^sub>2)"} check strict
identity of two theories.
- \item @{ML "Theory.subthy"}~@{text "(thy\<^sub>1, thy\<^sub>2)"} compares theories
+ \item @{ML "Context.subthy"}~@{text "(thy\<^sub>1, thy\<^sub>2)"} compares theories
according to the intrinsic graph structure of the construction.
This sub-theory relation is a nominal approximation of inclusion
(@{text "\<subseteq>"}) of the corresponding content (according to the
semantics of the ML modules that implement the data).
- \item @{ML "Theory.merge"}~@{text "(thy\<^sub>1, thy\<^sub>2)"} absorbs one theory
- into the other. This version of ad-hoc theory merge fails for
- unrelated theories!
-
\item @{ML "Theory.begin_theory"}~@{text "name parents"} constructs
a new theory based on the given parents. This ML function is
normally not invoked directly.
--- a/src/Doc/Prog_Prove/Isar.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Prog_Prove/Isar.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1068,7 +1068,7 @@
The form of the @{text IH} shows us that internally the lemma was expanded as explained
above: \noquotes{@{prop[source]"ev x \<Longrightarrow> x = Suc m \<Longrightarrow> \<not> ev m"}}.
\item
-The goal @{prop"\<not> ev (Suc n)"} may suprise. The expanded version of the lemma
+The goal @{prop"\<not> ev (Suc n)"} may surprise. The expanded version of the lemma
would suggest that we have a \isacom{fix} @{text m} \isacom{assume} @{prop"Suc(Suc n) = Suc m"}
and need to show @{prop"\<not> ev m"}. What happened is that Isabelle immediately
simplified @{prop"Suc(Suc n) = Suc m"} to @{prop"Suc n = m"} and could then eliminate
@@ -1104,7 +1104,7 @@
\begin{exercise}
Give a structured proof of @{prop "\<not> ev(Suc(Suc(Suc 0)))"}
by rule inversions. If there are no cases to be proved you can close
-a proof immediateley with \isacom{qed}.
+a proof immediately with \isacom{qed}.
\end{exercise}
\begin{exercise}
@@ -1118,6 +1118,17 @@
Define a recursive function @{text "elems ::"} @{typ"'a list \<Rightarrow> 'a set"}
and prove @{prop "x : elems xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> elems ys"}.
\end{exercise}
+
+\begin{exercise}
+Extend Exercise~\ref{exe:cfg} with a function that checks if some
+\mbox{@{text "alpha list"}} is a balanced
+string of parentheses. More precisely, define a \mbox{recursive} function
+@{text "balanced :: nat \<Rightarrow> alpha list \<Rightarrow> bool"} such that @{term"balanced n w"}
+is true iff (informally) @{text"S (a\<^sup>n @ w)"}. Formally, prove that
+@{prop "balanced n w \<longleftrightarrow> S (replicate n a @ w)"} where
+@{const replicate} @{text"::"} @{typ"nat \<Rightarrow> 'a \<Rightarrow> 'a list"} is predefined
+and @{term"replicate n x"} yields the list @{text"[x, \<dots>, x]"} of length @{text n}.
+\end{exercise}
*}
(*<*)
--- a/src/Doc/Prog_Prove/Logic.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Prog_Prove/Logic.thy Thu Sep 03 15:50:40 2015 +0200
@@ -826,7 +826,7 @@
@{prop"star r x y \<Longrightarrow> iter r n x y"}.
\end{exercise}
-\begin{exercise}
+\begin{exercise}\label{exe:cfg}
A context-free grammar can be seen as an inductive definition where each
nonterminal $A$ is an inductively defined predicate on lists of terminal
symbols: $A(w)$ means that $w$ is in the language generated by $A$.
--- a/src/Doc/Sledgehammer/document/root.tex Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Sledgehammer/document/root.tex Thu Sep 03 15:50:40 2015 +0200
@@ -370,7 +370,7 @@
Sledgehammer heuristically selects a few hundred relevant lemmas from the
currently loaded libraries. The component that performs this selection is
-called \emph{relevance filter}.
+called \emph{relevance filter} (\S\ref{relevance-filter}).
\begin{enum}
\item[\labelitemi]
@@ -390,13 +390,10 @@
\underline{S}ledge\underline{h}ammer). It applies machine learning to the
problem of finding relevant facts.
-\item[\labelitemi] The \emph{MeSh} filter combines MePo and MaSh.
+\item[\labelitemi] The \emph{MeSh} filter combines MePo and MaSh. This is
+the default.
\end{enum}
-The default is either MePo or MeSh, depending on whether the environment
-variable \texttt{MASH} is set and what class of provers the target prover
-belongs to (\S\ref{relevance-filter}).
-
The number of facts included in a problem varies from prover to prover, since
some provers get overwhelmed more easily than others. You can show the number of
facts given using the \textit{verbose} option (\S\ref{output-format}) and the
@@ -1018,10 +1015,7 @@
default (cf.\ \textit{smart} below).
The default algorithm is \textit{nb\_knn}. The algorithm can be selected by
-setting \texttt{MASH}---either in the environment in which Isabelle is launched,
-in your
-\texttt{\$ISABELLE\_\allowbreak HOME\_\allowbreak USER/\allowbreak etc/\allowbreak settings}
-file, or via the ``MaSh'' option under ``Plugins > Plugin Options > Isabelle >
+setting the ``MaSh'' option under ``Plugins > Plugin Options > Isabelle >
General'' in Isabelle/jEdit. Persistent data for both algorithms is stored in
the directory \texttt{\$ISABELLE\_\allowbreak HOME\_\allowbreak USER/\allowbreak
mash}.
--- a/src/Doc/Tutorial/Types/Axioms.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Doc/Tutorial/Types/Axioms.thy Thu Sep 03 15:50:40 2015 +0200
@@ -20,13 +20,13 @@
text {* \noindent This @{command class} specification requires that
all instances of @{class semigroup} obey @{fact "assoc:"}~@{prop
-[source] "\<And>x y z \<Colon> 'a\<Colon>semigroup. (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"}.
+[source] "\<And>x y z :: 'a::semigroup. (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"}.
We can use this class axiom to derive further abstract theorems
relative to class @{class semigroup}: *}
lemma assoc_left:
- fixes x y z :: "'a\<Colon>semigroup"
+ fixes x y z :: "'a::semigroup"
shows "x \<oplus> (y \<oplus> z) = (x \<oplus> y) \<oplus> z"
using assoc by (rule sym)
@@ -63,7 +63,7 @@
begin
instance proof
- fix p\<^sub>1 p\<^sub>2 p\<^sub>3 :: "'a\<Colon>semigroup \<times> 'b\<Colon>semigroup"
+ fix p\<^sub>1 p\<^sub>2 p\<^sub>3 :: "'a::semigroup \<times> 'b::semigroup"
show "p\<^sub>1 \<oplus> p\<^sub>2 \<oplus> p\<^sub>3 = p\<^sub>1 \<oplus> (p\<^sub>2 \<oplus> p\<^sub>3)"
by (cases p\<^sub>1, cases p\<^sub>2, cases p\<^sub>3) (simp add: assoc)
@@ -96,7 +96,7 @@
begin
definition
- neutral_nat_def: "\<zero> = (0\<Colon>nat)"
+ neutral_nat_def: "\<zero> = (0::nat)"
instance proof
fix n :: nat
@@ -119,7 +119,7 @@
neutral_prod_def: "\<zero> = (\<zero>, \<zero>)"
instance proof
- fix p :: "'a\<Colon>monoidl \<times> 'b\<Colon>monoidl"
+ fix p :: "'a::monoidl \<times> 'b::monoidl"
show "\<zero> \<oplus> p = p"
by (cases p) (simp add: neutral_prod_def neutl)
qed
@@ -149,7 +149,7 @@
proofs relative to type classes: *}
lemma left_cancel:
- fixes x y z :: "'a\<Colon>group"
+ fixes x y z :: "'a::group"
shows "x \<oplus> y = x \<oplus> z \<longleftrightarrow> y = z"
proof
assume "x \<oplus> y = x \<oplus> z"
@@ -255,7 +255,7 @@
Further note that classes may contain axioms but \emph{no} operations.
An example is class @{class finite} from theory @{theory Finite_Set}
-which specifies a type to be finite: @{lemma [source] "finite (UNIV \<Colon> 'a\<Colon>finite
+which specifies a type to be finite: @{lemma [source] "finite (UNIV :: 'a::finite
set)" by (fact finite_UNIV)}. *}
(*<*)end(*>*)
--- a/src/HOL/Archimedean_Field.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Archimedean_Field.thy Thu Sep 03 15:50:40 2015 +0200
@@ -546,14 +546,14 @@
lemma frac_lt_1: "frac x < 1"
by (simp add: frac_def) linarith
-lemma frac_eq_0_iff [simp]: "frac x = 0 \<longleftrightarrow> x \<in> Ints"
+lemma frac_eq_0_iff [simp]: "frac x = 0 \<longleftrightarrow> x \<in> \<int>"
by (simp add: frac_def) (metis Ints_cases Ints_of_int floor_of_int )
lemma frac_ge_0 [simp]: "frac x \<ge> 0"
unfolding frac_def
by linarith
-lemma frac_gt_0_iff [simp]: "frac x > 0 \<longleftrightarrow> x \<notin> Ints"
+lemma frac_gt_0_iff [simp]: "frac x > 0 \<longleftrightarrow> x \<notin> \<int>"
by (metis frac_eq_0_iff frac_ge_0 le_less less_irrefl)
lemma frac_of_int [simp]: "frac (of_int z) = 0"
@@ -582,7 +582,7 @@
lemma frac_unique_iff:
fixes x :: "'a::floor_ceiling"
- shows "(frac x) = a \<longleftrightarrow> x - a \<in> Ints \<and> 0 \<le> a \<and> a < 1"
+ shows "(frac x) = a \<longleftrightarrow> x - a \<in> \<int> \<and> 0 \<le> a \<and> a < 1"
apply (auto simp: Ints_def frac_def)
apply linarith
apply linarith
@@ -593,7 +593,7 @@
lemma frac_neg:
fixes x :: "'a::floor_ceiling"
- shows "frac (-x) = (if x \<in> Ints then 0 else 1 - frac x)"
+ shows "frac (-x) = (if x \<in> \<int> then 0 else 1 - frac x)"
apply (auto simp add: frac_unique_iff)
apply (simp add: frac_def)
by (meson frac_lt_1 less_iff_diff_less_0 not_le not_less_iff_gr_or_eq)
--- a/src/HOL/BNF_Composition.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/BNF_Composition.thy Thu Sep 03 15:50:40 2015 +0200
@@ -82,7 +82,7 @@
"\<lbrakk>A' = A; B1' = B1; B2' = B2; wpull A B1 B2 f1 f2 p1 p2\<rbrakk> \<Longrightarrow> wpull A' B1' B2' f1 f2 p1 p2"
by simp
-lemma Grp_fst_snd: "(Grp (Collect (split R)) fst)^--1 OO Grp (Collect (split R)) snd = R"
+lemma Grp_fst_snd: "(Grp (Collect (case_prod R)) fst)^--1 OO Grp (Collect (case_prod R)) snd = R"
unfolding Grp_def fun_eq_iff relcompp.simps by auto
lemma OO_Grp_cong: "A = B \<Longrightarrow> (Grp A f)^--1 OO Grp A g = (Grp B f)^--1 OO Grp B g"
--- a/src/HOL/BNF_Def.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/BNF_Def.thy Thu Sep 03 15:50:40 2015 +0200
@@ -15,7 +15,7 @@
"bnf" :: thy_goal
begin
-lemma Collect_splitD: "x \<in> Collect (split A) \<Longrightarrow> A (fst x) (snd x)"
+lemma Collect_splitD: "x \<in> Collect (case_prod A) \<Longrightarrow> A (fst x) (snd x)"
by auto
inductive
@@ -98,7 +98,7 @@
unfolding convol_def by simp
lemma convol_mem_GrpI:
- "x \<in> A \<Longrightarrow> \<langle>id, g\<rangle> x \<in> (Collect (split (Grp A g)))"
+ "x \<in> A \<Longrightarrow> \<langle>id, g\<rangle> x \<in> (Collect (case_prod (Grp A g)))"
unfolding convol_def Grp_def by auto
definition csquare where
@@ -131,10 +131,10 @@
lemma GrpE: "Grp A f x y \<Longrightarrow> (\<lbrakk>f x = y; x \<in> A\<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R"
unfolding Grp_def by auto
-lemma Collect_split_Grp_eqD: "z \<in> Collect (split (Grp A f)) \<Longrightarrow> (f \<circ> fst) z = snd z"
+lemma Collect_split_Grp_eqD: "z \<in> Collect (case_prod (Grp A f)) \<Longrightarrow> (f \<circ> fst) z = snd z"
unfolding Grp_def comp_def by auto
-lemma Collect_split_Grp_inD: "z \<in> Collect (split (Grp A f)) \<Longrightarrow> fst z \<in> A"
+lemma Collect_split_Grp_inD: "z \<in> Collect (case_prod (Grp A f)) \<Longrightarrow> fst z \<in> A"
unfolding Grp_def comp_def by auto
definition "pick_middlep P Q a c = (SOME b. P a b \<and> Q b c)"
@@ -149,7 +149,7 @@
definition sndOp where
"sndOp P Q ac = (pick_middlep P Q (fst ac) (snd ac), (snd ac))"
-lemma fstOp_in: "ac \<in> Collect (split (P OO Q)) \<Longrightarrow> fstOp P Q ac \<in> Collect (split P)"
+lemma fstOp_in: "ac \<in> Collect (case_prod (P OO Q)) \<Longrightarrow> fstOp P Q ac \<in> Collect (case_prod P)"
unfolding fstOp_def mem_Collect_eq
by (subst (asm) surjective_pairing, unfold prod.case) (erule pick_middlep[THEN conjunct1])
@@ -159,7 +159,7 @@
lemma snd_sndOp: "snd bc = (snd \<circ> sndOp P Q) bc"
unfolding comp_def sndOp_def by simp
-lemma sndOp_in: "ac \<in> Collect (split (P OO Q)) \<Longrightarrow> sndOp P Q ac \<in> Collect (split Q)"
+lemma sndOp_in: "ac \<in> Collect (case_prod (P OO Q)) \<Longrightarrow> sndOp P Q ac \<in> Collect (case_prod Q)"
unfolding sndOp_def mem_Collect_eq
by (subst (asm) surjective_pairing, unfold prod.case) (erule pick_middlep[THEN conjunct2])
@@ -173,15 +173,15 @@
lemma fst_snd_flip: "fst xy = (snd \<circ> (%(x, y). (y, x))) xy"
by (simp split: prod.split)
-lemma flip_pred: "A \<subseteq> Collect (split (R ^--1)) \<Longrightarrow> (%(x, y). (y, x)) ` A \<subseteq> Collect (split R)"
+lemma flip_pred: "A \<subseteq> Collect (case_prod (R ^--1)) \<Longrightarrow> (%(x, y). (y, x)) ` A \<subseteq> Collect (case_prod R)"
by auto
-lemma Collect_split_mono: "A \<le> B \<Longrightarrow> Collect (split A) \<subseteq> Collect (split B)"
+lemma Collect_split_mono: "A \<le> B \<Longrightarrow> Collect (case_prod A) \<subseteq> Collect (case_prod B)"
by auto
lemma Collect_split_mono_strong:
- "\<lbrakk>X = fst ` A; Y = snd ` A; \<forall>a\<in>X. \<forall>b \<in> Y. P a b \<longrightarrow> Q a b; A \<subseteq> Collect (split P)\<rbrakk> \<Longrightarrow>
- A \<subseteq> Collect (split Q)"
+ "\<lbrakk>X = fst ` A; Y = snd ` A; \<forall>a\<in>X. \<forall>b \<in> Y. P a b \<longrightarrow> Q a b; A \<subseteq> Collect (case_prod P)\<rbrakk> \<Longrightarrow>
+ A \<subseteq> Collect (case_prod Q)"
by fastforce
@@ -216,7 +216,7 @@
lemma rel_fun_iff_leq_vimage2p: "(rel_fun R S) f g = (R \<le> vimage2p f g S)"
unfolding rel_fun_def vimage2p_def by auto
-lemma convol_image_vimage2p: "\<langle>f \<circ> fst, g \<circ> snd\<rangle> ` Collect (split (vimage2p f g R)) \<subseteq> Collect (split R)"
+lemma convol_image_vimage2p: "\<langle>f \<circ> fst, g \<circ> snd\<rangle> ` Collect (case_prod (vimage2p f g R)) \<subseteq> Collect (case_prod R)"
unfolding vimage2p_def convol_def by auto
lemma vimage2p_Grp: "vimage2p f g P = Grp UNIV f OO P OO (Grp UNIV g)\<inverse>\<inverse>"
--- a/src/HOL/BNF_Greatest_Fixpoint.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/BNF_Greatest_Fixpoint.thy Thu Sep 03 15:50:40 2015 +0200
@@ -82,13 +82,13 @@
lemma subset_CollectI: "B \<subseteq> A \<Longrightarrow> (\<And>x. x \<in> B \<Longrightarrow> Q x \<Longrightarrow> P x) \<Longrightarrow> ({x \<in> B. Q x} \<subseteq> {x \<in> A. P x})"
by blast
-lemma in_rel_Collect_split_eq: "in_rel (Collect (split X)) = X"
+lemma in_rel_Collect_split_eq: "in_rel (Collect (case_prod X)) = X"
unfolding fun_eq_iff by auto
-lemma Collect_split_in_rel_leI: "X \<subseteq> Y \<Longrightarrow> X \<subseteq> Collect (split (in_rel Y))"
+lemma Collect_split_in_rel_leI: "X \<subseteq> Y \<Longrightarrow> X \<subseteq> Collect (case_prod (in_rel Y))"
by auto
-lemma Collect_split_in_rel_leE: "X \<subseteq> Collect (split (in_rel Y)) \<Longrightarrow> (X \<subseteq> Y \<Longrightarrow> R) \<Longrightarrow> R"
+lemma Collect_split_in_rel_leE: "X \<subseteq> Collect (case_prod (in_rel Y)) \<Longrightarrow> (X \<subseteq> Y \<Longrightarrow> R) \<Longrightarrow> R"
by force
lemma conversep_in_rel: "(in_rel R)\<inverse>\<inverse> = in_rel (R\<inverse>)"
--- a/src/HOL/Bali/AxCompl.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Bali/AxCompl.thy Thu Sep 03 15:50:40 2015 +0200
@@ -859,7 +859,7 @@
assumes wf: "wf_prog G"
and mgf_c1: "G,A\<turnstile>{=:n} \<langle>c1\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
and mgf_c2: "G,A\<turnstile>{=:n} \<langle>c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
- shows "G,(A\<Colon>state triple set)\<turnstile>{=:n} \<langle>c1 Finally c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
+ shows "G,(A::state triple set)\<turnstile>{=:n} \<langle>c1 Finally c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
proof (rule MGFn_free_wt_da_NormalConformI [rule_format],clarsimp)
fix T L accC C
assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>In1r (c1 Finally c2)\<Colon>T"
@@ -956,7 +956,7 @@
assumes wf: "wf_prog G"
and mgf_init: "G,A\<turnstile>{=:n} \<langle>Init D\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
and mgf_c: "G,A\<turnstile>{=:n} \<langle>c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
- shows "G,(A\<Colon>state triple set)\<turnstile>{=:n} \<langle>Body D c\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
+ shows "G,(A::state triple set)\<turnstile>{=:n} \<langle>Body D c\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
proof (rule MGFn_free_wt_da_NormalConformI [rule_format],clarsimp)
fix T L accC E
assume wt: "\<lparr>prg=G, cls=accC,lcl=L\<rparr>\<turnstile>\<langle>Body D c\<rangle>\<^sub>e\<Colon>T"
--- a/src/HOL/Bali/Table.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Bali/Table.thy Thu Sep 03 15:50:40 2015 +0200
@@ -361,7 +361,7 @@
(*###TO Map?*)
-primrec atleast_free :: "('a ~=> 'b) => nat => bool"
+primrec atleast_free :: "('a \<rightharpoonup> 'b) => nat => bool"
where
"atleast_free m 0 = True"
| atleast_free_Suc: "atleast_free m (Suc n) = (\<exists>a. m a = None & (!b. atleast_free (m(a|->b)) n))"
--- a/src/HOL/Basic_BNF_LFPs.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Basic_BNF_LFPs.thy Thu Sep 03 15:50:40 2015 +0200
@@ -94,7 +94,7 @@
ML_file "~~/src/HOL/Tools/Old_Datatype/old_size.ML"
-lemma size_bool[code]: "size (b\<Colon>bool) = 0"
+lemma size_bool[code]: "size (b::bool) = 0"
by (cases b) auto
declare prod.size[no_atp]
--- a/src/HOL/Basic_BNFs.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Basic_BNFs.thy Thu Sep 03 15:50:40 2015 +0200
@@ -83,8 +83,8 @@
next
fix R S
show "rel_sum R S =
- (Grp {x. setl x \<subseteq> Collect (split R) \<and> setr x \<subseteq> Collect (split S)} (map_sum fst fst))\<inverse>\<inverse> OO
- Grp {x. setl x \<subseteq> Collect (split R) \<and> setr x \<subseteq> Collect (split S)} (map_sum snd snd)"
+ (Grp {x. setl x \<subseteq> Collect (case_prod R) \<and> setr x \<subseteq> Collect (case_prod S)} (map_sum fst fst))\<inverse>\<inverse> OO
+ Grp {x. setl x \<subseteq> Collect (case_prod R) \<and> setr x \<subseteq> Collect (case_prod S)} (map_sum snd snd)"
unfolding sum_set_defs Grp_def relcompp.simps conversep.simps fun_eq_iff
by (fastforce elim: rel_sum.cases split: sum.splits)
qed (auto simp: sum_set_defs)
@@ -153,8 +153,8 @@
next
fix R S
show "rel_prod R S =
- (Grp {x. {fst x} \<subseteq> Collect (split R) \<and> {snd x} \<subseteq> Collect (split S)} (map_prod fst fst))\<inverse>\<inverse> OO
- Grp {x. {fst x} \<subseteq> Collect (split R) \<and> {snd x} \<subseteq> Collect (split S)} (map_prod snd snd)"
+ (Grp {x. {fst x} \<subseteq> Collect (case_prod R) \<and> {snd x} \<subseteq> Collect (case_prod S)} (map_prod fst fst))\<inverse>\<inverse> OO
+ Grp {x. {fst x} \<subseteq> Collect (case_prod R) \<and> {snd x} \<subseteq> Collect (case_prod S)} (map_prod snd snd)"
unfolding prod_set_defs rel_prod_apply Grp_def relcompp.simps conversep.simps fun_eq_iff
by auto
qed
@@ -197,8 +197,8 @@
next
fix R
show "rel_fun op = R =
- (Grp {x. range x \<subseteq> Collect (split R)} (op \<circ> fst))\<inverse>\<inverse> OO
- Grp {x. range x \<subseteq> Collect (split R)} (op \<circ> snd)"
+ (Grp {x. range x \<subseteq> Collect (case_prod R)} (op \<circ> fst))\<inverse>\<inverse> OO
+ Grp {x. range x \<subseteq> Collect (case_prod R)} (op \<circ> snd)"
unfolding rel_fun_def Grp_def fun_eq_iff relcompp.simps conversep.simps subset_iff image_iff
comp_apply mem_Collect_eq split_beta bex_UNIV
proof (safe, unfold fun_eq_iff[symmetric])
--- a/src/HOL/Binomial.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Binomial.thy Thu Sep 03 15:50:40 2015 +0200
@@ -448,7 +448,7 @@
case False
have *: "finite {1 .. n}" "0 \<notin> {1 .. n}" by auto
have eq: "insert 0 {1 .. n} = {0..n}" by auto
- have **: "(\<Prod>n\<in>{1\<Colon>nat..n}. a + of_nat n) = (\<Prod>n\<in>{0\<Colon>nat..n - 1}. a + 1 + of_nat n)"
+ have **: "(\<Prod>n\<in>{1::nat..n}. a + of_nat n) = (\<Prod>n\<in>{0::nat..n - 1}. a + 1 + of_nat n)"
apply (rule setprod.reindex_cong [where l = Suc])
using False
apply (auto simp add: fun_eq_iff field_simps)
@@ -564,7 +564,7 @@
next
case False
from this setprod_constant[of "{0 .. n - 1}" "- (1:: 'a)"]
- have eq: "(- (1\<Colon>'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
+ have eq: "(- (1::'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
by auto
from False show ?thesis
by (simp add: pochhammer_def gbinomial_def field_simps
@@ -687,7 +687,7 @@
(of_nat h * (\<Prod>i = 0..h. a - of_nat i) + 2 * (\<Prod>i = 0..h. a - of_nat i))"
by (simp add: field_simps)
also have "... =
- ((a gchoose Suc h) * (fact (Suc h)) * of_nat (Suc k)) + (\<Prod>i\<in>{0\<Colon>nat..Suc h}. a - of_nat i)"
+ ((a gchoose Suc h) * (fact (Suc h)) * of_nat (Suc k)) + (\<Prod>i\<in>{0::nat..Suc h}. a - of_nat i)"
unfolding gbinomial_mult_fact'
by (simp add: comm_semiring_class.distrib field_simps Suc)
also have "\<dots> = (\<Prod>i\<in>{0..h}. a - of_nat i) * (a + 1)"
--- a/src/HOL/Cardinals/Ordinal_Arithmetic.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Cardinals/Ordinal_Arithmetic.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1608,14 +1608,14 @@
(\<Union>g \<in> fg ` Field t - {rs.const}. rs.SUPP g)"
unfolding support_def by auto
from * have "\<forall>g \<in> fg ` Field t. finite (rs.SUPP g)" "finite (rst.SUPP fg)"
- unfolding rs.Field_oexp FinFunc_def Func_def fin_support_def these_def by force+
+ unfolding rs.Field_oexp FinFunc_def Func_def fin_support_def Option.these_def by force+
moreover hence "finite (fg ` Field t - {rs.const})" using *
unfolding support_def rs.zero_oexp[OF Field] FinFunc_def Func_def
- by (elim finite_surj[of _ _ fg]) (fastforce simp: image_iff these_def)
+ by (elim finite_surj[of _ _ fg]) (fastforce simp: image_iff Option.these_def)
ultimately have "finite ((\<Union>g \<in> fg ` Field t. rs.SUPP g) \<times> rst.SUPP fg)"
by (subst **) (auto intro!: finite_cartesian_product)
with * show "?g \<in> FinFunc r (s *o t)"
- unfolding Field_oprod rs.Field_oexp FinFunc_def Func_def fin_support_def these_def
+ unfolding Field_oprod rs.Field_oexp FinFunc_def Func_def fin_support_def Option.these_def
support_def rs.zero_oexp[OF Field] by (auto elim!: finite_subset[rotated])
qed
qed
--- a/src/HOL/Code_Evaluation.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Code_Evaluation.thy Thu Sep 03 15:50:40 2015 +0200
@@ -93,7 +93,7 @@
begin
definition
- "term_of (f \<Colon> 'a \<Rightarrow> 'b) =
+ "term_of (f :: 'a \<Rightarrow> 'b) =
Const (STR ''Pure.dummy_pattern'')
(Typerep.Typerep (STR ''fun'') [Typerep.typerep TYPE('a), Typerep.typerep TYPE('b)])"
@@ -119,8 +119,8 @@
by (subst term_of_anything) rule
code_printing
- constant "term_of \<Colon> integer \<Rightarrow> term" \<rightharpoonup> (Eval) "HOLogic.mk'_number/ HOLogic.code'_integerT"
-| constant "term_of \<Colon> String.literal \<Rightarrow> term" \<rightharpoonup> (Eval) "HOLogic.mk'_literal"
+ constant "term_of :: integer \<Rightarrow> term" \<rightharpoonup> (Eval) "HOLogic.mk'_number/ HOLogic.code'_integerT"
+| constant "term_of :: String.literal \<Rightarrow> term" \<rightharpoonup> (Eval) "HOLogic.mk'_literal"
declare [[code drop: "term_of :: integer \<Rightarrow> _"]]
--- a/src/HOL/Code_Numeral.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Code_Numeral.thy Thu Sep 03 15:50:40 2015 +0200
@@ -10,7 +10,7 @@
subsection \<open>Type of target language integers\<close>
-typedef integer = "UNIV \<Colon> int set"
+typedef integer = "UNIV :: int set"
morphisms int_of_integer integer_of_int ..
setup_lifting type_definition_integer
@@ -615,7 +615,7 @@
subsection \<open>Type of target language naturals\<close>
-typedef natural = "UNIV \<Colon> nat set"
+typedef natural = "UNIV :: nat set"
morphisms nat_of_natural natural_of_nat ..
setup_lifting type_definition_natural
--- a/src/HOL/Complex.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Complex.thy Thu Sep 03 15:50:40 2015 +0200
@@ -70,7 +70,7 @@
"Re (inverse x) = Re x / ((Re x)\<^sup>2 + (Im x)\<^sup>2)"
| "Im (inverse x) = - Im x / ((Re x)\<^sup>2 + (Im x)\<^sup>2)"
-definition "x div (y\<Colon>complex) = x * inverse y"
+definition "x div (y::complex) = x * inverse y"
instance
by intro_classes
--- a/src/HOL/Datatype_Examples/Misc_Primcorec.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Datatype_Examples/Misc_Primcorec.thy Thu Sep 03 15:50:40 2015 +0200
@@ -30,7 +30,7 @@
else if ys = MyNil then xs
else MyCons (myhd xs) (myapp (mytl xs) ys))"
-primcorec shuffle_sp :: "('a \<Colon> ord, 'b \<Colon> ord, 'c, 'd) some_passive \<Rightarrow> ('d, 'a, 'b, 'c) some_passive" where
+primcorec shuffle_sp :: "('a :: ord, 'b :: ord, 'c, 'd) some_passive \<Rightarrow> ('d, 'a, 'b, 'c) some_passive" where
"shuffle_sp sp =
(case sp of
SP1 sp' \<Rightarrow> SP1 (shuffle_sp sp')
@@ -48,7 +48,7 @@
| Let SL l \<Rightarrow> Let (fimage (map_prod f (rename_lam f)) SL) (rename_lam f l))"
primcorec
- j1_sum :: "('a\<Colon>{zero,one,plus}) \<Rightarrow> 'a J1" and
+ j1_sum :: "('a::{zero,one,plus}) \<Rightarrow> 'a J1" and
j2_sum :: "'a \<Rightarrow> 'a J2"
where
"n = 0 \<Longrightarrow> is_J11 (j1_sum n)" |
--- a/src/HOL/Datatype_Examples/Misc_Primrec.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Datatype_Examples/Misc_Primrec.thy Thu Sep 03 15:50:40 2015 +0200
@@ -35,7 +35,7 @@
"myrev MyNil = MyNil" |
"myrev (MyCons x xs) = myapp (myrev xs) (MyCons x MyNil)"
-primrec shuffle_sp :: "('a \<Colon> ord, 'b \<Colon> ord, 'c, 'd) some_passive \<Rightarrow> ('d, 'a, 'b, 'c) some_passive" where
+primrec shuffle_sp :: "('a :: ord, 'b :: ord, 'c, 'd) some_passive \<Rightarrow> ('d, 'a, 'b, 'c) some_passive" where
"shuffle_sp (SP1 sp) = SP1 (shuffle_sp sp)" |
"shuffle_sp (SP2 a) = SP3 a" |
"shuffle_sp (SP3 b) = SP4 b" |
@@ -54,7 +54,7 @@
"rename_lam f (Let SL l) = Let (fimage (map_prod f (rename_lam f)) SL) (rename_lam f l)"
primrec
- sum_i1 :: "('a\<Colon>{zero,plus}) I1 \<Rightarrow> 'a" and
+ sum_i1 :: "('a::{zero,plus}) I1 \<Rightarrow> 'a" and
sum_i2 :: "'a I2 \<Rightarrow> 'a"
where
"sum_i1 (I11 n i) = n + sum_i1 i" |
--- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy Thu Sep 03 15:50:40 2015 +0200
@@ -736,8 +736,8 @@
else Ferrante_Rackoff_Data.Nox
| _ => Ferrante_Rackoff_Data.Nox
in h end
- fun ss phi =
- simpset_of (put_simpset HOL_ss @{context} addsimps (simps phi))
+ fun ss phi ctxt =
+ simpset_of (put_simpset HOL_ss ctxt addsimps (simps phi))
in
Ferrante_Rackoff_Data.funs @{thm "ferrack_axiom"}
{isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss}
@@ -884,7 +884,6 @@
shows "x + t = 0 \<equiv> x = - t"
using eq_diff_eq[where a= x and b=t and c=0] by simp
-
interpretation class_dense_linordered_field: constr_dense_linorder
"op \<le>" "op <" "\<lambda>x y. 1/2 * ((x::'a::linordered_field) + y)"
by unfold_locales (dlo, dlo, auto)
@@ -902,15 +901,6 @@
| Const(@{const_name inverse}, _)$a => Rat.rat_of_quotient(1, HOLogic.dest_number a |> snd)
| t => Rat.rat_of_int (snd (HOLogic.dest_number t))
-fun mk_frac phi cT x =
- let val (a, b) = Rat.quotient_of_rat x
- in if b = 1 then Numeral.mk_cnumber cT a
- else Thm.apply
- (Thm.apply (Drule.cterm_rule (Thm.instantiate' [SOME cT] []) @{cpat "op /"})
- (Numeral.mk_cnumber cT a))
- (Numeral.mk_cnumber cT b)
- end
-
fun whatis x ct = case Thm.term_of ct of
Const(@{const_name Groups.plus}, _)$(Const(@{const_name Groups.times},_)$_$y)$_ =>
if y aconv Thm.term_of x then ("c*x+t",[(funpow 2 Thm.dest_arg1) ct, Thm.dest_arg ct])
@@ -973,9 +963,10 @@
(case whatis x (Thm.dest_arg1 ct) of
("c*x+t",[c,t]) =>
let
- val T = Thm.ctyp_of_cterm x
+ val T = Thm.typ_of_cterm x
+ val cT = Thm.ctyp_of_cterm x
val cr = dest_frac c
- val clt = Drule.cterm_rule (Thm.instantiate' [SOME T] []) @{cpat "op <"}
+ val clt = Thm.cterm_of ctxt (Const (@{const_name ord_class.less}, T --> T --> @{typ bool}))
val cz = Thm.dest_arg ct
val neg = cr </ Rat.zero
val cthp = Simplifier.rewrite ctxt
@@ -983,7 +974,7 @@
(if neg then Thm.apply (Thm.apply clt c) cz
else Thm.apply (Thm.apply clt cz) c))
val cth = Thm.equal_elim (Thm.symmetric cthp) TrueI
- val th = Thm.implies_elim (Thm.instantiate' [SOME T] (map SOME [c,x,t])
+ val th = Thm.implies_elim (Thm.instantiate' [SOME cT] (map SOME [c,x,t])
(if neg then @{thm neg_prod_sum_le} else @{thm pos_prod_sum_le})) cth
val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
(Semiring_Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
@@ -997,9 +988,10 @@
in rth end
| ("c*x",[c]) =>
let
- val T = Thm.ctyp_of_cterm x
+ val T = Thm.typ_of_cterm x
+ val cT = Thm.ctyp_of_cterm x
val cr = dest_frac c
- val clt = Drule.cterm_rule (Thm.instantiate' [SOME T] []) @{cpat "op <"}
+ val clt = Thm.cterm_of ctxt (Const (@{const_name ord_class.less}, T --> T --> @{typ bool}))
val cz = Thm.dest_arg ct
val neg = cr </ Rat.zero
val cthp = Simplifier.rewrite ctxt
@@ -1111,8 +1103,8 @@
else Ferrante_Rackoff_Data.Nox
| _ => Ferrante_Rackoff_Data.Nox
in h end;
-fun class_field_ss phi =
- simpset_of (put_simpset HOL_basic_ss @{context}
+fun class_field_ss phi ctxt =
+ simpset_of (put_simpset HOL_basic_ss ctxt
addsimps ([@{thm "linorder_not_less"}, @{thm "linorder_not_le"}])
|> fold Splitter.add_split [@{thm "abs_split"}, @{thm "split_max"}, @{thm "split_min"}])
--- a/src/HOL/Decision_Procs/MIR.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Decision_Procs/MIR.thy Thu Sep 03 15:50:40 2015 +0200
@@ -48,7 +48,7 @@
(* The Divisibility relation between reals *)
definition rdvd:: "real \<Rightarrow> real \<Rightarrow> bool" (infixl "rdvd" 50)
- where "x rdvd y \<longleftrightarrow> (\<exists>k\<Colon>int. y = x * real k)"
+ where "x rdvd y \<longleftrightarrow> (\<exists>k::int. y = x * real k)"
lemma int_rdvd_real:
"real (i::int) rdvd x = (i dvd (floor x) \<and> real (floor x) = x)" (is "?l = ?r")
@@ -60,7 +60,7 @@
hence "\<exists> k. floor x = i*k" by (simp only: real_of_int_inject)
thus ?r using th' by (simp add: dvd_def)
next
- assume "?r" hence "(i\<Colon>int) dvd \<lfloor>x\<Colon>real\<rfloor>" ..
+ assume "?r" hence "(i::int) dvd \<lfloor>x::real\<rfloor>" ..
hence "\<exists> k. real (floor x) = real (i*k)"
by (simp only: real_of_int_inject) (simp add: dvd_def)
thus ?l using \<open>?r\<close> by (simp add: rdvd_def)
@@ -2438,7 +2438,7 @@
have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
by simp
- hence "(real l * real x + real (l div c) * Inum (real x # bs) e < (0\<Colon>real)) =
+ hence "(real l * real x + real (l div c) * Inum (real x # bs) e < (0::real)) =
(real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e < 0)"
by simp
also have "\<dots> = (real (l div c) * (real c * real x + Inum (real x # bs) e) < (real (l div c)) * 0)" by (simp add: algebra_simps)
@@ -2456,7 +2456,7 @@
have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
by simp
- hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<le> (0\<Colon>real)) =
+ hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<le> (0::real)) =
(real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e \<le> 0)"
by simp
also have "\<dots> = (real (l div c) * (real c * real x + Inum (real x # bs) e) \<le> (real (l div c)) * 0)" by (simp add: algebra_simps)
@@ -2474,7 +2474,7 @@
have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
by simp
- hence "(real l * real x + real (l div c) * Inum (real x # bs) e > (0\<Colon>real)) =
+ hence "(real l * real x + real (l div c) * Inum (real x # bs) e > (0::real)) =
(real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e > 0)"
by simp
also have "\<dots> = (real (l div c) * (real c * real x + Inum (real x # bs) e) > (real (l div c)) * 0)" by (simp add: algebra_simps)
@@ -2492,7 +2492,7 @@
have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
by simp
- hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<ge> (0\<Colon>real)) =
+ hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<ge> (0::real)) =
(real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e \<ge> 0)"
by simp
also have "\<dots> = (real (l div c) * (real c * real x + Inum (real x # bs) e) \<ge> (real (l div c)) * 0)" by (simp add: algebra_simps)
@@ -2510,7 +2510,7 @@
have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
by simp
- hence "(real l * real x + real (l div c) * Inum (real x # bs) e = (0\<Colon>real)) =
+ hence "(real l * real x + real (l div c) * Inum (real x # bs) e = (0::real)) =
(real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = 0)"
by simp
also have "\<dots> = (real (l div c) * (real c * real x + Inum (real x # bs) e) = (real (l div c)) * 0)" by (simp add: algebra_simps)
@@ -2528,7 +2528,7 @@
have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
by simp
- hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<noteq> (0\<Colon>real)) =
+ hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<noteq> (0::real)) =
(real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e \<noteq> 0)"
by simp
also have "\<dots> = (real (l div c) * (real c * real x + Inum (real x # bs) e) \<noteq> (real (l div c)) * 0)" by (simp add: algebra_simps)
@@ -3431,7 +3431,7 @@
and n0: "n = 0"
and s_def: "s = (Add (Floor s') (C j))"
and jp: "0 \<le> j" and jn: "j \<le> n'"
- from 5 pns have H:"(Ifm ((x\<Colon>real) # (bs\<Colon>real list)) p' \<longrightarrow>
+ from 5 pns have H:"(Ifm ((x::real) # (bs::real list)) p' \<longrightarrow>
Inum (x # bs) a = Inum (x # bs) (CN 0 n' s')) \<and>
numbound0 s' \<and> isrlfm p'" by blast
hence nb: "numbound0 s'" by simp
@@ -3457,7 +3457,7 @@
and n0: "n = 0"
and s_def: "s = (Add (Floor s') (C j))"
and jp: "n' \<le> j" and jn: "j \<le> 0"
- from 5 pns have H:"(Ifm ((x\<Colon>real) # (bs\<Colon>real list)) p' \<longrightarrow>
+ from 5 pns have H:"(Ifm ((x::real) # (bs::real list)) p' \<longrightarrow>
Inum (x # bs) a = Inum (x # bs) (CN 0 n' s')) \<and>
numbound0 s' \<and> isrlfm p'" by blast
hence nb: "numbound0 s'" by simp
--- a/src/HOL/Decision_Procs/ferrante_rackoff.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Decision_Procs/ferrante_rackoff.ML Thu Sep 03 15:50:40 2015 +0200
@@ -206,7 +206,7 @@
val pcv = Simplifier.rewrite (put_simpset ss' ctxt);
val postcv = Simplifier.rewrite (put_simpset ss ctxt);
val nnf = K (nnf_conv ctxt then_conv postcv)
- val qe_conv = Qelim.gen_qelim_conv pcv postcv pcv cons (Drule.cterm_add_frees tm [])
+ val qe_conv = Qelim.gen_qelim_conv ctxt pcv postcv pcv cons (Drule.cterm_add_frees tm [])
(isolate_conv ctxt) nnf
(fn vs => ferrack_conv ctxt (thy,{isolate_conv = isolate_conv ctxt,
whatis = whatis, simpset = ss}) vs
--- a/src/HOL/Decision_Procs/ferrante_rackoff_data.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Decision_Procs/ferrante_rackoff_data.ML Thu Sep 03 15:50:40 2015 +0200
@@ -15,7 +15,7 @@
val funs: thm ->
{isolate_conv: morphism -> Proof.context -> cterm list -> cterm -> thm,
whatis: morphism -> cterm -> cterm -> ord,
- simpset: morphism -> simpset} -> declaration
+ simpset: morphism -> Proof.context -> simpset} -> declaration
val match: Proof.context -> cterm -> entry option
end;
@@ -57,13 +57,15 @@
(* extra-logical functions *)
-fun funs raw_key {isolate_conv = icv, whatis = wi, simpset = ss} phi = Data.map (fn data =>
- let
- val key = Morphism.thm phi raw_key;
- val _ = AList.defined eq_key data key orelse
- raise THM ("No data entry for structure key", 0, [key]);
- val fns = {isolate_conv = icv phi, whatis = wi phi, simpset = ss phi};
- in AList.map_entry eq_key key (apsnd (K fns)) data end);
+fun funs raw_key {isolate_conv = icv, whatis = wi, simpset = ss} phi context =
+ context |> Data.map (fn data =>
+ let
+ val key = Morphism.thm phi raw_key;
+ val _ = AList.defined eq_key data key orelse
+ raise THM ("No data entry for structure key", 0, [key]);
+ val fns =
+ {isolate_conv = icv phi, whatis = wi phi, simpset = ss phi (Context.proof_of context)};
+ in AList.map_entry eq_key key (apsnd (K fns)) data end);
fun match ctxt tm =
let
--- a/src/HOL/Decision_Procs/langford.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Decision_Procs/langford.ML Thu Sep 03 15:50:40 2015 +0200
@@ -190,7 +190,7 @@
addsimps @{thms simp_thms ex_simps all_simps all_not_ex not_all ex_disj_distrib})
in
fn p =>
- Qelim.gen_qelim_conv pcv pcv dnfex_conv cons
+ Qelim.gen_qelim_conv ctxt pcv pcv dnfex_conv cons
(Drule.cterm_add_frees p []) (K Thm.reflexive) (K Thm.reflexive)
(K (basic_dloqe ctxt gst qe_bnds qe_nolb qe_noub gs)) p
end;
@@ -228,12 +228,12 @@
(_, NONE) => raise CTERM ("dlo_conv (langford): no corresponding instance in context!", [tm])
| (ss, SOME instance) => raw_dlo_conv ctxt ss instance tm);
-fun generalize_tac f = CSUBGOAL (fn (p, _) => PRIMITIVE (fn st =>
+fun generalize_tac ctxt f = CSUBGOAL (fn (p, _) => PRIMITIVE (fn st =>
let
- fun all T = Drule.cterm_rule (Thm.instantiate' [SOME T] []) @{cpat "Pure.all"}
- fun gen x t = Thm.apply (all (Thm.ctyp_of_cterm x)) (Thm.lambda x t)
- val ts = sort (fn (a,b) => Term_Ord.fast_term_ord (Thm.term_of a, Thm.term_of b)) (f p)
- val p' = fold_rev gen ts p
+ fun all x t =
+ Thm.apply (Thm.cterm_of ctxt (Logic.all_const (Thm.typ_of_cterm x))) (Thm.lambda x t)
+ val ts = sort (fn (a, b) => Term_Ord.fast_term_ord (Thm.term_of a, Thm.term_of b)) (f p)
+ val p' = fold_rev all ts p
in Thm.implies_intr p' (Thm.implies_elim st (fold Thm.forall_elim ts (Thm.assume p'))) end));
fun cfrees ats ct =
@@ -259,7 +259,7 @@
Object_Logic.full_atomize_tac ctxt i THEN
simp_tac (put_simpset ss ctxt) i
THEN (CONVERSION Thm.eta_long_conversion) i
- THEN (TRY o generalize_tac (cfrees (#atoms instance))) i
+ THEN (TRY o generalize_tac ctxt (cfrees (#atoms instance))) i
THEN Object_Logic.full_atomize_tac ctxt i
THEN CONVERSION (Object_Logic.judgment_conv ctxt (raw_dlo_conv ctxt ss instance)) i
THEN (simp_tac (put_simpset ss ctxt) i)));
--- a/src/HOL/Divides.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Divides.thy Thu Sep 03 15:50:40 2015 +0200
@@ -814,8 +814,8 @@
text \<open>
We define @{const divide} and @{const mod} on @{typ nat} by means
of a characteristic relation with two input arguments
- @{term "m\<Colon>nat"}, @{term "n\<Colon>nat"} and two output arguments
- @{term "q\<Colon>nat"}(uotient) and @{term "r\<Colon>nat"}(emainder).
+ @{term "m::nat"}, @{term "n::nat"} and two output arguments
+ @{term "q::nat"}(uotient) and @{term "r::nat"}(emainder).
\<close>
definition divmod_nat_rel :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat \<Rightarrow> bool" where
@@ -835,7 +835,7 @@
have "\<exists>q r. m = q * n + r \<and> r < n"
proof (induct m)
case 0 with \<open>n \<noteq> 0\<close>
- have "(0\<Colon>nat) = 0 * n + 0 \<and> 0 < n" by simp
+ have "(0::nat) = 0 * n + 0 \<and> 0 < n" by simp
then show ?case by blast
next
case (Suc m) then obtain q' r'
@@ -868,7 +868,7 @@
(simp add: divmod_nat_rel_def)
next
case False
- have aux: "\<And>q r q' r'. q' * n + r' = q * n + r \<Longrightarrow> r < n \<Longrightarrow> q' \<le> (q\<Colon>nat)"
+ have aux: "\<And>q r q' r'. q' * n + r' = q * n + r \<Longrightarrow> r < n \<Longrightarrow> q' \<le> (q::nat)"
apply (rule leI)
apply (subst less_iff_Suc_add)
apply (auto simp add: add_mult_distrib)
@@ -1115,10 +1115,10 @@
then show "m div n * n + m mod n \<le> m" by auto
qed
-lemma mod_geq: "\<not> m < (n\<Colon>nat) \<Longrightarrow> m mod n = (m - n) mod n"
+lemma mod_geq: "\<not> m < (n::nat) \<Longrightarrow> m mod n = (m - n) mod n"
by (simp add: le_mod_geq linorder_not_less)
-lemma mod_if: "m mod (n\<Colon>nat) = (if m < n then m else (m - n) mod n)"
+lemma mod_if: "m mod (n::nat) = (if m < n then m else (m - n) mod n)"
by (simp add: le_mod_geq)
lemma mod_1 [simp]: "m mod Suc 0 = 0"
@@ -1313,7 +1313,7 @@
lemma split_div_lemma:
assumes "0 < n"
- shows "n * q \<le> m \<and> m < n * Suc q \<longleftrightarrow> q = ((m\<Colon>nat) div n)" (is "?lhs \<longleftrightarrow> ?rhs")
+ shows "n * q \<le> m \<and> m < n * Suc q \<longleftrightarrow> q = ((m::nat) div n)" (is "?lhs \<longleftrightarrow> ?rhs")
proof
assume ?rhs
with mult_div_cancel have nq: "n * q = m - (m mod n)" by simp
@@ -1486,7 +1486,7 @@
lemma add_self_div_2 [simp]: "(m + m) div 2 = (m::nat)"
by (simp add: mult_2 [symmetric])
-lemma mod2_gr_0 [simp]: "0 < (m\<Colon>nat) mod 2 \<longleftrightarrow> m mod 2 = 1"
+lemma mod2_gr_0 [simp]: "0 < (m::nat) mod 2 \<longleftrightarrow> m mod 2 = 1"
proof -
{ fix n :: nat have "(n::nat) < 2 \<Longrightarrow> n = 0 \<or> n = 1" by (cases n) simp_all }
moreover have "m mod 2 < 2" by simp
@@ -1999,7 +1999,7 @@
lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
lemma zmod_zdiv_equality' [nitpick_unfold]:
- "(m\<Colon>int) mod n = m - (m div n) * n"
+ "(m::int) mod n = m - (m div n) * n"
using mod_div_equality [of m n] by arith
@@ -2311,15 +2311,18 @@
pos_imp_zdiv_pos_iff div_pos_pos_trivial mod_pos_pos_trivial
zmod_zmult2_eq zdiv_zmult2_eq)
-definition adjust_div :: "int \<times> int \<Rightarrow> int"
+context
+begin
+
+qualified definition adjust_div :: "int \<times> int \<Rightarrow> int"
where
"adjust_div qr = (let (q, r) = qr in q + of_bool (r \<noteq> 0))"
-lemma adjust_div_eq [simp, code]:
+qualified lemma adjust_div_eq [simp, code]:
"adjust_div (q, r) = q + of_bool (r \<noteq> 0)"
by (simp add: adjust_div_def)
-definition adjust_mod :: "int \<Rightarrow> int \<Rightarrow> int"
+qualified definition adjust_mod :: "int \<Rightarrow> int \<Rightarrow> int"
where
[simp]: "adjust_mod l r = (if r = 0 then 0 else l - r)"
@@ -2375,6 +2378,8 @@
"1 mod - numeral n = - adjust_mod (numeral n) (snd (divmod Num.One n) :: int)"
using numeral_mod_minus_numeral [of Num.One n] by simp
+end
+
subsubsection \<open>Further properties\<close>
@@ -2574,10 +2579,10 @@
one_div_minus_numeral one_mod_minus_numeral
numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral
numeral_div_minus_numeral numeral_mod_minus_numeral
- div_minus_minus mod_minus_minus adjust_div_eq of_bool_eq one_neq_zero
+ div_minus_minus mod_minus_minus Divides.adjust_div_eq of_bool_eq one_neq_zero
numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial
divmod_cancel divmod_steps divmod_step_eq fst_conv snd_conv numeral_One
- case_prod_beta rel_simps adjust_mod_def div_minus1_right mod_minus1_right
+ case_prod_beta rel_simps Divides.adjust_mod_def div_minus1_right mod_minus1_right
minus_minus numeral_times_numeral mult_zero_right mult_1_right}
@ [@{lemma "0 = 0 \<longleftrightarrow> True" by simp}]);
fun prepare_simpset ctxt = HOL_ss |> Simplifier.simpset_map ctxt
@@ -2602,10 +2607,10 @@
"k mod Int.Neg Num.One = 0"
"Int.Pos m div Int.Pos n = (fst (divmod m n) :: int)"
"Int.Pos m mod Int.Pos n = (snd (divmod m n) :: int)"
- "Int.Neg m div Int.Pos n = - (adjust_div (divmod m n) :: int)"
- "Int.Neg m mod Int.Pos n = adjust_mod (Int.Pos n) (snd (divmod m n) :: int)"
- "Int.Pos m div Int.Neg n = - (adjust_div (divmod m n) :: int)"
- "Int.Pos m mod Int.Neg n = - adjust_mod (Int.Pos n) (snd (divmod m n) :: int)"
+ "Int.Neg m div Int.Pos n = - (Divides.adjust_div (divmod m n) :: int)"
+ "Int.Neg m mod Int.Pos n = Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)"
+ "Int.Pos m div Int.Neg n = - (Divides.adjust_div (divmod m n) :: int)"
+ "Int.Pos m mod Int.Neg n = - Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)"
"Int.Neg m div Int.Neg n = (fst (divmod m n) :: int)"
"Int.Neg m mod Int.Neg n = - (snd (divmod m n) :: int)"
by simp_all
--- a/src/HOL/Eisbach/match_method.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Eisbach/match_method.ML Thu Sep 03 15:50:40 2015 +0200
@@ -400,7 +400,7 @@
let
val ident = Thm.cterm_of ctxt (HOLogic.mk_number @{typ nat} ident |> Logic.mk_term);
val hyp =
- (case #hyps (Thm.crep_thm prem) of
+ (case Thm.chyps_of prem of
[hyp] => hyp
| _ => error "Prem should have exactly one hyp"); (* FIXME error vs. raise Fail !? *)
val ct = Drule.mk_term (hyp) |> Thm.cprop_of;
@@ -455,7 +455,7 @@
fun get_thinned_prems goal =
let
- val chyps = Thm.crep_thm goal |> #hyps;
+ val chyps = Thm.chyps_of goal;
fun prem_from_hyp hyp goal =
let
@@ -735,7 +735,7 @@
(focus_prems inner_ctxt |> snd |> Item_Net.content)
(focus_prems focus_ctxt |> snd |> Item_Net.content))
|> map (fn (id, thm) =>
- #hyps (Thm.crep_thm thm)
+ Thm.chyps_of thm
|> (fn [chyp] => (id, (SOME chyp, NONE))
| _ => error "Prem should have only one hyp")));
--- a/src/HOL/Enum.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Enum.thy Thu Sep 03 15:50:40 2015 +0200
@@ -144,7 +144,7 @@
by (fact equal_refl)
lemma order_fun [code]:
- fixes f g :: "'a\<Colon>enum \<Rightarrow> 'b\<Colon>order"
+ fixes f g :: "'a::enum \<Rightarrow> 'b::order"
shows "f \<le> g \<longleftrightarrow> enum_all (\<lambda>x. f x \<le> g x)"
and "f < g \<longleftrightarrow> f \<le> g \<and> enum_ex (\<lambda>x. f x \<noteq> g x)"
by (simp_all add: fun_eq_iff le_fun_def order_less_le)
@@ -244,32 +244,32 @@
subsection \<open>Default instances for @{class enum}\<close>
lemma map_of_zip_enum_is_Some:
- assumes "length ys = length (enum \<Colon> 'a\<Colon>enum list)"
- shows "\<exists>y. map_of (zip (enum \<Colon> 'a\<Colon>enum list) ys) x = Some y"
+ assumes "length ys = length (enum :: 'a::enum list)"
+ shows "\<exists>y. map_of (zip (enum :: 'a::enum list) ys) x = Some y"
proof -
- from assms have "x \<in> set (enum \<Colon> 'a\<Colon>enum list) \<longleftrightarrow>
- (\<exists>y. map_of (zip (enum \<Colon> 'a\<Colon>enum list) ys) x = Some y)"
+ from assms have "x \<in> set (enum :: 'a::enum list) \<longleftrightarrow>
+ (\<exists>y. map_of (zip (enum :: 'a::enum list) ys) x = Some y)"
by (auto intro!: map_of_zip_is_Some)
then show ?thesis using enum_UNIV by auto
qed
lemma map_of_zip_enum_inject:
- fixes xs ys :: "'b\<Colon>enum list"
- assumes length: "length xs = length (enum \<Colon> 'a\<Colon>enum list)"
- "length ys = length (enum \<Colon> 'a\<Colon>enum list)"
- and map_of: "the \<circ> map_of (zip (enum \<Colon> 'a\<Colon>enum list) xs) = the \<circ> map_of (zip (enum \<Colon> 'a\<Colon>enum list) ys)"
+ fixes xs ys :: "'b::enum list"
+ assumes length: "length xs = length (enum :: 'a::enum list)"
+ "length ys = length (enum :: 'a::enum list)"
+ and map_of: "the \<circ> map_of (zip (enum :: 'a::enum list) xs) = the \<circ> map_of (zip (enum :: 'a::enum list) ys)"
shows "xs = ys"
proof -
- have "map_of (zip (enum \<Colon> 'a list) xs) = map_of (zip (enum \<Colon> 'a list) ys)"
+ have "map_of (zip (enum :: 'a list) xs) = map_of (zip (enum :: 'a list) ys)"
proof
fix x :: 'a
from length map_of_zip_enum_is_Some obtain y1 y2
- where "map_of (zip (enum \<Colon> 'a list) xs) x = Some y1"
- and "map_of (zip (enum \<Colon> 'a list) ys) x = Some y2" by blast
+ where "map_of (zip (enum :: 'a list) xs) x = Some y1"
+ and "map_of (zip (enum :: 'a list) ys) x = Some y2" by blast
moreover from map_of
- have "the (map_of (zip (enum \<Colon> 'a\<Colon>enum list) xs) x) = the (map_of (zip (enum \<Colon> 'a\<Colon>enum list) ys) x)"
+ have "the (map_of (zip (enum :: 'a::enum list) xs) x) = the (map_of (zip (enum :: 'a::enum list) ys) x)"
by (auto dest: fun_cong)
- ultimately show "map_of (zip (enum \<Colon> 'a\<Colon>enum list) xs) x = map_of (zip (enum \<Colon> 'a\<Colon>enum list) ys) x"
+ ultimately show "map_of (zip (enum :: 'a::enum list) xs) x = map_of (zip (enum :: 'a::enum list) ys) x"
by simp
qed
with length enum_distinct show "xs = ys" by (rule map_of_zip_inject)
@@ -297,7 +297,7 @@
begin
definition
- "enum = map (\<lambda>ys. the o map_of (zip (enum\<Colon>'a list) ys)) (List.n_lists (length (enum\<Colon>'a\<Colon>enum list)) enum)"
+ "enum = map (\<lambda>ys. the o map_of (zip (enum::'a list) ys)) (List.n_lists (length (enum::'a::enum list)) enum)"
definition
"enum_all P = all_n_lists (\<lambda>bs. P (the o map_of (zip enum bs))) (length (enum :: 'a list))"
@@ -306,17 +306,17 @@
"enum_ex P = ex_n_lists (\<lambda>bs. P (the o map_of (zip enum bs))) (length (enum :: 'a list))"
instance proof
- show "UNIV = set (enum \<Colon> ('a \<Rightarrow> 'b) list)"
+ show "UNIV = set (enum :: ('a \<Rightarrow> 'b) list)"
proof (rule UNIV_eq_I)
fix f :: "'a \<Rightarrow> 'b"
- have "f = the \<circ> map_of (zip (enum \<Colon> 'a\<Colon>enum list) (map f enum))"
+ have "f = the \<circ> map_of (zip (enum :: 'a::enum list) (map f enum))"
by (auto simp add: map_of_zip_map fun_eq_iff intro: in_enum)
then show "f \<in> set enum"
by (auto simp add: enum_fun_def set_n_lists intro: in_enum)
qed
next
from map_of_zip_enum_inject
- show "distinct (enum \<Colon> ('a \<Rightarrow> 'b) list)"
+ show "distinct (enum :: ('a \<Rightarrow> 'b) list)"
by (auto intro!: inj_onI simp add: enum_fun_def
distinct_map distinct_n_lists enum_distinct set_n_lists)
next
@@ -327,7 +327,7 @@
show "Ball UNIV P"
proof
fix f :: "'a \<Rightarrow> 'b"
- have f: "f = the \<circ> map_of (zip (enum \<Colon> 'a\<Colon>enum list) (map f enum))"
+ have f: "f = the \<circ> map_of (zip (enum :: 'a::enum list) (map f enum))"
by (auto simp add: map_of_zip_map fun_eq_iff intro: in_enum)
from \<open>enum_all P\<close> have "P (the \<circ> map_of (zip enum (map f enum)))"
unfolding enum_all_fun_def all_n_lists_def
@@ -352,9 +352,9 @@
next
assume "Bex UNIV P"
from this obtain f where "P f" ..
- have f: "f = the \<circ> map_of (zip (enum \<Colon> 'a\<Colon>enum list) (map f enum))"
+ have f: "f = the \<circ> map_of (zip (enum :: 'a::enum list) (map f enum))"
by (auto simp add: map_of_zip_map fun_eq_iff intro: in_enum)
- from \<open>P f\<close> this have "P (the \<circ> map_of (zip (enum \<Colon> 'a\<Colon>enum list) (map f enum)))"
+ from \<open>P f\<close> this have "P (the \<circ> map_of (zip (enum :: 'a::enum list) (map f enum)))"
by auto
from this show "enum_ex P"
unfolding enum_ex_fun_def ex_n_lists_def
@@ -367,7 +367,7 @@
end
-lemma enum_fun_code [code]: "enum = (let enum_a = (enum \<Colon> 'a\<Colon>{enum, equal} list)
+lemma enum_fun_code [code]: "enum = (let enum_a = (enum :: 'a::{enum, equal} list)
in map (\<lambda>ys. the o map_of (zip enum_a ys)) (List.n_lists (length enum_a) enum))"
by (simp add: enum_fun_def Let_def)
--- a/src/HOL/Fields.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Fields.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1161,7 +1161,7 @@
unfolding le_divide_eq if_P[OF \<open>0 < x\<close>] by simp
next
assume "\<not>0 < x" hence "x \<le> 0" by simp
- obtain s::'a where s: "0 < s" "s < 1" using dense[of 0 "1\<Colon>'a"] by auto
+ obtain s::'a where s: "0 < s" "s < 1" using dense[of 0 "1::'a"] by auto
hence "x \<le> s * x" using mult_le_cancel_right[of 1 x s] \<open>x \<le> 0\<close> by auto
also note *[OF s]
finally show ?thesis .
--- a/src/HOL/Filter.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Filter.thy Thu Sep 03 15:50:40 2015 +0200
@@ -670,7 +670,7 @@
"F \<le> sequentially \<longleftrightarrow> (\<forall>N. eventually (\<lambda>n. N \<le> n) F)"
by (simp add: at_top_def le_INF_iff le_principal)
-lemma eventually_sequentiallyI:
+lemma eventually_sequentiallyI [intro?]:
assumes "\<And>x. c \<le> x \<Longrightarrow> P x"
shows "eventually P sequentially"
using assms by (auto simp: eventually_sequentially)
--- a/src/HOL/Finite_Set.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Finite_Set.thy Thu Sep 03 15:50:40 2015 +0200
@@ -561,13 +561,13 @@
subsection \<open>Class @{text finite}\<close>
class finite =
- assumes finite_UNIV: "finite (UNIV \<Colon> 'a set)"
+ assumes finite_UNIV: "finite (UNIV :: 'a set)"
begin
-lemma finite [simp]: "finite (A \<Colon> 'a set)"
+lemma finite [simp]: "finite (A :: 'a set)"
by (rule subset_UNIV finite_UNIV finite_subset)+
-lemma finite_code [code]: "finite (A \<Colon> 'a set) \<longleftrightarrow> True"
+lemma finite_code [code]: "finite (A :: 'a set) \<longleftrightarrow> True"
by simp
end
--- a/src/HOL/Fun.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Fun.thy Thu Sep 03 15:50:40 2015 +0200
@@ -94,6 +94,14 @@
lemma bind_image: "Set.bind (f ` A) g = Set.bind A (g \<circ> f)"
by(auto simp add: Set.bind_def)
+lemma (in group_add) minus_comp_minus [simp]:
+ "uminus \<circ> uminus = id"
+ by (simp add: fun_eq_iff)
+
+lemma (in boolean_algebra) minus_comp_minus [simp]:
+ "uminus \<circ> uminus = id"
+ by (simp add: fun_eq_iff)
+
code_printing
constant comp \<rightharpoonup> (SML) infixl 5 "o" and (Haskell) infixr 9 "."
--- a/src/HOL/Fun_Def.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Fun_Def.thy Thu Sep 03 15:50:40 2015 +0200
@@ -143,7 +143,7 @@
lemma split_cong [fundef_cong]:
"(\<And>x y. (x, y) = q \<Longrightarrow> f x y = g x y) \<Longrightarrow> p = q
- \<Longrightarrow> split f p = split g q"
+ \<Longrightarrow> case_prod f p = case_prod g q"
by (auto simp: split_def)
lemma comp_cong [fundef_cong]:
--- a/src/HOL/Groups.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Groups.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1392,7 +1392,7 @@
subsection \<open>Tools setup\<close>
lemma add_mono_thms_linordered_semiring:
- fixes i j k :: "'a\<Colon>ordered_ab_semigroup_add"
+ fixes i j k :: "'a::ordered_ab_semigroup_add"
shows "i \<le> j \<and> k \<le> l \<Longrightarrow> i + k \<le> j + l"
and "i = j \<and> k \<le> l \<Longrightarrow> i + k \<le> j + l"
and "i \<le> j \<and> k = l \<Longrightarrow> i + k \<le> j + l"
@@ -1400,7 +1400,7 @@
by (rule add_mono, clarify+)+
lemma add_mono_thms_linordered_field:
- fixes i j k :: "'a\<Colon>ordered_cancel_ab_semigroup_add"
+ fixes i j k :: "'a::ordered_cancel_ab_semigroup_add"
shows "i < j \<and> k = l \<Longrightarrow> i + k < j + l"
and "i = j \<and> k < l \<Longrightarrow> i + k < j + l"
and "i < j \<and> k \<le> l \<Longrightarrow> i + k < j + l"
--- a/src/HOL/Groups_Big.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Groups_Big.thy Thu Sep 03 15:50:40 2015 +0200
@@ -184,7 +184,7 @@
using assms by (induct A rule: infinite_finite_induct) (simp_all add: assoc commute left_commute)
lemma Sigma:
- "finite A \<Longrightarrow> \<forall>x\<in>A. finite (B x) \<Longrightarrow> F (\<lambda>x. F (g x) (B x)) A = F (split g) (SIGMA x:A. B x)"
+ "finite A \<Longrightarrow> \<forall>x\<in>A. finite (B x) \<Longrightarrow> F (\<lambda>x. F (g x) (B x)) A = F (case_prod g) (SIGMA x:A. B x)"
apply (subst Sigma_def)
apply (subst UNION_disjoint, assumption, simp)
apply blast
@@ -350,7 +350,7 @@
qed
lemma cartesian_product:
- "F (\<lambda>x. F (g x) B) A = F (split g) (A <*> B)"
+ "F (\<lambda>x. F (g x) B) A = F (case_prod g) (A <*> B)"
apply (rule sym)
apply (cases "finite A")
apply (cases "finite B")
@@ -807,20 +807,10 @@
case False thus ?thesis by simp
qed
-lemma setsum_abs_ge_zero[iff]:
+lemma setsum_abs_ge_zero[iff]:
fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
shows "0 \<le> setsum (%i. abs(f i)) A"
-proof (cases "finite A")
- case True
- thus ?thesis
- proof induct
- case empty thus ?case by simp
- next
- case (insert x A) thus ?case by auto
- qed
-next
- case False thus ?thesis by simp
-qed
+ by (simp add: setsum_nonneg)
lemma abs_setsum_abs[simp]:
fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
@@ -931,6 +921,19 @@
"(\<And>a. a \<in> A \<Longrightarrow> d dvd f a) \<Longrightarrow> d dvd setsum f A"
by (induct A rule: infinite_finite_induct) simp_all
+lemma setsum_pos2:
+ assumes "finite I" "i \<in> I" "0 < f i" "(\<And>i. i \<in> I \<Longrightarrow> 0 \<le> f i)"
+ shows "(0::'a::{ordered_ab_group_add,comm_monoid_add}) < setsum f I"
+proof -
+ have "0 \<le> setsum f (I-{i})"
+ using assms by (simp add: setsum_nonneg)
+ also have "... < setsum f (I-{i}) + f i"
+ using assms by auto
+ also have "... = setsum f I"
+ using assms by (simp add: setsum.remove)
+ finally show ?thesis .
+qed
+
subsubsection \<open>Cardinality as special case of @{const setsum}\<close>
@@ -957,7 +960,7 @@
using setsum.distrib[of f "\<lambda>_. 1" A]
by simp
-lemma setsum_bounded:
+lemma setsum_bounded_above:
assumes le: "\<And>i. i\<in>A \<Longrightarrow> f i \<le> (K::'a::{semiring_1, ordered_ab_semigroup_add})"
shows "setsum f A \<le> of_nat (card A) * K"
proof (cases "finite A")
@@ -967,6 +970,23 @@
case False thus ?thesis by simp
qed
+lemma setsum_bounded_above_strict:
+ assumes "\<And>i. i\<in>A \<Longrightarrow> f i < (K::'a::{ordered_cancel_ab_semigroup_add,semiring_1})"
+ "card A > 0"
+ shows "setsum f A < of_nat (card A) * K"
+using assms setsum_strict_mono[where A=A and g = "%x. K"]
+by (simp add: card_gt_0_iff)
+
+lemma setsum_bounded_below:
+ assumes le: "\<And>i. i\<in>A \<Longrightarrow> (K::'a::{semiring_1, ordered_ab_semigroup_add}) \<le> f i"
+ shows "of_nat (card A) * K \<le> setsum f A"
+proof (cases "finite A")
+ case True
+ thus ?thesis using le setsum_mono[where K=A and f = "%x. K"] by simp
+next
+ case False thus ?thesis by simp
+qed
+
lemma card_UN_disjoint:
assumes "finite I" and "\<forall>i\<in>I. finite (A i)"
and "\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}"
@@ -1210,6 +1230,15 @@
using assms by (induct A rule: infinite_finite_induct)
(auto intro!: setprod_nonneg mult_mono)
+lemma (in linordered_semidom) setprod_mono_strict:
+ assumes"finite A" "\<forall>i\<in>A. 0 \<le> f i \<and> f i < g i" "A \<noteq> {}"
+ shows "setprod f A < setprod g A"
+using assms
+apply (induct A rule: finite_induct)
+apply (simp add: )
+apply (force intro: mult_strict_mono' setprod_nonneg)
+done
+
lemma (in linordered_field) abs_setprod:
"\<bar>setprod f A\<bar> = (\<Prod>x\<in>A. \<bar>f x\<bar>)"
by (induct A rule: infinite_finite_induct) (simp_all add: abs_mult)
@@ -1218,12 +1247,15 @@
"finite A \<Longrightarrow> setprod f A = 1 \<longleftrightarrow> (\<forall>a\<in>A. f a = (1::nat))"
by (induct A rule: finite_induct) simp_all
-lemma setprod_pos_nat:
- "finite A \<Longrightarrow> (\<forall>a\<in>A. f a > (0::nat)) \<Longrightarrow> setprod f A > 0"
- using setprod_zero_iff by (simp del: neq0_conv add: neq0_conv [symmetric])
-
lemma setprod_pos_nat_iff [simp]:
"finite A \<Longrightarrow> setprod f A > 0 \<longleftrightarrow> (\<forall>a\<in>A. f a > (0::nat))"
using setprod_zero_iff by (simp del:neq0_conv add:neq0_conv [symmetric])
+lemma setsum_nonneg_eq_0_iff:
+ fixes f :: "'a \<Rightarrow> 'b::ordered_ab_group_add"
+ shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
+ apply (induct set: finite, simp)
+ apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
+ done
+
end
--- a/src/HOL/HOL.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOL.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1792,7 +1792,7 @@
"equal TYPE('a) TYPE('a) \<longleftrightarrow> True"
by (simp add: equal)
-setup \<open>Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a\<Colon>type \<Rightarrow> 'a \<Rightarrow> bool"})\<close>
+setup \<open>Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a::type \<Rightarrow> 'a \<Rightarrow> bool"})\<close>
lemma equal_alias_cert: "OFCLASS('a, equal_class) \<equiv> ((op = :: 'a \<Rightarrow> 'a \<Rightarrow> bool) \<equiv> equal)" (is "?ofclass \<equiv> ?equal")
proof
@@ -1806,7 +1806,7 @@
qed (simp add: \<open>PROP ?equal\<close>)
qed
-setup \<open>Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a\<Colon>equal \<Rightarrow> 'a \<Rightarrow> bool"})\<close>
+setup \<open>Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a::equal \<Rightarrow> 'a \<Rightarrow> bool"})\<close>
setup \<open>Nbe.add_const_alias @{thm equal_alias_cert}\<close>
--- a/src/HOL/HOLCF/IOA/ABP/Abschannel.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/ABP/Abschannel.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The transmission channel *}
theory Abschannel
-imports IOA Action Lemmas
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action Lemmas
begin
datatype 'a abs_action = S 'a | R 'a
--- a/src/HOL/HOLCF/IOA/ABP/Abschannel_finite.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/ABP/Abschannel_finite.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The transmission channel -- finite version *}
theory Abschannel_finite
-imports Abschannel IOA Action Lemmas
+imports Abschannel "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action Lemmas
begin
primrec reverse :: "'a list => 'a list"
--- a/src/HOL/HOLCF/IOA/ABP/Correctness.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/ABP/Correctness.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The main correctness proof: System_fin implements System *}
theory Correctness
-imports IOA Env Impl Impl_finite
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Env Impl Impl_finite
begin
ML_file "Check.ML"
--- a/src/HOL/HOLCF/IOA/ABP/Env.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/ABP/Env.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The environment *}
theory Env
-imports IOA Action
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action
begin
type_synonym
--- a/src/HOL/HOLCF/IOA/ABP/Receiver.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/ABP/Receiver.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The implementation: receiver *}
theory Receiver
-imports IOA Action Lemmas
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action Lemmas
begin
type_synonym
--- a/src/HOL/HOLCF/IOA/ABP/Sender.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/ABP/Sender.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The implementation: sender *}
theory Sender
-imports IOA Action Lemmas
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action Lemmas
begin
type_synonym
--- a/src/HOL/HOLCF/IOA/NTP/Abschannel.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/NTP/Abschannel.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The (faulty) transmission channel (both directions) *}
theory Abschannel
-imports IOA Action
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action
begin
datatype 'a abs_action = S 'a | R 'a
--- a/src/HOL/HOLCF/IOA/NTP/Receiver.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/NTP/Receiver.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The implementation: receiver *}
theory Receiver
-imports IOA Action
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action
begin
type_synonym
--- a/src/HOL/HOLCF/IOA/NTP/Sender.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/NTP/Sender.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The implementation: sender *}
theory Sender
-imports IOA Action
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action
begin
type_synonym
--- a/src/HOL/HOLCF/IOA/NTP/Spec.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/NTP/Spec.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The specification of reliable transmission *}
theory Spec
-imports IOA Action
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action
begin
definition
--- a/src/HOL/HOLCF/IOA/Storage/Spec.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/Storage/Spec.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
section {* The specification of a memory *}
theory Spec
-imports IOA Action
+imports "~~/src/HOL/HOLCF/IOA/meta_theory/IOA" Action
begin
definition
--- a/src/HOL/HOLCF/IOA/meta_theory/Abstraction.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/meta_theory/Abstraction.thy Thu Sep 03 15:50:40 2015 +0200
@@ -364,7 +364,7 @@
(* main case *)
apply clarify
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
(* UU case *)
apply (simp add: nil_is_Conc)
(* nil case *)
@@ -431,7 +431,7 @@
temp_sat_def satisfies_def Init_def unlift_def)
apply auto
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
done
@@ -441,7 +441,7 @@
lemma TL_ex2seq_UU:
"(TL$(ex2seq (cex_abs h ex))=UU) = (TL$(ex2seq ex)=UU)"
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply (tactic {* Seq_case_simp_tac @{context} "s" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
@@ -450,7 +450,7 @@
lemma TL_ex2seq_nil:
"(TL$(ex2seq (cex_abs h ex))=nil) = (TL$(ex2seq ex)=nil)"
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply (tactic {* Seq_case_simp_tac @{context} "s" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
@@ -474,7 +474,7 @@
lemma TLex2seq: "[| (snd ex)~=UU ; (snd ex)~=nil |] ==> (? ex'. TL$(ex2seq ex) = ex2seq ex')"
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply auto
done
@@ -482,7 +482,7 @@
lemma ex2seqnilTL: "(TL$(ex2seq ex)~=nil) = ((snd ex)~=nil & (snd ex)~=UU)"
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply (tactic {* Seq_case_simp_tac @{context} "s" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
@@ -517,7 +517,7 @@
temp_sat_def satisfies_def Init_def unlift_def)
apply auto
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
done
--- a/src/HOL/HOLCF/IOA/meta_theory/RefCorrectness.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/meta_theory/RefCorrectness.thy Thu Sep 03 15:50:40 2015 +0200
@@ -185,8 +185,7 @@
apply (auto simp add: mk_traceConc)
apply (frule reachable.reachable_n)
apply assumption
-apply (erule_tac x = "y" in allE)
-apply (simp add: move_subprop4 split add: split_if)
+apply (auto simp add: move_subprop4 split add: split_if)
done
declare split_if [split]
@@ -232,7 +231,7 @@
apply (tactic {* pair_induct_tac @{context} "xs" [@{thm is_exec_frag_def}] 1 *})
(* main case *)
apply auto
-apply (rule_tac t = "f y" in lemma_2_1)
+apply (rule_tac t = "f x2" in lemma_2_1)
(* Finite *)
apply (erule move_subprop2)
@@ -246,7 +245,7 @@
(* Induction hypothesis *)
(* reachable_n looping, therefore apply it manually *)
-apply (erule_tac x = "y" in allE)
+apply (erule_tac x = "x2" in allE)
apply simp
apply (frule reachable.reachable_n)
apply assumption
--- a/src/HOL/HOLCF/IOA/meta_theory/Sequence.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/meta_theory/Sequence.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1102,7 +1102,7 @@
THEN (REPEAT_DETERM (CHANGED (asm_simp_tac ctxt i)));
fun pair_tac ctxt s =
- Rule_Insts.res_inst_tac ctxt [((("p", 0), Position.none), s)] [] @{thm PairE}
+ Rule_Insts.res_inst_tac ctxt [((("y", 0), Position.none), s)] [] @{thm PairE}
THEN' hyp_subst_tac ctxt THEN' asm_full_simp_tac ctxt;
(* induction on a sequence of pairs with pairsplitting and simplification *)
--- a/src/HOL/HOLCF/IOA/meta_theory/ShortExecutions.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/meta_theory/ShortExecutions.thy Thu Sep 03 15:50:40 2015 +0200
@@ -227,7 +227,7 @@
apply (simp add: executions_def)
apply (tactic {* pair_tac @{context} "ex" 1 *})
apply auto
-apply (rule_tac x = " (x,Cut (%a. fst a:ext A) y) " in exI)
+apply (rule_tac x = " (x1,Cut (%a. fst a:ext A) x2) " in exI)
apply (simp (no_asm_simp))
(* Subgoal 1: Lemma: propagation of execution through Cut *)
@@ -237,7 +237,7 @@
(* Subgoal 2: Lemma: Filter P s = Filter P (Cut P s) *)
apply (simp (no_asm) add: filter_act_def)
-apply (subgoal_tac "Map fst$ (Cut (%a. fst a: ext A) y) = Cut (%a. a:ext A) (Map fst$y) ")
+apply (subgoal_tac "Map fst$ (Cut (%a. fst a: ext A) x2) = Cut (%a. a:ext A) (Map fst$x2) ")
apply (rule_tac [2] MapCut [unfolded o_def])
apply (simp add: FilterCut [symmetric])
@@ -245,7 +245,7 @@
(* Subgoal 3: Lemma: Cut idempotent *)
apply (simp (no_asm) add: LastActExtsch_def filter_act_def)
-apply (subgoal_tac "Map fst$ (Cut (%a. fst a: ext A) y) = Cut (%a. a:ext A) (Map fst$y) ")
+apply (subgoal_tac "Map fst$ (Cut (%a. fst a: ext A) x2) = Cut (%a. a:ext A) (Map fst$x2) ")
apply (rule_tac [2] MapCut [unfolded o_def])
apply (simp add: Cut_idemp)
done
--- a/src/HOL/HOLCF/IOA/meta_theory/TLS.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/meta_theory/TLS.thy Thu Sep 03 15:50:40 2015 +0200
@@ -152,7 +152,7 @@
lemma ex2seq_nUUnnil: "ex2seq exec ~= UU & ex2seq exec ~= nil"
apply (tactic {* pair_tac @{context} "exec" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
done
@@ -173,14 +173,14 @@
(* TL = UU *)
apply (rule conjI)
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply (tactic {* Seq_case_simp_tac @{context} "s" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
(* TL = nil *)
apply (rule conjI)
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_tac @{context} "x2" 1 *})
apply (simp add: unlift_def)
apply fast
apply (simp add: unlift_def)
@@ -193,7 +193,7 @@
apply (simp add: unlift_def)
apply (tactic {* pair_tac @{context} "ex" 1 *})
-apply (tactic {* Seq_case_simp_tac @{context} "y" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x2" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply (tactic {* Seq_case_simp_tac @{context} "s" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
--- a/src/HOL/HOLCF/IOA/meta_theory/Traces.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/IOA/meta_theory/Traces.thy Thu Sep 03 15:50:40 2015 +0200
@@ -396,7 +396,7 @@
lemma execfrag_prefixclosed: "!x s. is_exec_frag A (s,x) & y<<x --> is_exec_frag A (s,y)"
apply (tactic {* pair_induct_tac @{context} "y" [@{thm is_exec_frag_def}] 1 *})
apply (intro strip)
-apply (tactic {* Seq_case_simp_tac @{context} "xa" 1 *})
+apply (tactic {* Seq_case_simp_tac @{context} "x" 1 *})
apply (tactic {* pair_tac @{context} "a" 1 *})
apply auto
done
--- a/src/HOL/HOLCF/Lift.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/Lift.thy Thu Sep 03 15:50:40 2015 +0200
@@ -29,7 +29,7 @@
apply (simp add: Def_def)
done
-old_rep_datatype "\<bottom>\<Colon>'a lift" Def
+old_rep_datatype "\<bottom>::'a lift" Def
by (erule lift_induct) (simp_all add: Def_def Abs_lift_inject inst_lift_pcpo)
text {* @{term bottom} and @{term Def} *}
--- a/src/HOL/HOLCF/Tools/Domain/domain_induction.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/HOLCF/Tools/Domain/domain_induction.ML Thu Sep 03 15:50:40 2015 +0200
@@ -132,8 +132,6 @@
mk_trp (p $ HOLCF_Library.mk_bottom T) :: map (con_assm true p) cons
val assms = maps eq_assms (Ps ~~ newTs ~~ map #con_specs constr_infos)
- val take_ss =
- simpset_of (put_simpset HOL_ss @{context} addsimps (@{thm Rep_cfun_strict1} :: take_rews))
fun quant_tac ctxt i = EVERY
(map (fn name =>
Rule_Insts.res_inst_tac ctxt [((("x", 0), Position.none), name)] [] spec i) x_names)
@@ -154,6 +152,8 @@
fun tacf {prems, context = ctxt} =
let
+ val take_ctxt = put_simpset HOL_ss ctxt addsimps (@{thm Rep_cfun_strict1} :: take_rews)
+
(* Prove stronger prems, without definedness side conditions *)
fun con_thm p (con, args) =
let
@@ -177,14 +177,14 @@
quant_tac ctxt 1,
simp_tac (put_simpset HOL_ss ctxt) 1,
Induct_Tacs.induct_tac ctxt [[SOME "n"]] NONE 1,
- simp_tac (put_simpset take_ss ctxt addsimps prems) 1,
+ simp_tac (take_ctxt addsimps prems) 1,
TRY (safe_tac (put_claset HOL_cs ctxt))]
fun con_tac _ =
- asm_simp_tac (put_simpset take_ss ctxt) 1 THEN
+ asm_simp_tac take_ctxt 1 THEN
(resolve_tac ctxt prems' THEN_ALL_NEW eresolve_tac ctxt [spec]) 1
fun cases_tacs (cons, exhaust) =
Rule_Insts.res_inst_tac ctxt [((("y", 0), Position.none), "x")] [] exhaust 1 ::
- asm_simp_tac (put_simpset take_ss ctxt addsimps prems) 1 ::
+ asm_simp_tac (take_ctxt addsimps prems) 1 ::
map con_tac cons
val tacs = tacs1 @ maps cases_tacs (conss ~~ exhausts)
in
--- a/src/HOL/Hahn_Banach/Linearform.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Hahn_Banach/Linearform.thy Thu Sep 03 15:50:40 2015 +0200
@@ -14,7 +14,7 @@
\<close>
locale linearform =
- fixes V :: "'a\<Colon>{minus, plus, zero, uminus} set" and f
+ fixes V :: "'a::{minus, plus, zero, uminus} set" and f
assumes add [iff]: "x \<in> V \<Longrightarrow> y \<in> V \<Longrightarrow> f (x + y) = f x + f y"
and mult [iff]: "x \<in> V \<Longrightarrow> f (a \<cdot> x) = a * f x"
--- a/src/HOL/Hahn_Banach/Normed_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Hahn_Banach/Normed_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -17,7 +17,7 @@
\<close>
locale seminorm =
- fixes V :: "'a\<Colon>{minus, plus, zero, uminus} set"
+ fixes V :: "'a::{minus, plus, zero, uminus} set"
fixes norm :: "'a \<Rightarrow> real" ("\<parallel>_\<parallel>")
assumes ge_zero [iff?]: "x \<in> V \<Longrightarrow> 0 \<le> \<parallel>x\<parallel>"
and abs_homogenous [iff?]: "x \<in> V \<Longrightarrow> \<parallel>a \<cdot> x\<parallel> = \<bar>a\<bar> * \<parallel>x\<parallel>"
--- a/src/HOL/Hahn_Banach/Subspace.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Hahn_Banach/Subspace.thy Thu Sep 03 15:50:40 2015 +0200
@@ -17,7 +17,7 @@
\<close>
locale subspace =
- fixes U :: "'a\<Colon>{minus, plus, zero, uminus} set" and V
+ fixes U :: "'a::{minus, plus, zero, uminus} set" and V
assumes non_empty [iff, intro]: "U \<noteq> {}"
and subset [iff]: "U \<subseteq> V"
and add_closed [iff]: "x \<in> U \<Longrightarrow> y \<in> U \<Longrightarrow> x + y \<in> U"
--- a/src/HOL/Hilbert_Choice.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Hilbert_Choice.thy Thu Sep 03 15:50:40 2015 +0200
@@ -49,12 +49,16 @@
text\<open>Easier to apply than @{text someI} because the conclusion has only one
occurrence of @{term P}.\<close>
lemma someI2: "[| P a; !!x. P x ==> Q x |] ==> Q (SOME x. P x)"
-by (blast intro: someI)
+ by (blast intro: someI)
text\<open>Easier to apply than @{text someI2} if the witness comes from an
existential formula\<close>
+
lemma someI2_ex: "[| \<exists>a. P a; !!x. P x ==> Q x |] ==> Q (SOME x. P x)"
-by (blast intro: someI2)
+ by (blast intro: someI2)
+
+lemma someI2_bex: "[| \<exists>a\<in>A. P a; !!x. x \<in> A \<and> P x ==> Q x |] ==> Q (SOME x. x \<in> A \<and> P x)"
+ by (blast intro: someI2)
lemma some_equality [intro]:
"[| P a; !!x. P x ==> x=a |] ==> (SOME x. P x) = a"
@@ -102,7 +106,7 @@
by (fast elim: someI)
lemma dependent_nat_choice:
- assumes 1: "\<exists>x. P 0 x" and
+ assumes 1: "\<exists>x. P 0 x" and
2: "\<And>x n. P n x \<Longrightarrow> \<exists>y. P (Suc n) y \<and> Q n x y"
shows "\<exists>f. \<forall>n. P n (f n) \<and> Q n (f n) (f (Suc n))"
proof (intro exI allI conjI)
@@ -263,7 +267,7 @@
apply (blast intro: bij_is_surj [THEN surj_f_inv_f, symmetric])
done
-lemma bij_vimage_eq_inv_image: "bij f ==> f -` A = inv f ` A"
+lemma bij_vimage_eq_inv_image: "bij f ==> f -` A = inv f ` A"
apply (auto simp add: bij_is_surj [THEN surj_f_inv_f])
apply (blast intro: bij_is_inj [THEN inv_into_f_f, symmetric])
done
@@ -283,7 +287,7 @@
proof (rule UNIV_eq_I)
fix x :: 'a
from b1b2 have "x = inv (\<lambda>y. if y = x then b1 else b2) b1" by (simp add: inv_into_def)
- thus "x \<in> range (\<lambda>f\<Colon>'a \<Rightarrow> 'b. inv f b1)" by blast
+ thus "x \<in> range (\<lambda>f::'a \<Rightarrow> 'b. inv f b1)" by blast
qed
ultimately show "finite (UNIV :: 'a set)" by simp
qed
@@ -312,7 +316,7 @@
unfolding pick_def by (subst (asm) finite.simps) (auto simp add: ex_in_conv intro: someI_ex)
ultimately have "range pick \<subseteq> S" by auto
moreover
- { fix n m
+ { fix n m
have "pick n \<notin> Sseq (n + Suc m)" by (induct m) (auto simp add: Sseq_def pick_def)
with * have "pick n \<noteq> pick (n + Suc m)" by auto
}
@@ -542,7 +546,7 @@
lemma split_paired_Eps: "(SOME x. P x) = (SOME (a,b). P(a,b))"
by simp
-lemma Eps_split: "Eps (split P) = (SOME xy. P (fst xy) (snd xy))"
+lemma Eps_split: "Eps (case_prod P) = (SOME xy. P (fst xy) (snd xy))"
by (simp add: split_def)
lemma Eps_split_eq [simp]: "(@(x',y'). x = x' & y = y') = (x,y)"
--- a/src/HOL/IMP/Abs_Int0.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/IMP/Abs_Int0.thy Thu Sep 03 15:50:40 2015 +0200
@@ -317,7 +317,7 @@
"m_s S X = (\<Sum> x \<in> X. m(S x))"
lemma m_s_h: "finite X \<Longrightarrow> m_s S X \<le> h * card X"
-by(simp add: m_s_def) (metis mult.commute of_nat_id setsum_bounded[OF h])
+by(simp add: m_s_def) (metis mult.commute of_nat_id setsum_bounded_above[OF h])
fun m_o :: "'av st option \<Rightarrow> vname set \<Rightarrow> nat" ("m\<^sub>o") where
"m_o (Some S) X = m_s S X" |
--- a/src/HOL/IMP/Abs_Int1.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/IMP/Abs_Int1.thy Thu Sep 03 15:50:40 2015 +0200
@@ -109,7 +109,7 @@
"m_s S X = (\<Sum> x \<in> X. m(fun S x))"
lemma m_s_h: "finite X \<Longrightarrow> m_s S X \<le> h * card X"
-by(simp add: m_s_def) (metis mult.commute of_nat_id setsum_bounded[OF h])
+by(simp add: m_s_def) (metis mult.commute of_nat_id setsum_bounded_above[OF h])
definition m_o :: "'av st option \<Rightarrow> vname set \<Rightarrow> nat" ("m\<^sub>o") where
"m_o opt X = (case opt of None \<Rightarrow> h * card X + 1 | Some S \<Rightarrow> m_s S X)"
--- a/src/HOL/IMP/Abs_Int_ITP/Abs_Int3_ITP.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/IMP/Abs_Int_ITP/Abs_Int3_ITP.thy Thu Sep 03 15:50:40 2015 +0200
@@ -494,7 +494,7 @@
definition "m_c m c = (let as = annos c in \<Sum>i=0..<size as. m(as!i))"
-lemma measure_m_c: "finite X \<Longrightarrow> {(c, c \<nabla>\<^sub>c c') |c c'\<Colon>ivl st option acom.
+lemma measure_m_c: "finite X \<Longrightarrow> {(c, c \<nabla>\<^sub>c c') |c c'::ivl st option acom.
strip c' = strip c \<and> c : Com X \<and> c' : Com X \<and> \<not> c' \<sqsubseteq> c}\<inverse>
\<subseteq> measure(m_c(m_o (m_st m_ivl) (2*card(X))))"
apply(auto simp: m_c_def Let_def Com_def)
--- a/src/HOL/IMP/Hoare_Examples.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/IMP/Hoare_Examples.thy Thu Sep 03 15:50:40 2015 +0200
@@ -60,12 +60,12 @@
apply(rule Assign)
apply(rule Assign')
apply simp
- apply(simp)
+ apply simp
apply(rule Assign')
apply simp
done
-text{* The proof is intentionally an apply skript because it merely composes
+text{* The proof is intentionally an apply script because it merely composes
the rules of Hoare logic. Of course, in a few places side conditions have to
be proved. But since those proofs are 1-liners, a structured proof is
overkill. In fact, we shall learn later that the application of the Hoare
--- a/src/HOL/IMPP/Com.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/IMPP/Com.thy Thu Sep 03 15:50:40 2015 +0200
@@ -43,7 +43,7 @@
consts bodies :: "(pname * com) list"(* finitely many procedure definitions *)
definition
- body :: " pname ~=> com" where
+ body :: " pname \<rightharpoonup> com" where
"body = map_of bodies"
--- a/src/HOL/Imperative_HOL/Array.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Imperative_HOL/Array.thy Thu Sep 03 15:50:40 2015 +0200
@@ -10,63 +10,63 @@
subsection {* Primitives *}
-definition present :: "heap \<Rightarrow> 'a\<Colon>heap array \<Rightarrow> bool" where
+definition present :: "heap \<Rightarrow> 'a::heap array \<Rightarrow> bool" where
"present h a \<longleftrightarrow> addr_of_array a < lim h"
-definition get :: "heap \<Rightarrow> 'a\<Colon>heap array \<Rightarrow> 'a list" where
+definition get :: "heap \<Rightarrow> 'a::heap array \<Rightarrow> 'a list" where
"get h a = map from_nat (arrays h (TYPEREP('a)) (addr_of_array a))"
-definition set :: "'a\<Colon>heap array \<Rightarrow> 'a list \<Rightarrow> heap \<Rightarrow> heap" where
+definition set :: "'a::heap array \<Rightarrow> 'a list \<Rightarrow> heap \<Rightarrow> heap" where
"set a x = arrays_update (\<lambda>h. h(TYPEREP('a) := ((h(TYPEREP('a))) (addr_of_array a:=map to_nat x))))"
-definition alloc :: "'a list \<Rightarrow> heap \<Rightarrow> 'a\<Colon>heap array \<times> heap" where
+definition alloc :: "'a list \<Rightarrow> heap \<Rightarrow> 'a::heap array \<times> heap" where
"alloc xs h = (let
l = lim h;
r = Array l;
h'' = set r xs (h\<lparr>lim := l + 1\<rparr>)
in (r, h''))"
-definition length :: "heap \<Rightarrow> 'a\<Colon>heap array \<Rightarrow> nat" where
+definition length :: "heap \<Rightarrow> 'a::heap array \<Rightarrow> nat" where
"length h a = List.length (get h a)"
-definition update :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> heap \<Rightarrow> heap" where
+definition update :: "'a::heap array \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> heap \<Rightarrow> heap" where
"update a i x h = set a ((get h a)[i:=x]) h"
-definition noteq :: "'a\<Colon>heap array \<Rightarrow> 'b\<Colon>heap array \<Rightarrow> bool" (infix "=!!=" 70) where
+definition noteq :: "'a::heap array \<Rightarrow> 'b::heap array \<Rightarrow> bool" (infix "=!!=" 70) where
"r =!!= s \<longleftrightarrow> TYPEREP('a) \<noteq> TYPEREP('b) \<or> addr_of_array r \<noteq> addr_of_array s"
subsection {* Monad operations *}
-definition new :: "nat \<Rightarrow> 'a\<Colon>heap \<Rightarrow> 'a array Heap" where
+definition new :: "nat \<Rightarrow> 'a::heap \<Rightarrow> 'a array Heap" where
[code del]: "new n x = Heap_Monad.heap (alloc (replicate n x))"
-definition of_list :: "'a\<Colon>heap list \<Rightarrow> 'a array Heap" where
+definition of_list :: "'a::heap list \<Rightarrow> 'a array Heap" where
[code del]: "of_list xs = Heap_Monad.heap (alloc xs)"
-definition make :: "nat \<Rightarrow> (nat \<Rightarrow> 'a\<Colon>heap) \<Rightarrow> 'a array Heap" where
+definition make :: "nat \<Rightarrow> (nat \<Rightarrow> 'a::heap) \<Rightarrow> 'a array Heap" where
[code del]: "make n f = Heap_Monad.heap (alloc (map f [0 ..< n]))"
-definition len :: "'a\<Colon>heap array \<Rightarrow> nat Heap" where
+definition len :: "'a::heap array \<Rightarrow> nat Heap" where
[code del]: "len a = Heap_Monad.tap (\<lambda>h. length h a)"
-definition nth :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> 'a Heap" where
+definition nth :: "'a::heap array \<Rightarrow> nat \<Rightarrow> 'a Heap" where
[code del]: "nth a i = Heap_Monad.guard (\<lambda>h. i < length h a)
(\<lambda>h. (get h a ! i, h))"
-definition upd :: "nat \<Rightarrow> 'a \<Rightarrow> 'a\<Colon>heap array \<Rightarrow> 'a\<Colon>heap array Heap" where
+definition upd :: "nat \<Rightarrow> 'a \<Rightarrow> 'a::heap array \<Rightarrow> 'a::heap array Heap" where
[code del]: "upd i x a = Heap_Monad.guard (\<lambda>h. i < length h a)
(\<lambda>h. (a, update a i x h))"
-definition map_entry :: "nat \<Rightarrow> ('a\<Colon>heap \<Rightarrow> 'a) \<Rightarrow> 'a array \<Rightarrow> 'a array Heap" where
+definition map_entry :: "nat \<Rightarrow> ('a::heap \<Rightarrow> 'a) \<Rightarrow> 'a array \<Rightarrow> 'a array Heap" where
[code del]: "map_entry i f a = Heap_Monad.guard (\<lambda>h. i < length h a)
(\<lambda>h. (a, update a i (f (get h a ! i)) h))"
-definition swap :: "nat \<Rightarrow> 'a \<Rightarrow> 'a\<Colon>heap array \<Rightarrow> 'a Heap" where
+definition swap :: "nat \<Rightarrow> 'a \<Rightarrow> 'a::heap array \<Rightarrow> 'a Heap" where
[code del]: "swap i x a = Heap_Monad.guard (\<lambda>h. i < length h a)
(\<lambda>h. (get h a ! i, update a i x h))"
-definition freeze :: "'a\<Colon>heap array \<Rightarrow> 'a list Heap" where
+definition freeze :: "'a::heap array \<Rightarrow> 'a list Heap" where
[code del]: "freeze a = Heap_Monad.tap (\<lambda>h. get h a)"
--- a/src/HOL/Imperative_HOL/Heap.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Imperative_HOL/Heap.thy Thu Sep 03 15:50:40 2015 +0200
@@ -79,10 +79,10 @@
text {* Syntactic convenience *}
setup {*
- Sign.add_const_constraint (@{const_name Array}, SOME @{typ "nat \<Rightarrow> 'a\<Colon>heap array"})
- #> Sign.add_const_constraint (@{const_name Ref}, SOME @{typ "nat \<Rightarrow> 'a\<Colon>heap ref"})
- #> Sign.add_const_constraint (@{const_name addr_of_array}, SOME @{typ "'a\<Colon>heap array \<Rightarrow> nat"})
- #> Sign.add_const_constraint (@{const_name addr_of_ref}, SOME @{typ "'a\<Colon>heap ref \<Rightarrow> nat"})
+ Sign.add_const_constraint (@{const_name Array}, SOME @{typ "nat \<Rightarrow> 'a::heap array"})
+ #> Sign.add_const_constraint (@{const_name Ref}, SOME @{typ "nat \<Rightarrow> 'a::heap ref"})
+ #> Sign.add_const_constraint (@{const_name addr_of_array}, SOME @{typ "'a::heap array \<Rightarrow> nat"})
+ #> Sign.add_const_constraint (@{const_name addr_of_ref}, SOME @{typ "'a::heap ref \<Rightarrow> nat"})
*}
hide_const (open) empty
--- a/src/HOL/Imperative_HOL/Ref.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Imperative_HOL/Ref.thy Thu Sep 03 15:50:40 2015 +0200
@@ -16,38 +16,38 @@
subsection {* Primitives *}
-definition present :: "heap \<Rightarrow> 'a\<Colon>heap ref \<Rightarrow> bool" where
+definition present :: "heap \<Rightarrow> 'a::heap ref \<Rightarrow> bool" where
"present h r \<longleftrightarrow> addr_of_ref r < lim h"
-definition get :: "heap \<Rightarrow> 'a\<Colon>heap ref \<Rightarrow> 'a" where
+definition get :: "heap \<Rightarrow> 'a::heap ref \<Rightarrow> 'a" where
"get h = from_nat \<circ> refs h TYPEREP('a) \<circ> addr_of_ref"
-definition set :: "'a\<Colon>heap ref \<Rightarrow> 'a \<Rightarrow> heap \<Rightarrow> heap" where
+definition set :: "'a::heap ref \<Rightarrow> 'a \<Rightarrow> heap \<Rightarrow> heap" where
"set r x = refs_update
(\<lambda>h. h(TYPEREP('a) := ((h (TYPEREP('a))) (addr_of_ref r := to_nat x))))"
-definition alloc :: "'a \<Rightarrow> heap \<Rightarrow> 'a\<Colon>heap ref \<times> heap" where
+definition alloc :: "'a \<Rightarrow> heap \<Rightarrow> 'a::heap ref \<times> heap" where
"alloc x h = (let
l = lim h;
r = Ref l
in (r, set r x (h\<lparr>lim := l + 1\<rparr>)))"
-definition noteq :: "'a\<Colon>heap ref \<Rightarrow> 'b\<Colon>heap ref \<Rightarrow> bool" (infix "=!=" 70) where
+definition noteq :: "'a::heap ref \<Rightarrow> 'b::heap ref \<Rightarrow> bool" (infix "=!=" 70) where
"r =!= s \<longleftrightarrow> TYPEREP('a) \<noteq> TYPEREP('b) \<or> addr_of_ref r \<noteq> addr_of_ref s"
subsection {* Monad operations *}
-definition ref :: "'a\<Colon>heap \<Rightarrow> 'a ref Heap" where
+definition ref :: "'a::heap \<Rightarrow> 'a ref Heap" where
[code del]: "ref v = Heap_Monad.heap (alloc v)"
-definition lookup :: "'a\<Colon>heap ref \<Rightarrow> 'a Heap" ("!_" 61) where
+definition lookup :: "'a::heap ref \<Rightarrow> 'a Heap" ("!_" 61) where
[code del]: "lookup r = Heap_Monad.tap (\<lambda>h. get h r)"
-definition update :: "'a ref \<Rightarrow> 'a\<Colon>heap \<Rightarrow> unit Heap" ("_ := _" 62) where
+definition update :: "'a ref \<Rightarrow> 'a::heap \<Rightarrow> unit Heap" ("_ := _" 62) where
[code del]: "update r v = Heap_Monad.heap (\<lambda>h. ((), set r v h))"
-definition change :: "('a\<Colon>heap \<Rightarrow> 'a) \<Rightarrow> 'a ref \<Rightarrow> 'a Heap" where
+definition change :: "('a::heap \<Rightarrow> 'a) \<Rightarrow> 'a ref \<Rightarrow> 'a Heap" where
"change f r = do {
x \<leftarrow> ! r;
let y = f x;
--- a/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy Thu Sep 03 15:50:40 2015 +0200
@@ -8,7 +8,7 @@
imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
begin
-fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
+fun swap :: "'a::heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
"swap a i j = do {
x \<leftarrow> Array.nth a i;
y \<leftarrow> Array.nth a j;
@@ -17,7 +17,7 @@
return ()
}"
-fun rev :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
+fun rev :: "'a::heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
"rev a i j = (if (i < j) then do {
swap a i j;
rev a (i + 1) (j - 1)
--- a/src/HOL/Imperative_HOL/ex/Linked_Lists.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Imperative_HOL/ex/Linked_Lists.thy Thu Sep 03 15:50:40 2015 +0200
@@ -10,25 +10,25 @@
section {* Definition of Linked Lists *}
-setup {* Sign.add_const_constraint (@{const_name Ref}, SOME @{typ "nat \<Rightarrow> 'a\<Colon>type ref"}) *}
+setup {* Sign.add_const_constraint (@{const_name Ref}, SOME @{typ "nat \<Rightarrow> 'a::type ref"}) *}
datatype 'a node = Empty | Node 'a "'a node ref"
primrec
- node_encode :: "'a\<Colon>countable node \<Rightarrow> nat"
+ node_encode :: "'a::countable node \<Rightarrow> nat"
where
"node_encode Empty = 0"
| "node_encode (Node x r) = Suc (to_nat (x, r))"
instance node :: (countable) countable
proof (rule countable_classI [of "node_encode"])
- fix x y :: "'a\<Colon>countable node"
+ fix x y :: "'a::countable node"
show "node_encode x = node_encode y \<Longrightarrow> x = y"
by (induct x, auto, induct y, auto, induct y, auto)
qed
instance node :: (heap) heap ..
-primrec make_llist :: "'a\<Colon>heap list \<Rightarrow> 'a node Heap"
+primrec make_llist :: "'a::heap list \<Rightarrow> 'a node Heap"
where
[simp del]: "make_llist [] = return Empty"
| "make_llist (x#xs) = do { tl \<leftarrow> make_llist xs;
@@ -37,7 +37,7 @@
}"
-partial_function (heap) traverse :: "'a\<Colon>heap node \<Rightarrow> 'a list Heap"
+partial_function (heap) traverse :: "'a::heap node \<Rightarrow> 'a list Heap"
where
[code del]: "traverse l =
(case l of Empty \<Rightarrow> return []
--- a/src/HOL/Imperative_HOL/ex/SatChecker.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy Thu Sep 03 15:50:40 2015 +0200
@@ -119,7 +119,7 @@
text {* Specific definition for derived clauses in the Array *}
definition
- array_ran :: "('a\<Colon>heap) option array \<Rightarrow> heap \<Rightarrow> 'a set" where
+ array_ran :: "('a::heap) option array \<Rightarrow> heap \<Rightarrow> 'a set" where
"array_ran a h = {e. Some e \<in> set (Array.get h a)}"
-- {*FIXME*}
--- a/src/HOL/Import/HOL_Light_Maps.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Import/HOL_Light_Maps.thy Thu Sep 03 15:50:40 2015 +0200
@@ -16,19 +16,19 @@
by simp
lemma [import_const "/\\"]:
- "(op \<and>) = (\<lambda>p q. (\<lambda>f. f p q \<Colon> bool) = (\<lambda>f. f True True))"
+ "(op \<and>) = (\<lambda>p q. (\<lambda>f. f p q :: bool) = (\<lambda>f. f True True))"
by metis
lemma [import_const "==>"]:
- "(op \<longrightarrow>) = (\<lambda>(p\<Colon>bool) q\<Colon>bool. (p \<and> q) = p)"
+ "(op \<longrightarrow>) = (\<lambda>(p::bool) q::bool. (p \<and> q) = p)"
by auto
lemma [import_const "!"]:
- "All = (\<lambda>P\<Colon>'A \<Rightarrow> bool. P = (\<lambda>x\<Colon>'A. True))"
+ "All = (\<lambda>P::'A \<Rightarrow> bool. P = (\<lambda>x::'A. True))"
by auto
lemma [import_const "?"]:
- "Ex = (\<lambda>P\<Colon>'A \<Rightarrow> bool. All (\<lambda>q\<Colon>bool. (All (\<lambda>x\<Colon>'A\<Colon>type. (P x) \<longrightarrow> q)) \<longrightarrow> q))"
+ "Ex = (\<lambda>P::'A \<Rightarrow> bool. All (\<lambda>q::bool. (All (\<lambda>x::'A::type. (P x) \<longrightarrow> q)) \<longrightarrow> q))"
by auto
lemma [import_const "\\/"]:
@@ -44,16 +44,16 @@
by simp
lemma [import_const "?!"]:
- "Ex1 = (\<lambda>P\<Colon>'A \<Rightarrow> bool. Ex P \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> x = y))"
+ "Ex1 = (\<lambda>P::'A \<Rightarrow> bool. Ex P \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> x = y))"
by auto
lemma [import_const "_FALSITY_"]: "False = False"
by simp
-lemma hl_ax1: "\<forall>t\<Colon>'A \<Rightarrow> 'B. (\<lambda>x. t x) = t"
+lemma hl_ax1: "\<forall>t::'A \<Rightarrow> 'B. (\<lambda>x. t x) = t"
by metis
-lemma hl_ax2: "\<forall>P x\<Colon>'A. P x \<longrightarrow> P (Eps P)"
+lemma hl_ax2: "\<forall>P x::'A. P x \<longrightarrow> P (Eps P)"
by (auto intro: someI)
lemma [import_const COND]:
@@ -61,51 +61,51 @@
unfolding fun_eq_iff by auto
lemma [import_const o]:
- "(op \<circ>) = (\<lambda>(f\<Colon>'B \<Rightarrow> 'C) g x\<Colon>'A. f (g x))"
+ "(op \<circ>) = (\<lambda>(f::'B \<Rightarrow> 'C) g x::'A. f (g x))"
unfolding fun_eq_iff by simp
-lemma [import_const I]: "id = (\<lambda>x\<Colon>'A. x)"
+lemma [import_const I]: "id = (\<lambda>x::'A. x)"
by auto
lemma [import_type 1 one_ABS one_REP]:
"type_definition Rep_unit Abs_unit (Collect (\<lambda>b. b))"
by (metis (full_types) Collect_cong singleton_conv2 type_definition_unit)
-lemma [import_const one]: "() = (SOME x\<Colon>unit. True)"
+lemma [import_const one]: "() = (SOME x::unit. True)"
by auto
lemma [import_const mk_pair]:
- "Pair_Rep = (\<lambda>(x\<Colon>'A) (y\<Colon>'B) (a\<Colon>'A) b\<Colon>'B. a = x \<and> b = y)"
+ "Pair_Rep = (\<lambda>(x::'A) (y::'B) (a::'A) b::'B. a = x \<and> b = y)"
by (simp add: Pair_Rep_def fun_eq_iff)
lemma [import_type prod ABS_prod REP_prod]:
- "type_definition Rep_prod Abs_prod (Collect (\<lambda>x\<Colon>'A \<Rightarrow> 'B \<Rightarrow> bool. \<exists>a b. x = Pair_Rep a b))"
+ "type_definition Rep_prod Abs_prod (Collect (\<lambda>x::'A \<Rightarrow> 'B \<Rightarrow> bool. \<exists>a b. x = Pair_Rep a b))"
using type_definition_prod[unfolded Product_Type.prod_def] by simp
-lemma [import_const ","]: "Pair = (\<lambda>(x\<Colon>'A) y\<Colon>'B. Abs_prod (Pair_Rep x y))"
+lemma [import_const ","]: "Pair = (\<lambda>(x::'A) y::'B. Abs_prod (Pair_Rep x y))"
by (metis Pair_def)
lemma [import_const FST]:
- "fst = (\<lambda>p\<Colon>'A \<times> 'B. SOME x\<Colon>'A. \<exists>y\<Colon>'B. p = (x, y))"
+ "fst = (\<lambda>p::'A \<times> 'B. SOME x::'A. \<exists>y::'B. p = (x, y))"
by auto
lemma [import_const SND]:
- "snd = (\<lambda>p\<Colon>'A \<times> 'B. SOME y\<Colon>'B. \<exists>x\<Colon>'A. p = (x, y))"
+ "snd = (\<lambda>p::'A \<times> 'B. SOME y::'B. \<exists>x::'A. p = (x, y))"
by auto
lemma CURRY_DEF[import_const CURRY]:
- "curry = (\<lambda>(f\<Colon>'A \<times> 'B \<Rightarrow> 'C) x y. f (x, y))"
+ "curry = (\<lambda>(f::'A \<times> 'B \<Rightarrow> 'C) x y. f (x, y))"
using curry_def .
lemma [import_const ONE_ONE : inj]:
- "inj = (\<lambda>(f\<Colon>'A \<Rightarrow> 'B). \<forall>x1 x2. f x1 = f x2 \<longrightarrow> x1 = x2)"
+ "inj = (\<lambda>(f::'A \<Rightarrow> 'B). \<forall>x1 x2. f x1 = f x2 \<longrightarrow> x1 = x2)"
by (auto simp add: fun_eq_iff inj_on_def)
lemma [import_const ONTO : surj]:
- "surj = (\<lambda>(f\<Colon>'A \<Rightarrow> 'B). \<forall>y. \<exists>x. y = f x)"
+ "surj = (\<lambda>(f::'A \<Rightarrow> 'B). \<forall>y. \<exists>x. y = f x)"
by (auto simp add: fun_eq_iff)
-lemma hl_ax3: "\<exists>f\<Colon>ind \<Rightarrow> ind. inj f \<and> \<not> surj f"
+lemma hl_ax3: "\<exists>f::ind \<Rightarrow> ind. inj f \<and> \<not> surj f"
by (rule_tac x="Suc_Rep" in exI)
(metis Suc_Rep_inject' injI Suc_Rep_not_Zero_Rep surjD)
@@ -142,7 +142,7 @@
definition [simp]: "pred n = n - 1"
lemma PRE[import_const PRE : pred]:
- "pred (id (0\<Colon>nat)) = id (0\<Colon>nat) \<and> (\<forall>n\<Colon>nat. pred (Suc n) = n)"
+ "pred (id (0::nat)) = id (0::nat) \<and> (\<forall>n::nat. pred (Suc n) = n)"
by simp
lemma ADD[import_const "+" : plus]:
@@ -186,11 +186,11 @@
"even = Parity.even"
lemma EVEN[import_const "EVEN" : even]:
- "even (id 0\<Colon>nat) = True \<and> (\<forall>n. even (Suc n) = (\<not> even n))"
+ "even (id 0::nat) = True \<and> (\<forall>n. even (Suc n) = (\<not> even n))"
by (simp add: even_def)
lemma SUB[import_const "-" : minus]:
- "(\<forall>m\<Colon>nat. m - (id 0) = m) \<and> (\<forall>m n. m - (Suc n) = pred (m - n))"
+ "(\<forall>m::nat. m - (id 0) = m) \<and> (\<forall>m n. m - (Suc n) = pred (m - n))"
by simp
lemma FACT[import_const "FACT" : fact]:
@@ -201,7 +201,7 @@
import_const_map DIV : divide
lemma DIVISION_0:
- "\<forall>m n\<Colon>nat. if n = id 0 then m div n = id 0 \<and> m mod n = m else m = m div n * n + m mod n \<and> m mod n < n"
+ "\<forall>m n::nat. if n = id 0 then m div n = id 0 \<and> m mod n = m else m = m div n * n + m mod n \<and> m mod n < n"
by simp
lemmas [import_type sum "_dest_sum" "_mk_sum"] = type_definition_sum[where 'a="'A" and 'b="'B"]
@@ -229,40 +229,40 @@
import_const_map CONS : Cons
lemma list_INDUCT:
- "\<forall>P\<Colon>'A list \<Rightarrow> bool. P [] \<and> (\<forall>a0 a1. P a1 \<longrightarrow> P (a0 # a1)) \<longrightarrow> (\<forall>x. P x)"
+ "\<forall>P::'A list \<Rightarrow> bool. P [] \<and> (\<forall>a0 a1. P a1 \<longrightarrow> P (a0 # a1)) \<longrightarrow> (\<forall>x. P x)"
using list.induct by auto
lemma list_RECURSION:
- "\<forall>nil' cons'. \<exists>fn\<Colon>'A list \<Rightarrow> 'Z. fn [] = nil' \<and> (\<forall>(a0\<Colon>'A) a1\<Colon>'A list. fn (a0 # a1) = cons' a0 a1 (fn a1))"
+ "\<forall>nil' cons'. \<exists>fn::'A list \<Rightarrow> 'Z. fn [] = nil' \<and> (\<forall>(a0::'A) a1::'A list. fn (a0 # a1) = cons' a0 a1 (fn a1))"
by (intro allI, rule_tac x="rec_list nil' cons'" in exI) auto
lemma HD[import_const HD : hd]:
- "hd ((h\<Colon>'A) # t) = h"
+ "hd ((h::'A) # t) = h"
by simp
lemma TL[import_const TL : tl]:
- "tl ((h\<Colon>'A) # t) = t"
+ "tl ((h::'A) # t) = t"
by simp
lemma APPEND[import_const APPEND : append]:
- "(\<forall>l\<Colon>'A list. [] @ l = l) \<and> (\<forall>(h\<Colon>'A) t l. (h # t) @ l = h # t @ l)"
+ "(\<forall>l::'A list. [] @ l = l) \<and> (\<forall>(h::'A) t l. (h # t) @ l = h # t @ l)"
by simp
lemma REVERSE[import_const REVERSE : rev]:
- "rev [] = ([] :: 'A list) \<and> rev ((x\<Colon>'A) # l) = rev l @ [x]"
+ "rev [] = ([] :: 'A list) \<and> rev ((x::'A) # l) = rev l @ [x]"
by simp
lemma LENGTH[import_const LENGTH : length]:
- "length ([] :: 'A list) = id 0 \<and> (\<forall>(h\<Colon>'A) t. length (h # t) = Suc (length t))"
+ "length ([] :: 'A list) = id 0 \<and> (\<forall>(h::'A) t. length (h # t) = Suc (length t))"
by simp
lemma MAP[import_const MAP : map]:
- "(\<forall>f\<Colon>'A \<Rightarrow> 'B. map f [] = []) \<and>
- (\<forall>(f\<Colon>'A \<Rightarrow> 'B) h t. map f (h # t) = f h # map f t)"
+ "(\<forall>f::'A \<Rightarrow> 'B. map f [] = []) \<and>
+ (\<forall>(f::'A \<Rightarrow> 'B) h t. map f (h # t) = f h # map f t)"
by simp
lemma LAST[import_const LAST : last]:
- "last ((h\<Colon>'A) # t) = (if t = [] then h else last t)"
+ "last ((h::'A) # t) = (if t = [] then h else last t)"
by simp
lemma BUTLAST[import_const BUTLAST : butlast]:
@@ -271,43 +271,43 @@
by simp
lemma REPLICATE[import_const REPLICATE : replicate]:
- "replicate (id (0\<Colon>nat)) (x\<Colon>'t18358) = [] \<and>
+ "replicate (id (0::nat)) (x::'t18358) = [] \<and>
replicate (Suc n) x = x # replicate n x"
by simp
lemma NULL[import_const NULL : List.null]:
- "List.null ([]\<Colon>'t18373 list) = True \<and> List.null ((h\<Colon>'t18373) # t) = False"
+ "List.null ([]::'t18373 list) = True \<and> List.null ((h::'t18373) # t) = False"
unfolding null_def by simp
lemma ALL[import_const ALL : list_all]:
- "list_all (P\<Colon>'t18393 \<Rightarrow> bool) [] = True \<and>
+ "list_all (P::'t18393 \<Rightarrow> bool) [] = True \<and>
list_all P (h # t) = (P h \<and> list_all P t)"
by simp
lemma EX[import_const EX : list_ex]:
- "list_ex (P\<Colon>'t18414 \<Rightarrow> bool) [] = False \<and>
+ "list_ex (P::'t18414 \<Rightarrow> bool) [] = False \<and>
list_ex P (h # t) = (P h \<or> list_ex P t)"
by simp
lemma ITLIST[import_const ITLIST : foldr]:
- "foldr (f\<Colon>'t18437 \<Rightarrow> 't18436 \<Rightarrow> 't18436) [] b = b \<and>
+ "foldr (f::'t18437 \<Rightarrow> 't18436 \<Rightarrow> 't18436) [] b = b \<and>
foldr f (h # t) b = f h (foldr f t b)"
by simp
lemma ALL2_DEF[import_const ALL2 : list_all2]:
- "list_all2 (P\<Colon>'t18495 \<Rightarrow> 't18502 \<Rightarrow> bool) [] (l2\<Colon>'t18502 list) = (l2 = []) \<and>
- list_all2 P ((h1\<Colon>'t18495) # (t1\<Colon>'t18495 list)) l2 =
+ "list_all2 (P::'t18495 \<Rightarrow> 't18502 \<Rightarrow> bool) [] (l2::'t18502 list) = (l2 = []) \<and>
+ list_all2 P ((h1::'t18495) # (t1::'t18495 list)) l2 =
(if l2 = [] then False else P h1 (hd l2) \<and> list_all2 P t1 (tl l2))"
by simp (induct_tac l2, simp_all)
lemma FILTER[import_const FILTER : filter]:
- "filter (P\<Colon>'t18680 \<Rightarrow> bool) [] = [] \<and>
- filter P ((h\<Colon>'t18680) # t) = (if P h then h # filter P t else filter P t)"
+ "filter (P::'t18680 \<Rightarrow> bool) [] = [] \<and>
+ filter P ((h::'t18680) # t) = (if P h then h # filter P t else filter P t)"
by simp
lemma ZIP[import_const ZIP : zip]:
"zip [] [] = ([] :: ('t18824 \<times> 't18825) list) \<and>
- zip ((h1\<Colon>'t18849) # t1) ((h2\<Colon>'t18850) # t2) = (h1, h2) # zip t1 t2"
+ zip ((h1::'t18849) # t1) ((h2::'t18850) # t2) = (h1, h2) # zip t1 t2"
by simp
lemma WF[import_const WF : wfP]:
--- a/src/HOL/Inductive.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Inductive.thy Thu Sep 03 15:50:40 2015 +0200
@@ -57,7 +57,7 @@
subsection \<open>General induction rules for least fixed points\<close>
lemma lfp_ordinal_induct[case_names mono step union]:
- fixes f :: "'a\<Colon>complete_lattice \<Rightarrow> 'a"
+ fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
assumes mono: "mono f"
and P_f: "\<And>S. P S \<Longrightarrow> S \<le> lfp f \<Longrightarrow> P (f S)"
and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Sup M)"
@@ -177,7 +177,7 @@
by (blast dest: gfp_lemma2 mono_Un)
lemma gfp_ordinal_induct[case_names mono step union]:
- fixes f :: "'a\<Colon>complete_lattice \<Rightarrow> 'a"
+ fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
assumes mono: "mono f"
and P_f: "\<And>S. P S \<Longrightarrow> gfp f \<le> S \<Longrightarrow> P (f S)"
and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Inf M)"
--- a/src/HOL/Int.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Int.thy Thu Sep 03 15:50:40 2015 +0200
@@ -107,10 +107,10 @@
begin
definition
- "(inf \<Colon> int \<Rightarrow> int \<Rightarrow> int) = min"
+ "(inf :: int \<Rightarrow> int \<Rightarrow> int) = min"
definition
- "(sup \<Colon> int \<Rightarrow> int \<Rightarrow> int) = max"
+ "(sup :: int \<Rightarrow> int \<Rightarrow> int) = max"
instance
by intro_classes
@@ -161,10 +161,10 @@
begin
definition
- zabs_def: "\<bar>i\<Colon>int\<bar> = (if i < 0 then - i else i)"
+ zabs_def: "\<bar>i::int\<bar> = (if i < 0 then - i else i)"
definition
- zsgn_def: "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
+ zsgn_def: "sgn (i::int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
instance proof
fix i j k :: int
@@ -172,17 +172,17 @@
by (rule zmult_zless_mono2)
show "\<bar>i\<bar> = (if i < 0 then -i else i)"
by (simp only: zabs_def)
- show "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
+ show "sgn (i::int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
by (simp only: zsgn_def)
qed
end
-lemma zless_imp_add1_zle: "w < z \<Longrightarrow> w + (1\<Colon>int) \<le> z"
+lemma zless_imp_add1_zle: "w < z \<Longrightarrow> w + (1::int) \<le> z"
by transfer clarsimp
lemma zless_iff_Suc_zadd:
- "(w \<Colon> int) < z \<longleftrightarrow> (\<exists>n. z = w + int (Suc n))"
+ "(w :: int) < z \<longleftrightarrow> (\<exists>n. z = w + int (Suc n))"
apply transfer
apply auto
apply (rename_tac a b c d)
@@ -438,7 +438,7 @@
subsection\<open>Lemmas about the Function @{term of_nat} and Orderings\<close>
-lemma negative_zless_0: "- (int (Suc n)) < (0 \<Colon> int)"
+lemma negative_zless_0: "- (int (Suc n)) < (0 :: int)"
by (simp add: order_less_le del: of_nat_Suc)
lemma negative_zless [iff]: "- (int (Suc n)) < int m"
@@ -623,11 +623,8 @@
context ring_1
begin
-definition Ints :: "'a set" where
- "Ints = range of_int"
-
-notation (xsymbols)
- Ints ("\<int>")
+definition Ints :: "'a set" ("\<int>")
+ where "\<int> = range of_int"
lemma Ints_of_int [simp]: "of_int z \<in> \<int>"
by (simp add: Ints_def)
@@ -687,7 +684,7 @@
text \<open>The premise involving @{term Ints} prevents @{term "a = 1/2"}.\<close>
lemma Ints_double_eq_0_iff:
- assumes in_Ints: "a \<in> Ints"
+ assumes in_Ints: "a \<in> \<int>"
shows "(a + a = 0) = (a = (0::'a::ring_char_0))"
proof -
from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
@@ -706,7 +703,7 @@
qed
lemma Ints_odd_nonzero:
- assumes in_Ints: "a \<in> Ints"
+ assumes in_Ints: "a \<in> \<int>"
shows "1 + a + a \<noteq> (0::'a::ring_char_0)"
proof -
from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
@@ -720,11 +717,11 @@
qed
qed
-lemma Nats_numeral [simp]: "numeral w \<in> Nats"
+lemma Nats_numeral [simp]: "numeral w \<in> \<nat>"
using of_nat_in_Nats [of "numeral w"] by simp
lemma Ints_odd_less_0:
- assumes in_Ints: "a \<in> Ints"
+ assumes in_Ints: "a \<in> \<int>"
shows "(1 + a + a < 0) = (a < (0::'a::linordered_idom))"
proof -
from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
@@ -1120,9 +1117,9 @@
lemma infinite_UNIV_int: "\<not> finite (UNIV::int set)"
proof
assume "finite (UNIV::int set)"
- moreover have "inj (\<lambda>i\<Colon>int. 2 * i)"
+ moreover have "inj (\<lambda>i::int. 2 * i)"
by (rule injI) simp
- ultimately have "surj (\<lambda>i\<Colon>int. 2 * i)"
+ ultimately have "surj (\<lambda>i::int. 2 * i)"
by (rule finite_UNIV_inj_surj)
then obtain i :: int where "1 = 2 * i" by (rule surjE)
then show False by (simp add: pos_zmult_eq_1_iff)
--- a/src/HOL/Lattice/Orders.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Lattice/Orders.thy Thu Sep 03 15:50:40 2015 +0200
@@ -10,7 +10,7 @@
text {*
We define several classes of ordered structures over some type @{typ
- 'a} with relation @{text "\<sqsubseteq> \<Colon> 'a \<Rightarrow> 'a \<Rightarrow> bool"}. For a
+ 'a} with relation @{text "\<sqsubseteq> :: 'a \<Rightarrow> 'a \<Rightarrow> bool"}. For a
\emph{quasi-order} that relation is required to be reflexive and
transitive, for a \emph{partial order} it also has to be
anti-symmetric, while for a \emph{linear order} all elements are
--- a/src/HOL/Lattices.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Lattices.thy Thu Sep 03 15:50:40 2015 +0200
@@ -222,7 +222,7 @@
by (fast intro: inf_greatest le_infI1 le_infI2)
lemma mono_inf:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>semilattice_inf"
+ fixes f :: "'a \<Rightarrow> 'b::semilattice_inf"
shows "mono f \<Longrightarrow> f (A \<sqinter> B) \<sqsubseteq> f A \<sqinter> f B"
by (auto simp add: mono_def intro: Lattices.inf_greatest)
@@ -259,7 +259,7 @@
by (fast intro: sup_least le_supI1 le_supI2)
lemma mono_sup:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>semilattice_sup"
+ fixes f :: "'a \<Rightarrow> 'b::semilattice_sup"
shows "mono f \<Longrightarrow> f A \<squnion> f B \<sqsubseteq> f (A \<squnion> B)"
by (auto simp add: mono_def intro: Lattices.sup_least)
@@ -770,21 +770,21 @@
by (simp add: max_def)
lemma min_of_mono:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>linorder"
+ fixes f :: "'a \<Rightarrow> 'b::linorder"
shows "mono f \<Longrightarrow> min (f m) (f n) = f (min m n)"
by (auto simp: mono_def Orderings.min_def min_def intro: Orderings.antisym)
lemma max_of_mono:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>linorder"
+ fixes f :: "'a \<Rightarrow> 'b::linorder"
shows "mono f \<Longrightarrow> max (f m) (f n) = f (max m n)"
by (auto simp: mono_def Orderings.max_def max_def intro: Orderings.antisym)
end
-lemma inf_min: "inf = (min \<Colon> 'a\<Colon>{semilattice_inf, linorder} \<Rightarrow> 'a \<Rightarrow> 'a)"
+lemma inf_min: "inf = (min :: 'a::{semilattice_inf,linorder} \<Rightarrow> 'a \<Rightarrow> 'a)"
by (auto intro: antisym simp add: min_def fun_eq_iff)
-lemma sup_max: "sup = (max \<Colon> 'a\<Colon>{semilattice_sup, linorder} \<Rightarrow> 'a \<Rightarrow> 'a)"
+lemma sup_max: "sup = (max :: 'a::{semilattice_sup,linorder} \<Rightarrow> 'a \<Rightarrow> 'a)"
by (auto intro: antisym simp add: max_def fun_eq_iff)
--- a/src/HOL/Library/Cardinality.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Cardinality.thy Thu Sep 03 15:50:40 2015 +0200
@@ -41,7 +41,7 @@
syntax "_type_card" :: "type => nat" ("(1CARD/(1'(_')))")
-translations "CARD('t)" => "CONST card (CONST UNIV \<Colon> 't set)"
+translations "CARD('t)" => "CONST card (CONST UNIV :: 't set)"
print_translation \<open>
let
--- a/src/HOL/Library/Char_ord.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Char_ord.thy Thu Sep 03 15:50:40 2015 +0200
@@ -22,8 +22,8 @@
instantiation nibble :: distrib_lattice
begin
-definition "(inf \<Colon> nibble \<Rightarrow> _) = min"
-definition "(sup \<Colon> nibble \<Rightarrow> _) = max"
+definition "(inf :: nibble \<Rightarrow> _) = min"
+definition "(sup :: nibble \<Rightarrow> _) = max"
instance
by standard (auto simp add: inf_nibble_def sup_nibble_def max_min_distrib2)
@@ -74,8 +74,8 @@
instantiation char :: distrib_lattice
begin
-definition "(inf \<Colon> char \<Rightarrow> _) = min"
-definition "(sup \<Colon> char \<Rightarrow> _) = max"
+definition "(inf :: char \<Rightarrow> _) = min"
+definition "(sup :: char \<Rightarrow> _) = max"
instance
by standard (auto simp add: inf_char_def sup_char_def max_min_distrib2)
--- a/src/HOL/Library/Code_Binary_Nat.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Code_Binary_Nat.thy Thu Sep 03 15:50:40 2015 +0200
@@ -27,10 +27,10 @@
by (simp_all add: nat_of_num_inverse)
lemma [code]:
- "(1\<Colon>nat) = Numeral1"
+ "(1::nat) = Numeral1"
by simp
-lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
+lemma [code_abbrev]: "Numeral1 = (1::nat)"
by simp
lemma [code]:
--- a/src/HOL/Library/Code_Char.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Code_Char.thy Thu Sep 03 15:50:40 2015 +0200
@@ -28,7 +28,7 @@
and (OCaml) "!((_ : char) = _)"
and (Haskell) infix 4 "=="
and (Scala) infixl 5 "=="
-| constant "Code_Evaluation.term_of \<Colon> char \<Rightarrow> term" \<rightharpoonup>
+| constant "Code_Evaluation.term_of :: char \<Rightarrow> term" \<rightharpoonup>
(Eval) "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))"
code_reserved SML
--- a/src/HOL/Library/Convex.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Convex.thy Thu Sep 03 15:50:40 2015 +0200
@@ -137,7 +137,7 @@
by (simp only: convex_Int 3 4)
qed
-lemma convex_Reals: "convex Reals"
+lemma convex_Reals: "convex \<real>"
by (simp add: convex_def scaleR_conv_of_real)
--- a/src/HOL/Library/Countable.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Countable.thy Thu Sep 03 15:50:40 2015 +0200
@@ -13,7 +13,7 @@
subsection \<open>The class of countable types\<close>
class countable =
- assumes ex_inj: "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat"
+ assumes ex_inj: "\<exists>to_nat :: 'a \<Rightarrow> nat. inj to_nat"
lemma countable_classI:
fixes f :: "'a \<Rightarrow> nat"
@@ -27,11 +27,11 @@
subsection \<open>Conversion functions\<close>
-definition to_nat :: "'a\<Colon>countable \<Rightarrow> nat" where
+definition to_nat :: "'a::countable \<Rightarrow> nat" where
"to_nat = (SOME f. inj f)"
-definition from_nat :: "nat \<Rightarrow> 'a\<Colon>countable" where
- "from_nat = inv (to_nat \<Colon> 'a \<Rightarrow> nat)"
+definition from_nat :: "nat \<Rightarrow> 'a::countable" where
+ "from_nat = inv (to_nat :: 'a \<Rightarrow> nat)"
lemma inj_to_nat [simp]: "inj to_nat"
by (rule exE_some [OF ex_inj]) (simp add: to_nat_def)
@@ -54,13 +54,13 @@
subclass (in finite) countable
proof
- have "finite (UNIV\<Colon>'a set)" by (rule finite_UNIV)
+ have "finite (UNIV::'a set)" by (rule finite_UNIV)
with finite_conv_nat_seg_image [of "UNIV::'a set"]
obtain n and f :: "nat \<Rightarrow> 'a"
where "UNIV = f ` {i. i < n}" by auto
then have "surj f" unfolding surj_def by auto
then have "inj (inv f)" by (rule surj_imp_inj_inv)
- then show "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat" by (rule exI[of inj])
+ then show "\<exists>to_nat :: 'a \<Rightarrow> nat. inj to_nat" by (rule exI[of inj])
qed
--- a/src/HOL/Library/Extended_Nat.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Extended_Nat.thy Thu Sep 03 15:50:40 2015 +0200
@@ -112,8 +112,8 @@
by (simp add: zero_enat_def)
lemma zero_one_enat_neq [simp]:
- "\<not> 0 = (1\<Colon>enat)"
- "\<not> 1 = (0\<Colon>enat)"
+ "\<not> 0 = (1::enat)"
+ "\<not> 1 = (0::enat)"
unfolding zero_enat_def one_enat_def by simp_all
lemma infinity_ne_i1 [simp]: "(\<infinity>::enat) \<noteq> 1"
@@ -380,14 +380,14 @@
a generalize linordered_semidom to a new class that includes enat? *)
lemma enat_ord_number [simp]:
- "(numeral m \<Colon> enat) \<le> numeral n \<longleftrightarrow> (numeral m \<Colon> nat) \<le> numeral n"
- "(numeral m \<Colon> enat) < numeral n \<longleftrightarrow> (numeral m \<Colon> nat) < numeral n"
+ "(numeral m :: enat) \<le> numeral n \<longleftrightarrow> (numeral m :: nat) \<le> numeral n"
+ "(numeral m :: enat) < numeral n \<longleftrightarrow> (numeral m :: nat) < numeral n"
by (simp_all add: numeral_eq_enat)
-lemma i0_lb [simp]: "(0\<Colon>enat) \<le> n"
+lemma i0_lb [simp]: "(0::enat) \<le> n"
by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
-lemma ile0_eq [simp]: "n \<le> (0\<Colon>enat) \<longleftrightarrow> n = 0"
+lemma ile0_eq [simp]: "n \<le> (0::enat) \<longleftrightarrow> n = 0"
by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
lemma infinity_ileE [elim!]: "\<infinity> \<le> enat m \<Longrightarrow> R"
@@ -396,10 +396,10 @@
lemma infinity_ilessE [elim!]: "\<infinity> < enat m \<Longrightarrow> R"
by simp
-lemma not_iless0 [simp]: "\<not> n < (0\<Colon>enat)"
+lemma not_iless0 [simp]: "\<not> n < (0::enat)"
by (simp add: zero_enat_def less_enat_def split: enat.splits)
-lemma i0_less [simp]: "(0\<Colon>enat) < n \<longleftrightarrow> n \<noteq> 0"
+lemma i0_less [simp]: "(0::enat) < n \<longleftrightarrow> n \<noteq> 0"
by (simp add: zero_enat_def less_enat_def split: enat.splits)
lemma eSuc_ile_mono [simp]: "eSuc n \<le> eSuc m \<longleftrightarrow> n \<le> m"
@@ -623,7 +623,7 @@
instance enat :: wellorder
proof
fix P and n
- assume hyp: "(\<And>n\<Colon>enat. (\<And>m\<Colon>enat. m < n \<Longrightarrow> P m) \<Longrightarrow> P n)"
+ assume hyp: "(\<And>n::enat. (\<And>m::enat. m < n \<Longrightarrow> P m) \<Longrightarrow> P n)"
show "P n" by (blast intro: enat_less_induct hyp)
qed
--- a/src/HOL/Library/Fraction_Field.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Fraction_Field.thy Thu Sep 03 15:50:40 2015 +0200
@@ -366,10 +366,10 @@
by transfer(auto simp add: zero_less_mult_iff le_less)
definition inf_fract_def:
- "(inf \<Colon> 'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract) = min"
+ "(inf :: 'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract) = min"
definition sup_fract_def:
- "(sup \<Colon> 'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract) = max"
+ "(sup :: 'a fract \<Rightarrow> 'a fract \<Rightarrow> 'a fract) = max"
instance
by intro_classes (simp_all add: abs_fract_def2 sgn_fract_def inf_fract_def sup_fract_def max_min_distrib2)
--- a/src/HOL/Library/List_lexord.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/List_lexord.thy Thu Sep 03 15:50:40 2015 +0200
@@ -69,9 +69,9 @@
instantiation list :: (linorder) distrib_lattice
begin
-definition "(inf \<Colon> 'a list \<Rightarrow> _) = min"
+definition "(inf :: 'a list \<Rightarrow> _) = min"
-definition "(sup \<Colon> 'a list \<Rightarrow> _) = max"
+definition "(sup :: 'a list \<Rightarrow> _) = max"
instance
by standard (auto simp add: inf_list_def sup_list_def max_min_distrib2)
@@ -107,15 +107,15 @@
end
lemma less_list_code [code]:
- "xs < ([]\<Colon>'a\<Colon>{equal, order} list) \<longleftrightarrow> False"
- "[] < (x\<Colon>'a\<Colon>{equal, order}) # xs \<longleftrightarrow> True"
- "(x\<Colon>'a\<Colon>{equal, order}) # xs < y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs < ys"
+ "xs < ([]::'a::{equal, order} list) \<longleftrightarrow> False"
+ "[] < (x::'a::{equal, order}) # xs \<longleftrightarrow> True"
+ "(x::'a::{equal, order}) # xs < y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs < ys"
by simp_all
lemma less_eq_list_code [code]:
- "x # xs \<le> ([]\<Colon>'a\<Colon>{equal, order} list) \<longleftrightarrow> False"
- "[] \<le> (xs\<Colon>'a\<Colon>{equal, order} list) \<longleftrightarrow> True"
- "(x\<Colon>'a\<Colon>{equal, order}) # xs \<le> y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs \<le> ys"
+ "x # xs \<le> ([]::'a::{equal, order} list) \<longleftrightarrow> False"
+ "[] \<le> (xs::'a::{equal, order} list) \<longleftrightarrow> True"
+ "(x::'a::{equal, order}) # xs \<le> y # ys \<longleftrightarrow> x < y \<or> x = y \<and> xs \<le> ys"
by simp_all
end
--- a/src/HOL/Library/Mapping.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Mapping.thy Thu Sep 03 15:50:40 2015 +0200
@@ -40,12 +40,12 @@
lemma is_none_parametric [transfer_rule]:
"(rel_option A ===> HOL.eq) Option.is_none Option.is_none"
- by (auto simp add: is_none_def rel_fun_def rel_option_iff split: option.split)
+ by (auto simp add: Option.is_none_def rel_fun_def rel_option_iff split: option.split)
lemma dom_parametric:
assumes [transfer_rule]: "bi_total A"
shows "((A ===> rel_option B) ===> rel_set A) dom dom"
- unfolding dom_def [abs_def] is_none_def [symmetric] by transfer_prover
+ unfolding dom_def [abs_def] Option.is_none_def [symmetric] by transfer_prover
lemma map_of_parametric [transfer_rule]:
assumes [transfer_rule]: "bi_unique R1"
@@ -138,7 +138,7 @@
subsection \<open>Derived operations\<close>
-definition ordered_keys :: "('a\<Colon>linorder, 'b) mapping \<Rightarrow> 'a list"
+definition ordered_keys :: "('a::linorder, 'b) mapping \<Rightarrow> 'a list"
where
"ordered_keys m = (if finite (keys m) then sorted_list_of_set (keys m) else [])"
@@ -223,7 +223,7 @@
lemma keys_is_none_rep [code_unfold]:
"k \<in> keys m \<longleftrightarrow> \<not> (Option.is_none (lookup m k))"
- by transfer (auto simp add: is_none_def)
+ by transfer (auto simp add: Option.is_none_def)
lemma update_update:
"update k v (update k w m) = update k v m"
--- a/src/HOL/Library/Multiset.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Multiset.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1169,6 +1169,10 @@
lemma filter_eq_replicate_mset: "{#y \<in># D. y = x#} = replicate_mset (count D x) x"
by (induct D) simp_all
+lemma replicate_count_mset_eq_filter_eq:
+ "replicate (count (mset xs) k) k = filter (HOL.eq k) xs"
+ by (induct xs) auto
+
subsection \<open>Big operators\<close>
@@ -1201,7 +1205,7 @@
end
-lemma comp_fun_commute_plus_mset[simp]: "comp_fun_commute (op + \<Colon> 'a multiset \<Rightarrow> _ \<Rightarrow> _)"
+lemma comp_fun_commute_plus_mset[simp]: "comp_fun_commute (op + :: 'a multiset \<Rightarrow> _ \<Rightarrow> _)"
by standard (simp add: add_ac comp_def)
declare comp_fun_commute.fold_mset_insert[OF comp_fun_commute_plus_mset, simp]
@@ -1236,7 +1240,7 @@
end
lemma msetsum_diff:
- fixes M N :: "('a \<Colon> ordered_cancel_comm_monoid_diff) multiset"
+ fixes M N :: "('a :: ordered_cancel_comm_monoid_diff) multiset"
shows "N \<le># M \<Longrightarrow> msetsum (M - N) = msetsum M - msetsum N"
by (metis add_diff_cancel_right' msetsum.union subset_mset.diff_add)
@@ -1396,6 +1400,43 @@
by (simp add: replicate_length_filter)
qed
+lemma sort_key_inj_key_eq:
+ assumes mset_equal: "mset xs = mset ys"
+ and "inj_on f (set xs)"
+ and "sorted (map f ys)"
+ shows "sort_key f xs = ys"
+proof (rule properties_for_sort_key)
+ from mset_equal
+ show "mset ys = mset xs" by simp
+ from `sorted (map f ys)`
+ 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))"
+ 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)
+ also have "\<dots> = replicate (count (mset ys) k) k"
+ by (simp add: replicate_count_mset_eq_filter_eq)
+ also have "\<dots> = replicate (count (mset xs) k) k"
+ using mset_equal by simp
+ also have "\<dots> = filter (HOL.eq k) xs"
+ by (simp add: replicate_count_mset_eq_filter_eq)
+ also have "\<dots> = [x\<leftarrow>xs . f k = f x]"
+ using inj by (auto intro!: inj_on_filter_key_eq [symmetric] simp add: set_equal)
+ finally show ?thesis .
+ qed
+qed
+
+lemma sort_key_eq_sort_key:
+ assumes "mset xs = mset ys"
+ and "inj_on f (set xs)"
+ shows "sort_key f xs = sort_key f ys"
+ by (rule sort_key_inj_key_eq) (simp_all add: assms)
+
lemma sort_key_by_quicksort:
"sort_key f xs = sort_key f [x\<leftarrow>xs. f x < f (xs ! (length xs div 2))]
@ [x\<leftarrow>xs. f x = f (xs ! (length xs div 2))]
@@ -1715,10 +1756,10 @@
subsubsection \<open>Partial-order properties\<close>
-definition less_multiset :: "'a\<Colon>order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" (infix "#<#" 50) where
+definition less_multiset :: "'a::order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" (infix "#<#" 50) where
"M' #<# M \<longleftrightarrow> (M', M) \<in> mult {(x', x). x' < x}"
-definition le_multiset :: "'a\<Colon>order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" (infix "#<=#" 50) where
+definition le_multiset :: "'a::order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" (infix "#<=#" 50) where
"M' #<=# M \<longleftrightarrow> M' #<# M \<or> M' = M"
notation (xsymbols) less_multiset (infix "#\<subset>#" 50)
@@ -2169,7 +2210,7 @@
text \<open>Quickcheck generators\<close>
definition (in term_syntax)
- msetify :: "'a\<Colon>typerep list \<times> (unit \<Rightarrow> Code_Evaluation.term)
+ msetify :: "'a::typerep list \<times> (unit \<Rightarrow> Code_Evaluation.term)
\<Rightarrow> 'a multiset \<times> (unit \<Rightarrow> Code_Evaluation.term)" where
[code_unfold]: "msetify xs = Code_Evaluation.valtermify mset {\<cdot>} xs"
--- a/src/HOL/Library/Multiset_Order.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Multiset_Order.thy Thu Sep 03 15:50:40 2015 +0200
@@ -178,10 +178,10 @@
context linorder
begin
-lemma total_le: "total {(a \<Colon> 'a, b). a \<le> b}"
+lemma total_le: "total {(a :: 'a, b). a \<le> b}"
unfolding total_on_def by auto
-lemma total_less: "total {(a \<Colon> 'a, b). a < b}"
+lemma total_less: "total {(a :: 'a, b). a < b}"
unfolding total_on_def by auto
lemma linorder_mult: "class.linorder
@@ -205,78 +205,78 @@
lemmas less_multiset\<^sub>H\<^sub>O = mult\<^sub>H\<^sub>O[folded less_multiset_def]
lemma le_multiset\<^sub>H\<^sub>O:
- fixes M N :: "('a \<Colon> linorder) multiset"
+ fixes M N :: "('a :: linorder) multiset"
shows "M #\<subseteq># N \<longleftrightarrow> (\<forall>y. count N y < count M y \<longrightarrow> (\<exists>x. y < x \<and> count M x < count N x))"
by (auto simp: le_multiset_def less_multiset\<^sub>H\<^sub>O)
-lemma wf_less_multiset: "wf {(M \<Colon> ('a \<Colon> wellorder) multiset, N). M #\<subset># N}"
+lemma wf_less_multiset: "wf {(M :: ('a :: wellorder) multiset, N). M #\<subset># N}"
unfolding less_multiset_def by (auto intro: wf_mult wf)
lemma order_multiset: "class.order
- (le_multiset :: ('a \<Colon> order) multiset \<Rightarrow> ('a \<Colon> order) multiset \<Rightarrow> bool)
- (less_multiset :: ('a \<Colon> order) multiset \<Rightarrow> ('a \<Colon> order) multiset \<Rightarrow> bool)"
+ (le_multiset :: ('a :: order) multiset \<Rightarrow> ('a :: order) multiset \<Rightarrow> bool)
+ (less_multiset :: ('a :: order) multiset \<Rightarrow> ('a :: order) multiset \<Rightarrow> bool)"
by unfold_locales
lemma linorder_multiset: "class.linorder
- (le_multiset :: ('a \<Colon> linorder) multiset \<Rightarrow> ('a \<Colon> linorder) multiset \<Rightarrow> bool)
- (less_multiset :: ('a \<Colon> linorder) multiset \<Rightarrow> ('a \<Colon> linorder) multiset \<Rightarrow> bool)"
+ (le_multiset :: ('a :: linorder) multiset \<Rightarrow> ('a :: linorder) multiset \<Rightarrow> bool)
+ (less_multiset :: ('a :: linorder) multiset \<Rightarrow> ('a :: linorder) multiset \<Rightarrow> bool)"
by unfold_locales (fastforce simp add: less_multiset\<^sub>H\<^sub>O le_multiset_def not_less_iff_gr_or_eq)
interpretation multiset_linorder: linorder
- "le_multiset :: ('a \<Colon> linorder) multiset \<Rightarrow> ('a \<Colon> linorder) multiset \<Rightarrow> bool"
- "less_multiset :: ('a \<Colon> linorder) multiset \<Rightarrow> ('a \<Colon> linorder) multiset \<Rightarrow> bool"
+ "le_multiset :: ('a :: linorder) multiset \<Rightarrow> ('a :: linorder) multiset \<Rightarrow> bool"
+ "less_multiset :: ('a :: linorder) multiset \<Rightarrow> ('a :: linorder) multiset \<Rightarrow> bool"
by (rule linorder_multiset)
interpretation multiset_wellorder: wellorder
- "le_multiset :: ('a \<Colon> wellorder) multiset \<Rightarrow> ('a \<Colon> wellorder) multiset \<Rightarrow> bool"
- "less_multiset :: ('a \<Colon> wellorder) multiset \<Rightarrow> ('a \<Colon> wellorder) multiset \<Rightarrow> bool"
+ "le_multiset :: ('a :: wellorder) multiset \<Rightarrow> ('a :: wellorder) multiset \<Rightarrow> bool"
+ "less_multiset :: ('a :: wellorder) multiset \<Rightarrow> ('a :: wellorder) multiset \<Rightarrow> bool"
by unfold_locales (blast intro: wf_less_multiset[unfolded wf_def, rule_format])
lemma le_multiset_total:
- fixes M N :: "('a \<Colon> linorder) multiset"
+ fixes M N :: "('a :: linorder) multiset"
shows "\<not> M #\<subseteq># N \<Longrightarrow> N #\<subseteq># M"
by (metis multiset_linorder.le_cases)
lemma less_eq_imp_le_multiset:
- fixes M N :: "('a \<Colon> linorder) multiset"
+ fixes M N :: "('a :: linorder) multiset"
shows "M \<le># N \<Longrightarrow> M #\<subseteq># N"
unfolding le_multiset_def less_multiset\<^sub>H\<^sub>O
by (simp add: less_le_not_le subseteq_mset_def)
lemma less_multiset_right_total:
- fixes M :: "('a \<Colon> linorder) multiset"
+ fixes M :: "('a :: linorder) multiset"
shows "M #\<subset># M + {#undefined#}"
unfolding le_multiset_def less_multiset\<^sub>H\<^sub>O by simp
lemma le_multiset_empty_left[simp]:
- fixes M :: "('a \<Colon> linorder) multiset"
+ fixes M :: "('a :: linorder) multiset"
shows "{#} #\<subseteq># M"
by (simp add: less_eq_imp_le_multiset)
lemma le_multiset_empty_right[simp]:
- fixes M :: "('a \<Colon> linorder) multiset"
+ fixes M :: "('a :: linorder) multiset"
shows "M \<noteq> {#} \<Longrightarrow> \<not> M #\<subseteq># {#}"
by (metis le_multiset_empty_left multiset_order.antisym)
lemma less_multiset_empty_left[simp]:
- fixes M :: "('a \<Colon> linorder) multiset"
+ fixes M :: "('a :: linorder) multiset"
shows "M \<noteq> {#} \<Longrightarrow> {#} #\<subset># M"
by (simp add: less_multiset\<^sub>H\<^sub>O)
lemma less_multiset_empty_right[simp]:
- fixes M :: "('a \<Colon> linorder) multiset"
+ fixes M :: "('a :: linorder) multiset"
shows "\<not> M #\<subset># {#}"
using le_empty less_multiset\<^sub>D\<^sub>M by blast
lemma
- fixes M N :: "('a \<Colon> linorder) multiset"
+ fixes M N :: "('a :: linorder) multiset"
shows
le_multiset_plus_left[simp]: "N #\<subseteq># (M + N)" and
le_multiset_plus_right[simp]: "M #\<subseteq># (M + N)"
using [[metis_verbose = false]] by (metis less_eq_imp_le_multiset mset_le_add_left add.commute)+
lemma
- fixes M N :: "('a \<Colon> linorder) multiset"
+ fixes M N :: "('a :: linorder) multiset"
shows
less_multiset_plus_plus_left_iff[simp]: "M + N #\<subset># M' + N \<longleftrightarrow> M #\<subset># M'" and
less_multiset_plus_plus_right_iff[simp]: "M + N #\<subset># M + N' \<longleftrightarrow> N #\<subset># N'"
@@ -286,7 +286,7 @@
by (metis add.commute add_diff_cancel_right' monoid_add_class.add.left_neutral)
lemma
- fixes M N :: "('a \<Colon> linorder) multiset"
+ fixes M N :: "('a :: linorder) multiset"
shows
less_multiset_plus_left_nonempty[simp]: "M \<noteq> {#} \<Longrightarrow> N #\<subset># M + N" and
less_multiset_plus_right_nonempty[simp]: "N \<noteq> {#} \<Longrightarrow> M #\<subset># M + N"
@@ -294,11 +294,11 @@
by (metis add.right_neutral less_multiset_empty_left less_multiset_plus_plus_right_iff
add.commute)+
-lemma ex_gt_imp_less_multiset: "(\<exists>y \<Colon> 'a \<Colon> linorder. y \<in># N \<and> (\<forall>x. x \<in># M \<longrightarrow> x < y)) \<Longrightarrow> M #\<subset># N"
+lemma ex_gt_imp_less_multiset: "(\<exists>y :: 'a :: linorder. y \<in># N \<and> (\<forall>x. x \<in># M \<longrightarrow> x < y)) \<Longrightarrow> M #\<subset># N"
unfolding less_multiset\<^sub>H\<^sub>O by (metis less_irrefl less_nat_zero_code not_gr0)
lemma ex_gt_count_imp_less_multiset:
- "(\<forall>y \<Colon> 'a \<Colon> linorder. y \<in># M + N \<longrightarrow> y \<le> x) \<Longrightarrow> count M x < count N x \<Longrightarrow> M #\<subset># N"
+ "(\<forall>y :: 'a :: linorder. y \<in># M + N \<longrightarrow> y \<le> x) \<Longrightarrow> count M x < count N x \<Longrightarrow> M #\<subset># N"
unfolding less_multiset\<^sub>H\<^sub>O by (metis add.left_neutral add_lessD1 dual_order.strict_iff_order
less_not_sym mset_leD mset_le_add_left)
--- a/src/HOL/Library/Old_SMT/old_z3_proof_reconstruction.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Old_SMT/old_z3_proof_reconstruction.ML Thu Sep 03 15:50:40 2015 +0200
@@ -694,7 +694,7 @@
Old_Z3_Proof_Tools.with_conv unfold_conv Old_Z3_Proof_Literals.prove_conj_disj_eq
fun declare_hyps ctxt thm =
- (thm, snd (Assumption.add_assumes (#hyps (Thm.crep_thm thm)) ctxt))
+ (thm, snd (Assumption.add_assumes (Thm.chyps_of thm) ctxt))
in
val abstraction_depth = 3
--- a/src/HOL/Library/RBT.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/RBT.thy Thu Sep 03 15:50:40 2015 +0200
@@ -10,7 +10,7 @@
subsection \<open>Type definition\<close>
-typedef ('a, 'b) rbt = "{t :: ('a\<Colon>linorder, 'b) RBT_Impl.rbt. is_rbt t}"
+typedef ('a, 'b) rbt = "{t :: ('a::linorder, 'b) RBT_Impl.rbt. is_rbt t}"
morphisms impl_of RBT
proof -
have "RBT_Impl.Empty \<in> ?rbt" by simp
@@ -37,32 +37,32 @@
setup_lifting type_definition_rbt
-lift_definition lookup :: "('a\<Colon>linorder, 'b) rbt \<Rightarrow> 'a \<rightharpoonup> 'b" is "rbt_lookup" .
+lift_definition lookup :: "('a::linorder, 'b) rbt \<Rightarrow> 'a \<rightharpoonup> 'b" is "rbt_lookup" .
-lift_definition empty :: "('a\<Colon>linorder, 'b) rbt" is RBT_Impl.Empty
+lift_definition empty :: "('a::linorder, 'b) rbt" is RBT_Impl.Empty
by (simp add: empty_def)
-lift_definition insert :: "'a\<Colon>linorder \<Rightarrow> 'b \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is "rbt_insert"
+lift_definition insert :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is "rbt_insert"
by simp
-lift_definition delete :: "'a\<Colon>linorder \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is "rbt_delete"
+lift_definition delete :: "'a::linorder \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is "rbt_delete"
by simp
-lift_definition entries :: "('a\<Colon>linorder, 'b) rbt \<Rightarrow> ('a \<times> 'b) list" is RBT_Impl.entries .
+lift_definition entries :: "('a::linorder, 'b) rbt \<Rightarrow> ('a \<times> 'b) list" is RBT_Impl.entries .
-lift_definition keys :: "('a\<Colon>linorder, 'b) rbt \<Rightarrow> 'a list" is RBT_Impl.keys .
+lift_definition keys :: "('a::linorder, 'b) rbt \<Rightarrow> 'a list" is RBT_Impl.keys .
-lift_definition bulkload :: "('a\<Colon>linorder \<times> 'b) list \<Rightarrow> ('a, 'b) rbt" is "rbt_bulkload" ..
+lift_definition bulkload :: "('a::linorder \<times> 'b) list \<Rightarrow> ('a, 'b) rbt" is "rbt_bulkload" ..
-lift_definition map_entry :: "'a \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a\<Colon>linorder, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is rbt_map_entry
+lift_definition map_entry :: "'a \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a::linorder, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is rbt_map_entry
by simp
-lift_definition map :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('a\<Colon>linorder, 'b) rbt \<Rightarrow> ('a, 'c) rbt" is RBT_Impl.map
+lift_definition map :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('a::linorder, 'b) rbt \<Rightarrow> ('a, 'c) rbt" is RBT_Impl.map
by simp
-lift_definition fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> 'c) \<Rightarrow> ('a\<Colon>linorder, 'b) rbt \<Rightarrow> 'c \<Rightarrow> 'c" is RBT_Impl.fold .
+lift_definition fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> 'c) \<Rightarrow> ('a::linorder, 'b) rbt \<Rightarrow> 'c \<Rightarrow> 'c" is RBT_Impl.fold .
-lift_definition union :: "('a\<Colon>linorder, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is "rbt_union"
+lift_definition union :: "('a::linorder, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" is "rbt_union"
by (simp add: rbt_union_is_rbt)
lift_definition foldi :: "('c \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> 'c) \<Rightarrow> ('a :: linorder, 'b) rbt \<Rightarrow> 'c \<Rightarrow> 'c"
@@ -70,7 +70,7 @@
subsection \<open>Derived operations\<close>
-definition is_empty :: "('a\<Colon>linorder, 'b) rbt \<Rightarrow> bool" where
+definition is_empty :: "('a::linorder, 'b) rbt \<Rightarrow> bool" where
[code]: "is_empty t = (case impl_of t of RBT_Impl.Empty \<Rightarrow> True | _ \<Rightarrow> False)"
--- a/src/HOL/Library/RBT_Impl.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/RBT_Impl.thy Thu Sep 03 15:50:40 2015 +0200
@@ -2060,19 +2060,19 @@
(@{const_name rbt_sorted}, SOME @{typ "('a :: linorder, 'b) rbt \<Rightarrow> bool"}),
(@{const_name rbt_lookup}, SOME @{typ "('a :: linorder, 'b) rbt \<Rightarrow> 'a \<rightharpoonup> 'b"}),
(@{const_name is_rbt}, SOME @{typ "('a :: linorder, 'b) rbt \<Rightarrow> bool"}),
- (@{const_name rbt_ins}, SOME @{typ "('a\<Colon>linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_insert_with_key}, SOME @{typ "('a\<Colon>linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_ins}, SOME @{typ "('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_insert_with_key}, SOME @{typ "('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
(@{const_name rbt_insert_with}, SOME @{typ "('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a :: linorder) \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
(@{const_name rbt_insert}, SOME @{typ "('a :: linorder) \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_del_from_left}, SOME @{typ "('a\<Colon>linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_del_from_right}, SOME @{typ "('a\<Colon>linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_del}, SOME @{typ "('a\<Colon>linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_delete}, SOME @{typ "('a\<Colon>linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_union_with_key}, SOME @{typ "('a\<Colon>linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_union_with}, SOME @{typ "('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a\<Colon>linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_union}, SOME @{typ "('a\<Colon>linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_map_entry}, SOME @{typ "'a\<Colon>linorder \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_bulkload}, SOME @{typ "('a \<times> 'b) list \<Rightarrow> ('a\<Colon>linorder,'b) rbt"})]
+ (@{const_name rbt_del_from_left}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_del_from_right}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_del}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_delete}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_union_with_key}, SOME @{typ "('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_union_with}, SOME @{typ "('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a::linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_union}, SOME @{typ "('a::linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_map_entry}, SOME @{typ "'a::linorder \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
+ (@{const_name rbt_bulkload}, SOME @{typ "('a \<times> 'b) list \<Rightarrow> ('a::linorder,'b) rbt"})]
\<close>
hide_const (open) R B Empty entries keys fold gen_keys gen_entries
--- a/src/HOL/Library/RBT_Mapping.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/RBT_Mapping.thy Thu Sep 03 15:50:40 2015 +0200
@@ -12,7 +12,7 @@
subsection \<open>Implementation of mappings\<close>
context includes rbt.lifting begin
-lift_definition Mapping :: "('a\<Colon>linorder, 'b) rbt \<Rightarrow> ('a, 'b) mapping" is RBT.lookup .
+lift_definition Mapping :: "('a::linorder, 'b) rbt \<Rightarrow> ('a, 'b) mapping" is RBT.lookup .
end
code_datatype Mapping
--- a/src/HOL/Library/RBT_Set.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/RBT_Set.thy Thu Sep 03 15:50:40 2015 +0200
@@ -18,10 +18,10 @@
section \<open>Definition of code datatype constructors\<close>
-definition Set :: "('a\<Colon>linorder, unit) rbt \<Rightarrow> 'a set"
+definition Set :: "('a::linorder, unit) rbt \<Rightarrow> 'a set"
where "Set t = {x . RBT.lookup t x = Some ()}"
-definition Coset :: "('a\<Colon>linorder, unit) rbt \<Rightarrow> 'a set"
+definition Coset :: "('a::linorder, unit) rbt \<Rightarrow> 'a set"
where [simp]: "Coset t = - Set t"
--- a/src/HOL/Library/Sublist.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/Sublist.thy Thu Sep 03 15:50:40 2015 +0200
@@ -111,7 +111,7 @@
assume a1: "\<exists>zs. ys = xs @ zs"
then obtain sk :: "'a list" where sk: "ys = xs @ sk" by fastforce
assume a2: "length xs < length ys"
- have f1: "\<And>v. ([]\<Colon>'a list) @ v = v" using append_Nil2 by simp
+ have f1: "\<And>v. ([]::'a list) @ v = v" using append_Nil2 by simp
have "[] \<noteq> sk" using a1 a2 sk less_not_refl by force
hence "\<exists>v. xs @ hd sk # v = ys" using sk by (metis hd_Cons_tl)
thus "\<exists>zs. ys = (xs @ [ys ! length xs]) @ zs" using f1 by fastforce
--- a/src/HOL/Library/code_test.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/code_test.ML Thu Sep 03 15:50:40 2015 +0200
@@ -180,7 +180,7 @@
Exn.interruptible_capture evaluate (Code_Target.evaluator ctxt target program deps true vs_ty);
fun postproc f = map (apsnd (map_option (map f)))
in
- Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_result o postproc) evaluator t)
+ Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t)
end;
(* Term preprocessing *)
--- a/src/HOL/Library/old_recdef.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/old_recdef.ML Thu Sep 03 15:50:40 2015 +0200
@@ -914,13 +914,12 @@
fun RULES_ERR func mesg = Utils.ERR {module = "Rules", func = func, mesg = mesg};
-fun cconcl thm = Dcterm.drop_prop (#prop (Thm.crep_thm thm));
-fun chyps thm = map Dcterm.drop_prop (#hyps (Thm.crep_thm thm));
+fun cconcl thm = Dcterm.drop_prop (Thm.cprop_of thm);
+fun chyps thm = map Dcterm.drop_prop (Thm.chyps_of thm);
fun dest_thm thm =
- let val {prop,hyps,...} = Thm.rep_thm thm
- in (map HOLogic.dest_Trueprop hyps, HOLogic.dest_Trueprop prop) end
- handle TERM _ => raise RULES_ERR "dest_thm" "missing Trueprop";
+ (map HOLogic.dest_Trueprop (Thm.hyps_of thm), HOLogic.dest_Trueprop (Thm.prop_of thm))
+ handle TERM _ => raise RULES_ERR "dest_thm" "missing Trueprop";
(* Inference rules *)
@@ -971,7 +970,7 @@
fun DISCH tm thm = Thm.implies_intr (Dcterm.mk_prop tm) thm COMP impI
handle THM (msg, _, _) => raise RULES_ERR "DISCH" msg;
-fun DISCH_ALL thm = fold_rev DISCH (#hyps (Thm.crep_thm thm)) thm;
+fun DISCH_ALL thm = fold_rev DISCH (Thm.chyps_of thm) thm;
fun FILTER_DISCH_ALL P thm =
@@ -1225,19 +1224,6 @@
blist' th
end;
-(*---------------------------------------------------------------------------
- * Faster version, that fails for some as yet unknown reason
- * fun IT_EXISTS blist th =
- * let val {thy,...} = rep_thm th
- * val tych = cterm_of thy
- * fun detype (x,y) = ((#t o rep_cterm) x, (#t o rep_cterm) y)
- * in
- * fold (fn (b as (r1,r2), thm) =>
- * EXISTS(D.mk_exists(r2, tych(subst_free[detype b](#t(rep_cterm(cconcl thm))))),
- * r1) thm) blist th
- * end;
- *---------------------------------------------------------------------------*)
-
(*----------------------------------------------------------------------------
* Rewriting
*---------------------------------------------------------------------------*)
--- a/src/HOL/Library/positivstellensatz.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Library/positivstellensatz.ML Thu Sep 03 15:50:40 2015 +0200
@@ -514,14 +514,15 @@
| _ => "x"
fun mk_forall x th =
- Drule.arg_cong_rule
- (instantiate_cterm' [SOME (Thm.ctyp_of_cterm x)] [] @{cpat "All :: (?'a => bool) => _" })
- (Thm.abstract_rule (name_of x) x th)
+ let
+ val T = Thm.typ_of_cterm x
+ val all = Thm.cterm_of ctxt (Const (@{const_name All}, (T --> @{typ bool}) --> @{typ bool}))
+ in Drule.arg_cong_rule all (Thm.abstract_rule (name_of x) x th) end
val specl = fold_rev (fn x => fn th => Thm.instantiate' [] [SOME x] (th RS spec));
- fun ext T = Drule.cterm_rule (Thm.instantiate' [SOME T] []) @{cpat Ex}
- fun mk_ex v t = Thm.apply (ext (Thm.ctyp_of_cterm v)) (Thm.lambda v t)
+ fun ext T = Thm.cterm_of ctxt (Const (@{const_name Ex}, (T --> @{typ bool}) --> @{typ bool}))
+ fun mk_ex v t = Thm.apply (ext (Thm.typ_of_cterm v)) (Thm.lambda v t)
fun choose v th th' =
case Thm.concl_of th of
@@ -540,7 +541,7 @@
fun simple_choose v th =
choose v
(Thm.assume
- ((Thm.apply @{cterm Trueprop} o mk_ex v) ((Thm.dest_arg o hd o #hyps o Thm.crep_thm) th))) th
+ ((Thm.apply @{cterm Trueprop} o mk_ex v) (Thm.dest_arg (hd (Thm.chyps_of th))))) th
val strip_forall =
let
--- a/src/HOL/Limits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Limits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -22,7 +22,7 @@
(auto simp: subset_eq eventually_principal intro!: exI[of _ "max a b" for a b])
lemma at_infinity_eq_at_top_bot:
- "(at_infinity \<Colon> real filter) = sup at_top at_bot"
+ "(at_infinity :: real filter) = sup at_top at_bot"
apply (simp add: filter_eq_iff eventually_sup eventually_at_infinity
eventually_at_top_linorder eventually_at_bot_linorder)
apply safe
@@ -872,7 +872,7 @@
using assms unfolding continuous_on_def by (fast intro: tendsto_sgn)
lemma filterlim_at_infinity:
- fixes f :: "_ \<Rightarrow> 'a\<Colon>real_normed_vector"
+ fixes f :: "_ \<Rightarrow> 'a::real_normed_vector"
assumes "0 \<le> c"
shows "(LIM x F. f x :> at_infinity) \<longleftrightarrow> (\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F)"
unfolding filterlim_iff eventually_at_infinity
@@ -983,7 +983,7 @@
qed
lemma tendsto_inverse_0:
- fixes x :: "_ \<Rightarrow> 'a\<Colon>real_normed_div_algebra"
+ fixes x :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
shows "(inverse ---> (0::'a)) at_infinity"
unfolding tendsto_Zfun_iff diff_0_right Zfun_def eventually_at_infinity
proof safe
@@ -1041,7 +1041,7 @@
unfolding filterlim_def at_top_to_right filtermap_filtermap ..
lemma filterlim_inverse_at_infinity:
- fixes x :: "_ \<Rightarrow> 'a\<Colon>{real_normed_div_algebra, division_ring}"
+ fixes x :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
shows "filterlim inverse at_infinity (at (0::'a))"
unfolding filterlim_at_infinity[OF order_refl]
proof safe
@@ -1053,7 +1053,7 @@
qed
lemma filterlim_inverse_at_iff:
- fixes g :: "'a \<Rightarrow> 'b\<Colon>{real_normed_div_algebra, division_ring}"
+ fixes g :: "'a \<Rightarrow> 'b::{real_normed_div_algebra, division_ring}"
shows "(LIM x F. inverse (g x) :> at 0) \<longleftrightarrow> (LIM x F. g x :> at_infinity)"
unfolding filterlim_def filtermap_filtermap[symmetric]
proof
@@ -1078,7 +1078,7 @@
lemma at_to_infinity:
- fixes x :: "'a \<Colon> {real_normed_field,field}"
+ fixes x :: "'a :: {real_normed_field,field}"
shows "(at (0::'a)) = filtermap inverse at_infinity"
proof (rule antisym)
have "(inverse ---> (0::'a)) at_infinity"
@@ -1226,7 +1226,7 @@
qed
lemma tendsto_divide_0:
- fixes f :: "_ \<Rightarrow> 'a\<Colon>{real_normed_div_algebra, division_ring}"
+ fixes f :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
assumes f: "(f ---> c) F"
assumes g: "LIM x F. g x :> at_infinity"
shows "((\<lambda>x. f x / g x) ---> 0) F"
@@ -1945,6 +1945,20 @@
by auto
qed
+lemma open_Collect_positive:
+ fixes f :: "'a::t2_space \<Rightarrow> real"
+ assumes f: "continuous_on s f"
+ shows "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. 0 < f x}"
+ using continuous_on_open_invariant[THEN iffD1, OF f, rule_format, of "{0 <..}"]
+ by (auto simp: Int_def field_simps)
+
+lemma open_Collect_less_Int:
+ fixes f g :: "'a::t2_space \<Rightarrow> real"
+ assumes f: "continuous_on s f" and g: "continuous_on s g"
+ shows "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. f x < g x}"
+ using open_Collect_positive[OF continuous_on_diff[OF g f]] by (simp add: field_simps)
+
+
subsection \<open>Boundedness of continuous functions\<close>
text\<open>By bisection, function continuous on closed interval is bounded above\<close>
--- a/src/HOL/List.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/List.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1555,6 +1555,11 @@
(\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)"
by(auto dest:Cons_eq_filterD)
+lemma inj_on_filter_key_eq:
+ assumes "inj_on f (insert y (set xs))"
+ shows "[x\<leftarrow>xs . f y = f x] = filter (HOL.eq y) xs"
+ using assms by (induct xs) auto
+
lemma filter_cong[fundef_cong]:
"xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys"
apply simp
@@ -2659,7 +2664,7 @@
by (simp add: list_all2_conv_all_nth)
lemma list_all2I:
- "\<forall>x \<in> set (zip a b). split P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b"
+ "\<forall>x \<in> set (zip a b). case_prod P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b"
by (simp add: list_all2_iff)
lemma list_all2_nthD:
@@ -6275,19 +6280,19 @@
by auto
lemma all_nat_less_eq [code_unfold]:
- "(\<forall>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..<n}. P m)"
+ "(\<forall>m<n::nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..<n}. P m)"
by auto
lemma ex_nat_less_eq [code_unfold]:
- "(\<exists>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..<n}. P m)"
+ "(\<exists>m<n::nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..<n}. P m)"
by auto
lemma all_nat_less [code_unfold]:
- "(\<forall>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..n}. P m)"
+ "(\<forall>m\<le>n::nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..n}. P m)"
by auto
lemma ex_nat_less [code_unfold]:
- "(\<exists>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..n}. P m)"
+ "(\<exists>m\<le>n::nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..n}. P m)"
by auto
text\<open>Bounded @{text LEAST} operator:\<close>
--- a/src/HOL/MacLaurin.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/MacLaurin.thy Thu Sep 03 15:50:40 2015 +0200
@@ -83,7 +83,7 @@
by (cases n) (simp add: n)
obtain B where f_h: "f h =
- (\<Sum>m<n. diff m (0\<Colon>real) / (fact m) * h ^ m) + B * (h ^ n / (fact n))"
+ (\<Sum>m<n. diff m (0::real) / (fact m) * h ^ m) + B * (h ^ n / (fact n))"
using Maclaurin_lemma [OF h] ..
def g \<equiv> "(\<lambda>t. f t -
@@ -99,8 +99,8 @@
have difg_0: "difg 0 = g"
unfolding difg_def g_def by (simp add: diff_0)
- have difg_Suc: "\<forall>(m\<Colon>nat) t\<Colon>real.
- m < n \<and> (0\<Colon>real) \<le> t \<and> t \<le> h \<longrightarrow> DERIV (difg m) t :> difg (Suc m) t"
+ have difg_Suc: "\<forall>(m::nat) t::real.
+ m < n \<and> (0::real) \<le> t \<and> t \<le> h \<longrightarrow> DERIV (difg m) t :> difg (Suc m) t"
using diff_Suc m unfolding difg_def by (rule Maclaurin_lemma2)
have difg_eq_0: "\<forall>m<n. difg m 0 = 0"
@@ -127,9 +127,9 @@
proof (rule Rolle)
show "0 < h" by fact
show "difg 0 0 = difg 0 h" by (simp add: difg_0 g2)
- show "\<forall>x. 0 \<le> x \<and> x \<le> h \<longrightarrow> isCont (difg (0\<Colon>nat)) x"
+ show "\<forall>x. 0 \<le> x \<and> x \<le> h \<longrightarrow> isCont (difg (0::nat)) x"
by (simp add: isCont_difg n)
- show "\<forall>x. 0 < x \<and> x < h \<longrightarrow> difg (0\<Colon>nat) differentiable (at x)"
+ show "\<forall>x. 0 < x \<and> x < h \<longrightarrow> difg (0::nat) differentiable (at x)"
by (simp add: differentiable_difg n)
qed
next
--- a/src/HOL/Map.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Map.thy Thu Sep 03 15:50:40 2015 +0200
@@ -11,21 +11,15 @@
imports List
begin
-type_synonym ('a, 'b) "map" = "'a \<Rightarrow> 'b option" (infixr "~=>" 0)
-
-type_notation (xsymbols)
- "map" (infixr "\<rightharpoonup>" 0)
+type_synonym ('a, 'b) "map" = "'a \<Rightarrow> 'b option" (infixr "\<rightharpoonup>" 0)
abbreviation
empty :: "'a \<rightharpoonup> 'b" where
"empty \<equiv> \<lambda>x. None"
definition
- map_comp :: "('b \<rightharpoonup> 'c) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'c)" (infixl "o'_m" 55) where
- "f o_m g = (\<lambda>k. case g k of None \<Rightarrow> None | Some v \<Rightarrow> f v)"
-
-notation (xsymbols)
- map_comp (infixl "\<circ>\<^sub>m" 55)
+ map_comp :: "('b \<rightharpoonup> 'c) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'c)" (infixl "\<circ>\<^sub>m" 55) where
+ "f \<circ>\<^sub>m g = (\<lambda>k. case g k of None \<Rightarrow> None | Some v \<Rightarrow> f v)"
definition
map_add :: "('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'b) \<Rightarrow> ('a \<rightharpoonup> 'b)" (infixl "++" 100) where
@@ -227,14 +221,14 @@
lemma map_of_mapk_SomeI:
"inj f \<Longrightarrow> map_of t k = Some x \<Longrightarrow>
- map_of (map (split (\<lambda>k. Pair (f k))) t) (f k) = Some x"
+ map_of (map (case_prod (\<lambda>k. Pair (f k))) t) (f k) = Some x"
by (induct t) (auto simp: inj_eq)
lemma weak_map_of_SomeI: "(k, x) \<in> set l \<Longrightarrow> \<exists>x. map_of l k = Some x"
by (induct l) auto
lemma map_of_filter_in:
- "map_of xs k = Some z \<Longrightarrow> P k z \<Longrightarrow> map_of (filter (split P) xs) k = Some z"
+ "map_of xs k = Some z \<Longrightarrow> P k z \<Longrightarrow> map_of (filter (case_prod P) xs) k = Some z"
by (induct xs) auto
lemma map_of_map:
--- a/src/HOL/Matrix_LP/ComputeNumeral.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/ComputeNumeral.thy Thu Sep 03 15:50:40 2015 +0200
@@ -51,10 +51,10 @@
one_div_minus_numeral one_mod_minus_numeral
numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral
numeral_div_minus_numeral numeral_mod_minus_numeral
- div_minus_minus mod_minus_minus adjust_div_eq of_bool_eq one_neq_zero
+ div_minus_minus mod_minus_minus Divides.adjust_div_eq of_bool_eq one_neq_zero
numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial
divmod_steps divmod_cancel divmod_step_eq fst_conv snd_conv numeral_One
- case_prod_beta rel_simps adjust_mod_def div_minus1_right mod_minus1_right
+ case_prod_beta rel_simps Divides.adjust_mod_def div_minus1_right mod_minus1_right
minus_minus numeral_times_numeral mult_zero_right mult_1_right
--- a/src/HOL/Matrix_LP/Compute_Oracle/am_compiler.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/Compute_Oracle/am_compiler.ML Thu Sep 03 15:50:40 2015 +0200
@@ -184,7 +184,8 @@
in
compiled_rewriter := NONE;
- use_text ML_Env.local_context (1, "") false (!buffer);
+ use_text ML_Env.local_context
+ {line = 1, file = "", verbose = false, debug = false} (!buffer);
case !compiled_rewriter of
NONE => raise (Compile "cannot communicate with compiled function")
| SOME r => (compiled_rewriter := NONE; r)
--- a/src/HOL/Matrix_LP/Compute_Oracle/am_sml.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/Compute_Oracle/am_sml.ML Thu Sep 03 15:50:40 2015 +0200
@@ -485,7 +485,8 @@
fun writeTextFile name s = File.write (Path.explode name) s
-fun use_source src = use_text ML_Env.local_context (1, "") false src
+fun use_source src =
+ use_text ML_Env.local_context {line = 1, file = "", verbose = false, debug = false} src
fun compile rules =
let
--- a/src/HOL/Matrix_LP/Compute_Oracle/compute.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/Compute_Oracle/compute.ML Thu Sep 03 15:50:40 2015 +0200
@@ -191,12 +191,8 @@
datatype cthm = ComputeThm of term list * sort list * term
fun thm2cthm th =
- let
- val {hyps, prop, tpairs, shyps, ...} = Thm.rep_thm th
- val _ = if not (null tpairs) then raise Make "theorems may not contain tpairs" else ()
- in
- ComputeThm (hyps, shyps, prop)
- end
+ (if not (null (Thm.tpairs_of th)) then raise Make "theorems may not contain tpairs" else ();
+ ComputeThm (Thm.hyps_of th, Thm.shyps_of th, Thm.prop_of th))
fun make_internal machine thy stamp encoding cache_pattern_terms raw_ths =
let
@@ -607,7 +603,7 @@
val thy = theory_of computer
val _ = check_compatible computer th
val _ =
- Theory.subthy (theory_of_theorem th, thy) orelse raise Compute "modus_ponens: bad theory"
+ Context.subthy (theory_of_theorem th, thy) orelse raise Compute "modus_ponens: bad theory"
val th' = make_theorem computer (Thm.transfer thy raw_th') []
val varsubst = varsubst_of_theorem th
fun run vars_allowed t =
--- a/src/HOL/Matrix_LP/Compute_Oracle/linker.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/Compute_Oracle/linker.ML Thu Sep 03 15:50:40 2015 +0200
@@ -367,16 +367,13 @@
datatype cthm = ComputeThm of term list * sort list * term
-fun thm2cthm th =
- let
- val {hyps, prop, shyps, ...} = Thm.rep_thm th
- in
- ComputeThm (hyps, shyps, prop)
- end
+fun thm2cthm th = ComputeThm (Thm.hyps_of th, Thm.shyps_of th, Thm.prop_of th)
-val cthm_ord' = prod_ord (prod_ord (list_ord Term_Ord.term_ord) (list_ord Term_Ord.sort_ord)) Term_Ord.term_ord
+val cthm_ord' =
+ prod_ord (prod_ord (list_ord Term_Ord.term_ord) (list_ord Term_Ord.sort_ord)) Term_Ord.term_ord
-fun cthm_ord (ComputeThm (h1, sh1, p1), ComputeThm (h2, sh2, p2)) = cthm_ord' (((h1,sh1), p1), ((h2, sh2), p2))
+fun cthm_ord (ComputeThm (h1, sh1, p1), ComputeThm (h2, sh2, p2)) =
+ cthm_ord' (((h1,sh1), p1), ((h2, sh2), p2))
structure CThmtab = Table(type key = cthm val ord = cthm_ord)
--- a/src/HOL/Matrix_LP/Matrix.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/Matrix.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1290,7 +1290,7 @@
le_matrix_def: "A \<le> B \<longleftrightarrow> (\<forall>j i. Rep_matrix A j i \<le> Rep_matrix B j i)"
definition
- less_def: "A < (B\<Colon>'a matrix) \<longleftrightarrow> A \<le> B \<and> \<not> B \<le> A"
+ less_def: "A < (B::'a matrix) \<longleftrightarrow> A \<le> B \<and> \<not> B \<le> A"
instance ..
@@ -1496,7 +1496,7 @@
begin
definition
- abs_matrix_def: "abs (A \<Colon> 'a matrix) = sup A (- A)"
+ abs_matrix_def: "abs (A :: 'a matrix) = sup A (- A)"
instance ..
--- a/src/HOL/Matrix_LP/SparseMatrix.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Matrix_LP/SparseMatrix.thy Thu Sep 03 15:50:40 2015 +0200
@@ -834,14 +834,14 @@
lemma bool1: "(\<not> True) = False" by blast
lemma bool2: "(\<not> False) = True" by blast
-lemma bool3: "((P\<Colon>bool) \<and> True) = P" by blast
-lemma bool4: "(True \<and> (P\<Colon>bool)) = P" by blast
-lemma bool5: "((P\<Colon>bool) \<and> False) = False" by blast
-lemma bool6: "(False \<and> (P\<Colon>bool)) = False" by blast
-lemma bool7: "((P\<Colon>bool) \<or> True) = True" by blast
-lemma bool8: "(True \<or> (P\<Colon>bool)) = True" by blast
-lemma bool9: "((P\<Colon>bool) \<or> False) = P" by blast
-lemma bool10: "(False \<or> (P\<Colon>bool)) = P" by blast
+lemma bool3: "((P::bool) \<and> True) = P" by blast
+lemma bool4: "(True \<and> (P::bool)) = P" by blast
+lemma bool5: "((P::bool) \<and> False) = False" by blast
+lemma bool6: "(False \<and> (P::bool)) = False" by blast
+lemma bool7: "((P::bool) \<or> True) = True" by blast
+lemma bool8: "(True \<or> (P::bool)) = True" by blast
+lemma bool9: "((P::bool) \<or> False) = P" by blast
+lemma bool10: "(False \<or> (P::bool)) = P" by blast
lemmas boolarith = bool1 bool2 bool3 bool4 bool5 bool6 bool7 bool8 bool9 bool10
lemma if_case_eq: "(if b then x else y) = (case b of True => x | False => y)" by simp
--- a/src/HOL/Meson.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Meson.thy Thu Sep 03 15:50:40 2015 +0200
@@ -182,7 +182,7 @@
definition skolem :: "'a \<Rightarrow> 'a" where
"skolem = (\<lambda>x. x)"
-lemma skolem_COMBK_iff: "P \<longleftrightarrow> skolem (COMBK P (i\<Colon>nat))"
+lemma skolem_COMBK_iff: "P \<longleftrightarrow> skolem (COMBK P (i::nat))"
unfolding skolem_def COMBK_def by (rule refl)
lemmas skolem_COMBK_I = iffD1 [OF skolem_COMBK_iff]
--- a/src/HOL/Metis_Examples/Big_O.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Metis_Examples/Big_O.thy Thu Sep 03 15:50:40 2015 +0200
@@ -16,11 +16,11 @@
subsection {* Definitions *}
-definition bigo :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
- "O(f\<Colon>('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
+definition bigo :: "('a => 'b::linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
+ "O(f::('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
lemma bigo_pos_const:
- "(\<exists>c\<Colon>'a\<Colon>linordered_idom.
+ "(\<exists>c::'a::linordered_idom.
\<forall>x. abs (h x) \<le> c * abs (f x))
\<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. abs(h x) \<le> c * abs (f x)))"
by (metis (no_types) abs_ge_zero
@@ -32,7 +32,7 @@
sledgehammer_params [isar_proofs, compress = 1]
lemma
- "(\<exists>c\<Colon>'a\<Colon>linordered_idom.
+ "(\<exists>c::'a::linordered_idom.
\<forall>x. abs (h x) \<le> c * abs (f x))
\<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. abs(h x) \<le> c * abs (f x)))"
apply auto
@@ -42,19 +42,19 @@
proof -
fix c :: 'a and x :: 'b
assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
- have F1: "\<forall>x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 0 \<le> \<bar>x\<^sub>1\<bar>" by (metis abs_ge_zero)
- have F2: "\<forall>x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
+ have F1: "\<forall>x\<^sub>1::'a::linordered_idom. 0 \<le> \<bar>x\<^sub>1\<bar>" by (metis abs_ge_zero)
+ have F2: "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
have F3: "\<forall>x\<^sub>1 x\<^sub>3. x\<^sub>3 \<le> \<bar>h x\<^sub>1\<bar> \<longrightarrow> x\<^sub>3 \<le> c * \<bar>f x\<^sub>1\<bar>" by (metis A1 order_trans)
- have F4: "\<forall>x\<^sub>2 x\<^sub>3\<Colon>'a\<Colon>linordered_idom. \<bar>x\<^sub>3\<bar> * \<bar>x\<^sub>2\<bar> = \<bar>x\<^sub>3 * x\<^sub>2\<bar>"
+ have F4: "\<forall>x\<^sub>2 x\<^sub>3::'a::linordered_idom. \<bar>x\<^sub>3\<bar> * \<bar>x\<^sub>2\<bar> = \<bar>x\<^sub>3 * x\<^sub>2\<bar>"
by (metis abs_mult)
- have F5: "\<forall>x\<^sub>3 x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 0 \<le> x\<^sub>1 \<longrightarrow> \<bar>x\<^sub>3 * x\<^sub>1\<bar> = \<bar>x\<^sub>3\<bar> * x\<^sub>1"
+ have F5: "\<forall>x\<^sub>3 x\<^sub>1::'a::linordered_idom. 0 \<le> x\<^sub>1 \<longrightarrow> \<bar>x\<^sub>3 * x\<^sub>1\<bar> = \<bar>x\<^sub>3\<bar> * x\<^sub>1"
by (metis abs_mult_pos)
- hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1\<Colon>'a\<Colon>linordered_idom\<bar> = \<bar>1\<bar> * x\<^sub>1" by (metis F2)
- hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1\<Colon>'a\<Colon>linordered_idom\<bar> = x\<^sub>1" by (metis F2 abs_one)
+ hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = \<bar>1\<bar> * x\<^sub>1" by (metis F2)
+ hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = x\<^sub>1" by (metis F2 abs_one)
hence "\<forall>x\<^sub>3. 0 \<le> \<bar>h x\<^sub>3\<bar> \<longrightarrow> \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>" by (metis F3)
hence "\<forall>x\<^sub>3. \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>" by (metis F1)
- hence "\<forall>x\<^sub>3. (0\<Colon>'a) \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c\<bar> * \<bar>f x\<^sub>3\<bar>" by (metis F5)
- hence "\<forall>x\<^sub>3. (0\<Colon>'a) \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F4)
+ hence "\<forall>x\<^sub>3. (0::'a) \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c\<bar> * \<bar>f x\<^sub>3\<bar>" by (metis F5)
+ hence "\<forall>x\<^sub>3. (0::'a) \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F4)
hence "\<forall>x\<^sub>3. c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F1)
hence "\<bar>h x\<bar> \<le> \<bar>c * f x\<bar>" by (metis A1)
thus "\<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>" by (metis F4)
@@ -63,7 +63,7 @@
sledgehammer_params [isar_proofs, compress = 2]
lemma
- "(\<exists>c\<Colon>'a\<Colon>linordered_idom.
+ "(\<exists>c::'a::linordered_idom.
\<forall>x. abs (h x) \<le> c * abs (f x))
\<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. abs(h x) \<le> c * abs (f x)))"
apply auto
@@ -73,10 +73,10 @@
proof -
fix c :: 'a and x :: 'b
assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
- have F1: "\<forall>x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
- have F2: "\<forall>x\<^sub>2 x\<^sub>3\<Colon>'a\<Colon>linordered_idom. \<bar>x\<^sub>3\<bar> * \<bar>x\<^sub>2\<bar> = \<bar>x\<^sub>3 * x\<^sub>2\<bar>"
+ have F1: "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
+ have F2: "\<forall>x\<^sub>2 x\<^sub>3::'a::linordered_idom. \<bar>x\<^sub>3\<bar> * \<bar>x\<^sub>2\<bar> = \<bar>x\<^sub>3 * x\<^sub>2\<bar>"
by (metis abs_mult)
- have "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1\<Colon>'a\<Colon>linordered_idom\<bar> = x\<^sub>1" by (metis F1 abs_mult_pos abs_one)
+ have "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = x\<^sub>1" by (metis F1 abs_mult_pos abs_one)
hence "\<forall>x\<^sub>3. \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>" by (metis A1 abs_ge_zero order_trans)
hence "\<forall>x\<^sub>3. 0 \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c * f x\<^sub>3\<bar>" by (metis F2 abs_mult_pos)
hence "\<bar>h x\<bar> \<le> \<bar>c * f x\<bar>" by (metis A1 abs_ge_zero)
@@ -86,7 +86,7 @@
sledgehammer_params [isar_proofs, compress = 3]
lemma
- "(\<exists>c\<Colon>'a\<Colon>linordered_idom.
+ "(\<exists>c::'a::linordered_idom.
\<forall>x. abs (h x) \<le> c * abs (f x))
\<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. abs(h x) \<le> c * abs (f x)))"
apply auto
@@ -96,9 +96,9 @@
proof -
fix c :: 'a and x :: 'b
assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
- have F1: "\<forall>x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
- have F2: "\<forall>x\<^sub>3 x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 0 \<le> x\<^sub>1 \<longrightarrow> \<bar>x\<^sub>3 * x\<^sub>1\<bar> = \<bar>x\<^sub>3\<bar> * x\<^sub>1" by (metis abs_mult_pos)
- hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1\<Colon>'a\<Colon>linordered_idom\<bar> = x\<^sub>1" by (metis F1 abs_one)
+ have F1: "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
+ have F2: "\<forall>x\<^sub>3 x\<^sub>1::'a::linordered_idom. 0 \<le> x\<^sub>1 \<longrightarrow> \<bar>x\<^sub>3 * x\<^sub>1\<bar> = \<bar>x\<^sub>3\<bar> * x\<^sub>1" by (metis abs_mult_pos)
+ hence "\<forall>x\<^sub>1\<ge>0. \<bar>x\<^sub>1::'a::linordered_idom\<bar> = x\<^sub>1" by (metis F1 abs_one)
hence "\<forall>x\<^sub>3. 0 \<le> \<bar>f x\<^sub>3\<bar> \<longrightarrow> c * \<bar>f x\<^sub>3\<bar> = \<bar>c\<bar> * \<bar>f x\<^sub>3\<bar>" by (metis F2 A1 abs_ge_zero order_trans)
thus "\<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>" by (metis A1 abs_ge_zero)
qed
@@ -106,7 +106,7 @@
sledgehammer_params [isar_proofs, compress = 4]
lemma
- "(\<exists>c\<Colon>'a\<Colon>linordered_idom.
+ "(\<exists>c::'a::linordered_idom.
\<forall>x. abs (h x) \<le> c * abs (f x))
\<longleftrightarrow> (\<exists>c. 0 < c \<and> (\<forall>x. abs(h x) \<le> c * abs (f x)))"
apply auto
@@ -116,7 +116,7 @@
proof -
fix c :: 'a and x :: 'b
assume A1: "\<forall>x. \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
- have "\<forall>x\<^sub>1\<Colon>'a\<Colon>linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
+ have "\<forall>x\<^sub>1::'a::linordered_idom. 1 * x\<^sub>1 = x\<^sub>1" by (metis mult_1)
hence "\<forall>x\<^sub>3. \<bar>c * \<bar>f x\<^sub>3\<bar>\<bar> = c * \<bar>f x\<^sub>3\<bar>"
by (metis A1 abs_ge_zero order_trans abs_mult_pos abs_one)
hence "\<bar>h x\<bar> \<le> \<bar>c * f x\<bar>" by (metis A1 abs_ge_zero abs_mult_pos abs_mult)
@@ -321,7 +321,7 @@
by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
- O(f * g) <= (f\<Colon>'a => ('b\<Colon>linordered_field)) *o O(g)"
+ O(f * g) <= (f::'a => ('b::linordered_field)) *o O(g)"
proof -
assume a: "\<forall>x. f x ~= 0"
show "O(f * g) <= f *o O(g)"
@@ -334,31 +334,31 @@
by (rule bigo_mult2)
also have "(\<lambda>x. 1 / f x) * (f * g) = g"
by (simp add: fun_eq_iff a)
- finally have "(\<lambda>x. (1\<Colon>'b) / f x) * h : O(g)".
- then have "f * ((\<lambda>x. (1\<Colon>'b) / f x) * h) : f *o O(g)"
+ finally have "(\<lambda>x. (1::'b) / f x) * h : O(g)".
+ then have "f * ((\<lambda>x. (1::'b) / f x) * h) : f *o O(g)"
by auto
- also have "f * ((\<lambda>x. (1\<Colon>'b) / f x) * h) = h"
+ also have "f * ((\<lambda>x. (1::'b) / f x) * h) = h"
by (simp add: func_times fun_eq_iff a)
finally show "h : f *o O(g)".
qed
qed
lemma bigo_mult6:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) *o O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f::'a \<Rightarrow> ('b::linordered_field)) *o O(g)"
by (metis bigo_mult2 bigo_mult5 order_antisym)
(*proof requires relaxing relevance: 2007-01-25*)
declare bigo_mult6 [simp]
lemma bigo_mult7:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) * O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f::'a \<Rightarrow> ('b::linordered_field)) * O(g)"
by (metis bigo_refl bigo_mult6 set_times_mono3)
declare bigo_mult6 [simp del]
declare bigo_mult7 [intro!]
lemma bigo_mult8:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) * O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f::'a \<Rightarrow> ('b::linordered_field)) * O(g)"
by (metis bigo_mult bigo_mult7 order_antisym_conv)
lemma bigo_minus [intro]: "f : O(g) \<Longrightarrow> - f : O(g)"
@@ -397,14 +397,14 @@
lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
by (metis bigo_const1 bigo_elt_subset)
-lemma bigo_const3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
+lemma bigo_const3: "(c::'a::linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
apply (simp add: bigo_def)
by (metis abs_eq_0 left_inverse order_refl)
-lemma bigo_const4: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
+lemma bigo_const4: "(c::'a::linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
by (metis bigo_elt_subset bigo_const3)
-lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
+lemma bigo_const [simp]: "(c::'a::linordered_field) ~= 0 \<Longrightarrow>
O(\<lambda>x. c) = O(\<lambda>x. 1)"
by (metis bigo_const2 bigo_const4 equalityI)
@@ -415,19 +415,19 @@
lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
by (rule bigo_elt_subset, rule bigo_const_mult1)
-lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
+lemma bigo_const_mult3: "(c::'a::linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
apply (simp add: bigo_def)
by (metis (no_types) abs_mult mult.assoc mult_1 order_refl left_inverse)
lemma bigo_const_mult4:
-"(c\<Colon>'a\<Colon>linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
+"(c::'a::linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
by (metis bigo_elt_subset bigo_const_mult3)
-lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
+lemma bigo_const_mult [simp]: "(c::'a::linordered_field) ~= 0 \<Longrightarrow>
O(\<lambda>x. c * f x) = O(f)"
by (metis equalityI bigo_const_mult2 bigo_const_mult4)
-lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
+lemma bigo_const_mult5 [simp]: "(c::'a::linordered_field) ~= 0 \<Longrightarrow>
(\<lambda>x. c) *o O(f) = O(f)"
apply (auto del: subsetI)
apply (rule order_trans)
@@ -444,20 +444,20 @@
(* couldn't get this proof without the step above *)
proof -
fix g :: "'b \<Rightarrow> 'a" and d :: 'a
- assume A1: "c \<noteq> (0\<Colon>'a)"
- assume A2: "\<forall>x\<Colon>'b. \<bar>g x\<bar> \<le> d * \<bar>f x\<bar>"
+ assume A1: "c \<noteq> (0::'a)"
+ assume A2: "\<forall>x::'b. \<bar>g x\<bar> \<le> d * \<bar>f x\<bar>"
have F1: "inverse \<bar>c\<bar> = \<bar>inverse c\<bar>" using A1 by (metis nonzero_abs_inverse)
- have F2: "(0\<Colon>'a) < \<bar>c\<bar>" using A1 by (metis zero_less_abs_iff)
- have "(0\<Colon>'a) < \<bar>c\<bar> \<longrightarrow> (0\<Colon>'a) < \<bar>inverse c\<bar>" using F1 by (metis positive_imp_inverse_positive)
- hence "(0\<Colon>'a) < \<bar>inverse c\<bar>" using F2 by metis
- hence F3: "(0\<Colon>'a) \<le> \<bar>inverse c\<bar>" by (metis order_le_less)
- have "\<exists>(u\<Colon>'a) SKF\<^sub>7\<Colon>'a \<Rightarrow> 'b. \<bar>g (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<le> u * \<bar>f (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar>"
+ have F2: "(0::'a) < \<bar>c\<bar>" using A1 by (metis zero_less_abs_iff)
+ have "(0::'a) < \<bar>c\<bar> \<longrightarrow> (0::'a) < \<bar>inverse c\<bar>" using F1 by (metis positive_imp_inverse_positive)
+ hence "(0::'a) < \<bar>inverse c\<bar>" using F2 by metis
+ hence F3: "(0::'a) \<le> \<bar>inverse c\<bar>" by (metis order_le_less)
+ have "\<exists>(u::'a) SKF\<^sub>7::'a \<Rightarrow> 'b. \<bar>g (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<le> u * \<bar>f (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar>"
using A2 by metis
- hence F4: "\<exists>(u\<Colon>'a) SKF\<^sub>7\<Colon>'a \<Rightarrow> 'b. \<bar>g (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<le> u * \<bar>f (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<and> (0\<Colon>'a) \<le> \<bar>inverse c\<bar>"
+ hence F4: "\<exists>(u::'a) SKF\<^sub>7::'a \<Rightarrow> 'b. \<bar>g (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<le> u * \<bar>f (SKF\<^sub>7 (\<bar>inverse c\<bar> * u))\<bar> \<and> (0::'a) \<le> \<bar>inverse c\<bar>"
using F3 by metis
- hence "\<exists>(v\<Colon>'a) (u\<Colon>'a) SKF\<^sub>7\<Colon>'a \<Rightarrow> 'b. \<bar>inverse c\<bar> * \<bar>g (SKF\<^sub>7 (u * v))\<bar> \<le> u * (v * \<bar>f (SKF\<^sub>7 (u * v))\<bar>)"
+ hence "\<exists>(v::'a) (u::'a) SKF\<^sub>7::'a \<Rightarrow> 'b. \<bar>inverse c\<bar> * \<bar>g (SKF\<^sub>7 (u * v))\<bar> \<le> u * (v * \<bar>f (SKF\<^sub>7 (u * v))\<bar>)"
by (metis mult_left_mono)
- then show "\<exists>ca\<Colon>'a. \<forall>x\<Colon>'b. inverse \<bar>c\<bar> * \<bar>g x\<bar> \<le> ca * \<bar>f x\<bar>"
+ then show "\<exists>ca::'a. \<forall>x::'b. inverse \<bar>c\<bar> * \<bar>g x\<bar> \<le> ca * \<bar>f x\<bar>"
using A2 F4 by (metis F1 `0 < \<bar>inverse c\<bar>` linordered_field_class.sign_simps(23) mult_le_cancel_left_pos)
qed
@@ -582,7 +582,7 @@
apply assumption+
done
-lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
+lemma bigo_useful_const_mult: "(c::'a::linordered_field) ~= 0 \<Longrightarrow>
(\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
apply (rule subsetD)
apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) <= O(h)")
@@ -594,13 +594,13 @@
apply (simp add: func_times)
done
-lemma bigo_fix: "(\<lambda>x. f ((x\<Colon>nat) + 1)) =o O(\<lambda>x. h(x + 1)) \<Longrightarrow> f 0 = 0 \<Longrightarrow>
+lemma bigo_fix: "(\<lambda>x. f ((x::nat) + 1)) =o O(\<lambda>x. h(x + 1)) \<Longrightarrow> f 0 = 0 \<Longrightarrow>
f =o O(h)"
apply (simp add: bigo_alt_def)
by (metis abs_ge_zero abs_mult abs_of_pos abs_zero not0_implies_Suc)
lemma bigo_fix2:
- "(\<lambda>x. f ((x\<Colon>nat) + 1)) =o (\<lambda>x. g(x + 1)) +o O(\<lambda>x. h(x + 1)) \<Longrightarrow>
+ "(\<lambda>x. f ((x::nat) + 1)) =o (\<lambda>x. g(x + 1)) +o O(\<lambda>x. h(x + 1)) \<Longrightarrow>
f 0 = g 0 \<Longrightarrow> f =o g +o O(h)"
apply (rule set_minus_imp_plus)
apply (rule bigo_fix)
@@ -613,7 +613,7 @@
subsection {* Less than or equal to *}
-definition lesso :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) => ('a => 'b)" (infixl "<o" 70) where
+definition lesso :: "('a => 'b::linordered_idom) => ('a => 'b) => ('a => 'b)" (infixl "<o" 70) where
"f <o g == (\<lambda>x. max (f x - g x) 0)"
lemma bigo_lesseq1: "f =o O(h) \<Longrightarrow> \<forall>x. abs (g x) <= abs (f x) \<Longrightarrow>
@@ -691,7 +691,7 @@
by (metis abs_ge_zero linorder_linear max.absorb1 max.commute)
lemma bigo_lesso4:
- "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field}) \<Longrightarrow>
+ "f <o g =o O(k::'a=>'b::{linordered_field}) \<Longrightarrow>
g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
apply (unfold lesso_def)
apply (drule set_plus_imp_minus)
--- a/src/HOL/Metis_Examples/Clausification.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Metis_Examples/Clausification.thy Thu Sep 03 15:50:40 2015 +0200
@@ -140,7 +140,7 @@
lemma ex_tl: "EX ys. tl ys = xs"
using list.sel(3) by fast
-lemma "(\<exists>ys\<Colon>nat list. tl ys = xs) \<and> (\<exists>bs\<Colon>int list. tl bs = as)"
+lemma "(\<exists>ys::nat list. tl ys = xs) \<and> (\<exists>bs::int list. tl bs = as)"
by (metis ex_tl)
end
--- a/src/HOL/Metis_Examples/Message.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Metis_Examples/Message.thy Thu Sep 03 15:50:40 2015 +0200
@@ -707,7 +707,7 @@
have F2: "\<forall>x\<^sub>1. parts x\<^sub>1 \<union> synth (analz x\<^sub>1) = parts (synth (analz x\<^sub>1))"
by (metis parts_analz parts_synth)
have F3: "X \<in> synth (analz H)" using A1 by metis
- have "\<forall>x\<^sub>2 x\<^sub>1\<Colon>msg set. x\<^sub>1 \<le> sup x\<^sub>1 x\<^sub>2" by (metis inf_sup_ord(3))
+ have "\<forall>x\<^sub>2 x\<^sub>1::msg set. x\<^sub>1 \<le> sup x\<^sub>1 x\<^sub>2" by (metis inf_sup_ord(3))
hence F4: "\<forall>x\<^sub>1. analz x\<^sub>1 \<subseteq> analz (synth x\<^sub>1)" by (metis analz_synth)
have F5: "X \<in> synth (analz H)" using F3 by metis
have "\<forall>x\<^sub>1. analz x\<^sub>1 \<subseteq> synth (analz x\<^sub>1)
--- a/src/HOL/Metis_Examples/Proxies.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Metis_Examples/Proxies.thy Thu Sep 03 15:50:40 2015 +0200
@@ -19,7 +19,7 @@
text {* Extensionality and set constants *}
-lemma plus_1_not_0: "n + (1\<Colon>nat) \<noteq> 0"
+lemma plus_1_not_0: "n + (1::nat) \<noteq> 0"
by simp
definition inc :: "nat \<Rightarrow> nat" where
@@ -40,7 +40,7 @@
sledgehammer [expect = some] (add_swap_def)
by (metis_exhaust add_swap_def)
-definition "A = {xs\<Colon>'a list. True}"
+definition "A = {xs::'a list. True}"
lemma "xs \<in> A"
(* The "add:" argument is unfortunate. *)
--- a/src/HOL/Metis_Examples/Sets.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Metis_Examples/Sets.thy Thu Sep 03 15:50:40 2015 +0200
@@ -27,47 +27,47 @@
lemma (*equal_union: *)
"(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
proof -
- have F1: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>1 \<union> x\<^sub>2" by (metis Un_commute Un_upper2)
- have F2a: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<longrightarrow> x\<^sub>2 = x\<^sub>2 \<union> x\<^sub>1" by (metis Un_commute subset_Un_eq)
- have F2: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis F2a subset_Un_eq)
+ have F1: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>1 \<union> x\<^sub>2" by (metis Un_commute Un_upper2)
+ have F2a: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<longrightarrow> x\<^sub>2 = x\<^sub>2 \<union> x\<^sub>1" by (metis Un_commute subset_Un_eq)
+ have F2: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis F2a subset_Un_eq)
{ assume "\<not> Z \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
moreover
{ assume AA1: "Y \<union> Z \<noteq> X"
{ assume "\<not> Y \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1) }
moreover
{ assume AAA1: "Y \<subseteq> X \<and> Y \<union> Z \<noteq> X"
{ assume "\<not> Z \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
moreover
{ assume "(Z \<subseteq> X \<and> Y \<subseteq> X) \<and> Y \<union> Z \<noteq> X"
hence "Y \<union> Z \<subseteq> X \<and> X \<noteq> Y \<union> Z" by (metis Un_subset_iff)
hence "Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> Y \<union> Z" by (metis F2)
- hence "\<exists>x\<^sub>1\<Colon>'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1)
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AAA1) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1) }
+ hence "\<exists>x\<^sub>1::'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1)
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AAA1) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1) }
moreover
- { assume "\<exists>x\<^sub>1\<Colon>'a set. (Z \<subseteq> x\<^sub>1 \<and> Y \<subseteq> x\<^sub>1) \<and> \<not> X \<subseteq> x\<^sub>1"
+ { assume "\<exists>x\<^sub>1::'a set. (Z \<subseteq> x\<^sub>1 \<and> Y \<subseteq> x\<^sub>1) \<and> \<not> X \<subseteq> x\<^sub>1"
{ assume "\<not> Y \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1) }
moreover
{ assume AAA1: "Y \<subseteq> X \<and> Y \<union> Z \<noteq> X"
{ assume "\<not> Z \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
moreover
{ assume "(Z \<subseteq> X \<and> Y \<subseteq> X) \<and> Y \<union> Z \<noteq> X"
hence "Y \<union> Z \<subseteq> X \<and> X \<noteq> Y \<union> Z" by (metis Un_subset_iff)
hence "Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> Y \<union> Z" by (metis F2)
- hence "\<exists>x\<^sub>1\<Colon>'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1)
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AAA1) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by blast }
+ hence "\<exists>x\<^sub>1::'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1)
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AAA1) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by blast }
moreover
{ assume "\<not> Y \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1) }
- ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by metis
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1) }
+ ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by metis
qed
sledgehammer_params [isar_proofs, compress = 2]
@@ -75,36 +75,36 @@
lemma (*equal_union: *)
"(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
proof -
- have F1: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis Un_commute subset_Un_eq)
- { assume AA1: "\<exists>x\<^sub>1\<Colon>'a set. (Z \<subseteq> x\<^sub>1 \<and> Y \<subseteq> x\<^sub>1) \<and> \<not> X \<subseteq> x\<^sub>1"
+ have F1: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis Un_commute subset_Un_eq)
+ { assume AA1: "\<exists>x\<^sub>1::'a set. (Z \<subseteq> x\<^sub>1 \<and> Y \<subseteq> x\<^sub>1) \<and> \<not> X \<subseteq> x\<^sub>1"
{ assume AAA1: "Y \<subseteq> X \<and> Y \<union> Z \<noteq> X"
{ assume "\<not> Z \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
moreover
{ assume "Y \<union> Z \<subseteq> X \<and> X \<noteq> Y \<union> Z"
- hence "\<exists>x\<^sub>1\<Colon>'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1 Un_commute Un_upper2)
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AAA1 Un_subset_iff) }
+ hence "\<exists>x\<^sub>1::'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1 Un_commute Un_upper2)
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AAA1 Un_subset_iff) }
moreover
{ assume "\<not> Y \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 Un_subset_iff) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 Un_subset_iff) }
moreover
{ assume "\<not> Z \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
moreover
{ assume "\<not> Y \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2) }
moreover
{ assume AA1: "Y \<subseteq> X \<and> Y \<union> Z \<noteq> X"
{ assume "\<not> Z \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
moreover
{ assume "Y \<union> Z \<subseteq> X \<and> X \<noteq> Y \<union> Z"
- hence "\<exists>x\<^sub>1\<Colon>'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1 Un_commute Un_upper2)
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
- ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 Un_subset_iff) }
- ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by metis
+ hence "\<exists>x\<^sub>1::'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z" by (metis F1 Un_commute Un_upper2)
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ ultimately have "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 Un_subset_iff) }
+ ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by metis
qed
sledgehammer_params [isar_proofs, compress = 3]
@@ -112,16 +112,16 @@
lemma (*equal_union: *)
"(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
proof -
- have F1a: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<longrightarrow> x\<^sub>2 = x\<^sub>2 \<union> x\<^sub>1" by (metis Un_commute subset_Un_eq)
- have F1: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis F1a subset_Un_eq)
+ have F1a: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<longrightarrow> x\<^sub>2 = x\<^sub>2 \<union> x\<^sub>1" by (metis Un_commute subset_Un_eq)
+ have F1: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis F1a subset_Un_eq)
{ assume "(Z \<subseteq> X \<and> Y \<subseteq> X) \<and> Y \<union> Z \<noteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1 Un_commute Un_subset_iff Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1 Un_commute Un_subset_iff Un_upper2) }
moreover
- { assume AA1: "\<exists>x\<^sub>1\<Colon>'a set. (Z \<subseteq> x\<^sub>1 \<and> Y \<subseteq> x\<^sub>1) \<and> \<not> X \<subseteq> x\<^sub>1"
+ { assume AA1: "\<exists>x\<^sub>1::'a set. (Z \<subseteq> x\<^sub>1 \<and> Y \<subseteq> x\<^sub>1) \<and> \<not> X \<subseteq> x\<^sub>1"
{ assume "(Z \<subseteq> X \<and> Y \<subseteq> X) \<and> Y \<union> Z \<noteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1 Un_commute Un_subset_iff Un_upper2) }
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 Un_commute Un_subset_iff Un_upper2) }
- ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2)
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis F1 Un_commute Un_subset_iff Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 Un_commute Un_subset_iff Un_upper2) }
+ ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2)
qed
sledgehammer_params [isar_proofs, compress = 4]
@@ -129,15 +129,15 @@
lemma (*equal_union: *)
"(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
proof -
- have F1: "\<forall>(x\<^sub>2\<Colon>'b set) x\<^sub>1\<Colon>'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis Un_commute subset_Un_eq)
+ have F1: "\<forall>(x\<^sub>2::'b set) x\<^sub>1::'b set. x\<^sub>1 \<subseteq> x\<^sub>2 \<and> x\<^sub>2 \<subseteq> x\<^sub>1 \<longrightarrow> x\<^sub>1 = x\<^sub>2" by (metis Un_commute subset_Un_eq)
{ assume "\<not> Y \<subseteq> X"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_commute Un_upper2) }
moreover
{ assume AA1: "Y \<subseteq> X \<and> Y \<union> Z \<noteq> X"
- { assume "\<exists>x\<^sub>1\<Colon>'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z"
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
- hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 F1 Un_commute Un_subset_iff Un_upper2) }
- ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V\<Colon>'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_subset_iff Un_upper2)
+ { assume "\<exists>x\<^sub>1::'a set. Y \<subseteq> x\<^sub>1 \<union> Z \<and> Y \<union> Z \<noteq> X \<and> \<not> X \<subseteq> x\<^sub>1 \<union> Z"
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_upper2) }
+ hence "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis AA1 F1 Un_commute Un_subset_iff Un_upper2) }
+ ultimately show "(X = Y \<union> Z) = (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V::'a set. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" by (metis Un_subset_iff Un_upper2)
qed
sledgehammer_params [isar_proofs, compress = 1]
@@ -154,8 +154,8 @@
lemma (* fixedpoint: *) "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
proof -
- assume "\<exists>!x\<Colon>'a. f (g x) = x"
- thus "\<exists>!y\<Colon>'b. g (f y) = y" by metis
+ assume "\<exists>!x::'a. f (g x) = x"
+ thus "\<exists>!y::'b. g (f y) = y" by metis
qed
lemma (* singleton_example_2: *)
@@ -172,8 +172,8 @@
assume "\<forall>x \<in> S. \<Union>S \<subseteq> x"
hence "\<forall>x\<^sub>1. x\<^sub>1 \<subseteq> \<Union>S \<and> x\<^sub>1 \<in> S \<longrightarrow> x\<^sub>1 = \<Union>S" by (metis set_eq_subset)
hence "\<forall>x\<^sub>1. x\<^sub>1 \<in> S \<longrightarrow> x\<^sub>1 = \<Union>S" by (metis Union_upper)
- hence "\<forall>x\<^sub>1\<Colon>('a set) set. \<Union>S \<in> x\<^sub>1 \<longrightarrow> S \<subseteq> x\<^sub>1" by (metis subsetI)
- hence "\<forall>x\<^sub>1\<Colon>('a set) set. S \<subseteq> insert (\<Union>S) x\<^sub>1" by (metis insert_iff)
+ hence "\<forall>x\<^sub>1::('a set) set. \<Union>S \<in> x\<^sub>1 \<longrightarrow> S \<subseteq> x\<^sub>1" by (metis subsetI)
+ hence "\<forall>x\<^sub>1::('a set) set. S \<subseteq> insert (\<Union>S) x\<^sub>1" by (metis insert_iff)
thus "\<exists>z. S \<subseteq> {z}" by metis
qed
--- a/src/HOL/Metis_Examples/Type_Encodings.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Metis_Examples/Type_Encodings.thy Thu Sep 03 15:50:40 2015 +0200
@@ -89,7 +89,7 @@
lemma "P (null xs) \<Longrightarrow> null xs \<Longrightarrow> xs = []"
by (metis_exhaust null_def)
-lemma "(0\<Colon>nat) + 0 = 0"
+lemma "(0::nat) + 0 = 0"
by (metis_exhaust add_0_left)
end
--- a/src/HOL/MicroJava/Comp/LemmasComp.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/MicroJava/Comp/LemmasComp.thy Thu Sep 03 15:50:40 2015 +0200
@@ -311,10 +311,10 @@
apply (simp add: map_of_map [symmetric])
apply (simp add: split_beta)
apply (simp add: Fun.comp_def split_beta)
- apply (subgoal_tac "(\<lambda>x\<Colon>(vname list \<times> fdecl list \<times> stmt \<times> expr) mdecl.
+ apply (subgoal_tac "(\<lambda>x::(vname list \<times> fdecl list \<times> stmt \<times> expr) mdecl.
(fst x, Object,
snd (compMethod G Object
- (inv (\<lambda>(s\<Colon>sig, m\<Colon>ty \<times> vname list \<times> fdecl list \<times> stmt \<times> expr).
+ (inv (\<lambda>(s::sig, m::ty \<times> vname list \<times> fdecl list \<times> stmt \<times> expr).
(s, Object, m))
(S, Object, snd x)))))
= (\<lambda>x. (fst x, Object, fst (snd x),
--- a/src/HOL/MicroJava/Comp/TypeInf.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/MicroJava/Comp/TypeInf.thy Thu Sep 03 15:50:40 2015 +0200
@@ -108,9 +108,9 @@
(* Uniqueness of types property *)
lemma uniqueness_of_types: "
- (\<forall> (E\<Colon>'a prog \<times> (vname \<Rightarrow> ty option)) T1 T2.
+ (\<forall> (E::'a prog \<times> (vname \<Rightarrow> ty option)) T1 T2.
E\<turnstile>e :: T1 \<longrightarrow> E\<turnstile>e :: T2 \<longrightarrow> T1 = T2) \<and>
- (\<forall> (E\<Colon>'a prog \<times> (vname \<Rightarrow> ty option)) Ts1 Ts2.
+ (\<forall> (E::'a prog \<times> (vname \<Rightarrow> ty option)) Ts1 Ts2.
E\<turnstile>es [::] Ts1 \<longrightarrow> E\<turnstile>es [::] Ts2 \<longrightarrow> Ts1 = Ts2)"
apply (rule compat_expr_expr_list.induct)
(* NewC *)
--- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -61,7 +61,7 @@
text\<open>The ordering on one-dimensional vectors is linear.\<close>
class cart_one =
- assumes UNIV_one: "card (UNIV \<Colon> 'a set) = Suc 0"
+ assumes UNIV_one: "card (UNIV :: 'a set) = Suc 0"
begin
subclass finite
@@ -690,7 +690,7 @@
{ fix y
have "?P y"
proof (rule span_induct_alt[of ?P "columns A", folded scalar_mult_eq_scaleR])
- show "\<exists>x\<Colon>real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0"
+ show "\<exists>x::real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0"
by (rule exI[where x=0], simp)
next
fix c y1 y2
--- a/src/HOL/Multivariate_Analysis/Complex_Analysis_Basics.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Complex_Analysis_Basics.thy Thu Sep 03 15:50:40 2015 +0200
@@ -242,9 +242,9 @@
by (intro open_Collect_less closed_Collect_le closed_Collect_eq isCont_Re
isCont_Im continuous_ident continuous_const)+
-lemma closed_complex_Reals: "closed (Reals :: complex set)"
+lemma closed_complex_Reals: "closed (\<real> :: complex set)"
proof -
- have "(Reals :: complex set) = {z. Im z = 0}"
+ have "(\<real> :: complex set) = {z. Im z = 0}"
by (auto simp: complex_is_Real_iff)
then show ?thesis
by (metis closed_halfspace_Im_eq)
--- a/src/HOL/Multivariate_Analysis/Complex_Transcendental.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Complex_Transcendental.thy Thu Sep 03 15:50:40 2015 +0200
@@ -211,7 +211,7 @@
by (auto simp: exp_eq abs_mult)
lemma exp_integer_2pi:
- assumes "n \<in> Ints"
+ assumes "n \<in> \<int>"
shows "exp((2 * n * pi) * ii) = 1"
proof -
have "exp((2 * n * pi) * ii) = exp 0"
@@ -751,15 +751,15 @@
by blast
qed
-lemma Arg_eq_0: "Arg z = 0 \<longleftrightarrow> z \<in> Reals \<and> 0 \<le> Re z"
+lemma Arg_eq_0: "Arg z = 0 \<longleftrightarrow> z \<in> \<real> \<and> 0 \<le> Re z"
proof (cases "z=0")
case True then show ?thesis
by simp
next
case False
- have "z \<in> Reals \<and> 0 \<le> Re z \<longleftrightarrow> z \<in> Reals \<and> 0 \<le> Re (of_real (cmod z) * exp (\<i> * complex_of_real (Arg z)))"
+ have "z \<in> \<real> \<and> 0 \<le> Re z \<longleftrightarrow> z \<in> \<real> \<and> 0 \<le> Re (of_real (cmod z) * exp (\<i> * complex_of_real (Arg z)))"
by (metis Arg_eq)
- also have "... \<longleftrightarrow> z \<in> Reals \<and> 0 \<le> Re (exp (\<i> * complex_of_real (Arg z)))"
+ also have "... \<longleftrightarrow> z \<in> \<real> \<and> 0 \<le> Re (exp (\<i> * complex_of_real (Arg z)))"
using False
by (simp add: zero_le_mult_iff)
also have "... \<longleftrightarrow> Arg z = 0"
@@ -955,7 +955,7 @@
corollary Im_Ln_of_real [simp]: "r > 0 \<Longrightarrow> Im (ln (of_real r)) = 0"
by (simp add: Ln_of_real)
-lemma cmod_Ln_Reals [simp]: "z \<in> Reals \<Longrightarrow> 0 < Re z \<Longrightarrow> cmod (ln z) = norm (ln (Re z))"
+lemma cmod_Ln_Reals [simp]: "z \<in> \<real> \<Longrightarrow> 0 < Re z \<Longrightarrow> cmod (ln z) = norm (ln (Re z))"
using Ln_of_real by force
lemma Ln_1: "ln 1 = (0::complex)"
@@ -1565,10 +1565,10 @@
using lim_Ln_over_power [of 1]
by simp
-lemma Ln_Reals_eq: "x \<in> Reals \<Longrightarrow> Re x > 0 \<Longrightarrow> Ln x = of_real (ln (Re x))"
+lemma Ln_Reals_eq: "x \<in> \<real> \<Longrightarrow> Re x > 0 \<Longrightarrow> Ln x = of_real (ln (Re x))"
using Ln_of_real by force
-lemma powr_Reals_eq: "x \<in> Reals \<Longrightarrow> Re x > 0 \<Longrightarrow> x powr complex_of_real y = of_real (x powr y)"
+lemma powr_Reals_eq: "x \<in> \<real> \<Longrightarrow> Re x > 0 \<Longrightarrow> x powr complex_of_real y = of_real (x powr y)"
by (simp add: powr_of_real)
lemma lim_ln_over_power:
--- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1226,7 +1226,7 @@
then have "0 \<in> closure S \<and> (\<forall>c. c > 0 \<longrightarrow> op *\<^sub>R c ` closure S = closure S)"
using closure_subset by (auto simp add: closure_scaleR)
then show ?thesis
- using cone_iff[of "closure S"] by auto
+ using False cone_iff[of "closure S"] by auto
qed
@@ -3706,7 +3706,7 @@
shows "affine hull (insert 0 d) = {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
(is "affine hull (insert 0 ?A) = ?B")
proof -
- have *: "\<And>A. op + (0\<Colon>'a) ` A = A" "\<And>A. op + (- (0\<Colon>'a)) ` A = A"
+ have *: "\<And>A. op + (0::'a) ` A = A" "\<And>A. op + (- (0::'a)) ` A = A"
by auto
show ?thesis
unfolding affine_hull_insert_span_gen span_substd_basis[OF assms,symmetric] * ..
@@ -9545,4 +9545,216 @@
apply simp
done
+subsection\<open>The infimum of the distance between two sets\<close>
+
+definition setdist :: "'a::metric_space set \<Rightarrow> 'a set \<Rightarrow> real" where
+ "setdist s t \<equiv>
+ (if s = {} \<or> t = {} then 0
+ else Inf {dist x y| x y. x \<in> s \<and> y \<in> t})"
+
+lemma setdist_empty1 [simp]: "setdist {} t = 0"
+ by (simp add: setdist_def)
+
+lemma setdist_empty2 [simp]: "setdist t {} = 0"
+ by (simp add: setdist_def)
+
+lemma setdist_pos_le: "0 \<le> setdist s t"
+ by (auto simp: setdist_def ex_in_conv [symmetric] intro: cInf_greatest)
+
+lemma le_setdistI:
+ assumes "s \<noteq> {}" "t \<noteq> {}" "\<And>x y. \<lbrakk>x \<in> s; y \<in> t\<rbrakk> \<Longrightarrow> d \<le> dist x y"
+ shows "d \<le> setdist s t"
+ using assms
+ by (auto simp: setdist_def Set.ex_in_conv [symmetric] intro: cInf_greatest)
+
+lemma setdist_le_dist: "\<lbrakk>x \<in> s; y \<in> t\<rbrakk> \<Longrightarrow> setdist s t \<le> dist x y"
+ unfolding setdist_def
+ by (auto intro!: bdd_belowI [where m=0] cInf_lower)
+
+lemma le_setdist_iff:
+ "d \<le> setdist s t \<longleftrightarrow>
+ (\<forall>x \<in> s. \<forall>y \<in> t. d \<le> dist x y) \<and> (s = {} \<or> t = {} \<longrightarrow> d \<le> 0)"
+ apply (cases "s = {} \<or> t = {}")
+ apply (force simp add: setdist_def)
+ apply (intro iffI conjI)
+ using setdist_le_dist apply fastforce
+ apply (auto simp: intro: le_setdistI)
+ done
+
+lemma setdist_ltE:
+ assumes "setdist s t < b" "s \<noteq> {}" "t \<noteq> {}"
+ obtains x y where "x \<in> s" "y \<in> t" "dist x y < b"
+using assms
+by (auto simp: not_le [symmetric] le_setdist_iff)
+
+lemma setdist_refl: "setdist s s = 0"
+ apply (cases "s = {}")
+ apply (force simp add: setdist_def)
+ apply (rule antisym [OF _ setdist_pos_le])
+ apply (metis all_not_in_conv dist_self setdist_le_dist)
+ done
+
+lemma setdist_sym: "setdist s t = setdist t s"
+ by (force simp: setdist_def dist_commute intro!: arg_cong [where f=Inf])
+
+lemma setdist_triangle: "setdist s t \<le> setdist s {a} + setdist {a} t"
+proof (cases "s = {} \<or> t = {}")
+ case True then show ?thesis
+ using setdist_pos_le by fastforce
+next
+ case False
+ have "\<And>x. x \<in> s \<Longrightarrow> setdist s t - dist x a \<le> setdist {a} t"
+ apply (rule le_setdistI, blast)
+ using False apply (fastforce intro: le_setdistI)
+ apply (simp add: algebra_simps)
+ apply (metis dist_commute dist_triangle_alt order_trans [OF setdist_le_dist])
+ done
+ then have "setdist s t - setdist {a} t \<le> setdist s {a}"
+ using False by (fastforce intro: le_setdistI)
+ then show ?thesis
+ by (simp add: algebra_simps)
+qed
+
+lemma setdist_singletons [simp]: "setdist {x} {y} = dist x y"
+ by (simp add: setdist_def)
+
+lemma setdist_Lipschitz: "abs(setdist {x} s - setdist {y} s) \<le> dist x y"
+ apply (subst setdist_singletons [symmetric])
+ by (metis abs_diff_le_iff diff_le_eq setdist_triangle setdist_sym)
+
+lemma continuous_at_setdist: "continuous (at x) (\<lambda>y. (setdist {y} s))"
+ by (force simp: continuous_at_eps_delta dist_real_def intro: le_less_trans [OF setdist_Lipschitz])
+
+lemma continuous_on_setdist: "continuous_on t (\<lambda>y. (setdist {y} s))"
+ by (metis continuous_at_setdist continuous_at_imp_continuous_on)
+
+lemma uniformly_continuous_on_setdist: "uniformly_continuous_on t (\<lambda>y. (setdist {y} s))"
+ by (force simp: uniformly_continuous_on_def dist_real_def intro: le_less_trans [OF setdist_Lipschitz])
+
+lemma setdist_subset_right: "\<lbrakk>t \<noteq> {}; t \<subseteq> u\<rbrakk> \<Longrightarrow> setdist s u \<le> setdist s t"
+ apply (cases "s = {} \<or> u = {}", force)
+ apply (auto simp: setdist_def intro!: bdd_belowI [where m=0] cInf_superset_mono)
+ done
+
+lemma setdist_subset_left: "\<lbrakk>s \<noteq> {}; s \<subseteq> t\<rbrakk> \<Longrightarrow> setdist t u \<le> setdist s u"
+ by (metis setdist_subset_right setdist_sym)
+
+lemma setdist_closure_1 [simp]: "setdist (closure s) t = setdist s t"
+proof (cases "s = {} \<or> t = {}")
+ case True then show ?thesis by force
+next
+ case False
+ { fix y
+ assume "y \<in> t"
+ have "continuous_on (closure s) (\<lambda>a. dist a y)"
+ by (auto simp: continuous_intros dist_norm)
+ then have *: "\<And>x. x \<in> closure s \<Longrightarrow> setdist s t \<le> dist x y"
+ apply (rule continuous_ge_on_closure)
+ apply assumption
+ apply (blast intro: setdist_le_dist `y \<in> t` )
+ done
+ } note * = this
+ show ?thesis
+ apply (rule antisym)
+ using False closure_subset apply (blast intro: setdist_subset_left)
+ using False *
+ apply (force simp add: closure_eq_empty intro!: le_setdistI)
+ done
+qed
+
+lemma setdist_closure_2 [simp]: "setdist t (closure s) = setdist t s"
+by (metis setdist_closure_1 setdist_sym)
+
+lemma setdist_compact_closed:
+ fixes s :: "'a::euclidean_space set"
+ assumes s: "compact s" and t: "closed t"
+ and "s \<noteq> {}" "t \<noteq> {}"
+ shows "\<exists>x \<in> s. \<exists>y \<in> t. dist x y = setdist s t"
+proof -
+ have "{x - y |x y. x \<in> s \<and> y \<in> t} \<noteq> {}"
+ using assms by blast
+ then
+ have "\<exists>x \<in> s. \<exists>y \<in> t. dist x y \<le> setdist s t"
+ using distance_attains_inf [where a=0, OF compact_closed_differences [OF s t]] assms
+ apply (clarsimp simp: dist_norm le_setdist_iff, blast)
+ done
+ then show ?thesis
+ by (blast intro!: antisym [OF _ setdist_le_dist] )
+qed
+
+lemma setdist_closed_compact:
+ fixes s :: "'a::euclidean_space set"
+ assumes s: "closed s" and t: "compact t"
+ and "s \<noteq> {}" "t \<noteq> {}"
+ shows "\<exists>x \<in> s. \<exists>y \<in> t. dist x y = setdist s t"
+ using setdist_compact_closed [OF t s `t \<noteq> {}` `s \<noteq> {}`]
+ by (metis dist_commute setdist_sym)
+
+lemma setdist_eq_0I: "\<lbrakk>x \<in> s; x \<in> t\<rbrakk> \<Longrightarrow> setdist s t = 0"
+ by (metis antisym dist_self setdist_le_dist setdist_pos_le)
+
+lemma setdist_eq_0_compact_closed:
+ fixes s :: "'a::euclidean_space set"
+ assumes s: "compact s" and t: "closed t"
+ shows "setdist s t = 0 \<longleftrightarrow> s = {} \<or> t = {} \<or> s \<inter> t \<noteq> {}"
+ apply (cases "s = {} \<or> t = {}", force)
+ using setdist_compact_closed [OF s t]
+ apply (force intro: setdist_eq_0I )
+ done
+
+corollary setdist_gt_0_compact_closed:
+ fixes s :: "'a::euclidean_space set"
+ assumes s: "compact s" and t: "closed t"
+ shows "setdist s t > 0 \<longleftrightarrow> (s \<noteq> {} \<and> t \<noteq> {} \<and> s \<inter> t = {})"
+ using setdist_pos_le [of s t] setdist_eq_0_compact_closed [OF assms]
+ by linarith
+
+lemma setdist_eq_0_closed_compact:
+ fixes s :: "'a::euclidean_space set"
+ assumes s: "closed s" and t: "compact t"
+ shows "setdist s t = 0 \<longleftrightarrow> s = {} \<or> t = {} \<or> s \<inter> t \<noteq> {}"
+ using setdist_eq_0_compact_closed [OF t s]
+ by (metis Int_commute setdist_sym)
+
+lemma setdist_eq_0_bounded:
+ fixes s :: "'a::euclidean_space set"
+ assumes "bounded s \<or> bounded t"
+ shows "setdist s t = 0 \<longleftrightarrow> s = {} \<or> t = {} \<or> closure s \<inter> closure t \<noteq> {}"
+ apply (cases "s = {} \<or> t = {}", force)
+ using setdist_eq_0_compact_closed [of "closure s" "closure t"]
+ setdist_eq_0_closed_compact [of "closure s" "closure t"] assms
+ apply (force simp add: bounded_closure compact_eq_bounded_closed)
+ done
+
+lemma setdist_unique:
+ "\<lbrakk>a \<in> s; b \<in> t; \<And>x y. x \<in> s \<and> y \<in> t ==> dist a b \<le> dist x y\<rbrakk>
+ \<Longrightarrow> setdist s t = dist a b"
+ by (force simp add: setdist_le_dist le_setdist_iff intro: antisym)
+
+lemma setdist_closest_point:
+ "\<lbrakk>closed s; s \<noteq> {}\<rbrakk> \<Longrightarrow> setdist {a} s = dist a (closest_point s a)"
+ apply (rule setdist_unique)
+ using closest_point_le
+ apply (auto simp: closest_point_in_set)
+ done
+
+lemma setdist_eq_0_sing_1 [simp]:
+ fixes s :: "'a::euclidean_space set"
+ shows "setdist {x} s = 0 \<longleftrightarrow> s = {} \<or> x \<in> closure s"
+by (auto simp: setdist_eq_0_bounded)
+
+lemma setdist_eq_0_sing_2 [simp]:
+ fixes s :: "'a::euclidean_space set"
+ shows "setdist s {x} = 0 \<longleftrightarrow> s = {} \<or> x \<in> closure s"
+by (auto simp: setdist_eq_0_bounded)
+
+lemma setdist_sing_in_set:
+ fixes s :: "'a::euclidean_space set"
+ shows "x \<in> s \<Longrightarrow> setdist {x} s = 0"
+using closure_subset by force
+
+lemma setdist_le_sing: "x \<in> s ==> setdist s t \<le> setdist {x} t"
+ using setdist_subset_left by auto
+
+
end
--- a/src/HOL/Multivariate_Analysis/Derivative.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Derivative.thy Thu Sep 03 15:50:40 2015 +0200
@@ -2178,7 +2178,7 @@
apply auto
done
-text \<open>Considering derivative @{typ "real \<Rightarrow> 'b\<Colon>real_normed_vector"} as a vector.\<close>
+text \<open>Considering derivative @{typ "real \<Rightarrow> 'b::real_normed_vector"} as a vector.\<close>
definition "vector_derivative f net = (SOME f'. (f has_vector_derivative f') net)"
--- a/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -92,6 +92,18 @@
by (auto intro!: exI[of _ "\<Sum>i\<in>Basis. f i *\<^sub>R i"])
qed auto
+lemma (in euclidean_space) euclidean_representation_setsum_fun:
+ "(\<lambda>x. \<Sum>b\<in>Basis. inner (f x) b *\<^sub>R b) = f"
+ by (rule ext) (simp add: euclidean_representation_setsum)
+
+lemma euclidean_isCont:
+ assumes "\<And>b. b \<in> Basis \<Longrightarrow> isCont (\<lambda>x. (inner (f x) b) *\<^sub>R b) x"
+ shows "isCont f x"
+ apply (subst euclidean_representation_setsum_fun [symmetric])
+ apply (rule isCont_setsum)
+ apply (blast intro: assms)
+ done
+
lemma DIM_positive: "0 < DIM('a::euclidean_space)"
by (simp add: card_gt_0_iff)
--- a/src/HOL/Multivariate_Analysis/Integration.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Integration.thy Thu Sep 03 15:50:40 2015 +0200
@@ -7948,7 +7948,7 @@
using assms by auto
have *: "a \<le> x"
using assms(5) by auto
- have "((\<lambda>x. 0\<Colon>'a) has_integral f x - f a) {a .. x}"
+ have "((\<lambda>x. 0::'a) has_integral f x - f a) {a .. x}"
apply (rule fundamental_theorem_of_calculus_interior_strong[OF assms(1) *])
apply (rule continuous_on_subset[OF assms(2)])
defer
--- a/src/HOL/Multivariate_Analysis/L2_Norm.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/L2_Norm.thy Thu Sep 03 15:50:40 2015 +0200
@@ -70,13 +70,6 @@
apply (simp add: real_sqrt_mult setsum_nonneg)
done
-lemma setsum_nonneg_eq_0_iff:
- fixes f :: "'a \<Rightarrow> 'b::ordered_ab_group_add"
- shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
- apply (induct set: finite, simp)
- apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
- done
-
lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
unfolding setL2_def
by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
--- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Thu Sep 03 15:50:40 2015 +0200
@@ -562,25 +562,45 @@
using reals_Archimedean[of e] less_trans[of 0 "1 / real n" e for n::nat]
by (auto simp add: field_simps cong: conj_cong)
-lemma real_pow_lbound: "0 \<le> x \<Longrightarrow> 1 + real n * x \<le> (1 + x) ^ n"
+text{*Bernoulli's inequality*}
+lemma Bernoulli_inequality:
+ fixes x :: real
+ assumes "-1 \<le> x"
+ shows "1 + n * x \<le> (1 + x) ^ n"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
- then have h: "1 + real n * x \<le> (1 + x) ^ n"
- by simp
- from h have p: "1 \<le> (1 + x) ^ n"
- using Suc.prems by simp
- from h have "1 + real n * x + x \<le> (1 + x) ^ n + x"
+ have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
+ by (simp add: algebra_simps)
+ also have "... = (1 + x) * (1 + n*x)"
+ by (auto simp: power2_eq_square algebra_simps real_of_nat_Suc)
+ also have "... \<le> (1 + x) ^ Suc n"
+ using Suc.hyps assms mult_left_mono by fastforce
+ finally show ?case .
+qed
+
+lemma Bernoulli_inequality_even:
+ fixes x :: real
+ assumes "even n"
+ shows "1 + n * x \<le> (1 + x) ^ n"
+proof (cases "-1 \<le> x \<or> n=0")
+ case True
+ then show ?thesis
+ by (auto simp: Bernoulli_inequality)
+next
+ case False
+ then have "real n \<ge> 1"
by simp
- also have "\<dots> \<le> (1 + x) ^ Suc n"
- apply (subst diff_le_0_iff_le[symmetric])
- using mult_left_mono[OF p Suc.prems]
- apply (simp add: field_simps)
- done
- finally show ?case
- by (simp add: real_of_nat_Suc field_simps)
+ with False have "n * x \<le> -1"
+ by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
+ then have "1 + n * x \<le> 0"
+ by auto
+ also have "... \<le> (1 + x) ^ n"
+ using assms
+ using zero_le_even_power by blast
+ finally show ?thesis .
qed
lemma real_arch_pow:
@@ -592,8 +612,8 @@
by arith
from reals_Archimedean3[OF x0, rule_format, of y]
obtain n :: nat where n: "y < real n * (x - 1)" by metis
- from x0 have x00: "x- 1 \<ge> 0" by arith
- from real_pow_lbound[OF x00, of n] n
+ from x0 have x00: "x- 1 \<ge> -1" by arith
+ from Bernoulli_inequality[OF x00, of n] n
have "y < x^n" by auto
then show ?thesis by metis
qed
@@ -1417,7 +1437,7 @@
also have "(\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>) = (\<Sum>b\<in>Basis. \<Sum>x\<in>P. \<bar>f x \<bullet> b\<bar>)"
by (rule setsum.commute)
also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
- proof (rule setsum_bounded)
+ proof (rule setsum_bounded_above)
fix i :: 'n
assume i: "i \<in> Basis"
have "norm (\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le>
@@ -2828,7 +2848,7 @@
unfolding real_of_nat_def
apply (subst euclidean_inner)
apply (subst power2_abs[symmetric])
- apply (rule order_trans[OF setsum_bounded[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
+ apply (rule order_trans[OF setsum_bounded_above[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
apply (auto simp add: power2_eq_square[symmetric])
apply (subst power2_abs[symmetric])
apply (rule power_mono)
--- a/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy Thu Sep 03 15:50:40 2015 +0200
@@ -7,6 +7,7 @@
Complex_Analysis_Basics
Bounded_Continuous_Function
Uniform_Limit
+ Weierstrass
begin
end
--- a/src/HOL/Multivariate_Analysis/Ordered_Euclidean_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Ordered_Euclidean_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -177,7 +177,7 @@
text\<open>Instantiation for intervals on @{text ordered_euclidean_space}\<close>
lemma
- fixes a :: "'a\<Colon>ordered_euclidean_space"
+ fixes a :: "'a::ordered_euclidean_space"
shows cbox_interval: "cbox a b = {a..b}"
and interval_cbox: "{a..b} = cbox a b"
and eucl_le_atMost: "{x. \<forall>i\<in>Basis. x \<bullet> i <= a \<bullet> i} = {..a}"
@@ -185,17 +185,17 @@
by (auto simp: eucl_le[where 'a='a] eucl_less_def box_def cbox_def)
lemma closed_eucl_atLeastAtMost[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
+ fixes a :: "'a::ordered_euclidean_space"
shows "closed {a..b}"
by (simp add: cbox_interval[symmetric] closed_cbox)
lemma closed_eucl_atMost[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
+ fixes a :: "'a::ordered_euclidean_space"
shows "closed {..a}"
by (simp add: eucl_le_atMost[symmetric])
lemma closed_eucl_atLeast[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
+ fixes a :: "'a::ordered_euclidean_space"
shows "closed {a..}"
by (simp add: eucl_le_atLeast[symmetric])
--- a/src/HOL/Multivariate_Analysis/Path_Connected.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Path_Connected.thy Thu Sep 03 15:50:40 2015 +0200
@@ -175,7 +175,7 @@
lemma simple_path_eq_arc: "pathfinish g \<noteq> pathstart g \<Longrightarrow> (simple_path g = arc g)"
by (simp add: arc_simple_path)
-lemma path_image_nonempty: "path_image g \<noteq> {}"
+lemma path_image_nonempty [simp]: "path_image g \<noteq> {}"
unfolding path_image_def image_is_empty box_eq_empty
by auto
--- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -869,7 +869,7 @@
unfolding set_eq_iff and Int_iff and mem_box by auto
lemma rational_boxes:
- fixes x :: "'a\<Colon>euclidean_space"
+ fixes x :: "'a::euclidean_space"
assumes "e > 0"
shows "\<exists>a b. (\<forall>i\<in>Basis. a \<bullet> i \<in> \<rat> \<and> b \<bullet> i \<in> \<rat> ) \<and> x \<in> box a b \<and> box a b \<subseteq> ball x e"
proof -
@@ -926,7 +926,7 @@
qed
lemma open_UNION_box:
- fixes M :: "'a\<Colon>euclidean_space set"
+ fixes M :: "'a::euclidean_space set"
assumes "open M"
defines "a' \<equiv> \<lambda>f :: 'a \<Rightarrow> real \<times> real. (\<Sum>(i::'a)\<in>Basis. fst (f i) *\<^sub>R i)"
defines "b' \<equiv> \<lambda>f :: 'a \<Rightarrow> real \<times> real. (\<Sum>(i::'a)\<in>Basis. snd (f i) *\<^sub>R i)"
@@ -1602,7 +1602,7 @@
lemma closure_union [simp]: "closure (S \<union> T) = closure S \<union> closure T"
unfolding closure_interior by simp
-lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
+lemma closure_eq_empty [iff]: "closure S = {} \<longleftrightarrow> S = {}"
using closure_empty closure_subset[of S]
by blast
@@ -1826,7 +1826,7 @@
text\<open>Interrelations between restricted and unrestricted limits.\<close>
-lemma Lim_at_imp_Lim_at_within:
+lemma Lim_at_imp_Lim_at_within:
"(f ---> l) (at x) \<Longrightarrow> (f ---> l) (at x within S)"
by (metis order_refl filterlim_mono subset_UNIV at_le)
@@ -2831,12 +2831,12 @@
(metis abs_le_D1 add.commute diff_le_eq)
lemma bounded_inner_imp_bdd_above:
- assumes "bounded s"
+ assumes "bounded s"
shows "bdd_above ((\<lambda>x. x \<bullet> a) ` s)"
by (simp add: assms bounded_imp_bdd_above bounded_linear_image bounded_linear_inner_left)
lemma bounded_inner_imp_bdd_below:
- assumes "bounded s"
+ assumes "bounded s"
shows "bdd_below ((\<lambda>x. x \<bullet> a) ` s)"
by (simp add: assms bounded_imp_bdd_below bounded_linear_image bounded_linear_inner_left)
@@ -4635,6 +4635,12 @@
text\<open>Some simple consequential lemmas.\<close>
+lemma uniformly_continuous_onE:
+ assumes "uniformly_continuous_on s f" "0 < e"
+ obtains d where "d>0" "\<And>x x'. \<lbrakk>x\<in>s; x'\<in>s; dist x' x < d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
+using assms
+by (auto simp: uniformly_continuous_on_def)
+
lemma uniformly_continuous_imp_continuous:
"uniformly_continuous_on s f \<Longrightarrow> continuous_on s f"
unfolding uniformly_continuous_on_def continuous_on_iff by blast
@@ -6166,6 +6172,19 @@
finally show ?thesis .
qed
+lemma continuous_on_closed_Collect_le:
+ fixes f g :: "'a::t2_space \<Rightarrow> real"
+ assumes f: "continuous_on s f" and g: "continuous_on s g" and s: "closed s"
+ shows "closed {x \<in> s. f x \<le> g x}"
+proof -
+ have "closed ((\<lambda>x. g x - f x) -` {0..} \<inter> s)"
+ using closed_real_atLeast continuous_on_diff [OF g f]
+ by (simp add: continuous_on_closed_vimage [OF s])
+ also have "((\<lambda>x. g x - f x) -` {0..} \<inter> s) = {x\<in>s. f x \<le> g x}"
+ by auto
+ finally show ?thesis .
+qed
+
lemma continuous_at_inner: "continuous (at x) (inner a)"
unfolding continuous_at by (intro tendsto_intros)
@@ -6194,6 +6213,25 @@
shows "closed {x::'a. \<forall>i\<in>Basis. a\<bullet>i \<le> x\<bullet>i}"
by (simp add: Collect_ball_eq closed_INT closed_Collect_le)
+lemma continuous_le_on_closure:
+ fixes a::real
+ assumes f: "continuous_on (closure s) f"
+ and x: "x \<in> closure(s)"
+ and xlo: "\<And>x. x \<in> s ==> f(x) \<le> a"
+ shows "f(x) \<le> a"
+ using image_closure_subset [OF f]
+ using image_closure_subset [OF f] closed_halfspace_le [of "1::real" a] assms
+ by force
+
+lemma continuous_ge_on_closure:
+ fixes a::real
+ assumes f: "continuous_on (closure s) f"
+ and x: "x \<in> closure(s)"
+ and xlo: "\<And>x. x \<in> s ==> f(x) \<ge> a"
+ shows "f(x) \<ge> a"
+ using image_closure_subset [OF f] closed_halfspace_ge [of a "1::real"] assms
+ by force
+
text \<open>Openness of halfspaces.\<close>
lemma open_halfspace_lt: "open {x. inner a x < b}"
@@ -6639,25 +6677,25 @@
simp: euclidean_dist_l2[where 'a='a] cbox_def dist_norm)
lemma eucl_less_eq_halfspaces:
- fixes a :: "'a\<Colon>euclidean_space"
+ fixes a :: "'a::euclidean_space"
shows "{x. x <e a} = (\<Inter>i\<in>Basis. {x. x \<bullet> i < a \<bullet> i})"
"{x. a <e x} = (\<Inter>i\<in>Basis. {x. a \<bullet> i < x \<bullet> i})"
by (auto simp: eucl_less_def)
lemma eucl_le_eq_halfspaces:
- fixes a :: "'a\<Colon>euclidean_space"
+ fixes a :: "'a::euclidean_space"
shows "{x. \<forall>i\<in>Basis. x \<bullet> i \<le> a \<bullet> i} = (\<Inter>i\<in>Basis. {x. x \<bullet> i \<le> a \<bullet> i})"
"{x. \<forall>i\<in>Basis. a \<bullet> i \<le> x \<bullet> i} = (\<Inter>i\<in>Basis. {x. a \<bullet> i \<le> x \<bullet> i})"
by auto
lemma open_Collect_eucl_less[simp, intro]:
- fixes a :: "'a\<Colon>euclidean_space"
+ fixes a :: "'a::euclidean_space"
shows "open {x. x <e a}"
"open {x. a <e x}"
by (auto simp: eucl_less_eq_halfspaces open_halfspace_component_lt open_halfspace_component_gt)
lemma closed_Collect_eucl_le[simp, intro]:
- fixes a :: "'a\<Colon>euclidean_space"
+ fixes a :: "'a::euclidean_space"
shows "closed {x. \<forall>i\<in>Basis. a \<bullet> i \<le> x \<bullet> i}"
"closed {x. \<forall>i\<in>Basis. x \<bullet> i \<le> a \<bullet> i}"
unfolding eucl_le_eq_halfspaces
@@ -7320,7 +7358,7 @@
subsection \<open>Banach fixed point theorem (not really topological...)\<close>
-lemma banach_fix:
+theorem banach_fix:
assumes s: "complete s" "s \<noteq> {}"
and c: "0 \<le> c" "c < 1"
and f: "(f ` s) \<subseteq> s"
@@ -7501,7 +7539,7 @@
subsection \<open>Edelstein fixed point theorem\<close>
-lemma edelstein_fix:
+theorem edelstein_fix:
fixes s :: "'a::metric_space set"
assumes s: "compact s" "s \<noteq> {}"
and gs: "(g ` s) \<subseteq> s"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Weierstrass.thy Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,1224 @@
+section{*Bernstein-Weierstrass and Stone-Weierstrass Theorems*}
+
+theory Weierstrass
+imports Uniform_Limit Path_Connected
+
+begin
+
+(*FIXME: simplification changes to be enforced globally*)
+declare of_nat_Suc [simp del]
+
+(*Power.thy:*)
+declare power_divide [where b = "numeral w" for w, simp del]
+
+subsection {*Bernstein polynomials*}
+
+definition Bernstein :: "[nat,nat,real] \<Rightarrow> real" where
+ "Bernstein n k x \<equiv> of_nat (n choose k) * x ^ k * (1 - x) ^ (n - k)"
+
+lemma Bernstein_nonneg: "\<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> Bernstein n k x"
+ by (simp add: Bernstein_def)
+
+lemma Bernstein_pos: "\<lbrakk>0 < x; x < 1; k \<le> n\<rbrakk> \<Longrightarrow> 0 < Bernstein n k x"
+ by (simp add: Bernstein_def)
+
+lemma sum_Bernstein [simp]: "(\<Sum> k = 0..n. Bernstein n k x) = 1"
+ using binomial_ring [of x "1-x" n]
+ by (simp add: Bernstein_def)
+
+lemma binomial_deriv1:
+ "(\<Sum>k=0..n. (of_nat k * of_nat (n choose k)) * a^(k-1) * b^(n-k)) =
+ of_nat n * (a+b::real) ^ (n-1)"
+ apply (rule DERIV_unique [where f = "\<lambda>a. (a+b)^n" and x=a])
+ apply (subst binomial_ring)
+ apply (rule derivative_eq_intros setsum.cong | simp)+
+ done
+
+lemma binomial_deriv2:
+ "(\<Sum>k=0..n. (of_nat k * of_nat (k-1) * of_nat (n choose k)) * a^(k-2) * b^(n-k)) =
+ of_nat n * of_nat (n-1) * (a+b::real) ^ (n-2)"
+ apply (rule DERIV_unique [where f = "\<lambda>a. of_nat n * (a+b::real) ^ (n-1)" and x=a])
+ apply (subst binomial_deriv1 [symmetric])
+ apply (rule derivative_eq_intros setsum.cong | simp add: Num.numeral_2_eq_2)+
+ done
+
+lemma sum_k_Bernstein [simp]: "(\<Sum>k = 0..n. real k * Bernstein n k x) = of_nat n * x"
+ apply (subst binomial_deriv1 [of n x "1-x", simplified, symmetric])
+ apply (simp add: setsum_left_distrib)
+ apply (auto simp: Bernstein_def real_of_nat_def algebra_simps realpow_num_eq_if intro!: setsum.cong)
+ done
+
+lemma sum_kk_Bernstein [simp]: "(\<Sum> k = 0..n. real k * (real k - 1) * Bernstein n k x) = real n * (real n - 1) * x\<^sup>2"
+proof -
+ have "(\<Sum> k = 0..n. real k * (real k - 1) * Bernstein n k x) = real_of_nat n * real_of_nat (n - Suc 0) * x\<^sup>2"
+ apply (subst binomial_deriv2 [of n x "1-x", simplified, symmetric])
+ apply (simp add: setsum_left_distrib)
+ apply (rule setsum.cong [OF refl])
+ apply (simp add: Bernstein_def power2_eq_square algebra_simps real_of_nat_def)
+ apply (rename_tac k)
+ apply (subgoal_tac "k = 0 \<or> k = 1 \<or> (\<exists>k'. k = Suc (Suc k'))")
+ apply (force simp add: field_simps of_nat_Suc power2_eq_square)
+ by presburger
+ also have "... = n * (n - 1) * x\<^sup>2"
+ by auto
+ finally show ?thesis
+ by auto
+qed
+
+subsection {*Explicit Bernstein version of the 1D Weierstrass approximation theorem*}
+
+lemma Bernstein_Weierstrass:
+ fixes f :: "real \<Rightarrow> real"
+ assumes contf: "continuous_on {0..1} f" and e: "0 < e"
+ shows "\<exists>N. \<forall>n x. N \<le> n \<and> x \<in> {0..1}
+ \<longrightarrow> abs(f x - (\<Sum>k = 0..n. f(k/n) * Bernstein n k x)) < e"
+proof -
+ have "bounded (f ` {0..1})"
+ using compact_continuous_image compact_imp_bounded contf by blast
+ then obtain M where M: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> \<bar>f x\<bar> \<le> M"
+ by (force simp add: bounded_iff)
+ then have Mge0: "0 \<le> M" by force
+ have ucontf: "uniformly_continuous_on {0..1} f"
+ using compact_uniformly_continuous contf by blast
+ then obtain d where d: "d>0" "\<And>x x'. \<lbrakk> x \<in> {0..1}; x' \<in> {0..1}; \<bar>x' - x\<bar> < d\<rbrakk> \<Longrightarrow> \<bar>f x' - f x\<bar> < e/2"
+ apply (rule uniformly_continuous_onE [where e = "e/2"])
+ using e by (auto simp: dist_norm)
+ { fix n::nat and x::real
+ assume n: "Suc (nat\<lceil>4*M/(e*d\<^sup>2)\<rceil>) \<le> n" and x: "0 \<le> x" "x \<le> 1"
+ have "0 < n" using n by simp
+ have ed0: "- (e * d\<^sup>2) < 0"
+ using e `0<d` by simp
+ also have "... \<le> M * 4"
+ using `0\<le>M` by simp
+ finally have [simp]: "real (nat \<lceil>4 * M / (e * d\<^sup>2)\<rceil>) = real \<lceil>4 * M / (e * d\<^sup>2)\<rceil>"
+ using `0\<le>M` e `0<d`
+ by (simp add: Real.real_of_nat_Suc field_simps)
+ have "4*M/(e*d\<^sup>2) + 1 \<le> real (Suc (nat\<lceil>4*M/(e*d\<^sup>2)\<rceil>))"
+ by (simp add: Real.real_of_nat_Suc)
+ also have "... \<le> real n"
+ using n by (simp add: Real.real_of_nat_Suc field_simps)
+ finally have nbig: "4*M/(e*d\<^sup>2) + 1 \<le> real n" .
+ have sum_bern: "(\<Sum>k = 0..n. (x - k/n)\<^sup>2 * Bernstein n k x) = x * (1 - x) / n"
+ proof -
+ have *: "\<And>a b x::real. (a - b)\<^sup>2 * x = a * (a - 1) * x + (1 - 2 * b) * a * x + b * b * x"
+ by (simp add: algebra_simps power2_eq_square)
+ have "(\<Sum> k = 0..n. (k - n * x)\<^sup>2 * Bernstein n k x) = n * x * (1 - x)"
+ apply (simp add: * setsum.distrib)
+ apply (simp add: setsum_right_distrib [symmetric] mult.assoc)
+ apply (simp add: algebra_simps power2_eq_square)
+ done
+ then have "(\<Sum> k = 0..n. (k - n * x)\<^sup>2 * Bernstein n k x)/n^2 = x * (1 - x) / n"
+ by (simp add: power2_eq_square)
+ then show ?thesis
+ using n by (simp add: setsum_divide_distrib divide_simps mult.commute power2_commute)
+ qed
+ { fix k
+ assume k: "k \<le> n"
+ then have kn: "0 \<le> k / n" "k / n \<le> 1"
+ by (auto simp: divide_simps)
+ consider (lessd) "abs(x - k / n) < d" | (ged) "d \<le> abs(x - k / n)"
+ by linarith
+ then have "\<bar>(f x - f (k/n))\<bar> \<le> e/2 + 2 * M / d\<^sup>2 * (x - k/n)\<^sup>2"
+ proof cases
+ case lessd
+ then have "\<bar>(f x - f (k/n))\<bar> < e/2"
+ using d x kn by (simp add: abs_minus_commute)
+ also have "... \<le> (e/2 + 2 * M / d\<^sup>2 * (x - k/n)\<^sup>2)"
+ using Mge0 d by simp
+ finally show ?thesis by simp
+ next
+ case ged
+ then have dle: "d\<^sup>2 \<le> (x - k/n)\<^sup>2"
+ by (metis d(1) less_eq_real_def power2_abs power_mono)
+ have "\<bar>(f x - f (k/n))\<bar> \<le> \<bar>f x\<bar> + \<bar>f (k/n)\<bar>"
+ by (rule abs_triangle_ineq4)
+ also have "... \<le> M+M"
+ by (meson M add_mono_thms_linordered_semiring(1) kn x)
+ also have "... \<le> 2 * M * ((x - k/n)\<^sup>2 / d\<^sup>2)"
+ apply simp
+ apply (rule Rings.ordered_semiring_class.mult_left_mono [of 1 "((x - k/n)\<^sup>2 / d\<^sup>2)", simplified])
+ using dle `d>0` `M\<ge>0` by auto
+ also have "... \<le> e/2 + 2 * M / d\<^sup>2 * (x - k/n)\<^sup>2"
+ using e by simp
+ finally show ?thesis .
+ qed
+ } note * = this
+ have "\<bar>f x - (\<Sum> k = 0..n. f(k / n) * Bernstein n k x)\<bar> \<le> \<bar>\<Sum> k = 0..n. (f x - f(k / n)) * Bernstein n k x\<bar>"
+ by (simp add: setsum_subtractf setsum_right_distrib [symmetric] algebra_simps)
+ also have "... \<le> (\<Sum> k = 0..n. (e/2 + (2 * M / d\<^sup>2) * (x - k / n)\<^sup>2) * Bernstein n k x)"
+ apply (rule order_trans [OF setsum_abs setsum_mono])
+ using *
+ apply (simp add: abs_mult Bernstein_nonneg x mult_right_mono)
+ done
+ also have "... \<le> e/2 + (2 * M) / (d\<^sup>2 * n)"
+ apply (simp only: setsum.distrib Rings.semiring_class.distrib_right setsum_right_distrib [symmetric] mult.assoc sum_bern)
+ using `d>0` x
+ apply (simp add: divide_simps Mge0 mult_le_one mult_left_le)
+ done
+ also have "... < e"
+ apply (simp add: field_simps)
+ using `d>0` nbig e `n>0`
+ apply (simp add: divide_simps algebra_simps)
+ using ed0 by linarith
+ finally have "\<bar>f x - (\<Sum>k = 0..n. f (real k / real n) * Bernstein n k x)\<bar> < e" .
+ }
+ then show ?thesis
+ by auto
+qed
+
+
+subsection {*General Stone-Weierstrass theorem*}
+
+text\<open>Source:
+Bruno Brosowski and Frank Deutsch.
+An Elementary Proof of the Stone-Weierstrass Theorem.
+Proceedings of the American Mathematical Society
+Volume 81, Number 1, January 1981.\<close>
+
+locale function_ring_on =
+ fixes R :: "('a::t2_space \<Rightarrow> real) set" and s :: "'a set"
+ assumes compact: "compact s"
+ assumes continuous: "f \<in> R \<Longrightarrow> continuous_on s f"
+ assumes add: "f \<in> R \<Longrightarrow> g \<in> R \<Longrightarrow> (\<lambda>x. f x + g x) \<in> R"
+ assumes mult: "f \<in> R \<Longrightarrow> g \<in> R \<Longrightarrow> (\<lambda>x. f x * g x) \<in> R"
+ assumes const: "(\<lambda>_. c) \<in> R"
+ assumes separable: "x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>f\<in>R. f x \<noteq> f y"
+
+begin
+ lemma minus: "f \<in> R \<Longrightarrow> (\<lambda>x. - f x) \<in> R"
+ by (frule mult [OF const [of "-1"]]) simp
+
+ lemma diff: "f \<in> R \<Longrightarrow> g \<in> R \<Longrightarrow> (\<lambda>x. f x - g x) \<in> R"
+ unfolding diff_conv_add_uminus by (metis add minus)
+
+ lemma power: "f \<in> R \<Longrightarrow> (\<lambda>x. f x ^ n) \<in> R"
+ by (induct n) (auto simp: const mult)
+
+ lemma setsum: "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> f i \<in> R\<rbrakk> \<Longrightarrow> (\<lambda>x. \<Sum>i \<in> I. f i x) \<in> R"
+ by (induct I rule: finite_induct; simp add: const add)
+
+ lemma setprod: "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> f i \<in> R\<rbrakk> \<Longrightarrow> (\<lambda>x. \<Prod>i \<in> I. f i x) \<in> R"
+ by (induct I rule: finite_induct; simp add: const mult)
+
+ definition normf :: "('a::t2_space \<Rightarrow> real) \<Rightarrow> real"
+ where "normf f \<equiv> SUP x:s. \<bar>f x\<bar>"
+
+ lemma normf_upper: "\<lbrakk>continuous_on s f; x \<in> s\<rbrakk> \<Longrightarrow> \<bar>f x\<bar> \<le> normf f"
+ apply (simp add: normf_def)
+ apply (rule cSUP_upper, assumption)
+ by (simp add: bounded_imp_bdd_above compact compact_continuous_image compact_imp_bounded continuous_on_rabs)
+
+lemma normf_least: "s \<noteq> {} \<Longrightarrow> (\<And>x. x \<in> s \<Longrightarrow> \<bar>f x\<bar> \<le> M) \<Longrightarrow> normf f \<le> M"
+ by (simp add: normf_def cSUP_least)
+
+end
+
+lemma (in function_ring_on) one:
+ assumes U: "open U" and t0: "t0 \<in> s" "t0 \<in> U" and t1: "t1 \<in> s-U"
+ shows "\<exists>V. open V \<and> t0 \<in> V \<and> s \<inter> V \<subseteq> U \<and>
+ (\<forall>e>0. \<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>t \<in> s \<inter> V. f t < e) \<and> (\<forall>t \<in> s - U. f t > 1 - e))"
+proof -
+ have "\<exists>pt \<in> R. pt t0 = 0 \<and> pt t > 0 \<and> pt ` s \<subseteq> {0..1}" if t: "t \<in> s - U" for t
+ proof -
+ have "t \<noteq> t0" using t t0 by auto
+ then obtain g where g: "g \<in> R" "g t \<noteq> g t0"
+ using separable t0 by (metis Diff_subset subset_eq t)
+ def h \<equiv> "\<lambda>x. g x - g t0"
+ have "h \<in> R"
+ unfolding h_def by (fast intro: g const diff)
+ then have hsq: "(\<lambda>w. (h w)\<^sup>2) \<in> R"
+ by (simp add: power2_eq_square mult)
+ have "h t \<noteq> h t0"
+ by (simp add: h_def g)
+ then have "h t \<noteq> 0"
+ by (simp add: h_def)
+ then have ht2: "0 < (h t)^2"
+ by simp
+ also have "... \<le> normf (\<lambda>w. (h w)\<^sup>2)"
+ using t normf_upper [where x=t] continuous [OF hsq] by force
+ finally have nfp: "0 < normf (\<lambda>w. (h w)\<^sup>2)" .
+ def p \<equiv> "\<lambda>x. (1 / normf (\<lambda>w. (h w)\<^sup>2)) * (h x)^2"
+ have "p \<in> R"
+ unfolding p_def by (fast intro: hsq const mult)
+ moreover have "p t0 = 0"
+ by (simp add: p_def h_def)
+ moreover have "p t > 0"
+ using nfp ht2 by (simp add: p_def)
+ moreover have "\<And>x. x \<in> s \<Longrightarrow> p x \<in> {0..1}"
+ using nfp normf_upper [OF continuous [OF hsq] ] by (auto simp: p_def)
+ ultimately show "\<exists>pt \<in> R. pt t0 = 0 \<and> pt t > 0 \<and> pt ` s \<subseteq> {0..1}"
+ by auto
+ qed
+ then obtain pf where pf: "\<And>t. t \<in> s-U \<Longrightarrow> pf t \<in> R \<and> pf t t0 = 0 \<and> pf t t > 0"
+ and pf01: "\<And>t. t \<in> s-U \<Longrightarrow> pf t ` s \<subseteq> {0..1}"
+ by metis
+ have com_sU: "compact (s-U)"
+ using compact closed_inter_compact U by (simp add: Diff_eq compact_inter_closed open_closed)
+ have "\<And>t. t \<in> s-U \<Longrightarrow> \<exists>A. open A \<and> A \<inter> s = {x\<in>s. 0 < pf t x}"
+ apply (rule open_Collect_positive)
+ by (metis pf continuous)
+ then obtain Uf where Uf: "\<And>t. t \<in> s-U \<Longrightarrow> open (Uf t) \<and> (Uf t) \<inter> s = {x\<in>s. 0 < pf t x}"
+ by metis
+ then have open_Uf: "\<And>t. t \<in> s-U \<Longrightarrow> open (Uf t)"
+ by blast
+ have tUft: "\<And>t. t \<in> s-U \<Longrightarrow> t \<in> Uf t"
+ using pf Uf by blast
+ then have *: "s-U \<subseteq> (\<Union>x \<in> s-U. Uf x)"
+ by blast
+ obtain subU where subU: "subU \<subseteq> s - U" "finite subU" "s - U \<subseteq> (\<Union>x \<in> subU. Uf x)"
+ by (blast intro: that open_Uf compactE_image [OF com_sU _ *])
+ then have [simp]: "subU \<noteq> {}"
+ using t1 by auto
+ then have cardp: "card subU > 0" using subU
+ by (simp add: card_gt_0_iff)
+ def p \<equiv> "\<lambda>x. (1 / card subU) * (\<Sum>t \<in> subU. pf t x)"
+ have pR: "p \<in> R"
+ unfolding p_def using subU pf by (fast intro: pf const mult setsum)
+ have pt0 [simp]: "p t0 = 0"
+ using subU pf by (auto simp: p_def intro: setsum.neutral)
+ have pt_pos: "p t > 0" if t: "t \<in> s-U" for t
+ proof -
+ obtain i where i: "i \<in> subU" "t \<in> Uf i" using subU t by blast
+ show ?thesis
+ using subU i t
+ apply (clarsimp simp: p_def divide_simps)
+ apply (rule setsum_pos2 [OF `finite subU`])
+ using Uf t pf01 apply auto
+ apply (force elim!: subsetCE)
+ done
+ qed
+ have p01: "p x \<in> {0..1}" if t: "x \<in> s" for x
+ proof -
+ have "0 \<le> p x"
+ using subU cardp t
+ apply (simp add: p_def divide_simps setsum_nonneg)
+ apply (rule setsum_nonneg)
+ using pf01 by force
+ moreover have "p x \<le> 1"
+ using subU cardp t
+ apply (simp add: p_def divide_simps setsum_nonneg real_of_nat_def)
+ apply (rule setsum_bounded_above [where 'a=real and K=1, simplified])
+ using pf01 by force
+ ultimately show ?thesis
+ by auto
+ qed
+ have "compact (p ` (s-U))"
+ by (meson Diff_subset com_sU compact_continuous_image continuous continuous_on_subset pR)
+ then have "open (- (p ` (s-U)))"
+ by (simp add: compact_imp_closed open_Compl)
+ moreover have "0 \<in> - (p ` (s-U))"
+ by (metis (no_types) ComplI image_iff not_less_iff_gr_or_eq pt_pos)
+ ultimately obtain delta0 where delta0: "delta0 > 0" "ball 0 delta0 \<subseteq> - (p ` (s-U))"
+ by (auto simp: elim!: openE)
+ then have pt_delta: "\<And>x. x \<in> s-U \<Longrightarrow> p x \<ge> delta0"
+ by (force simp: ball_def dist_norm dest: p01)
+ def \<delta> \<equiv> "delta0/2"
+ have "delta0 \<le> 1" using delta0 p01 [of t1] t1
+ by (force simp: ball_def dist_norm dest: p01)
+ with delta0 have \<delta>01: "0 < \<delta>" "\<delta> < 1"
+ by (auto simp: \<delta>_def)
+ have pt_\<delta>: "\<And>x. x \<in> s-U \<Longrightarrow> p x \<ge> \<delta>"
+ using pt_delta delta0 by (force simp: \<delta>_def)
+ have "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. p x < \<delta>/2}"
+ by (rule open_Collect_less_Int [OF continuous [OF pR] continuous_on_const])
+ then obtain V where V: "open V" "V \<inter> s = {x\<in>s. p x < \<delta>/2}"
+ by blast
+ def k \<equiv> "nat\<lfloor>1/\<delta>\<rfloor> + 1"
+ have "k>0" by (simp add: k_def)
+ have "k-1 \<le> 1/\<delta>"
+ using \<delta>01 by (simp add: k_def)
+ with \<delta>01 have "k \<le> (1+\<delta>)/\<delta>"
+ by (auto simp: algebra_simps add_divide_distrib)
+ also have "... < 2/\<delta>"
+ using \<delta>01 by (auto simp: divide_simps)
+ finally have k2\<delta>: "k < 2/\<delta>" .
+ have "1/\<delta> < k"
+ using \<delta>01 unfolding k_def by linarith
+ with \<delta>01 k2\<delta> have k\<delta>: "1 < k*\<delta>" "k*\<delta> < 2"
+ by (auto simp: divide_simps)
+ def q \<equiv> "\<lambda>n t. (1 - p t ^ n) ^ (k^n)"
+ have qR: "q n \<in> R" for n
+ by (simp add: q_def const diff power pR)
+ have q01: "\<And>n t. t \<in> s \<Longrightarrow> q n t \<in> {0..1}"
+ using p01 by (simp add: q_def power_le_one algebra_simps)
+ have qt0 [simp]: "\<And>n. n>0 \<Longrightarrow> q n t0 = 1"
+ using t0 pf by (simp add: q_def power_0_left)
+ { fix t and n::nat
+ assume t: "t \<in> s \<inter> V"
+ with `k>0` V have "k * p t < k * \<delta> / 2"
+ by force
+ then have "1 - (k * \<delta> / 2)^n \<le> 1 - (k * p t)^n"
+ using `k>0` p01 t by (simp add: power_mono)
+ also have "... \<le> q n t"
+ using Bernoulli_inequality [of "- ((p t)^n)" "k^n"]
+ apply (simp add: q_def)
+ by (metis IntE atLeastAtMost_iff p01 power_le_one power_mult_distrib t)
+ finally have "1 - (k * \<delta> / 2) ^ n \<le> q n t" .
+ } note limitV = this
+ { fix t and n::nat
+ assume t: "t \<in> s - U"
+ with `k>0` U have "k * \<delta> \<le> k * p t"
+ by (simp add: pt_\<delta>)
+ with k\<delta> have kpt: "1 < k * p t"
+ by (blast intro: less_le_trans)
+ have ptn_pos: "0 < p t ^ n"
+ using pt_pos [OF t] by simp
+ have ptn_le: "p t ^ n \<le> 1"
+ by (meson DiffE atLeastAtMost_iff p01 power_le_one t)
+ have "q n t = (1/(k^n * (p t)^n)) * (1 - p t ^ n) ^ (k^n) * k^n * (p t)^n"
+ using pt_pos [OF t] `k>0` by (simp add: q_def)
+ also have "... \<le> (1/(k * (p t))^n) * (1 - p t ^ n) ^ (k^n) * (1 + k^n * (p t)^n)"
+ using pt_pos [OF t] `k>0`
+ apply simp
+ apply (simp only: times_divide_eq_right [symmetric])
+ apply (rule mult_left_mono [of "1::real", simplified])
+ apply (simp_all add: power_mult_distrib)
+ apply (rule zero_le_power)
+ using ptn_le by linarith
+ also have "... \<le> (1/(k * (p t))^n) * (1 - p t ^ n) ^ (k^n) * (1 + (p t)^n) ^ (k^n)"
+ apply (rule mult_left_mono [OF Bernoulli_inequality [of "p t ^ n" "k^n"]])
+ using `k>0` ptn_pos ptn_le
+ apply (auto simp: power_mult_distrib)
+ done
+ also have "... = (1/(k * (p t))^n) * (1 - p t ^ (2*n)) ^ (k^n)"
+ using pt_pos [OF t] `k>0`
+ by (simp add: algebra_simps power_mult power2_eq_square power_mult_distrib [symmetric])
+ also have "... \<le> (1/(k * (p t))^n) * 1"
+ apply (rule mult_left_mono [OF power_le_one])
+ apply (metis diff_le_iff(1) less_eq_real_def mult.commute power_le_one power_mult ptn_pos ptn_le)
+ using pt_pos [OF t] `k>0`
+ apply auto
+ done
+ also have "... \<le> (1 / (k*\<delta>))^n"
+ using `k>0` \<delta>01 power_mono pt_\<delta> t
+ by (fastforce simp: field_simps)
+ finally have "q n t \<le> (1 / (real k * \<delta>)) ^ n " .
+ } note limitNonU = this
+ def NN \<equiv> "\<lambda>e. 1 + nat \<lceil>max (ln e / ln (real k * \<delta> / 2)) (- ln e / ln (real k * \<delta>))\<rceil>"
+ have NN: "of_nat (NN e) > ln e / ln (real k * \<delta> / 2)" "of_nat (NN e) > - ln e / ln (real k * \<delta>)"
+ if "0<e" for e
+ unfolding NN_def by linarith+
+ have NN1: "\<And>e. e>0 \<Longrightarrow> (k * \<delta> / 2)^NN e < e"
+ apply (subst Transcendental.ln_less_cancel_iff [symmetric])
+ prefer 3 apply (subst ln_realpow)
+ using `k>0` `\<delta>>0` NN k\<delta>
+ apply (force simp add: field_simps)+
+ done
+ have NN0: "\<And>e. e>0 \<Longrightarrow> (1/(k*\<delta>))^NN e < e"
+ apply (subst Transcendental.ln_less_cancel_iff [symmetric])
+ prefer 3 apply (subst ln_realpow)
+ using `k>0` `\<delta>>0` NN k\<delta>
+ apply (force simp add: field_simps ln_div)+
+ done
+ { fix t and e::real
+ assume "e>0"
+ have "t \<in> s \<inter> V \<Longrightarrow> 1 - q (NN e) t < e" "t \<in> s - U \<Longrightarrow> q (NN e) t < e"
+ proof -
+ assume t: "t \<in> s \<inter> V"
+ show "1 - q (NN e) t < e"
+ by (metis add.commute diff_le_eq not_le limitV [OF t] less_le_trans [OF NN1 [OF `e>0`]])
+ next
+ assume t: "t \<in> s - U"
+ show "q (NN e) t < e"
+ using limitNonU [OF t] less_le_trans [OF NN0 [OF `e>0`]] not_le by blast
+ qed
+ } then have "\<And>e. e > 0 \<Longrightarrow> \<exists>f\<in>R. f ` s \<subseteq> {0..1} \<and> (\<forall>t \<in> s \<inter> V. f t < e) \<and> (\<forall>t \<in> s - U. 1 - e < f t)"
+ using q01
+ by (rule_tac x="\<lambda>x. 1 - q (NN e) x" in bexI) (auto simp: algebra_simps intro: diff const qR)
+ moreover have t0V: "t0 \<in> V" "s \<inter> V \<subseteq> U"
+ using pt_\<delta> t0 U V \<delta>01 by fastforce+
+ ultimately show ?thesis using V t0V
+ by blast
+qed
+
+text\<open>Non-trivial case, with @{term A} and @{term B} both non-empty\<close>
+lemma (in function_ring_on) two_special:
+ assumes A: "closed A" "A \<subseteq> s" "a \<in> A"
+ and B: "closed B" "B \<subseteq> s" "b \<in> B"
+ and disj: "A \<inter> B = {}"
+ and e: "0 < e" "e < 1"
+ shows "\<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>x \<in> A. f x < e) \<and> (\<forall>x \<in> B. f x > 1 - e)"
+proof -
+ { fix w
+ assume "w \<in> A"
+ then have "open ( - B)" "b \<in> s" "w \<notin> B" "w \<in> s"
+ using assms by auto
+ then have "\<exists>V. open V \<and> w \<in> V \<and> s \<inter> V \<subseteq> -B \<and>
+ (\<forall>e>0. \<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>x \<in> s \<inter> V. f x < e) \<and> (\<forall>x \<in> s \<inter> B. f x > 1 - e))"
+ using one [of "-B" w b] assms `w \<in> A` by simp
+ }
+ then obtain Vf where Vf:
+ "\<And>w. w \<in> A \<Longrightarrow> open (Vf w) \<and> w \<in> Vf w \<and> s \<inter> Vf w \<subseteq> -B \<and>
+ (\<forall>e>0. \<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>x \<in> s \<inter> Vf w. f x < e) \<and> (\<forall>x \<in> s \<inter> B. f x > 1 - e))"
+ by metis
+ then have open_Vf: "\<And>w. w \<in> A \<Longrightarrow> open (Vf w)"
+ by blast
+ have tVft: "\<And>w. w \<in> A \<Longrightarrow> w \<in> Vf w"
+ using Vf by blast
+ then have setsum_max_0: "A \<subseteq> (\<Union>x \<in> A. Vf x)"
+ by blast
+ have com_A: "compact A" using A
+ by (metis compact compact_inter_closed inf.absorb_iff2)
+ obtain subA where subA: "subA \<subseteq> A" "finite subA" "A \<subseteq> (\<Union>x \<in> subA. Vf x)"
+ by (blast intro: that open_Vf compactE_image [OF com_A _ setsum_max_0])
+ then have [simp]: "subA \<noteq> {}"
+ using `a \<in> A` by auto
+ then have cardp: "card subA > 0" using subA
+ by (simp add: card_gt_0_iff)
+ have "\<And>w. w \<in> A \<Longrightarrow> \<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>x \<in> s \<inter> Vf w. f x < e / card subA) \<and> (\<forall>x \<in> s \<inter> B. f x > 1 - e / card subA)"
+ using Vf e cardp by simp
+ then obtain ff where ff:
+ "\<And>w. w \<in> A \<Longrightarrow> ff w \<in> R \<and> ff w ` s \<subseteq> {0..1} \<and>
+ (\<forall>x \<in> s \<inter> Vf w. ff w x < e / card subA) \<and> (\<forall>x \<in> s \<inter> B. ff w x > 1 - e / card subA)"
+ by metis
+ def pff \<equiv> "\<lambda>x. (\<Prod>w \<in> subA. ff w x)"
+ have pffR: "pff \<in> R"
+ unfolding pff_def using subA ff by (auto simp: intro: setprod)
+ moreover
+ have pff01: "pff x \<in> {0..1}" if t: "x \<in> s" for x
+ proof -
+ have "0 \<le> pff x"
+ using subA cardp t
+ apply (simp add: pff_def divide_simps setsum_nonneg)
+ apply (rule Groups_Big.linordered_semidom_class.setprod_nonneg)
+ using ff by fastforce
+ moreover have "pff x \<le> 1"
+ using subA cardp t
+ apply (simp add: pff_def divide_simps setsum_nonneg real_of_nat_def)
+ apply (rule setprod_mono [where g = "\<lambda>x. 1", simplified])
+ using ff by fastforce
+ ultimately show ?thesis
+ by auto
+ qed
+ moreover
+ { fix v x
+ assume v: "v \<in> subA" and x: "x \<in> Vf v" "x \<in> s"
+ from subA v have "pff x = ff v x * (\<Prod>w \<in> subA - {v}. ff w x)"
+ unfolding pff_def by (metis setprod.remove)
+ also have "... \<le> ff v x * 1"
+ apply (rule Rings.ordered_semiring_class.mult_left_mono)
+ apply (rule setprod_mono [where g = "\<lambda>x. 1", simplified])
+ using ff [THEN conjunct2, THEN conjunct1] v subA x
+ apply auto
+ apply (meson atLeastAtMost_iff contra_subsetD imageI)
+ apply (meson atLeastAtMost_iff contra_subsetD image_eqI)
+ using atLeastAtMost_iff by blast
+ also have "... < e / card subA"
+ using ff [THEN conjunct2, THEN conjunct2, THEN conjunct1] v subA x
+ by auto
+ also have "... \<le> e"
+ using cardp e by (simp add: divide_simps)
+ finally have "pff x < e" .
+ }
+ then have "\<And>x. x \<in> A \<Longrightarrow> pff x < e"
+ using A Vf subA by (metis UN_E contra_subsetD)
+ moreover
+ { fix x
+ assume x: "x \<in> B"
+ then have "x \<in> s"
+ using B by auto
+ have "1 - e \<le> (1 - e / card subA) ^ card subA"
+ using Bernoulli_inequality [of "-e / card subA" "card subA"] e cardp
+ by (auto simp: field_simps)
+ also have "... = (\<Prod>w \<in> subA. 1 - e / card subA)"
+ by (simp add: setprod_constant subA(2))
+ also have "... < pff x"
+ apply (simp add: pff_def)
+ apply (rule setprod_mono_strict [where f = "\<lambda>x. 1 - e / card subA", simplified])
+ apply (simp_all add: subA(2))
+ apply (intro ballI conjI)
+ using e apply (force simp: divide_simps)
+ using ff [THEN conjunct2, THEN conjunct2, THEN conjunct2] subA B x
+ apply blast
+ done
+ finally have "1 - e < pff x" .
+ }
+ ultimately
+ show ?thesis by blast
+qed
+
+lemma (in function_ring_on) two:
+ assumes A: "closed A" "A \<subseteq> s"
+ and B: "closed B" "B \<subseteq> s"
+ and disj: "A \<inter> B = {}"
+ and e: "0 < e" "e < 1"
+ shows "\<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>x \<in> A. f x < e) \<and> (\<forall>x \<in> B. f x > 1 - e)"
+proof (cases "A \<noteq> {} \<and> B \<noteq> {}")
+ case True then show ?thesis
+ apply (simp add: ex_in_conv [symmetric])
+ using assms
+ apply safe
+ apply (force simp add: intro!: two_special)
+ done
+next
+ case False with e show ?thesis
+ apply simp
+ apply (erule disjE)
+ apply (rule_tac [2] x="\<lambda>x. 0" in bexI)
+ apply (rule_tac x="\<lambda>x. 1" in bexI)
+ apply (auto simp: const)
+ done
+qed
+
+text\<open>The special case where @{term f} is non-negative and @{term"e<1/3"}\<close>
+lemma (in function_ring_on) Stone_Weierstrass_special:
+ assumes f: "continuous_on s f" and fpos: "\<And>x. x \<in> s \<Longrightarrow> f x \<ge> 0"
+ and e: "0 < e" "e < 1/3"
+ shows "\<exists>g \<in> R. \<forall>x\<in>s. \<bar>f x - g x\<bar> < 2*e"
+proof -
+ def n \<equiv> "1 + nat \<lceil>normf f / e\<rceil>"
+ def A \<equiv> "\<lambda>j::nat. {x \<in> s. f x \<le> (j - 1/3)*e}"
+ def B \<equiv> "\<lambda>j::nat. {x \<in> s. f x \<ge> (j + 1/3)*e}"
+ have ngt: "(n-1) * e \<ge> normf f" "n\<ge>1"
+ using e
+ apply (simp_all add: n_def field_simps real_of_nat_Suc)
+ by (metis real_nat_ceiling_ge mult.commute not_less pos_less_divide_eq)
+ then have ge_fx: "(n-1) * e \<ge> f x" if "x \<in> s" for x
+ using f normf_upper that by fastforce
+ { fix j
+ have A: "closed (A j)" "A j \<subseteq> s"
+ apply (simp_all add: A_def Collect_restrict)
+ apply (rule continuous_on_closed_Collect_le [OF f continuous_on_const])
+ apply (simp add: compact compact_imp_closed)
+ done
+ have B: "closed (B j)" "B j \<subseteq> s"
+ apply (simp_all add: B_def Collect_restrict)
+ apply (rule continuous_on_closed_Collect_le [OF continuous_on_const f])
+ apply (simp add: compact compact_imp_closed)
+ done
+ have disj: "(A j) \<inter> (B j) = {}"
+ using e by (auto simp: A_def B_def field_simps)
+ have "\<exists>f \<in> R. f ` s \<subseteq> {0..1} \<and> (\<forall>x \<in> A j. f x < e/n) \<and> (\<forall>x \<in> B j. f x > 1 - e/n)"
+ apply (rule two)
+ using e A B disj ngt
+ apply simp_all
+ done
+ }
+ then obtain xf where xfR: "\<And>j. xf j \<in> R" and xf01: "\<And>j. xf j ` s \<subseteq> {0..1}"
+ and xfA: "\<And>x j. x \<in> A j \<Longrightarrow> xf j x < e/n"
+ and xfB: "\<And>x j. x \<in> B j \<Longrightarrow> xf j x > 1 - e/n"
+ by metis
+ def g \<equiv> "\<lambda>x. e * (\<Sum>i\<le>n. xf i x)"
+ have gR: "g \<in> R"
+ unfolding g_def by (fast intro: mult const setsum xfR)
+ have gge0: "\<And>x. x \<in> s \<Longrightarrow> g x \<ge> 0"
+ using e xf01 by (simp add: g_def zero_le_mult_iff image_subset_iff setsum_nonneg)
+ have A0: "A 0 = {}"
+ using fpos e by (fastforce simp: A_def)
+ have An: "A n = s"
+ using e ngt f normf_upper by (fastforce simp: A_def field_simps real_of_nat_diff)
+ have Asub: "A j \<subseteq> A i" if "i\<ge>j" for i j
+ using e that apply (clarsimp simp: A_def)
+ apply (erule order_trans, simp)
+ done
+ { fix t
+ assume t: "t \<in> s"
+ def j \<equiv> "LEAST j. t \<in> A j"
+ have jn: "j \<le> n"
+ using t An by (simp add: Least_le j_def)
+ have Aj: "t \<in> A j"
+ using t An by (fastforce simp add: j_def intro: LeastI)
+ then have Ai: "t \<in> A i" if "i\<ge>j" for i
+ using Asub [OF that] by blast
+ then have fj1: "f t \<le> (j - 1/3)*e"
+ by (simp add: A_def)
+ then have Anj: "t \<notin> A i" if "i<j" for i
+ using Aj `i<j`
+ apply (simp add: j_def)
+ using not_less_Least by blast
+ have j1: "1 \<le> j"
+ using A0 Aj j_def not_less_eq_eq by (fastforce simp add: j_def)
+ then have Anj: "t \<notin> A (j-1)"
+ using Least_le by (fastforce simp add: j_def)
+ then have fj2: "(j - 4/3)*e < f t"
+ using j1 t by (simp add: A_def real_of_nat_diff)
+ have ***: "xf i t \<le> e/n" if "i\<ge>j" for i
+ using xfA [OF Ai] that by (simp add: less_eq_real_def)
+ { fix i
+ assume "i+2 \<le> j"
+ then obtain d where "i+2+d = j"
+ using le_Suc_ex that by blast
+ then have "t \<in> B i"
+ using Anj e ge_fx [OF t] `1 \<le> n` fpos [OF t] t
+ apply (simp add: A_def B_def)
+ apply (clarsimp simp add: field_simps real_of_nat_diff not_le real_of_nat_Suc)
+ apply (rule order_trans [of _ "e * 2 + (e * (real d * 3) + e * (real i * 3))"])
+ apply auto
+ done
+ then have "xf i t > 1 - e/n"
+ by (rule xfB)
+ } note **** = this
+ have xf_le1: "\<And>i. xf i t \<le> 1"
+ using xf01 t by force
+ have "g t = e * (\<Sum>i<j. xf i t) + e * (\<Sum>i=j..n. xf i t)"
+ using j1 jn e
+ apply (simp add: g_def distrib_left [symmetric])
+ apply (subst setsum.union_disjoint [symmetric])
+ apply (auto simp: ivl_disj_un)
+ done
+ also have "... \<le> e*j + e * ((Suc n - j)*e/n)"
+ apply (rule add_mono)
+ apply (simp_all only: mult_le_cancel_left_pos e real_of_nat_def)
+ apply (rule setsum_bounded_above [OF xf_le1, where A = "lessThan j", simplified])
+ using setsum_bounded_above [of "{j..n}" "\<lambda>i. xf i t", OF ***]
+ apply simp
+ done
+ also have "... \<le> j*e + e*(n - j + 1)*e/n "
+ using `1 \<le> n` e by (simp add: field_simps)
+ also have "... \<le> j*e + e*e"
+ using `1 \<le> n` e j1 by (simp add: field_simps)
+ also have "... < (j + 1/3)*e"
+ using e by (auto simp: field_simps)
+ finally have gj1: "g t < (j + 1 / 3) * e" .
+ have gj2: "(j - 4/3)*e < g t"
+ proof (cases "2 \<le> j")
+ case False
+ then have "j=1" using j1 by simp
+ with t gge0 e show ?thesis by force
+ next
+ case True
+ then have "(j - 4/3)*e < (j-1)*e - e^2"
+ using e by (auto simp: real_of_nat_diff algebra_simps power2_eq_square)
+ also have "... < (j-1)*e - ((j - 1)/n) * e^2"
+ using e True jn by (simp add: power2_eq_square field_simps)
+ also have "... = e * (j-1) * (1 - e/n)"
+ by (simp add: power2_eq_square field_simps)
+ also have "... \<le> e * (\<Sum>i\<le>j-2. xf i t)"
+ using e
+ apply simp
+ apply (rule order_trans [OF _ setsum_bounded_below [OF less_imp_le [OF ****]]])
+ using True
+ apply (simp_all add: real_of_nat_def of_nat_Suc of_nat_diff)
+ done
+ also have "... \<le> g t"
+ using jn e
+ using e xf01 t
+ apply (simp add: g_def zero_le_mult_iff image_subset_iff setsum_nonneg)
+ apply (rule Groups_Big.setsum_mono2, auto)
+ done
+ finally show ?thesis .
+ qed
+ have "\<bar>f t - g t\<bar> < 2 * e"
+ using fj1 fj2 gj1 gj2 by (simp add: abs_less_iff field_simps)
+ }
+ then show ?thesis
+ by (rule_tac x=g in bexI) (auto intro: gR)
+qed
+
+text\<open>The ``unpretentious'' formulation\<close>
+lemma (in function_ring_on) Stone_Weierstrass_basic:
+ assumes f: "continuous_on s f" and e: "e > 0"
+ shows "\<exists>g \<in> R. \<forall>x\<in>s. \<bar>f x - g x\<bar> < e"
+proof -
+ have "\<exists>g \<in> R. \<forall>x\<in>s. \<bar>(f x + normf f) - g x\<bar> < 2 * min (e/2) (1/4)"
+ apply (rule Stone_Weierstrass_special)
+ apply (rule Limits.continuous_on_add [OF f Topological_Spaces.continuous_on_const])
+ using normf_upper [OF f] apply force
+ apply (simp add: e, linarith)
+ done
+ then obtain g where "g \<in> R" "\<forall>x\<in>s. \<bar>g x - (f x + normf f)\<bar> < e"
+ by force
+ then show ?thesis
+ apply (rule_tac x="\<lambda>x. g x - normf f" in bexI)
+ apply (auto simp: algebra_simps intro: diff const)
+ done
+qed
+
+
+theorem (in function_ring_on) Stone_Weierstrass:
+ assumes f: "continuous_on s f"
+ shows "\<exists>F\<in>UNIV \<rightarrow> R. LIM n sequentially. F n :> uniformly_on s f"
+proof -
+ { fix e::real
+ assume e: "0 < e"
+ then obtain N::nat where N: "0 < N" "0 < inverse N" "inverse N < e"
+ by (auto simp: real_arch_inv [of e])
+ { fix n :: nat and x :: 'a and g :: "'a \<Rightarrow> real"
+ assume n: "N \<le> n" "\<forall>x\<in>s. \<bar>f x - g x\<bar> < 1 / (1 + real n)"
+ assume x: "x \<in> s"
+ have "\<not> real (Suc n) < inverse e"
+ using `N \<le> n` N using less_imp_inverse_less by force
+ then have "1 / (1 + real n) \<le> e"
+ using e by (simp add: field_simps real_of_nat_Suc)
+ then have "\<bar>f x - g x\<bar> < e"
+ using n(2) x by auto
+ } note * = this
+ have "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>s. \<bar>f x - (SOME g. g \<in> R \<and> (\<forall>x\<in>s. \<bar>f x - g x\<bar> < 1 / (1 + real n))) x\<bar> < e"
+ apply (rule eventually_sequentiallyI [of N])
+ apply (auto intro: someI2_bex [OF Stone_Weierstrass_basic [OF f]] *)
+ done
+ } then
+ show ?thesis
+ apply (rule_tac x="\<lambda>n::nat. SOME g. g \<in> R \<and> (\<forall>x\<in>s. \<bar>f x - g x\<bar> < 1 / (1 + n))" in bexI)
+ prefer 2 apply (force intro: someI2_bex [OF Stone_Weierstrass_basic [OF f]])
+ unfolding uniform_limit_iff
+ apply (auto simp: dist_norm abs_minus_commute)
+ done
+qed
+
+text{*A HOL Light formulation*}
+corollary Stone_Weierstrass_HOL:
+ fixes R :: "('a::t2_space \<Rightarrow> real) set" and s :: "'a set"
+ assumes "compact s" "\<And>c. P(\<lambda>x. c::real)"
+ "\<And>f. P f \<Longrightarrow> continuous_on s f"
+ "\<And>f g. P(f) \<and> P(g) \<Longrightarrow> P(\<lambda>x. f x + g x)" "\<And>f g. P(f) \<and> P(g) \<Longrightarrow> P(\<lambda>x. f x * g x)"
+ "\<And>x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) \<Longrightarrow> \<exists>f. P(f) \<and> ~(f x = f y)"
+ "continuous_on s f"
+ "0 < e"
+ shows "\<exists>g. P(g) \<and> (\<forall>x \<in> s. abs(f x - g x) < e)"
+proof -
+ interpret PR: function_ring_on "Collect P"
+ apply unfold_locales
+ using assms
+ by auto
+ show ?thesis
+ using PR.Stone_Weierstrass_basic [OF `continuous_on s f` `0 < e`]
+ by blast
+qed
+
+
+subsection {*Polynomial functions*}
+
+inductive real_polynomial_function :: "('a::real_normed_vector \<Rightarrow> real) \<Rightarrow> bool" where
+ linear: "bounded_linear f \<Longrightarrow> real_polynomial_function f"
+ | const: "real_polynomial_function (\<lambda>x. c)"
+ | add: "\<lbrakk>real_polynomial_function f; real_polynomial_function g\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. f x + g x)"
+ | mult: "\<lbrakk>real_polynomial_function f; real_polynomial_function g\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. f x * g x)"
+
+declare real_polynomial_function.intros [intro]
+
+definition polynomial_function :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> bool"
+ where
+ "polynomial_function p \<equiv> (\<forall>f. bounded_linear f \<longrightarrow> real_polynomial_function (f o p))"
+
+lemma real_polynomial_function_eq: "real_polynomial_function p = polynomial_function p"
+unfolding polynomial_function_def
+proof
+ assume "real_polynomial_function p"
+ then show " \<forall>f. bounded_linear f \<longrightarrow> real_polynomial_function (f \<circ> p)"
+ proof (induction p rule: real_polynomial_function.induct)
+ case (linear h) then show ?case
+ by (auto simp: bounded_linear_compose real_polynomial_function.linear)
+ next
+ case (const h) then show ?case
+ by (simp add: real_polynomial_function.const)
+ next
+ case (add h) then show ?case
+ by (force simp add: bounded_linear_def linear_add real_polynomial_function.add)
+ next
+ case (mult h) then show ?case
+ by (force simp add: real_bounded_linear const real_polynomial_function.mult)
+ qed
+next
+ assume [rule_format, OF bounded_linear_ident]: "\<forall>f. bounded_linear f \<longrightarrow> real_polynomial_function (f \<circ> p)"
+ then show "real_polynomial_function p"
+ by (simp add: o_def)
+qed
+
+lemma polynomial_function_const [iff]: "polynomial_function (\<lambda>x. c)"
+ by (simp add: polynomial_function_def o_def const)
+
+lemma polynomial_function_bounded_linear:
+ "bounded_linear f \<Longrightarrow> polynomial_function f"
+ by (simp add: polynomial_function_def o_def bounded_linear_compose real_polynomial_function.linear)
+
+lemma polynomial_function_id [iff]: "polynomial_function(\<lambda>x. x)"
+ by (simp add: polynomial_function_bounded_linear)
+
+lemma polynomial_function_add [intro]:
+ "\<lbrakk>polynomial_function f; polynomial_function g\<rbrakk> \<Longrightarrow> polynomial_function (\<lambda>x. f x + g x)"
+ by (auto simp: polynomial_function_def bounded_linear_def linear_add real_polynomial_function.add o_def)
+
+lemma polynomial_function_mult [intro]:
+ assumes f: "polynomial_function f" and g: "polynomial_function g"
+ shows "polynomial_function (\<lambda>x. f x *\<^sub>R g x)"
+ using g
+ apply (auto simp: polynomial_function_def bounded_linear_def Real_Vector_Spaces.linear.scaleR const real_polynomial_function.mult o_def)
+ apply (rule mult)
+ using f
+ apply (auto simp: real_polynomial_function_eq)
+ done
+
+lemma polynomial_function_cmul [intro]:
+ assumes f: "polynomial_function f"
+ shows "polynomial_function (\<lambda>x. c *\<^sub>R f x)"
+ by (rule polynomial_function_mult [OF polynomial_function_const f])
+
+lemma polynomial_function_minus [intro]:
+ assumes f: "polynomial_function f"
+ shows "polynomial_function (\<lambda>x. - f x)"
+ using polynomial_function_cmul [OF f, of "-1"] by simp
+
+lemma polynomial_function_diff [intro]:
+ "\<lbrakk>polynomial_function f; polynomial_function g\<rbrakk> \<Longrightarrow> polynomial_function (\<lambda>x. f x - g x)"
+ unfolding add_uminus_conv_diff [symmetric]
+ by (metis polynomial_function_add polynomial_function_minus)
+
+lemma polynomial_function_setsum [intro]:
+ "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> polynomial_function (\<lambda>x. f x i)\<rbrakk> \<Longrightarrow> polynomial_function (\<lambda>x. setsum (f x) I)"
+by (induct I rule: finite_induct) auto
+
+lemma real_polynomial_function_minus [intro]:
+ "real_polynomial_function f \<Longrightarrow> real_polynomial_function (\<lambda>x. - f x)"
+ using polynomial_function_minus [of f]
+ by (simp add: real_polynomial_function_eq)
+
+lemma real_polynomial_function_diff [intro]:
+ "\<lbrakk>real_polynomial_function f; real_polynomial_function g\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. f x - g x)"
+ using polynomial_function_diff [of f]
+ by (simp add: real_polynomial_function_eq)
+
+lemma real_polynomial_function_setsum [intro]:
+ "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> real_polynomial_function (\<lambda>x. f x i)\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. setsum (f x) I)"
+ using polynomial_function_setsum [of I f]
+ by (simp add: real_polynomial_function_eq)
+
+lemma real_polynomial_function_power [intro]:
+ "real_polynomial_function f \<Longrightarrow> real_polynomial_function (\<lambda>x. f x ^ n)"
+ by (induct n) (simp_all add: const mult)
+
+lemma real_polynomial_function_compose [intro]:
+ assumes f: "polynomial_function f" and g: "real_polynomial_function g"
+ shows "real_polynomial_function (g o f)"
+ using g
+ apply (induction g rule: real_polynomial_function.induct)
+ using f
+ apply (simp_all add: polynomial_function_def o_def const add mult)
+ done
+
+lemma polynomial_function_compose [intro]:
+ assumes f: "polynomial_function f" and g: "polynomial_function g"
+ shows "polynomial_function (g o f)"
+ using g real_polynomial_function_compose [OF f]
+ by (auto simp: polynomial_function_def o_def)
+
+lemma setsum_max_0:
+ fixes x::real (*in fact "'a::comm_ring_1"*)
+ shows "(\<Sum>i = 0..max m n. x^i * (if i \<le> m then a i else 0)) = (\<Sum>i = 0..m. x^i * a i)"
+proof -
+ have "(\<Sum>i = 0..max m n. x^i * (if i \<le> m then a i else 0)) = (\<Sum>i = 0..max m n. (if i \<le> m then x^i * a i else 0))"
+ by (auto simp: algebra_simps intro: setsum.cong)
+ also have "... = (\<Sum>i = 0..m. (if i \<le> m then x^i * a i else 0))"
+ by (rule setsum.mono_neutral_right) auto
+ also have "... = (\<Sum>i = 0..m. x^i * a i)"
+ by (auto simp: algebra_simps intro: setsum.cong)
+ finally show ?thesis .
+qed
+
+lemma real_polynomial_function_imp_setsum:
+ assumes "real_polynomial_function f"
+ shows "\<exists>a n::nat. f = (\<lambda>x. \<Sum>i=0..n. a i * x ^ i)"
+using assms
+proof (induct f)
+ case (linear f)
+ then show ?case
+ apply (clarsimp simp add: real_bounded_linear)
+ apply (rule_tac x="\<lambda>i. if i=0 then 0 else c" in exI)
+ apply (rule_tac x=1 in exI)
+ apply (simp add: mult_ac)
+ done
+next
+ case (const c)
+ show ?case
+ apply (rule_tac x="\<lambda>i. c" in exI)
+ apply (rule_tac x=0 in exI)
+ apply (auto simp: mult_ac real_of_nat_Suc)
+ done
+ case (add f1 f2)
+ then obtain a1 n1 a2 n2 where
+ "f1 = (\<lambda>x. \<Sum>i = 0..n1. a1 i * x ^ i)" "f2 = (\<lambda>x. \<Sum>i = 0..n2. a2 i * x ^ i)"
+ by auto
+ then show ?case
+ apply (rule_tac x="\<lambda>i. (if i \<le> n1 then a1 i else 0) + (if i \<le> n2 then a2 i else 0)" in exI)
+ apply (rule_tac x="max n1 n2" in exI)
+ using setsum_max_0 [where m=n1 and n=n2] setsum_max_0 [where m=n2 and n=n1]
+ apply (simp add: setsum.distrib algebra_simps max.commute)
+ done
+ case (mult f1 f2)
+ then obtain a1 n1 a2 n2 where
+ "f1 = (\<lambda>x. \<Sum>i = 0..n1. a1 i * x ^ i)" "f2 = (\<lambda>x. \<Sum>i = 0..n2. a2 i * x ^ i)"
+ by auto
+ then obtain b1 b2 where
+ "f1 = (\<lambda>x. \<Sum>i = 0..n1. b1 i * x ^ i)" "f2 = (\<lambda>x. \<Sum>i = 0..n2. b2 i * x ^ i)"
+ "b1 = (\<lambda>i. if i\<le>n1 then a1 i else 0)" "b2 = (\<lambda>i. if i\<le>n2 then a2 i else 0)"
+ by auto
+ then show ?case
+ apply (rule_tac x="\<lambda>i. \<Sum>k\<le>i. b1 k * b2 (i - k)" in exI)
+ apply (rule_tac x="n1+n2" in exI)
+ using polynomial_product [of n1 b1 n2 b2]
+ apply (simp add: Set_Interval.atLeast0AtMost)
+ done
+qed
+
+lemma real_polynomial_function_iff_setsum:
+ "real_polynomial_function f \<longleftrightarrow> (\<exists>a n::nat. f = (\<lambda>x. \<Sum>i=0..n. a i * x ^ i))"
+ apply (rule iffI)
+ apply (erule real_polynomial_function_imp_setsum)
+ apply (auto simp: linear mult const real_polynomial_function_power real_polynomial_function_setsum)
+ done
+
+lemma polynomial_function_iff_Basis_inner:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
+ shows "polynomial_function f \<longleftrightarrow> (\<forall>b\<in>Basis. real_polynomial_function (\<lambda>x. inner (f x) b))"
+ (is "?lhs = ?rhs")
+unfolding polynomial_function_def
+proof (intro iffI allI impI)
+ assume "\<forall>h. bounded_linear h \<longrightarrow> real_polynomial_function (h \<circ> f)"
+ then show ?rhs
+ by (force simp add: bounded_linear_inner_left o_def)
+next
+ fix h :: "'b \<Rightarrow> real"
+ assume rp: "\<forall>b\<in>Basis. real_polynomial_function (\<lambda>x. f x \<bullet> b)" and h: "bounded_linear h"
+ have "real_polynomial_function (h \<circ> (\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b))"
+ apply (rule real_polynomial_function_compose [OF _ linear [OF h]])
+ using rp
+ apply (auto simp: real_polynomial_function_eq polynomial_function_mult)
+ done
+ then show "real_polynomial_function (h \<circ> f)"
+ by (simp add: euclidean_representation_setsum_fun)
+qed
+
+subsection {*Stone-Weierstrass theorem for polynomial functions*}
+
+text\<open>First, we need to show that they are continous, differentiable and separable.\<close>
+
+lemma continuous_real_polymonial_function:
+ assumes "real_polynomial_function f"
+ shows "continuous (at x) f"
+using assms
+by (induct f) (auto simp: linear_continuous_at)
+
+lemma continuous_polymonial_function:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
+ assumes "polynomial_function f"
+ shows "continuous (at x) f"
+ apply (rule euclidean_isCont)
+ using assms apply (simp add: polynomial_function_iff_Basis_inner)
+ apply (force dest: continuous_real_polymonial_function intro: isCont_scaleR)
+ done
+
+lemma continuous_on_polymonial_function:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
+ assumes "polynomial_function f"
+ shows "continuous_on s f"
+ using continuous_polymonial_function [OF assms] continuous_at_imp_continuous_on
+ by blast
+
+lemma has_real_derivative_polynomial_function:
+ assumes "real_polynomial_function p"
+ shows "\<exists>p'. real_polynomial_function p' \<and>
+ (\<forall>x. (p has_real_derivative (p' x)) (at x))"
+using assms
+proof (induct p)
+ case (linear p)
+ then show ?case
+ by (force simp: real_bounded_linear const intro!: derivative_eq_intros)
+next
+ case (const c)
+ show ?case
+ by (rule_tac x="\<lambda>x. 0" in exI) auto
+ case (add f1 f2)
+ then obtain p1 p2 where
+ "real_polynomial_function p1" "\<And>x. (f1 has_real_derivative p1 x) (at x)"
+ "real_polynomial_function p2" "\<And>x. (f2 has_real_derivative p2 x) (at x)"
+ by auto
+ then show ?case
+ apply (rule_tac x="\<lambda>x. p1 x + p2 x" in exI)
+ apply (auto intro!: derivative_eq_intros)
+ done
+ case (mult f1 f2)
+ then obtain p1 p2 where
+ "real_polynomial_function p1" "\<And>x. (f1 has_real_derivative p1 x) (at x)"
+ "real_polynomial_function p2" "\<And>x. (f2 has_real_derivative p2 x) (at x)"
+ by auto
+ then show ?case
+ using mult
+ apply (rule_tac x="\<lambda>x. f1 x * p2 x + f2 x * p1 x" in exI)
+ apply (auto intro!: derivative_eq_intros)
+ done
+qed
+
+lemma has_vector_derivative_polynomial_function:
+ fixes p :: "real \<Rightarrow> 'a::euclidean_space"
+ assumes "polynomial_function p"
+ shows "\<exists>p'. polynomial_function p' \<and>
+ (\<forall>x. (p has_vector_derivative (p' x)) (at x))"
+proof -
+ { fix b :: 'a
+ assume "b \<in> Basis"
+ then
+ obtain p' where p': "real_polynomial_function p'" and pd: "\<And>x. ((\<lambda>x. p x \<bullet> b) has_real_derivative p' x) (at x)"
+ using assms [unfolded polynomial_function_iff_Basis_inner, rule_format] `b \<in> Basis`
+ has_real_derivative_polynomial_function
+ by blast
+ have "\<exists>q. polynomial_function q \<and> (\<forall>x. ((\<lambda>u. (p u \<bullet> b) *\<^sub>R b) has_vector_derivative q x) (at x))"
+ apply (rule_tac x="\<lambda>x. p' x *\<^sub>R b" in exI)
+ using `b \<in> Basis` p'
+ apply (simp add: polynomial_function_iff_Basis_inner inner_Basis)
+ apply (auto intro: derivative_eq_intros pd)
+ done
+ }
+ then obtain qf where qf:
+ "\<And>b. b \<in> Basis \<Longrightarrow> polynomial_function (qf b)"
+ "\<And>b x. b \<in> Basis \<Longrightarrow> ((\<lambda>u. (p u \<bullet> b) *\<^sub>R b) has_vector_derivative qf b x) (at x)"
+ by metis
+ show ?thesis
+ apply (subst euclidean_representation_setsum_fun [of p, symmetric])
+ apply (rule_tac x="\<lambda>x. \<Sum>b\<in>Basis. qf b x" in exI)
+ apply (auto intro: has_vector_derivative_setsum qf)
+ done
+qed
+
+lemma real_polynomial_function_separable:
+ fixes x :: "'a::euclidean_space"
+ assumes "x \<noteq> y" shows "\<exists>f. real_polynomial_function f \<and> f x \<noteq> f y"
+proof -
+ have "real_polynomial_function (\<lambda>u. \<Sum>b\<in>Basis. (inner (x-u) b)^2)"
+ apply (rule real_polynomial_function_setsum)
+ apply (auto simp: algebra_simps real_polynomial_function_power real_polynomial_function_diff
+ const linear bounded_linear_inner_left)
+ done
+ then show ?thesis
+ apply (intro exI conjI, assumption)
+ using assms
+ apply (force simp add: euclidean_eq_iff [of x y] setsum_nonneg_eq_0_iff algebra_simps)
+ done
+qed
+
+lemma Stone_Weierstrass_real_polynomial_function:
+ fixes f :: "'a::euclidean_space \<Rightarrow> real"
+ assumes "compact s" "continuous_on s f" "0 < e"
+ shows "\<exists>g. real_polynomial_function g \<and> (\<forall>x \<in> s. abs(f x - g x) < e)"
+proof -
+ interpret PR: function_ring_on "Collect real_polynomial_function"
+ apply unfold_locales
+ using assms continuous_on_polymonial_function real_polynomial_function_eq
+ apply (auto intro: real_polynomial_function_separable)
+ done
+ show ?thesis
+ using PR.Stone_Weierstrass_basic [OF `continuous_on s f` `0 < e`]
+ by blast
+qed
+
+lemma Stone_Weierstrass_polynomial_function:
+ fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
+ assumes s: "compact s"
+ and f: "continuous_on s f"
+ and e: "0 < e"
+ shows "\<exists>g. polynomial_function g \<and> (\<forall>x \<in> s. norm(f x - g x) < e)"
+proof -
+ { fix b :: 'b
+ assume "b \<in> Basis"
+ have "\<exists>p. real_polynomial_function p \<and> (\<forall>x \<in> s. abs(f x \<bullet> b - p x) < e / DIM('b))"
+ apply (rule exE [OF Stone_Weierstrass_real_polynomial_function [OF s _, of "\<lambda>x. f x \<bullet> b" "e / card Basis"]])
+ using e f
+ apply (auto simp: Euclidean_Space.DIM_positive intro: continuous_intros)
+ done
+ }
+ then obtain pf where pf:
+ "\<And>b. b \<in> Basis \<Longrightarrow> real_polynomial_function (pf b) \<and> (\<forall>x \<in> s. abs(f x \<bullet> b - pf b x) < e / DIM('b))"
+ apply (rule bchoice [rule_format, THEN exE])
+ apply assumption
+ apply (force simp add: intro: that)
+ done
+ have "polynomial_function (\<lambda>x. \<Sum>b\<in>Basis. pf b x *\<^sub>R b)"
+ using pf
+ by (simp add: polynomial_function_setsum polynomial_function_mult real_polynomial_function_eq)
+ moreover
+ { fix x
+ assume "x \<in> s"
+ have "norm (\<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b - pf b x *\<^sub>R b) \<le> (\<Sum>b\<in>Basis. norm ((f x \<bullet> b) *\<^sub>R b - pf b x *\<^sub>R b))"
+ by (rule norm_setsum)
+ also have "... < of_nat DIM('b) * (e / DIM('b))"
+ apply (rule setsum_bounded_above_strict)
+ apply (simp add: Real_Vector_Spaces.scaleR_diff_left [symmetric] pf `x \<in> s`)
+ apply (rule DIM_positive)
+ done
+ also have "... = e"
+ using DIM_positive by (simp add: field_simps)
+ finally have "norm (\<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b - pf b x *\<^sub>R b) < e" .
+ }
+ ultimately
+ show ?thesis
+ apply (subst euclidean_representation_setsum_fun [of f, symmetric])
+ apply (rule_tac x="\<lambda>x. \<Sum>b\<in>Basis. pf b x *\<^sub>R b" in exI)
+ apply (auto simp: setsum_subtractf [symmetric])
+ done
+qed
+
+
+subsection\<open>Polynomial functions as paths\<close>
+
+text{*One application is to pick a smooth approximation to a path,
+or just pick a smooth path anyway in an open connected set*}
+
+lemma path_polynomial_function:
+ fixes g :: "real \<Rightarrow> 'b::euclidean_space"
+ shows "polynomial_function g \<Longrightarrow> path g"
+ by (simp add: path_def continuous_on_polymonial_function)
+
+lemma path_approx_polynomial_function:
+ fixes g :: "real \<Rightarrow> 'b::euclidean_space"
+ assumes "path g" "0 < e"
+ shows "\<exists>p. polynomial_function p \<and>
+ pathstart p = pathstart g \<and>
+ pathfinish p = pathfinish g \<and>
+ (\<forall>t \<in> {0..1}. norm(p t - g t) < e)"
+proof -
+ obtain q where poq: "polynomial_function q" and noq: "\<And>x. x \<in> {0..1} \<Longrightarrow> norm (g x - q x) < e/4"
+ using Stone_Weierstrass_polynomial_function [of "{0..1}" g "e/4"] assms
+ by (auto simp: path_def)
+ have pf: "polynomial_function (\<lambda>t. q t + (g 0 - q 0) + t *\<^sub>R (g 1 - q 1 - (g 0 - q 0)))"
+ by (force simp add: poq)
+ have *: "\<And>t. t \<in> {0..1} \<Longrightarrow> norm (((q t - g t) + (g 0 - q 0)) + (t *\<^sub>R (g 1 - q 1) + t *\<^sub>R (q 0 - g 0))) < (e/4 + e/4) + (e/4+e/4)"
+ apply (intro Real_Vector_Spaces.norm_add_less)
+ using noq
+ apply (auto simp: norm_minus_commute intro: le_less_trans [OF mult_left_le_one_le noq] simp del: less_divide_eq_numeral1)
+ done
+ show ?thesis
+ apply (intro exI conjI)
+ apply (rule pf)
+ using *
+ apply (auto simp add: pathstart_def pathfinish_def algebra_simps)
+ done
+qed
+
+lemma connected_open_polynomial_connected:
+ fixes s :: "'a::euclidean_space set"
+ assumes s: "open s" "connected s"
+ and "x \<in> s" "y \<in> s"
+ shows "\<exists>g. polynomial_function g \<and> path_image g \<subseteq> s \<and>
+ pathstart g = x \<and> pathfinish g = y"
+proof -
+ have "path_connected s" using assms
+ by (simp add: connected_open_path_connected)
+ with `x \<in> s` `y \<in> s` obtain p where p: "path p" "path_image p \<subseteq> s" "pathstart p = x" "pathfinish p = y"
+ by (force simp: path_connected_def)
+ have "\<exists>e. 0 < e \<and> (\<forall>x \<in> path_image p. ball x e \<subseteq> s)"
+ proof (cases "s = UNIV")
+ case True then show ?thesis
+ by (simp add: gt_ex)
+ next
+ case False
+ then have "- s \<noteq> {}" by blast
+ then show ?thesis
+ apply (rule_tac x="setdist (path_image p) (-s)" in exI)
+ using s p
+ apply (simp add: setdist_gt_0_compact_closed compact_path_image open_closed)
+ using setdist_le_dist [of _ "path_image p" _ "-s"]
+ by fastforce
+ qed
+ then obtain e where "0 < e"and eb: "\<And>x. x \<in> path_image p \<Longrightarrow> ball x e \<subseteq> s"
+ by auto
+ show ?thesis
+ using path_approx_polynomial_function [OF `path p` `0 < e`]
+ apply clarify
+ apply (intro exI conjI, assumption)
+ using p
+ apply (fastforce simp add: dist_norm path_image_def norm_minus_commute intro: eb [THEN subsetD])+
+ done
+qed
+
+hide_fact linear add mult const
+
+end
--- a/src/HOL/Multivariate_Analysis/normarith.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Multivariate_Analysis/normarith.ML Thu Sep 03 15:50:40 2015 +0200
@@ -343,8 +343,14 @@
val lctab = vector_lincombs (map snd (filter (not o fst) ntms))
val (fxns, ctxt') = Variable.variant_fixes (replicate (length lctab) "x") ctxt
fun instantiate_cterm' ty tms = Drule.cterm_rule (Thm.instantiate' ty tms)
- fun mk_norm t = Thm.apply (instantiate_cterm' [SOME (Thm.ctyp_of_cterm t)] [] @{cpat "norm :: (?'a :: real_normed_vector) => real"}) t
- fun mk_equals l r = Thm.apply (Thm.apply (instantiate_cterm' [SOME (Thm.ctyp_of_cterm l)] [] @{cpat "op == :: ?'a =>_"}) l) r
+ fun mk_norm t =
+ let val T = Thm.typ_of_cterm t
+ in Thm.apply (Thm.cterm_of ctxt' (Const (@{const_name norm}, T --> @{typ real}))) t end
+ fun mk_equals l r =
+ let
+ val T = Thm.typ_of_cterm l
+ val eq = Thm.cterm_of ctxt (Const (@{const_name Pure.eq}, T --> T --> propT))
+ in Thm.apply (Thm.apply eq l) r end
val asl = map2 (fn (t,_) => fn n => Thm.assume (mk_equals (mk_norm t) (Thm.cterm_of ctxt' (Free(n,@{typ real}))))) lctab fxns
val replace_conv = try_conv (rewrs_conv asl)
val replace_rule = fconv_rule (funpow 2 arg_conv (replacenegnorms replace_conv))
@@ -354,7 +360,7 @@
val gts' = map replace_rule gts
val nubs = map (conjunct2 o norm_mp) asl
val th1 = real_vector_combo_prover ctxt' translator (nubs,ges',gts')
- val shs = filter (member (fn (t,th) => t aconvc Thm.cprop_of th) asl) (#hyps (Thm.crep_thm th1))
+ val shs = filter (member (fn (t,th) => t aconvc Thm.cprop_of th) asl) (Thm.chyps_of th1)
val th11 = hd (Variable.export ctxt' ctxt [fold Thm.implies_intr shs th1])
val cps = map (swap o Thm.dest_equals) (cprems_of th11)
val th12 = Drule.instantiate_normalize ([], map (apfst (dest_Var o Thm.term_of)) cps) th11
--- a/src/HOL/NSA/HyperDef.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/NSA/HyperDef.thy Thu Sep 03 15:50:40 2015 +0200
@@ -103,7 +103,7 @@
by transfer simp
qed
-lemma Reals_eq_Standard: "(Reals :: hypreal set) = Standard"
+lemma Reals_eq_Standard: "(\<real> :: hypreal set) = Standard"
by (simp add: Reals_def Standard_def)
@@ -539,7 +539,7 @@
by transfer (rule refl)
lemma hyperpow_SReal [simp]:
- "(hypreal_of_real r) pow (hypnat_of_nat n) \<in> Reals"
+ "(hypreal_of_real r) pow (hypnat_of_nat n) \<in> \<real>"
by (simp add: Reals_eq_Standard)
lemma hyperpow_zero_HNatInfinite [simp]:
--- a/src/HOL/NSA/NSA.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/NSA/NSA.thy Thu Sep 03 15:50:40 2015 +0200
@@ -33,7 +33,7 @@
definition
st :: "hypreal => hypreal" where
--{*the standard part of a hyperreal*}
- "st = (%x. @r. x \<in> HFinite & r \<in> Reals & r @= x)"
+ "st = (%x. @r. x \<in> HFinite & r \<in> \<real> & r @= x)"
definition
monad :: "'a::real_normed_vector star => 'a star set" where
@@ -49,7 +49,7 @@
notation (HTML output)
approx (infixl "\<approx>" 50)
-lemma SReal_def: "Reals == {x. \<exists>r. x = hypreal_of_real r}"
+lemma SReal_def: "\<real> == {x. \<exists>r. x = hypreal_of_real r}"
by (simp add: Reals_def image_def)
subsection {* Nonstandard Extension of the Norm Function *}
@@ -104,11 +104,11 @@
by transfer (rule norm_power)
lemma hnorm_one [simp]:
- "hnorm (1\<Colon>'a::real_normed_div_algebra star) = 1"
+ "hnorm (1::'a::real_normed_div_algebra star) = 1"
by transfer (rule norm_one)
lemma hnorm_zero [simp]:
- "hnorm (0\<Colon>'a::real_normed_vector star) = 0"
+ "hnorm (0::'a::real_normed_vector star) = 0"
by transfer (rule norm_zero)
lemma zero_less_hnorm_iff [simp]:
@@ -176,54 +176,54 @@
subsection{*Closure Laws for the Standard Reals*}
-lemma Reals_minus_iff [simp]: "(-x \<in> Reals) = (x \<in> Reals)"
+lemma Reals_minus_iff [simp]: "(-x \<in> \<real>) = (x \<in> \<real>)"
apply auto
apply (drule Reals_minus, auto)
done
-lemma Reals_add_cancel: "\<lbrakk>x + y \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
+lemma Reals_add_cancel: "\<lbrakk>x + y \<in> \<real>; y \<in> \<real>\<rbrakk> \<Longrightarrow> x \<in> \<real>"
by (drule (1) Reals_diff, simp)
-lemma SReal_hrabs: "(x::hypreal) \<in> Reals ==> abs x \<in> Reals"
+lemma SReal_hrabs: "(x::hypreal) \<in> \<real> ==> abs x \<in> \<real>"
by (simp add: Reals_eq_Standard)
-lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> Reals"
+lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> \<real>"
by (simp add: Reals_eq_Standard)
-lemma SReal_divide_numeral: "r \<in> Reals ==> r/(numeral w::hypreal) \<in> Reals"
+lemma SReal_divide_numeral: "r \<in> \<real> ==> r/(numeral w::hypreal) \<in> \<real>"
by simp
text{*epsilon is not in Reals because it is an infinitesimal*}
-lemma SReal_epsilon_not_mem: "epsilon \<notin> Reals"
+lemma SReal_epsilon_not_mem: "epsilon \<notin> \<real>"
apply (simp add: SReal_def)
apply (auto simp add: hypreal_of_real_not_eq_epsilon [THEN not_sym])
done
-lemma SReal_omega_not_mem: "omega \<notin> Reals"
+lemma SReal_omega_not_mem: "omega \<notin> \<real>"
apply (simp add: SReal_def)
apply (auto simp add: hypreal_of_real_not_eq_omega [THEN not_sym])
done
-lemma SReal_UNIV_real: "{x. hypreal_of_real x \<in> Reals} = (UNIV::real set)"
+lemma SReal_UNIV_real: "{x. hypreal_of_real x \<in> \<real>} = (UNIV::real set)"
by simp
-lemma SReal_iff: "(x \<in> Reals) = (\<exists>y. x = hypreal_of_real y)"
+lemma SReal_iff: "(x \<in> \<real>) = (\<exists>y. x = hypreal_of_real y)"
by (simp add: SReal_def)
-lemma hypreal_of_real_image: "hypreal_of_real `(UNIV::real set) = Reals"
+lemma hypreal_of_real_image: "hypreal_of_real `(UNIV::real set) = \<real>"
by (simp add: Reals_eq_Standard Standard_def)
-lemma inv_hypreal_of_real_image: "inv hypreal_of_real ` Reals = UNIV"
+lemma inv_hypreal_of_real_image: "inv hypreal_of_real ` \<real> = UNIV"
apply (auto simp add: SReal_def)
apply (rule inj_star_of [THEN inv_f_f, THEN subst], blast)
done
lemma SReal_hypreal_of_real_image:
- "[| \<exists>x. x: P; P \<subseteq> Reals |] ==> \<exists>Q. P = hypreal_of_real ` Q"
+ "[| \<exists>x. x: P; P \<subseteq> \<real> |] ==> \<exists>Q. P = hypreal_of_real ` Q"
by (simp add: SReal_def image_def, blast)
lemma SReal_dense:
- "[| (x::hypreal) \<in> Reals; y \<in> Reals; x<y |] ==> \<exists>r \<in> Reals. x<r & r<y"
+ "[| (x::hypreal) \<in> \<real>; y \<in> \<real>; x<y |] ==> \<exists>r \<in> Reals. x<r & r<y"
apply (auto simp add: SReal_def)
apply (drule dense, auto)
done
@@ -231,12 +231,12 @@
text{*Completeness of Reals, but both lemmas are unused.*}
lemma SReal_sup_lemma:
- "P \<subseteq> Reals ==> ((\<exists>x \<in> P. y < x) =
+ "P \<subseteq> \<real> ==> ((\<exists>x \<in> P. y < x) =
(\<exists>X. hypreal_of_real X \<in> P & y < hypreal_of_real X))"
by (blast dest!: SReal_iff [THEN iffD1])
lemma SReal_sup_lemma2:
- "[| P \<subseteq> Reals; \<exists>x. x \<in> P; \<exists>y \<in> Reals. \<forall>x \<in> P. x < y |]
+ "[| P \<subseteq> \<real>; \<exists>x. x \<in> P; \<exists>y \<in> Reals. \<forall>x \<in> P. x < y |]
==> (\<exists>X. X \<in> {w. hypreal_of_real w \<in> P}) &
(\<exists>Y. \<forall>X \<in> {w. hypreal_of_real w \<in> P}. X < Y)"
apply (rule conjI)
@@ -277,7 +277,7 @@
apply (blast intro: Reals_add SReal_hypreal_of_real Reals_1)
done
-lemma SReal_subset_HFinite: "(Reals::hypreal set) \<subseteq> HFinite"
+lemma SReal_subset_HFinite: "(\<real>::hypreal set) \<subseteq> HFinite"
by (auto simp add: SReal_def)
lemma HFiniteD: "x \<in> HFinite ==> \<exists>t \<in> Reals. hnorm x < t"
@@ -850,29 +850,29 @@
by (blast intro!: approx_mult_HFinite approx_star_of_HFinite HFinite_star_of)
lemma approx_SReal_mult_cancel_zero:
- "[| (a::hypreal) \<in> Reals; a \<noteq> 0; a*x @= 0 |] ==> x @= 0"
+ "[| (a::hypreal) \<in> \<real>; a \<noteq> 0; a*x @= 0 |] ==> x @= 0"
apply (drule Reals_inverse [THEN SReal_subset_HFinite [THEN subsetD]])
apply (auto dest: approx_mult2 simp add: mult.assoc [symmetric])
done
-lemma approx_mult_SReal1: "[| (a::hypreal) \<in> Reals; x @= 0 |] ==> x*a @= 0"
+lemma approx_mult_SReal1: "[| (a::hypreal) \<in> \<real>; x @= 0 |] ==> x*a @= 0"
by (auto dest: SReal_subset_HFinite [THEN subsetD] approx_mult1)
-lemma approx_mult_SReal2: "[| (a::hypreal) \<in> Reals; x @= 0 |] ==> a*x @= 0"
+lemma approx_mult_SReal2: "[| (a::hypreal) \<in> \<real>; x @= 0 |] ==> a*x @= 0"
by (auto dest: SReal_subset_HFinite [THEN subsetD] approx_mult2)
lemma approx_mult_SReal_zero_cancel_iff [simp]:
- "[|(a::hypreal) \<in> Reals; a \<noteq> 0 |] ==> (a*x @= 0) = (x @= 0)"
+ "[|(a::hypreal) \<in> \<real>; a \<noteq> 0 |] ==> (a*x @= 0) = (x @= 0)"
by (blast intro: approx_SReal_mult_cancel_zero approx_mult_SReal2)
lemma approx_SReal_mult_cancel:
- "[| (a::hypreal) \<in> Reals; a \<noteq> 0; a* w @= a*z |] ==> w @= z"
+ "[| (a::hypreal) \<in> \<real>; a \<noteq> 0; a* w @= a*z |] ==> w @= z"
apply (drule Reals_inverse [THEN SReal_subset_HFinite [THEN subsetD]])
apply (auto dest: approx_mult2 simp add: mult.assoc [symmetric])
done
lemma approx_SReal_mult_cancel_iff1 [simp]:
- "[| (a::hypreal) \<in> Reals; a \<noteq> 0|] ==> (a* w @= a*z) = (w @= z)"
+ "[| (a::hypreal) \<in> \<real>; a \<noteq> 0|] ==> (a* w @= a*z) = (w @= z)"
by (auto intro!: approx_mult2 SReal_subset_HFinite [THEN subsetD]
intro: approx_SReal_mult_cancel)
@@ -907,7 +907,7 @@
subsection{* Zero is the Only Infinitesimal that is also a Real*}
lemma Infinitesimal_less_SReal:
- "[| (x::hypreal) \<in> Reals; y \<in> Infinitesimal; 0 < x |] ==> y < x"
+ "[| (x::hypreal) \<in> \<real>; y \<in> Infinitesimal; 0 < x |] ==> y < x"
apply (simp add: Infinitesimal_def)
apply (rule abs_ge_self [THEN order_le_less_trans], auto)
done
@@ -917,29 +917,29 @@
by (blast intro: Infinitesimal_less_SReal)
lemma SReal_not_Infinitesimal:
- "[| 0 < y; (y::hypreal) \<in> Reals|] ==> y \<notin> Infinitesimal"
+ "[| 0 < y; (y::hypreal) \<in> \<real>|] ==> y \<notin> Infinitesimal"
apply (simp add: Infinitesimal_def)
apply (auto simp add: abs_if)
done
lemma SReal_minus_not_Infinitesimal:
- "[| y < 0; (y::hypreal) \<in> Reals |] ==> y \<notin> Infinitesimal"
+ "[| y < 0; (y::hypreal) \<in> \<real> |] ==> y \<notin> Infinitesimal"
apply (subst Infinitesimal_minus_iff [symmetric])
apply (rule SReal_not_Infinitesimal, auto)
done
-lemma SReal_Int_Infinitesimal_zero: "Reals Int Infinitesimal = {0::hypreal}"
+lemma SReal_Int_Infinitesimal_zero: "\<real> Int Infinitesimal = {0::hypreal}"
apply auto
apply (cut_tac x = x and y = 0 in linorder_less_linear)
apply (blast dest: SReal_not_Infinitesimal SReal_minus_not_Infinitesimal)
done
lemma SReal_Infinitesimal_zero:
- "[| (x::hypreal) \<in> Reals; x \<in> Infinitesimal|] ==> x = 0"
+ "[| (x::hypreal) \<in> \<real>; x \<in> Infinitesimal|] ==> x = 0"
by (cut_tac SReal_Int_Infinitesimal_zero, blast)
lemma SReal_HFinite_diff_Infinitesimal:
- "[| (x::hypreal) \<in> Reals; x \<noteq> 0 |] ==> x \<in> HFinite - Infinitesimal"
+ "[| (x::hypreal) \<in> \<real>; x \<noteq> 0 |] ==> x \<in> HFinite - Infinitesimal"
by (auto dest: SReal_Infinitesimal_zero SReal_subset_HFinite [THEN subsetD])
lemma hypreal_of_real_HFinite_diff_Infinitesimal:
@@ -971,7 +971,7 @@
done
lemma approx_SReal_not_zero:
- "[| (y::hypreal) \<in> Reals; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
+ "[| (y::hypreal) \<in> \<real>; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
apply (cut_tac x = 0 and y = y in linorder_less_linear, simp)
apply (blast dest: approx_sym [THEN mem_infmal_iff [THEN iffD2]] SReal_not_Infinitesimal SReal_minus_not_Infinitesimal)
done
@@ -996,7 +996,7 @@
done
lemma Infinitesimal_SReal_divide:
- "[| (x::hypreal) \<in> Infinitesimal; y \<in> Reals |] ==> x/y \<in> Infinitesimal"
+ "[| (x::hypreal) \<in> Infinitesimal; y \<in> \<real> |] ==> x/y \<in> Infinitesimal"
apply (simp add: divide_inverse)
apply (auto intro!: Infinitesimal_HFinite_mult
dest!: Reals_inverse [THEN SReal_subset_HFinite [THEN subsetD]])
@@ -1018,7 +1018,7 @@
done
lemma SReal_approx_iff:
- "[|(x::hypreal) \<in> Reals; y \<in> Reals|] ==> (x @= y) = (x = y)"
+ "[|(x::hypreal) \<in> \<real>; y \<in> \<real>|] ==> (x @= y) = (x = y)"
apply auto
apply (simp add: approx_def)
apply (drule (1) Reals_diff)
@@ -1060,7 +1060,7 @@
by (simp_all add: star_of_approx_iff [symmetric])
lemma approx_unique_real:
- "[| (r::hypreal) \<in> Reals; s \<in> Reals; r @= x; s @= x|] ==> r = s"
+ "[| (r::hypreal) \<in> \<real>; s \<in> \<real>; r @= x; s @= x|] ==> r = s"
by (blast intro: SReal_approx_iff [THEN iffD1] approx_trans2)
@@ -1069,12 +1069,12 @@
subsubsection{*Lifting of the Ub and Lub Properties*}
lemma hypreal_of_real_isUb_iff:
- "(isUb (Reals) (hypreal_of_real ` Q) (hypreal_of_real Y)) =
+ "(isUb \<real> (hypreal_of_real ` Q) (hypreal_of_real Y)) =
(isUb (UNIV :: real set) Q Y)"
by (simp add: isUb_def setle_def)
lemma hypreal_of_real_isLub1:
- "isLub Reals (hypreal_of_real ` Q) (hypreal_of_real Y)
+ "isLub \<real> (hypreal_of_real ` Q) (hypreal_of_real Y)
==> isLub (UNIV :: real set) Q Y"
apply (simp add: isLub_def leastP_def)
apply (auto intro: hypreal_of_real_isUb_iff [THEN iffD2]
@@ -1083,30 +1083,30 @@
lemma hypreal_of_real_isLub2:
"isLub (UNIV :: real set) Q Y
- ==> isLub Reals (hypreal_of_real ` Q) (hypreal_of_real Y)"
+ ==> isLub \<real> (hypreal_of_real ` Q) (hypreal_of_real Y)"
apply (auto simp add: isLub_def leastP_def hypreal_of_real_isUb_iff setge_def)
by (metis SReal_iff hypreal_of_real_isUb_iff isUbD2a star_of_le)
lemma hypreal_of_real_isLub_iff:
- "(isLub Reals (hypreal_of_real ` Q) (hypreal_of_real Y)) =
+ "(isLub \<real> (hypreal_of_real ` Q) (hypreal_of_real Y)) =
(isLub (UNIV :: real set) Q Y)"
by (blast intro: hypreal_of_real_isLub1 hypreal_of_real_isLub2)
lemma lemma_isUb_hypreal_of_real:
- "isUb Reals P Y ==> \<exists>Yo. isUb Reals P (hypreal_of_real Yo)"
+ "isUb \<real> P Y ==> \<exists>Yo. isUb \<real> P (hypreal_of_real Yo)"
by (auto simp add: SReal_iff isUb_def)
lemma lemma_isLub_hypreal_of_real:
- "isLub Reals P Y ==> \<exists>Yo. isLub Reals P (hypreal_of_real Yo)"
+ "isLub \<real> P Y ==> \<exists>Yo. isLub \<real> P (hypreal_of_real Yo)"
by (auto simp add: isLub_def leastP_def isUb_def SReal_iff)
lemma lemma_isLub_hypreal_of_real2:
- "\<exists>Yo. isLub Reals P (hypreal_of_real Yo) ==> \<exists>Y. isLub Reals P Y"
+ "\<exists>Yo. isLub \<real> P (hypreal_of_real Yo) ==> \<exists>Y. isLub \<real> P Y"
by (auto simp add: isLub_def leastP_def isUb_def)
lemma SReal_complete:
- "[| P \<subseteq> Reals; \<exists>x. x \<in> P; \<exists>Y. isUb Reals P Y |]
- ==> \<exists>t::hypreal. isLub Reals P t"
+ "[| P \<subseteq> \<real>; \<exists>x. x \<in> P; \<exists>Y. isUb \<real> P Y |]
+ ==> \<exists>t::hypreal. isLub \<real> P t"
apply (frule SReal_hypreal_of_real_image)
apply (auto, drule lemma_isUb_hypreal_of_real)
apply (auto intro!: reals_complete lemma_isLub_hypreal_of_real2
@@ -1116,14 +1116,14 @@
(* lemma about lubs *)
lemma lemma_st_part_ub:
- "(x::hypreal) \<in> HFinite ==> \<exists>u. isUb Reals {s. s \<in> Reals & s < x} u"
+ "(x::hypreal) \<in> HFinite ==> \<exists>u. isUb \<real> {s. s \<in> \<real> & s < x} u"
apply (drule HFiniteD, safe)
apply (rule exI, rule isUbI)
apply (auto intro: setleI isUbI simp add: abs_less_iff)
done
lemma lemma_st_part_nonempty:
- "(x::hypreal) \<in> HFinite ==> \<exists>y. y \<in> {s. s \<in> Reals & s < x}"
+ "(x::hypreal) \<in> HFinite ==> \<exists>y. y \<in> {s. s \<in> \<real> & s < x}"
apply (drule HFiniteD, safe)
apply (drule Reals_minus)
apply (rule_tac x = "-t" in exI)
@@ -1131,12 +1131,12 @@
done
lemma lemma_st_part_lub:
- "(x::hypreal) \<in> HFinite ==> \<exists>t. isLub Reals {s. s \<in> Reals & s < x} t"
+ "(x::hypreal) \<in> HFinite ==> \<exists>t. isLub \<real> {s. s \<in> \<real> & s < x} t"
by (blast intro!: SReal_complete lemma_st_part_ub lemma_st_part_nonempty Collect_restrict)
lemma lemma_st_part_le1:
- "[| (x::hypreal) \<in> HFinite; isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |] ==> x \<le> t + r"
+ "[| (x::hypreal) \<in> HFinite; isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |] ==> x \<le> t + r"
apply (frule isLubD1a)
apply (rule ccontr, drule linorder_not_le [THEN iffD2])
apply (drule (1) Reals_add)
@@ -1156,8 +1156,8 @@
done
lemma lemma_st_part_gt_ub:
- "[| (x::hypreal) \<in> HFinite; x < y; y \<in> Reals |]
- ==> isUb Reals {s. s \<in> Reals & s < x} y"
+ "[| (x::hypreal) \<in> HFinite; x < y; y \<in> \<real> |]
+ ==> isUb \<real> {s. s \<in> \<real> & s < x} y"
by (auto dest: order_less_trans intro: order_less_imp_le intro!: isUbI setleI)
lemma lemma_minus_le_zero: "t \<le> t + -r ==> r \<le> (0::hypreal)"
@@ -1167,8 +1167,8 @@
lemma lemma_st_part_le2:
"[| (x::hypreal) \<in> HFinite;
- isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |]
+ isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |]
==> t + -r \<le> x"
apply (frule isLubD1a)
apply (rule ccontr, drule linorder_not_le [THEN iffD1])
@@ -1181,8 +1181,8 @@
lemma lemma_st_part1a:
"[| (x::hypreal) \<in> HFinite;
- isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |]
+ isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |]
==> x + -t \<le> r"
apply (subgoal_tac "x \<le> t+r")
apply (auto intro: lemma_st_part_le1)
@@ -1190,8 +1190,8 @@
lemma lemma_st_part2a:
"[| (x::hypreal) \<in> HFinite;
- isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |]
+ isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |]
==> -(x + -t) \<le> r"
apply (subgoal_tac "(t + -r \<le> x)")
apply simp
@@ -1200,11 +1200,11 @@
done
lemma lemma_SReal_ub:
- "(x::hypreal) \<in> Reals ==> isUb Reals {s. s \<in> Reals & s < x} x"
+ "(x::hypreal) \<in> \<real> ==> isUb \<real> {s. s \<in> \<real> & s < x} x"
by (auto intro: isUbI setleI order_less_imp_le)
lemma lemma_SReal_lub:
- "(x::hypreal) \<in> Reals ==> isLub Reals {s. s \<in> Reals & s < x} x"
+ "(x::hypreal) \<in> \<real> ==> isLub \<real> {s. s \<in> \<real> & s < x} x"
apply (auto intro!: isLubI2 lemma_SReal_ub setgeI)
apply (frule isUbD2a)
apply (rule_tac x = x and y = y in linorder_cases)
@@ -1216,8 +1216,8 @@
lemma lemma_st_part_not_eq1:
"[| (x::hypreal) \<in> HFinite;
- isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |]
+ isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |]
==> x + -t \<noteq> r"
apply auto
apply (frule isLubD1a [THEN Reals_minus])
@@ -1228,8 +1228,8 @@
lemma lemma_st_part_not_eq2:
"[| (x::hypreal) \<in> HFinite;
- isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |]
+ isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |]
==> -(x + -t) \<noteq> r"
apply (auto)
apply (frule isLubD1a)
@@ -1240,8 +1240,8 @@
lemma lemma_st_part_major:
"[| (x::hypreal) \<in> HFinite;
- isLub Reals {s. s \<in> Reals & s < x} t;
- r \<in> Reals; 0 < r |]
+ isLub \<real> {s. s \<in> \<real> & s < x} t;
+ r \<in> \<real>; 0 < r |]
==> abs (x - t) < r"
apply (frule lemma_st_part1a)
apply (frule_tac [4] lemma_st_part2a, auto)
@@ -1250,7 +1250,7 @@
done
lemma lemma_st_part_major2:
- "[| (x::hypreal) \<in> HFinite; isLub Reals {s. s \<in> Reals & s < x} t |]
+ "[| (x::hypreal) \<in> HFinite; isLub \<real> {s. s \<in> \<real> & s < x} t |]
==> \<forall>r \<in> Reals. 0 < r --> abs (x - t) < r"
by (blast dest!: lemma_st_part_major)
@@ -1271,7 +1271,7 @@
done
text{*There is a unique real infinitely close*}
-lemma st_part_Ex1: "x \<in> HFinite ==> EX! t::hypreal. t \<in> Reals & x @= t"
+lemma st_part_Ex1: "x \<in> HFinite ==> EX! t::hypreal. t \<in> \<real> & x @= t"
apply (drule st_part_Ex, safe)
apply (drule_tac [2] approx_sym, drule_tac [2] approx_sym, drule_tac [2] approx_sym)
apply (auto intro!: approx_unique_real)
@@ -1471,7 +1471,7 @@
done
lemma HInfinite_gt_SReal:
- "[| (x::hypreal) \<in> HInfinite; 0 < x; y \<in> Reals |] ==> y < x"
+ "[| (x::hypreal) \<in> HInfinite; 0 < x; y \<in> \<real> |] ==> y < x"
by (auto dest!: bspec simp add: HInfinite_def abs_if order_less_imp_le)
lemma HInfinite_gt_zero_gt_one:
@@ -1762,7 +1762,7 @@
apply (auto intro: approx_sym)
done
-lemma st_SReal: "x \<in> HFinite ==> st x \<in> Reals"
+lemma st_SReal: "x \<in> HFinite ==> st x \<in> \<real>"
apply (simp add: st_def)
apply (frule st_part_Ex, safe)
apply (rule someI2)
@@ -1780,7 +1780,7 @@
apply (auto intro: approx_unique_real)
done
-lemma st_SReal_eq: "x \<in> Reals ==> st x = x"
+lemma st_SReal_eq: "x \<in> \<real> ==> st x = x"
by (metis approx_refl st_unique)
lemma st_hypreal_of_real [simp]: "st (hypreal_of_real x) = hypreal_of_real x"
@@ -1793,7 +1793,7 @@
assumes x: "x \<in> HFinite" and y: "y \<in> HFinite" and xy: "x @= y"
shows "st x = st y"
proof -
- have "st x @= x" "st y @= y" "st x \<in> Reals" "st y \<in> Reals"
+ have "st x @= x" "st y @= y" "st x \<in> \<real>" "st y \<in> \<real>"
by (simp_all add: st_approx_self st_SReal x y)
with xy show ?thesis
by (fast elim: approx_trans approx_trans2 SReal_approx_iff [THEN iffD1])
@@ -1805,13 +1805,13 @@
by (blast intro: approx_st_eq st_eq_approx)
lemma st_Infinitesimal_add_SReal:
- "[| x \<in> Reals; e \<in> Infinitesimal |] ==> st(x + e) = x"
+ "[| x \<in> \<real>; e \<in> Infinitesimal |] ==> st(x + e) = x"
apply (erule st_unique)
apply (erule Infinitesimal_add_approx_self)
done
lemma st_Infinitesimal_add_SReal2:
- "[| x \<in> Reals; e \<in> Infinitesimal |] ==> st(e + x) = x"
+ "[| x \<in> \<real>; e \<in> Infinitesimal |] ==> st(e + x) = x"
apply (erule st_unique)
apply (erule Infinitesimal_add_approx_self2)
done
--- a/src/HOL/NSA/NSCA.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/NSA/NSCA.thy Thu Sep 03 15:50:40 2015 +0200
@@ -29,13 +29,13 @@
by (drule (1) Standard_diff, simp)
lemma SReal_hcmod_hcomplex_of_complex [simp]:
- "hcmod (hcomplex_of_complex r) \<in> Reals"
+ "hcmod (hcomplex_of_complex r) \<in> \<real>"
by (simp add: Reals_eq_Standard)
-lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> Reals"
+lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> \<real>"
by (simp add: Reals_eq_Standard)
-lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> Reals"
+lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> \<real>"
by (simp add: Reals_eq_Standard)
lemma SComplex_divide_numeral:
@@ -482,7 +482,7 @@
by (simp add: hcomplex_HFinite_iff)
lemma SComplex_SReal_hcomplex_of_hypreal:
- "x \<in> Reals ==> hcomplex_of_hypreal x \<in> SComplex"
+ "x \<in> \<real> ==> hcomplex_of_hypreal x \<in> SComplex"
apply (rule Standard_of_hypreal)
apply (simp add: Reals_eq_Standard)
done
--- a/src/HOL/NSA/Star.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/NSA/Star.thy Thu Sep 03 15:50:40 2015 +0200
@@ -53,7 +53,7 @@
lemma STAR_star_of_image_subset: "star_of ` A <= *s* A"
by auto
-lemma STAR_hypreal_of_real_Int: "*s* X Int Reals = hypreal_of_real ` X"
+lemma STAR_hypreal_of_real_Int: "*s* X Int \<real> = hypreal_of_real ` X"
by (auto simp add: SReal_def)
lemma STAR_star_of_Int: "*s* X Int Standard = star_of ` X"
--- a/src/HOL/NSA/StarDef.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/NSA/StarDef.thy Thu Sep 03 15:50:40 2015 +0200
@@ -927,7 +927,7 @@
then show ?case by simp
next
case (Suc n)
- have "\<And>x::'a star. x * ( *f* (\<lambda>x\<Colon>'a. x ^ n)) x = ( *f* (\<lambda>x\<Colon>'a. x * x ^ n)) x"
+ have "\<And>x::'a star. x * ( *f* (\<lambda>x::'a. x ^ n)) x = ( *f* (\<lambda>x::'a. x * x ^ n)) x"
by transfer simp
with Suc show ?case by simp
qed
--- a/src/HOL/Nat.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nat.thy Thu Sep 03 15:50:40 2015 +0200
@@ -85,10 +85,10 @@
done
free_constructors case_nat for
- "0 \<Colon> nat"
+ "0 :: nat"
| Suc pred
where
- "pred (0 \<Colon> nat) = (0 \<Colon> nat)"
+ "pred (0 :: nat) = (0 :: nat)"
apply atomize_elim
apply (rename_tac n, induct_tac n rule: nat_induct0, auto)
apply (simp add: Suc_def Nat_Abs_Nat_inject Nat_Rep_Nat Suc_RepI Suc_Rep_inject'
@@ -99,7 +99,7 @@
-- \<open>Avoid name clashes by prefixing the output of @{text old_rep_datatype} with @{text old}.\<close>
setup \<open>Sign.mandatory_path "old"\<close>
-old_rep_datatype "0 \<Colon> nat" Suc
+old_rep_datatype "0 :: nat" Suc
apply (erule nat_induct0, assumption)
apply (rule nat.inject)
apply (rule nat.distinct(1))
@@ -216,7 +216,7 @@
begin
primrec plus_nat where
- add_0: "0 + n = (n\<Colon>nat)"
+ add_0: "0 + n = (n::nat)"
| add_Suc: "Suc m + n = Suc (m + n)"
lemma add_0_right [simp]: "m + 0 = (m::nat)"
@@ -231,7 +231,7 @@
by simp
primrec minus_nat where
- diff_0 [code]: "m - 0 = (m\<Colon>nat)"
+ diff_0 [code]: "m - 0 = (m::nat)"
| diff_Suc: "m - Suc n = (case m - n of 0 => 0 | Suc k => k)"
declare diff_Suc [simp del]
@@ -263,7 +263,7 @@
One_nat_def [simp]: "1 = Suc 0"
primrec times_nat where
- mult_0: "0 * n = (0\<Colon>nat)"
+ mult_0: "0 * n = (0::nat)"
| mult_Suc: "Suc m * n = n + (m * n)"
lemma mult_0_right [simp]: "(m::nat) * 0 = 0"
@@ -349,7 +349,7 @@
subsubsection \<open>Difference\<close>
-lemma diff_self_eq_0 [simp]: "(m\<Colon>nat) - m = 0"
+lemma diff_self_eq_0 [simp]: "(m::nat) - m = 0"
by (fact diff_cancel)
lemma diff_diff_left: "(i::nat) - j - k = i - (j + k)"
@@ -435,12 +435,12 @@
begin
primrec less_eq_nat where
- "(0\<Colon>nat) \<le> n \<longleftrightarrow> True"
+ "(0::nat) \<le> n \<longleftrightarrow> True"
| "Suc m \<le> n \<longleftrightarrow> (case n of 0 \<Rightarrow> False | Suc n \<Rightarrow> m \<le> n)"
declare less_eq_nat.simps [simp del]
-lemma le0 [iff]: "0 \<le> (n\<Colon>nat)" by (simp add: less_eq_nat.simps)
-lemma [code]: "(0\<Colon>nat) \<le> n \<longleftrightarrow> True" by simp
+lemma le0 [iff]: "0 \<le> (n::nat)" by (simp add: less_eq_nat.simps)
+lemma [code]: "(0::nat) \<le> n \<longleftrightarrow> True" by simp
definition less_nat where
less_eq_Suc_le: "n < m \<longleftrightarrow> Suc n \<le> m"
@@ -451,13 +451,13 @@
lemma Suc_le_eq [code]: "Suc m \<le> n \<longleftrightarrow> m < n"
unfolding less_eq_Suc_le ..
-lemma le_0_eq [iff]: "(n\<Colon>nat) \<le> 0 \<longleftrightarrow> n = 0"
+lemma le_0_eq [iff]: "(n::nat) \<le> 0 \<longleftrightarrow> n = 0"
by (induct n) (simp_all add: less_eq_nat.simps(2))
-lemma not_less0 [iff]: "\<not> n < (0\<Colon>nat)"
+lemma not_less0 [iff]: "\<not> n < (0::nat)"
by (simp add: less_eq_Suc_le)
-lemma less_nat_zero_code [code]: "n < (0\<Colon>nat) \<longleftrightarrow> False"
+lemma less_nat_zero_code [code]: "n < (0::nat) \<longleftrightarrow> False"
by simp
lemma Suc_less_eq [iff]: "Suc m < Suc n \<longleftrightarrow> m < n"
@@ -1290,10 +1290,10 @@
begin
definition
- "(inf \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat) = min"
+ "(inf :: nat \<Rightarrow> nat \<Rightarrow> nat) = min"
definition
- "(sup \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat) = max"
+ "(sup :: nat \<Rightarrow> nat \<Rightarrow> nat) = max"
instance by intro_classes
(auto simp add: inf_nat_def sup_nat_def max_def not_le min_def
@@ -1588,11 +1588,8 @@
context semiring_1
begin
-definition Nats :: "'a set" where
- "Nats = range of_nat"
-
-notation (xsymbols)
- Nats ("\<nat>")
+definition Nats :: "'a set" ("\<nat>")
+ where "\<nat> = range of_nat"
lemma of_nat_in_Nats [simp]: "of_nat n \<in> \<nat>"
by (simp add: Nats_def)
@@ -1937,7 +1934,7 @@
text \<open>@{term "op dvd"} is a partial order\<close>
-interpretation dvd: order "op dvd" "\<lambda>n m \<Colon> nat. n dvd m \<and> \<not> m dvd n"
+interpretation dvd: order "op dvd" "\<lambda>n m :: nat. n dvd m \<and> \<not> m dvd n"
proof qed (auto intro: dvd_refl dvd_trans dvd_antisym)
lemma dvd_diff_nat[simp]: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
@@ -2024,7 +2021,7 @@
begin
definition size_nat where
- [simp, code]: "size (n \<Colon> nat) = n"
+ [simp, code]: "size (n::nat) = n"
instance ..
--- a/src/HOL/Nitpick.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick.thy Thu Sep 03 15:50:40 2015 +0200
@@ -72,7 +72,7 @@
definition card' :: "'a set \<Rightarrow> nat" where
"card' A \<equiv> if finite A then length (SOME xs. set xs = A \<and> distinct xs) else 0"
-definition setsum' :: "('a \<Rightarrow> 'b\<Colon>comm_monoid_add) \<Rightarrow> 'a set \<Rightarrow> 'b" where
+definition setsum' :: "('a \<Rightarrow> 'b::comm_monoid_add) \<Rightarrow> 'a set \<Rightarrow> 'b" where
"setsum' f A \<equiv> if finite A then listsum (map f (SOME xs. set xs = A \<and> distinct xs)) else 0"
inductive fold_graph' :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> bool" where
@@ -193,7 +193,7 @@
definition less_eq_frac :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
[nitpick_simp]: "less_eq_frac q r \<longleftrightarrow> num (plus_frac q (uminus_frac r)) \<le> 0"
-definition of_frac :: "'a \<Rightarrow> 'b\<Colon>{inverse,ring_1}" where
+definition of_frac :: "'a \<Rightarrow> 'b::{inverse,ring_1}" where
"of_frac q \<equiv> of_int (num q) / of_int (denom q)"
axiomatization wf_wfrec :: "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
--- a/src/HOL/Nitpick_Examples/Core_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Core_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -55,7 +55,7 @@
nitpick [card = 1, expect = genuine]
oops
-lemma "{(a\<Colon>'a\<times>'a, b\<Colon>'b)}^-1 = {(b, a)}"
+lemma "{(a::'a\<times>'a, b::'b)}^-1 = {(b, a)}"
nitpick [card = 1-12, expect = none]
by auto
@@ -67,11 +67,11 @@
nitpick [card = 1-20, expect = none]
by auto
-lemma "(a\<Colon>'a\<Rightarrow>'b, a) \<in> Id\<^sup>*"
+lemma "(a::'a\<Rightarrow>'b, a) \<in> Id\<^sup>*"
nitpick [card = 1-2, expect = none]
by auto
-lemma "(a\<Colon>'a\<times>'a, a) \<in> Id\<^sup>* \<union> {(a, b)}\<^sup>*"
+lemma "(a::'a\<times>'a, a) \<in> Id\<^sup>* \<union> {(a, b)}\<^sup>*"
nitpick [card = 1-4, expect = none]
by auto
@@ -79,11 +79,11 @@
nitpick [card = 1-50, expect = none]
by (auto simp: Id_def)
-lemma "((a\<Colon>'a, b\<Colon>'a), (a, b)) \<in> Id"
+lemma "((a::'a, b::'a), (a, b)) \<in> Id"
nitpick [card = 1-10, expect = none]
by (auto simp: Id_def)
-lemma "(x\<Colon>'a\<times>'a) \<in> UNIV"
+lemma "(x::'a\<times>'a) \<in> UNIV"
nitpick [card = 1-50, expect = none]
sorry
@@ -112,13 +112,13 @@
nitpick [card = 50, expect = genuine]
oops
-lemma "(a\<Colon>'a\<times>'a, a\<Colon>'a\<times>'a) \<in> R"
+lemma "(a::'a\<times>'a, a::'a\<times>'a) \<in> R"
nitpick [card = 1, expect = genuine]
nitpick [card = 10, expect = genuine]
nitpick [card = 5, dont_box, expect = genuine]
oops
-lemma "f (g\<Colon>'a\<Rightarrow>'a) = x"
+lemma "f (g::'a\<Rightarrow>'a) = x"
nitpick [card = 3, dont_box, expect = genuine]
nitpick [card = 8, expect = genuine]
oops
@@ -131,7 +131,7 @@
nitpick [card = 10, expect = genuine]
oops
-lemma "(x\<Colon>'a) = (\<lambda>a. \<lambda>b. \<lambda>c. if c then a else b) x x True"
+lemma "(x::'a) = (\<lambda>a. \<lambda>b. \<lambda>c. if c then a else b) x x True"
nitpick [card = 1-10, expect = none]
by auto
@@ -143,7 +143,7 @@
nitpick [card = 2, expect = genuine]
oops
-lemma "(A\<Colon>'a\<times>'a, B\<Colon>'a\<times>'a) \<in> R \<Longrightarrow> (A, B) \<in> R"
+lemma "(A::'a\<times>'a, B::'a\<times>'a) \<in> R \<Longrightarrow> (A, B) \<in> R"
nitpick [card = 15, expect = none]
by auto
@@ -152,7 +152,7 @@
nitpick [card = 1-25, expect = none]
by auto
-lemma "f = (\<lambda>x\<Colon>'a\<times>'b. x)"
+lemma "f = (\<lambda>x::'a\<times>'b. x)"
nitpick [card = 8, expect = genuine]
oops
@@ -168,16 +168,16 @@
nitpick [card 'a = 100, expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a \<Rightarrow> bool. x = y"
+lemma "\<forall>x::'a \<Rightarrow> bool. x = y"
nitpick [card 'a = 1, expect = genuine]
nitpick [card 'a = 100, expect = genuine]
oops
-lemma "\<exists>x\<Colon>'a \<Rightarrow> bool. x = y"
+lemma "\<exists>x::'a \<Rightarrow> bool. x = y"
nitpick [card 'a = 1-15, expect = none]
by auto
-lemma "\<exists>x y\<Colon>'a \<Rightarrow> bool. x = y"
+lemma "\<exists>x y::'a \<Rightarrow> bool. x = y"
nitpick [card = 1-15, expect = none]
by auto
@@ -208,22 +208,22 @@
nitpick [card = 1-2, expect = genuine]
oops
-lemma "\<forall>u\<Colon>'a \<times> 'b. \<exists>v\<Colon>'c. \<forall>w\<Colon>'d. \<exists>x\<Colon>'e \<times> 'f.
+lemma "\<forall>u::'a \<times> 'b. \<exists>v::'c. \<forall>w::'d. \<exists>x::'e \<times> 'f.
f u v w x = f u (g u) w (h u w)"
nitpick [card = 1-2, expect = none]
sorry
-lemma "\<forall>u\<Colon>'a \<times> 'b. \<exists>v\<Colon>'c. \<forall>w\<Colon>'d. \<exists>x\<Colon>'e \<times> 'f.
+lemma "\<forall>u::'a \<times> 'b. \<exists>v::'c. \<forall>w::'d. \<exists>x::'e \<times> 'f.
f u v w x = f u (g u w) w (h u)"
nitpick [card = 1-2, dont_box, expect = genuine]
oops
-lemma "\<forall>u\<Colon>'a \<Rightarrow> 'b. \<exists>v\<Colon>'c. \<forall>w\<Colon>'d. \<exists>x\<Colon>'e \<Rightarrow> 'f.
+lemma "\<forall>u::'a \<Rightarrow> 'b. \<exists>v::'c. \<forall>w::'d. \<exists>x::'e \<Rightarrow> 'f.
f u v w x = f u (g u) w (h u w)"
nitpick [card = 1-2, dont_box, expect = none]
sorry
-lemma "\<forall>u\<Colon>'a \<Rightarrow> 'b. \<exists>v\<Colon>'c. \<forall>w\<Colon>'d. \<exists>x\<Colon>'e \<Rightarrow> 'f.
+lemma "\<forall>u::'a \<Rightarrow> 'b. \<exists>v::'c. \<forall>w::'d. \<exists>x::'e \<Rightarrow> 'f.
f u v w x = f u (g u w) w (h u)"
nitpick [card = 1-2, dont_box, expect = genuine]
oops
@@ -233,7 +233,7 @@
nitpick [card = 2-5, expect = none]
oops
-lemma "\<forall>x\<Colon>'a\<times>'b. if (\<forall>y. x = y) then False else True"
+lemma "\<forall>x::'a\<times>'b. if (\<forall>y. x = y) then False else True"
nitpick [card = 1, expect = genuine]
nitpick [card = 2, expect = none]
oops
@@ -242,7 +242,7 @@
nitpick [expect = none]
sorry
-lemma "(\<exists>x\<Colon>'a. \<forall>y. P x y) \<or> (\<exists>x\<Colon>'a \<times> 'a. \<forall>y. P y x)"
+lemma "(\<exists>x::'a. \<forall>y. P x y) \<or> (\<exists>x::'a \<times> 'a. \<forall>y. P y x)"
nitpick [card 'a = 1, expect = genuine]
oops
@@ -260,7 +260,7 @@
nitpick [expect = none]
by auto
-lemma "let x = (\<forall>x\<Colon>'a \<times> 'b. P x) in if x then x else \<not> x"
+lemma "let x = (\<forall>x::'a \<times> 'b. P x) in if x then x else \<not> x"
nitpick [expect = none]
by auto
@@ -278,7 +278,7 @@
nitpick [expect = none]
by auto
-schematic_lemma "\<exists>x\<Colon>'a \<Rightarrow> 'b. x = ?x"
+schematic_lemma "\<exists>x::'a \<Rightarrow> 'b. x = ?x"
nitpick [expect = none]
by auto
@@ -491,35 +491,35 @@
nitpick [expect = none]
by (simp add: snd_def)
-lemma "fst (x\<Colon>'a\<Rightarrow>'b, y) = x"
+lemma "fst (x::'a\<Rightarrow>'b, y) = x"
nitpick [expect = none]
by (simp add: fst_def)
-lemma "snd (x\<Colon>'a\<Rightarrow>'b, y) = y"
+lemma "snd (x::'a\<Rightarrow>'b, y) = y"
nitpick [expect = none]
by (simp add: snd_def)
-lemma "fst (x, y\<Colon>'a\<Rightarrow>'b) = x"
+lemma "fst (x, y::'a\<Rightarrow>'b) = x"
nitpick [expect = none]
by (simp add: fst_def)
-lemma "snd (x, y\<Colon>'a\<Rightarrow>'b) = y"
+lemma "snd (x, y::'a\<Rightarrow>'b) = y"
nitpick [expect = none]
by (simp add: snd_def)
-lemma "fst (x\<Colon>'a\<times>'b, y) = x"
+lemma "fst (x::'a\<times>'b, y) = x"
nitpick [expect = none]
by (simp add: fst_def)
-lemma "snd (x\<Colon>'a\<times>'b, y) = y"
+lemma "snd (x::'a\<times>'b, y) = y"
nitpick [expect = none]
by (simp add: snd_def)
-lemma "fst (x, y\<Colon>'a\<times>'b) = x"
+lemma "fst (x, y::'a\<times>'b) = x"
nitpick [expect = none]
by (simp add: fst_def)
-lemma "snd (x, y\<Colon>'a\<times>'b) = y"
+lemma "snd (x, y::'a\<times>'b) = y"
nitpick [expect = none]
by (simp add: snd_def)
@@ -626,7 +626,7 @@
nitpick [card = 1-5, expect = none]
by auto
-lemma "x \<in> ((A\<Colon>'a set) - B) \<longleftrightarrow> x \<in> A \<and> x \<notin> B"
+lemma "x \<in> ((A::'a set) - B) \<longleftrightarrow> x \<in> A \<and> x \<notin> B"
nitpick [card = 1-5, expect = none]
by auto
@@ -650,7 +650,7 @@
nitpick [expect = none]
by auto
-lemma "I = (\<lambda>x\<Colon>'a set. x) \<Longrightarrow> uminus = (\<lambda>x. uminus (I x))"
+lemma "I = (\<lambda>x::'a set. x) \<Longrightarrow> uminus = (\<lambda>x. uminus (I x))"
nitpick [card = 1-7, expect = none]
by auto
@@ -662,7 +662,7 @@
nitpick [expect = none]
by auto
-lemma "A = -(A\<Colon>'a set)"
+lemma "A = -(A::'a set)"
nitpick [card 'a = 10, expect = genuine]
oops
@@ -743,7 +743,7 @@
nitpick [expect = genuine]
oops
-lemma "Eps (\<lambda>x. x \<in> P) \<in> (P\<Colon>nat set)"
+lemma "Eps (\<lambda>x. x \<in> P) \<in> (P::nat set)"
nitpick [expect = genuine]
oops
@@ -751,7 +751,7 @@
nitpick [expect = genuine]
oops
-lemma "\<not> (P \<Colon> nat \<Rightarrow> bool) (Eps P)"
+lemma "\<not> (P :: nat \<Rightarrow> bool) (Eps P)"
nitpick [expect = genuine]
oops
@@ -759,7 +759,7 @@
nitpick [expect = none]
sorry
-lemma "(P \<Colon> nat \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> P (Eps P)"
+lemma "(P :: nat \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> P (Eps P)"
nitpick [expect = none]
sorry
@@ -767,7 +767,7 @@
nitpick [expect = genuine]
oops
-lemma "(P \<Colon> nat \<Rightarrow> bool) (The P)"
+lemma "(P :: nat \<Rightarrow> bool) (The P)"
nitpick [expect = genuine]
oops
@@ -775,7 +775,7 @@
nitpick [expect = genuine]
oops
-lemma "\<not> (P \<Colon> nat \<Rightarrow> bool) (The P)"
+lemma "\<not> (P :: nat \<Rightarrow> bool) (The P)"
nitpick [expect = genuine]
oops
@@ -783,7 +783,7 @@
nitpick [expect = genuine]
oops
-lemma "The P \<noteq> (x\<Colon>nat)"
+lemma "The P \<noteq> (x::nat)"
nitpick [expect = genuine]
oops
@@ -791,7 +791,7 @@
nitpick [expect = genuine]
oops
-lemma "P (x\<Colon>nat) \<Longrightarrow> P (The P)"
+lemma "P (x::nat) \<Longrightarrow> P (The P)"
nitpick [expect = genuine]
oops
@@ -799,7 +799,7 @@
nitpick [expect = none]
oops
-lemma "P = {x\<Colon>nat} \<Longrightarrow> (THE x. x \<in> P) \<in> P"
+lemma "P = {x::nat} \<Longrightarrow> (THE x. x \<in> P) \<in> P"
nitpick [expect = none]
oops
@@ -809,23 +809,23 @@
nitpick [expect = genuine]
oops
-lemma "(Q \<Colon> nat \<Rightarrow> bool) (Eps Q)"
+lemma "(Q :: nat \<Rightarrow> bool) (Eps Q)"
nitpick [expect = none] (* unfortunate *)
oops
-lemma "\<not> (Q \<Colon> nat \<Rightarrow> bool) (Eps Q)"
+lemma "\<not> (Q :: nat \<Rightarrow> bool) (Eps Q)"
nitpick [expect = genuine]
oops
-lemma "\<not> (Q \<Colon> nat \<Rightarrow> bool) (Eps Q)"
+lemma "\<not> (Q :: nat \<Rightarrow> bool) (Eps Q)"
nitpick [expect = genuine]
oops
-lemma "(Q\<Colon>'a \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> (Q\<Colon>'a \<Rightarrow> bool) (Eps Q)"
+lemma "(Q::'a \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> (Q::'a \<Rightarrow> bool) (Eps Q)"
nitpick [expect = none]
sorry
-lemma "(Q\<Colon>nat \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> (Q\<Colon>nat \<Rightarrow> bool) (Eps Q)"
+lemma "(Q::nat \<Rightarrow> bool) \<noteq> bot \<Longrightarrow> (Q::nat \<Rightarrow> bool) (Eps Q)"
nitpick [expect = none]
sorry
@@ -833,7 +833,7 @@
nitpick [expect = genuine]
oops
-lemma "(Q\<Colon>nat \<Rightarrow> bool) (The Q)"
+lemma "(Q::nat \<Rightarrow> bool) (The Q)"
nitpick [expect = genuine]
oops
@@ -841,7 +841,7 @@
nitpick [expect = genuine]
oops
-lemma "\<not> (Q\<Colon>nat \<Rightarrow> bool) (The Q)"
+lemma "\<not> (Q::nat \<Rightarrow> bool) (The Q)"
nitpick [expect = genuine]
oops
@@ -849,7 +849,7 @@
nitpick [expect = genuine]
oops
-lemma "The Q \<noteq> (x\<Colon>nat)"
+lemma "The Q \<noteq> (x::nat)"
nitpick [expect = genuine]
oops
@@ -857,15 +857,15 @@
nitpick [expect = genuine]
oops
-lemma "Q (x\<Colon>nat) \<Longrightarrow> Q (The Q)"
+lemma "Q (x::nat) \<Longrightarrow> Q (The Q)"
nitpick [expect = genuine]
oops
-lemma "Q = (\<lambda>x\<Colon>'a. x = a) \<Longrightarrow> (Q\<Colon>'a \<Rightarrow> bool) (The Q)"
+lemma "Q = (\<lambda>x::'a. x = a) \<Longrightarrow> (Q::'a \<Rightarrow> bool) (The Q)"
nitpick [expect = none]
sorry
-lemma "Q = (\<lambda>x\<Colon>nat. x = a) \<Longrightarrow> (Q\<Colon>nat \<Rightarrow> bool) (The Q)"
+lemma "Q = (\<lambda>x::nat. x = a) \<Longrightarrow> (Q::nat \<Rightarrow> bool) (The Q)"
nitpick [expect = none]
sorry
@@ -921,7 +921,7 @@
subsection {* Destructors and Recursors *}
-lemma "(x\<Colon>'a) = (case True of True \<Rightarrow> x | False \<Rightarrow> x)"
+lemma "(x::'a) = (case True of True \<Rightarrow> x | False \<Rightarrow> x)"
nitpick [card = 2, expect = none]
by auto
--- a/src/HOL/Nitpick_Examples/Integer_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Integer_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -232,7 +232,7 @@
nitpick [expect = potential] (* unfortunate *)
sorry
-lemma "(\<Sum>i \<in> labels (Node x t u). f i\<Colon>nat) = f x + (\<Sum>i \<in> labels t. f i) + (\<Sum>i \<in> labels u. f i)"
+lemma "(\<Sum>i \<in> labels (Node x t u). f i::nat) = f x + (\<Sum>i \<in> labels t. f i) + (\<Sum>i \<in> labels u. f i)"
nitpick [expect = potential] (* unfortunate *)
oops
--- a/src/HOL/Nitpick_Examples/Manual_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Manual_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -68,7 +68,7 @@
subsection {* 2.5. Natural Numbers and Integers *}
-lemma "\<lbrakk>i \<le> j; n \<le> (m\<Colon>int)\<rbrakk> \<Longrightarrow> i * n + j * m \<le> i * m + j * n"
+lemma "\<lbrakk>i \<le> j; n \<le> (m::int)\<rbrakk> \<Longrightarrow> i * n + j * m \<le> i * m + j * n"
nitpick [expect = genuine]
nitpick [binary_ints, bits = 16, expect = genuine]
oops
@@ -81,7 +81,7 @@
nitpick [expect = none]
oops
-lemma "P (op +\<Colon>nat\<Rightarrow>nat\<Rightarrow>nat)"
+lemma "P (op +::nat\<Rightarrow>nat\<Rightarrow>nat)"
nitpick [card nat = 1, expect = genuine]
nitpick [card nat = 2, expect = none]
oops
@@ -101,7 +101,7 @@
subsection {* 2.7. Typedefs, Records, Rationals, and Reals *}
-definition "three = {0\<Colon>nat, 1, 2}"
+definition "three = {0::nat, 1, 2}"
typedef three = three
unfolding three_def by blast
@@ -120,9 +120,9 @@
by (auto simp add: equivp_def fun_eq_iff)
definition add_raw where
-"add_raw \<equiv> \<lambda>(x, y) (u, v). (x + (u\<Colon>nat), y + (v\<Colon>nat))"
+"add_raw \<equiv> \<lambda>(x, y) (u, v). (x + (u::nat), y + (v::nat))"
-quotient_definition "add\<Colon>my_int \<Rightarrow> my_int \<Rightarrow> my_int" is add_raw
+quotient_definition "add::my_int \<Rightarrow> my_int \<Rightarrow> my_int" is add_raw
unfolding add_raw_def by auto
lemma "add x y = add x x"
@@ -148,11 +148,11 @@
Xcoord :: int
Ycoord :: int
-lemma "Xcoord (p\<Colon>point) = Xcoord (q\<Colon>point)"
+lemma "Xcoord (p::point) = Xcoord (q::point)"
nitpick [show_types, expect = genuine]
oops
-lemma "4 * x + 3 * (y\<Colon>real) \<noteq> 1 / 2"
+lemma "4 * x + 3 * (y::real) \<noteq> 1 / 2"
nitpick [show_types, expect = genuine]
oops
@@ -172,7 +172,7 @@
oops
inductive even' where
-"even' (0\<Colon>nat)" |
+"even' (0::nat)" |
"even' 2" |
"\<lbrakk>even' m; even' n\<rbrakk> \<Longrightarrow> even' (m + n)"
@@ -185,7 +185,7 @@
oops
coinductive nats where
-"nats (x\<Colon>nat) \<Longrightarrow> nats x"
+"nats (x::nat) \<Longrightarrow> nats x"
lemma "nats = (\<lambda>n. n \<in> {0, 1, 2, 3, 4})"
nitpick [card nat = 10, show_consts, expect = genuine]
@@ -264,7 +264,7 @@
nitpick [verbose, expect = genuine]
oops
-lemma "\<exists>g. \<forall>x\<Colon>'b. g (f x) = x \<Longrightarrow> \<forall>y\<Colon>'a. \<exists>x. y = f x"
+lemma "\<exists>g. \<forall>x::'b. g (f x) = x \<Longrightarrow> \<forall>y::'a. \<exists>x. y = f x"
nitpick [mono, expect = none]
nitpick [expect = genuine]
oops
@@ -273,7 +273,7 @@
subsection {* 2.12. Inductive Properties *}
inductive_set reach where
-"(4\<Colon>nat) \<in> reach" |
+"(4::nat) \<in> reach" |
"n \<in> reach \<Longrightarrow> n < 4 \<Longrightarrow> 3 * n + 1 \<in> reach" |
"n \<in> reach \<Longrightarrow> n + 2 \<in> reach"
@@ -381,7 +381,7 @@
subsection {* 3.2. AA Trees *}
-datatype 'a aa_tree = \<Lambda> | N "'a\<Colon>linorder" nat "'a aa_tree" "'a aa_tree"
+datatype 'a aa_tree = \<Lambda> | N "'a::linorder" nat "'a aa_tree" "'a aa_tree"
primrec data where
"data \<Lambda> = undefined" |
@@ -449,7 +449,7 @@
nitpick [expect = genuine]
oops
-theorem wf_insort\<^sub>1_nat: "wf t \<Longrightarrow> wf (insort\<^sub>1 t (x\<Colon>nat))"
+theorem wf_insort\<^sub>1_nat: "wf t \<Longrightarrow> wf (insort\<^sub>1 t (x::nat))"
nitpick [eval = "insort\<^sub>1 t x", expect = genuine]
oops
--- a/src/HOL/Nitpick_Examples/Mini_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Mini_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -38,20 +38,20 @@
ML_val {* none 1 @{prop "\<forall>x. x = y"} *}
ML_val {* genuine 2 @{prop "\<forall>x. x = y"} *}
ML_val {* none 2 @{prop "\<exists>x. x = y"} *}
-ML_val {* none 2 @{prop "\<forall>x\<Colon>'a \<times> 'a. x = x"} *}
-ML_val {* none 2 @{prop "\<exists>x\<Colon>'a \<times> 'a. x = y"} *}
-ML_val {* genuine 2 @{prop "\<forall>x\<Colon>'a \<times> 'a. x = y"} *}
-ML_val {* none 2 @{prop "\<exists>x\<Colon>'a \<times> 'a. x = y"} *}
+ML_val {* none 2 @{prop "\<forall>x::'a \<times> 'a. x = x"} *}
+ML_val {* none 2 @{prop "\<exists>x::'a \<times> 'a. x = y"} *}
+ML_val {* genuine 2 @{prop "\<forall>x::'a \<times> 'a. x = y"} *}
+ML_val {* none 2 @{prop "\<exists>x::'a \<times> 'a. x = y"} *}
ML_val {* none 1 @{prop "All = Ex"} *}
ML_val {* genuine 2 @{prop "All = Ex"} *}
ML_val {* none 1 @{prop "All P = Ex P"} *}
ML_val {* genuine 2 @{prop "All P = Ex P"} *}
ML_val {* none 4 @{prop "x = y \<longrightarrow> P x = P y"} *}
-ML_val {* none 4 @{prop "(x\<Colon>'a \<times> 'a) = y \<longrightarrow> P x = P y"} *}
-ML_val {* none 2 @{prop "(x\<Colon>'a \<times> 'a) = y \<longrightarrow> P x y = P y x"} *}
-ML_val {* none 4 @{prop "\<exists>x\<Colon>'a \<times> 'a. x = y \<longrightarrow> P x = P y"} *}
-ML_val {* none 2 @{prop "(x\<Colon>'a \<Rightarrow> 'a) = y \<longrightarrow> P x = P y"} *}
-ML_val {* none 2 @{prop "\<exists>x\<Colon>'a \<Rightarrow> 'a. x = y \<longrightarrow> P x = P y"} *}
+ML_val {* none 4 @{prop "(x::'a \<times> 'a) = y \<longrightarrow> P x = P y"} *}
+ML_val {* none 2 @{prop "(x::'a \<times> 'a) = y \<longrightarrow> P x y = P y x"} *}
+ML_val {* none 4 @{prop "\<exists>x::'a \<times> 'a. x = y \<longrightarrow> P x = P y"} *}
+ML_val {* none 2 @{prop "(x::'a \<Rightarrow> 'a) = y \<longrightarrow> P x = P y"} *}
+ML_val {* none 2 @{prop "\<exists>x::'a \<Rightarrow> 'a. x = y \<longrightarrow> P x = P y"} *}
ML_val {* genuine 1 @{prop "(op =) X = Ex"} *}
ML_val {* none 2 @{prop "\<forall>x::'a \<Rightarrow> 'a. x = x"} *}
ML_val {* none 1 @{prop "x = y"} *}
@@ -68,8 +68,8 @@
ML_val {* genuine 1 @{prop "{a} \<noteq> {a, b}"} *}
ML_val {* none 4 @{prop "{}\<^sup>+ = {}"} *}
ML_val {* none 4 @{prop "UNIV\<^sup>+ = UNIV"} *}
-ML_val {* none 4 @{prop "(UNIV \<Colon> ('a \<times> 'b) set) - {} = UNIV"} *}
-ML_val {* none 4 @{prop "{} - (UNIV \<Colon> ('a \<times> 'b) set) = {}"} *}
+ML_val {* none 4 @{prop "(UNIV :: ('a \<times> 'b) set) - {} = UNIV"} *}
+ML_val {* none 4 @{prop "{} - (UNIV :: ('a \<times> 'b) set) = {}"} *}
ML_val {* none 1 @{prop "{(a, b), (b, c)}\<^sup>+ = {(a, b), (a, c), (b, c)}"} *}
ML_val {* genuine 2 @{prop "{(a, b), (b, c)}\<^sup>+ = {(a, b), (a, c), (b, c)}"} *}
ML_val {* none 4 @{prop "a \<noteq> c \<Longrightarrow> {(a, b), (b, c)}\<^sup>+ = {(a, b), (a, c), (b, c)}"} *}
@@ -79,12 +79,12 @@
ML_val {* none 4 @{prop "\<exists>a b. (a, b) = (b, a)"} *}
ML_val {* genuine 2 @{prop "(a, b) = (b, a)"} *}
ML_val {* genuine 2 @{prop "(a, b) \<noteq> (b, a)"} *}
-ML_val {* none 4 @{prop "\<exists>a b\<Colon>'a \<times> 'a. (a, b) = (b, a)"} *}
-ML_val {* genuine 2 @{prop "(a\<Colon>'a \<times> 'a, b) = (b, a)"} *}
-ML_val {* none 4 @{prop "\<exists>a b\<Colon>'a \<times> 'a \<times> 'a. (a, b) = (b, a)"} *}
-ML_val {* genuine 2 @{prop "(a\<Colon>'a \<times> 'a \<times> 'a, b) \<noteq> (b, a)"} *}
-ML_val {* none 4 @{prop "\<exists>a b\<Colon>'a \<Rightarrow> 'a. (a, b) = (b, a)"} *}
-ML_val {* genuine 1 @{prop "(a\<Colon>'a \<Rightarrow> 'a, b) \<noteq> (b, a)"} *}
+ML_val {* none 4 @{prop "\<exists>a b::'a \<times> 'a. (a, b) = (b, a)"} *}
+ML_val {* genuine 2 @{prop "(a::'a \<times> 'a, b) = (b, a)"} *}
+ML_val {* none 4 @{prop "\<exists>a b::'a \<times> 'a \<times> 'a. (a, b) = (b, a)"} *}
+ML_val {* genuine 2 @{prop "(a::'a \<times> 'a \<times> 'a, b) \<noteq> (b, a)"} *}
+ML_val {* none 4 @{prop "\<exists>a b::'a \<Rightarrow> 'a. (a, b) = (b, a)"} *}
+ML_val {* genuine 1 @{prop "(a::'a \<Rightarrow> 'a, b) \<noteq> (b, a)"} *}
ML_val {* none 4 @{prop "fst (a, b) = a"} *}
ML_val {* none 1 @{prop "fst (a, b) = b"} *}
ML_val {* genuine 2 @{prop "fst (a, b) = b"} *}
@@ -104,8 +104,8 @@
ML_val {* none 3 @{prop "f = (\<lambda>a b. (b, a)) \<longrightarrow> f x y = (y, x)"} *}
ML_val {* genuine 2 @{prop "f = (\<lambda>a b. (b, a)) \<longrightarrow> f x y = (x, y)"} *}
ML_val {* none 4 @{prop "f = (\<lambda>x. f x)"} *}
-ML_val {* none 4 @{prop "f = (\<lambda>x. f x\<Colon>'a \<Rightarrow> bool)"} *}
+ML_val {* none 4 @{prop "f = (\<lambda>x. f x::'a \<Rightarrow> bool)"} *}
ML_val {* none 4 @{prop "f = (\<lambda>x y. f x y)"} *}
-ML_val {* none 4 @{prop "f = (\<lambda>x y. f x y\<Colon>'a \<Rightarrow> bool)"} *}
+ML_val {* none 4 @{prop "f = (\<lambda>x y. f x y::'a \<Rightarrow> bool)"} *}
end
--- a/src/HOL/Nitpick_Examples/Mono_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Mono_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -66,78 +66,78 @@
ML {* Nitpick_Mono.trace := false *}
-ML_val {* const @{term "A\<Colon>('a\<Rightarrow>'b)"} *}
-ML_val {* const @{term "(A\<Colon>'a set) = A"} *}
-ML_val {* const @{term "(A\<Colon>'a set set) = A"} *}
-ML_val {* const @{term "(\<lambda>x\<Colon>'a set. a \<in> x)"} *}
-ML_val {* const @{term "{{a\<Colon>'a}} = C"} *}
-ML_val {* const @{term "{f\<Colon>'a\<Rightarrow>nat} = {g\<Colon>'a\<Rightarrow>nat}"} *}
-ML_val {* const @{term "A \<union> (B\<Colon>'a set)"} *}
-ML_val {* const @{term "\<lambda>A B x\<Colon>'a. A x \<or> B x"} *}
-ML_val {* const @{term "P (a\<Colon>'a)"} *}
-ML_val {* const @{term "\<lambda>a\<Colon>'a. b (c (d\<Colon>'a)) (e\<Colon>'a) (f\<Colon>'a)"} *}
-ML_val {* const @{term "\<forall>A\<Colon>'a set. a \<in> A"} *}
-ML_val {* const @{term "\<forall>A\<Colon>'a set. P A"} *}
+ML_val {* const @{term "A::('a\<Rightarrow>'b)"} *}
+ML_val {* const @{term "(A::'a set) = A"} *}
+ML_val {* const @{term "(A::'a set set) = A"} *}
+ML_val {* const @{term "(\<lambda>x::'a set. a \<in> x)"} *}
+ML_val {* const @{term "{{a::'a}} = C"} *}
+ML_val {* const @{term "{f::'a\<Rightarrow>nat} = {g::'a\<Rightarrow>nat}"} *}
+ML_val {* const @{term "A \<union> (B::'a set)"} *}
+ML_val {* const @{term "\<lambda>A B x::'a. A x \<or> B x"} *}
+ML_val {* const @{term "P (a::'a)"} *}
+ML_val {* const @{term "\<lambda>a::'a. b (c (d::'a)) (e::'a) (f::'a)"} *}
+ML_val {* const @{term "\<forall>A::'a set. a \<in> A"} *}
+ML_val {* const @{term "\<forall>A::'a set. P A"} *}
ML_val {* const @{term "P \<or> Q"} *}
-ML_val {* const @{term "A \<union> B = (C\<Colon>'a set)"} *}
-ML_val {* const @{term "(\<lambda>A B x\<Colon>'a. A x \<or> B x) A B = C"} *}
-ML_val {* const @{term "(if P then (A\<Colon>'a set) else B) = C"} *}
-ML_val {* const @{term "let A = (C\<Colon>'a set) in A \<union> B"} *}
-ML_val {* const @{term "THE x\<Colon>'b. P x"} *}
-ML_val {* const @{term "(\<lambda>x\<Colon>'a. False)"} *}
-ML_val {* const @{term "(\<lambda>x\<Colon>'a. True)"} *}
-ML_val {* const @{term "(\<lambda>x\<Colon>'a. False) = (\<lambda>x\<Colon>'a. False)"} *}
-ML_val {* const @{term "(\<lambda>x\<Colon>'a. True) = (\<lambda>x\<Colon>'a. True)"} *}
-ML_val {* const @{term "Let (a\<Colon>'a) A"} *}
-ML_val {* const @{term "A (a\<Colon>'a)"} *}
-ML_val {* const @{term "insert (a\<Colon>'a) A = B"} *}
-ML_val {* const @{term "- (A\<Colon>'a set)"} *}
-ML_val {* const @{term "finite (A\<Colon>'a set)"} *}
-ML_val {* const @{term "\<not> finite (A\<Colon>'a set)"} *}
-ML_val {* const @{term "finite (A\<Colon>'a set set)"} *}
-ML_val {* const @{term "\<lambda>a\<Colon>'a. A a \<and> \<not> B a"} *}
-ML_val {* const @{term "A < (B\<Colon>'a set)"} *}
-ML_val {* const @{term "A \<le> (B\<Colon>'a set)"} *}
-ML_val {* const @{term "[a\<Colon>'a]"} *}
-ML_val {* const @{term "[a\<Colon>'a set]"} *}
-ML_val {* const @{term "[A \<union> (B\<Colon>'a set)]"} *}
-ML_val {* const @{term "[A \<union> (B\<Colon>'a set)] = [C]"} *}
-ML_val {* const @{term "{(\<lambda>x\<Colon>'a. x = a)} = C"} *}
-ML_val {* const @{term "(\<lambda>a\<Colon>'a. \<not> A a) = B"} *}
-ML_val {* const @{prop "\<forall>F f g (h\<Colon>'a set). F f \<and> F g \<and> \<not> f a \<and> g a \<longrightarrow> \<not> f a"} *}
-ML_val {* const @{term "\<lambda>A B x\<Colon>'a. A x \<and> B x \<and> A = B"} *}
-ML_val {* const @{term "p = (\<lambda>(x\<Colon>'a) (y\<Colon>'a). P x \<or> \<not> Q y)"} *}
-ML_val {* const @{term "p = (\<lambda>(x\<Colon>'a) (y\<Colon>'a). p x y \<Colon> bool)"} *}
+ML_val {* const @{term "A \<union> B = (C::'a set)"} *}
+ML_val {* const @{term "(\<lambda>A B x::'a. A x \<or> B x) A B = C"} *}
+ML_val {* const @{term "(if P then (A::'a set) else B) = C"} *}
+ML_val {* const @{term "let A = (C::'a set) in A \<union> B"} *}
+ML_val {* const @{term "THE x::'b. P x"} *}
+ML_val {* const @{term "(\<lambda>x::'a. False)"} *}
+ML_val {* const @{term "(\<lambda>x::'a. True)"} *}
+ML_val {* const @{term "(\<lambda>x::'a. False) = (\<lambda>x::'a. False)"} *}
+ML_val {* const @{term "(\<lambda>x::'a. True) = (\<lambda>x::'a. True)"} *}
+ML_val {* const @{term "Let (a::'a) A"} *}
+ML_val {* const @{term "A (a::'a)"} *}
+ML_val {* const @{term "insert (a::'a) A = B"} *}
+ML_val {* const @{term "- (A::'a set)"} *}
+ML_val {* const @{term "finite (A::'a set)"} *}
+ML_val {* const @{term "\<not> finite (A::'a set)"} *}
+ML_val {* const @{term "finite (A::'a set set)"} *}
+ML_val {* const @{term "\<lambda>a::'a. A a \<and> \<not> B a"} *}
+ML_val {* const @{term "A < (B::'a set)"} *}
+ML_val {* const @{term "A \<le> (B::'a set)"} *}
+ML_val {* const @{term "[a::'a]"} *}
+ML_val {* const @{term "[a::'a set]"} *}
+ML_val {* const @{term "[A \<union> (B::'a set)]"} *}
+ML_val {* const @{term "[A \<union> (B::'a set)] = [C]"} *}
+ML_val {* const @{term "{(\<lambda>x::'a. x = a)} = C"} *}
+ML_val {* const @{term "(\<lambda>a::'a. \<not> A a) = B"} *}
+ML_val {* const @{prop "\<forall>F f g (h::'a set). F f \<and> F g \<and> \<not> f a \<and> g a \<longrightarrow> \<not> f a"} *}
+ML_val {* const @{term "\<lambda>A B x::'a. A x \<and> B x \<and> A = B"} *}
+ML_val {* const @{term "p = (\<lambda>(x::'a) (y::'a). P x \<or> \<not> Q y)"} *}
+ML_val {* const @{term "p = (\<lambda>(x::'a) (y::'a). p x y :: bool)"} *}
ML_val {* const @{term "p = (\<lambda>A B x. A x \<and> \<not> B x) (\<lambda>x. True) (\<lambda>y. x \<noteq> y)"} *}
ML_val {* const @{term "p = (\<lambda>y. x \<noteq> y)"} *}
-ML_val {* const @{term "(\<lambda>x. (p\<Colon>'a\<Rightarrow>bool\<Rightarrow>bool) x False)"} *}
-ML_val {* const @{term "(\<lambda>x y. (p\<Colon>'a\<Rightarrow>'a\<Rightarrow>bool\<Rightarrow>bool) x y False)"} *}
-ML_val {* const @{term "f = (\<lambda>x\<Colon>'a. P x \<longrightarrow> Q x)"} *}
-ML_val {* const @{term "\<forall>a\<Colon>'a. P a"} *}
+ML_val {* const @{term "(\<lambda>x. (p::'a\<Rightarrow>bool\<Rightarrow>bool) x False)"} *}
+ML_val {* const @{term "(\<lambda>x y. (p::'a\<Rightarrow>'a\<Rightarrow>bool\<Rightarrow>bool) x y False)"} *}
+ML_val {* const @{term "f = (\<lambda>x::'a. P x \<longrightarrow> Q x)"} *}
+ML_val {* const @{term "\<forall>a::'a. P a"} *}
-ML_val {* nonconst @{term "\<forall>P (a\<Colon>'a). P a"} *}
-ML_val {* nonconst @{term "THE x\<Colon>'a. P x"} *}
-ML_val {* nonconst @{term "SOME x\<Colon>'a. P x"} *}
-ML_val {* nonconst @{term "(\<lambda>A B x\<Colon>'a. A x \<or> B x) = myunion"} *}
-ML_val {* nonconst @{term "(\<lambda>x\<Colon>'a. False) = (\<lambda>x\<Colon>'a. True)"} *}
-ML_val {* nonconst @{prop "\<forall>F f g (h\<Colon>'a set). F f \<and> F g \<and> \<not> a \<in> f \<and> a \<in> g \<longrightarrow> F h"} *}
+ML_val {* nonconst @{term "\<forall>P (a::'a). P a"} *}
+ML_val {* nonconst @{term "THE x::'a. P x"} *}
+ML_val {* nonconst @{term "SOME x::'a. P x"} *}
+ML_val {* nonconst @{term "(\<lambda>A B x::'a. A x \<or> B x) = myunion"} *}
+ML_val {* nonconst @{term "(\<lambda>x::'a. False) = (\<lambda>x::'a. True)"} *}
+ML_val {* nonconst @{prop "\<forall>F f g (h::'a set). F f \<and> F g \<and> \<not> a \<in> f \<and> a \<in> g \<longrightarrow> F h"} *}
-ML_val {* mono @{prop "Q (\<forall>x\<Colon>'a set. P x)"} *}
-ML_val {* mono @{prop "P (a\<Colon>'a)"} *}
-ML_val {* mono @{prop "{a} = {b\<Colon>'a}"} *}
-ML_val {* mono @{prop "(\<lambda>x. x = a) = (\<lambda>y. y = (b\<Colon>'a))"} *}
-ML_val {* mono @{prop "(a\<Colon>'a) \<in> P \<and> P \<union> P = P"} *}
-ML_val {* mono @{prop "\<forall>F\<Colon>'a set set. P"} *}
-ML_val {* mono @{prop "\<not> (\<forall>F f g (h\<Colon>'a set). F f \<and> F g \<and> \<not> a \<in> f \<and> a \<in> g \<longrightarrow> F h)"} *}
-ML_val {* mono @{prop "\<not> Q (\<forall>x\<Colon>'a set. P x)"} *}
-ML_val {* mono @{prop "\<not> (\<forall>x\<Colon>'a. P x)"} *}
-ML_val {* mono @{prop "myall P = (P = (\<lambda>x\<Colon>'a. True))"} *}
-ML_val {* mono @{prop "myall P = (P = (\<lambda>x\<Colon>'a. False))"} *}
-ML_val {* mono @{prop "\<forall>x\<Colon>'a. P x"} *}
-ML_val {* mono @{term "(\<lambda>A B x\<Colon>'a. A x \<or> B x) \<noteq> myunion"} *}
+ML_val {* mono @{prop "Q (\<forall>x::'a set. P x)"} *}
+ML_val {* mono @{prop "P (a::'a)"} *}
+ML_val {* mono @{prop "{a} = {b::'a}"} *}
+ML_val {* mono @{prop "(\<lambda>x. x = a) = (\<lambda>y. y = (b::'a))"} *}
+ML_val {* mono @{prop "(a::'a) \<in> P \<and> P \<union> P = P"} *}
+ML_val {* mono @{prop "\<forall>F::'a set set. P"} *}
+ML_val {* mono @{prop "\<not> (\<forall>F f g (h::'a set). F f \<and> F g \<and> \<not> a \<in> f \<and> a \<in> g \<longrightarrow> F h)"} *}
+ML_val {* mono @{prop "\<not> Q (\<forall>x::'a set. P x)"} *}
+ML_val {* mono @{prop "\<not> (\<forall>x::'a. P x)"} *}
+ML_val {* mono @{prop "myall P = (P = (\<lambda>x::'a. True))"} *}
+ML_val {* mono @{prop "myall P = (P = (\<lambda>x::'a. False))"} *}
+ML_val {* mono @{prop "\<forall>x::'a. P x"} *}
+ML_val {* mono @{term "(\<lambda>A B x::'a. A x \<or> B x) \<noteq> myunion"} *}
ML_val {* nonmono @{prop "A = (\<lambda>x::'a. True) \<and> A = (\<lambda>x. False)"} *}
-ML_val {* nonmono @{prop "\<forall>F f g (h\<Colon>'a set). F f \<and> F g \<and> \<not> a \<in> f \<and> a \<in> g \<longrightarrow> F h"} *}
+ML_val {* nonmono @{prop "\<forall>F f g (h::'a set). F f \<and> F g \<and> \<not> a \<in> f \<and> a \<in> g \<longrightarrow> F h"} *}
ML {*
val preproc_timeout = seconds 5.0
--- a/src/HOL/Nitpick_Examples/Refute_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Refute_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -56,7 +56,7 @@
nitpick [expect = genuine]
oops
-lemma "(P\<Colon>bool) = Q"
+lemma "(P::bool) = Q"
nitpick [expect = genuine]
oops
@@ -96,11 +96,11 @@
nitpick [expect = genuine]
oops
-lemma "(f\<Colon>'a\<Rightarrow>'b) = g"
+lemma "(f::'a\<Rightarrow>'b) = g"
nitpick [expect = genuine]
oops
-lemma "(f\<Colon>('d\<Rightarrow>'d)\<Rightarrow>('c\<Rightarrow>'d)) = g"
+lemma "(f::('d\<Rightarrow>'d)\<Rightarrow>('c\<Rightarrow>'d)) = g"
nitpick [expect = genuine]
oops
@@ -202,7 +202,7 @@
text {* "Two functions that are equivalent wrt.\ the same predicate 'P' are equal." *}
-lemma "((P\<Colon>('a\<Rightarrow>'b)\<Rightarrow>bool) f = P g) \<longrightarrow> (f x = g x)"
+lemma "((P::('a\<Rightarrow>'b)\<Rightarrow>bool) f = P g) \<longrightarrow> (f x = g x)"
nitpick [expect = genuine]
oops
@@ -367,11 +367,11 @@
subsubsection {* Sets *}
-lemma "P (A\<Colon>'a set)"
+lemma "P (A::'a set)"
nitpick [expect = genuine]
oops
-lemma "P (A\<Colon>'a set set)"
+lemma "P (A::'a set set)"
nitpick [expect = genuine]
oops
@@ -473,33 +473,33 @@
subsubsection {* Operations on Natural Numbers *}
-lemma "(x\<Colon>nat) + y = 0"
+lemma "(x::nat) + y = 0"
nitpick [expect = genuine]
oops
-lemma "(x\<Colon>nat) = x + x"
+lemma "(x::nat) = x + x"
nitpick [expect = genuine]
oops
-lemma "(x\<Colon>nat) - y + y = x"
+lemma "(x::nat) - y + y = x"
nitpick [expect = genuine]
oops
-lemma "(x\<Colon>nat) = x * x"
+lemma "(x::nat) = x * x"
nitpick [expect = genuine]
oops
-lemma "(x\<Colon>nat) < x + y"
+lemma "(x::nat) < x + y"
nitpick [card = 1, expect = genuine]
oops
text {* \<times> *}
-lemma "P (x\<Colon>'a\<times>'b)"
+lemma "P (x::'a\<times>'b)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a\<times>'b. P x"
+lemma "\<forall>x::'a\<times>'b. P x"
nitpick [expect = genuine]
oops
@@ -532,7 +532,7 @@
typedef 'a myTdef = "myTdef :: 'a set"
unfolding myTdef_def by auto
-lemma "(x\<Colon>'a myTdef) = y"
+lemma "(x::'a myTdef) = y"
nitpick [expect = genuine]
oops
@@ -543,7 +543,7 @@
typedef 'a T_bij = "T_bij :: ('a \<Rightarrow> 'a) set"
unfolding T_bij_def by auto
-lemma "P (f\<Colon>(myTdecl myTdef) T_bij)"
+lemma "P (f::(myTdecl myTdef) T_bij)"
nitpick [expect = genuine]
oops
@@ -551,11 +551,11 @@
text {* unit *}
-lemma "P (x\<Colon>unit)"
+lemma "P (x::unit)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>unit. P x"
+lemma "\<forall>x::unit. P x"
nitpick [expect = genuine]
oops
@@ -569,11 +569,11 @@
text {* option *}
-lemma "P (x\<Colon>'a option)"
+lemma "P (x::'a option)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a option. P x"
+lemma "\<forall>x::'a option. P x"
nitpick [expect = genuine]
oops
@@ -591,11 +591,11 @@
text {* + *}
-lemma "P (x\<Colon>'a+'b)"
+lemma "P (x::'a+'b)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a+'b. P x"
+lemma "\<forall>x::'a+'b. P x"
nitpick [expect = genuine]
oops
@@ -619,11 +619,11 @@
datatype T1 = A | B
-lemma "P (x\<Colon>T1)"
+lemma "P (x::T1)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>T1. P x"
+lemma "\<forall>x::T1. P x"
nitpick [expect = genuine]
oops
@@ -655,11 +655,11 @@
datatype 'a T2 = C T1 | D 'a
-lemma "P (x\<Colon>'a T2)"
+lemma "P (x::'a T2)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a T2. P x"
+lemma "\<forall>x::'a T2. P x"
nitpick [expect = genuine]
oops
@@ -687,11 +687,11 @@
datatype ('a, 'b) T3 = E "'a \<Rightarrow> 'b"
-lemma "P (x\<Colon>('a, 'b) T3)"
+lemma "P (x::('a, 'b) T3)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>('a, 'b) T3. P x"
+lemma "\<forall>x::('a, 'b) T3. P x"
nitpick [expect = genuine]
oops
@@ -716,11 +716,11 @@
text {* nat *}
-lemma "P (x\<Colon>nat)"
+lemma "P (x::nat)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>nat. P x"
+lemma "\<forall>x::nat. P x"
nitpick [expect = genuine]
oops
@@ -752,11 +752,11 @@
text {* 'a list *}
-lemma "P (xs\<Colon>'a list)"
+lemma "P (xs::'a list)"
nitpick [expect = genuine]
oops
-lemma "\<forall>xs\<Colon>'a list. P xs"
+lemma "\<forall>xs::'a list. P xs"
nitpick [expect = genuine]
oops
@@ -782,7 +782,7 @@
nitpick [expect = genuine]
oops
-lemma "(xs\<Colon>'a list) = ys"
+lemma "(xs::'a list) = ys"
nitpick [expect = genuine]
oops
@@ -792,11 +792,11 @@
datatype BitList = BitListNil | Bit0 BitList | Bit1 BitList
-lemma "P (x\<Colon>BitList)"
+lemma "P (x::BitList)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>BitList. P x"
+lemma "\<forall>x::BitList. P x"
nitpick [expect = genuine]
oops
@@ -825,11 +825,11 @@
datatype 'a BinTree = Leaf 'a | Node "'a BinTree" "'a BinTree"
-lemma "P (x\<Colon>'a BinTree)"
+lemma "P (x::'a BinTree)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a BinTree. P x"
+lemma "\<forall>x::'a BinTree. P x"
nitpick [expect = genuine]
oops
@@ -860,11 +860,11 @@
datatype 'a aexp = Number 'a | ITE "'a bexp" "'a aexp" "'a aexp"
and 'a bexp = Equal "'a aexp" "'a aexp"
-lemma "P (x\<Colon>'a aexp)"
+lemma "P (x::'a aexp)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a aexp. P x"
+lemma "\<forall>x::'a aexp. P x"
nitpick [expect = genuine]
oops
@@ -872,11 +872,11 @@
nitpick [expect = genuine]
oops
-lemma "P (x\<Colon>'a bexp)"
+lemma "P (x::'a bexp)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a bexp. P x"
+lemma "\<forall>x::'a bexp. P x"
nitpick [expect = genuine]
oops
@@ -913,11 +913,11 @@
datatype X = A | B X | C Y and Y = D X | E Y | F
-lemma "P (x\<Colon>X)"
+lemma "P (x::X)"
nitpick [expect = genuine]
oops
-lemma "P (y\<Colon>Y)"
+lemma "P (y::Y)"
nitpick [expect = genuine]
oops
@@ -1001,7 +1001,7 @@
datatype XOpt = CX "XOpt option" | DX "bool \<Rightarrow> XOpt option"
-lemma "P (x\<Colon>XOpt)"
+lemma "P (x::XOpt)"
nitpick [expect = genuine]
oops
@@ -1019,7 +1019,7 @@
datatype 'a YOpt = CY "('a \<Rightarrow> 'a YOpt) option"
-lemma "P (x\<Colon>'a YOpt)"
+lemma "P (x::'a YOpt)"
nitpick [expect = genuine]
oops
@@ -1033,11 +1033,11 @@
datatype Trie = TR "Trie list"
-lemma "P (x\<Colon>Trie)"
+lemma "P (x::Trie)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>Trie. P x"
+lemma "\<forall>x::Trie. P x"
nitpick [expect = genuine]
oops
@@ -1047,11 +1047,11 @@
datatype InfTree = Leaf | Node "nat \<Rightarrow> InfTree"
-lemma "P (x\<Colon>InfTree)"
+lemma "P (x::InfTree)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>InfTree. P x"
+lemma "\<forall>x::InfTree. P x"
nitpick [expect = genuine]
oops
@@ -1075,11 +1075,11 @@
datatype 'a lambda = Var 'a | App "'a lambda" "'a lambda" | Lam "'a \<Rightarrow> 'a lambda"
-lemma "P (x\<Colon>'a lambda)"
+lemma "P (x::'a lambda)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'a lambda. P x"
+lemma "\<forall>x::'a lambda. P x"
nitpick [expect = genuine]
oops
@@ -1112,11 +1112,11 @@
datatype (dead 'a, 'b) T = C "'a \<Rightarrow> bool" | D "'b list"
datatype 'c U = E "('c, 'c U) T"
-lemma "P (x\<Colon>'c U)"
+lemma "P (x::'c U)"
nitpick [expect = genuine]
oops
-lemma "\<forall>x\<Colon>'c U. P x"
+lemma "\<forall>x::'c U. P x"
nitpick [expect = genuine]
oops
@@ -1130,14 +1130,14 @@
xpos :: 'a
ypos :: 'b
-lemma "(x\<Colon>('a, 'b) point) = y"
+lemma "(x::('a, 'b) point) = y"
nitpick [expect = genuine]
oops
record ('a, 'b, 'c) extpoint = "('a, 'b) point" +
ext :: 'c
-lemma "(x\<Colon>('a, 'b, 'c) extpoint) = y"
+lemma "(x::('a, 'b, 'c) extpoint) = y"
nitpick [expect = genuine]
oops
@@ -1218,7 +1218,7 @@
class classA
-lemma "P (x\<Colon>'a\<Colon>classA)"
+lemma "P (x::'a::classA)"
nitpick [expect = genuine]
oops
@@ -1227,11 +1227,11 @@
class classC =
assumes classC_ax: "\<exists>x y. x \<noteq> y"
-lemma "P (x\<Colon>'a\<Colon>classC)"
+lemma "P (x::'a::classC)"
nitpick [expect = genuine]
oops
-lemma "\<exists>x y. (x\<Colon>'a\<Colon>classC) \<noteq> y"
+lemma "\<exists>x y. (x::'a::classC) \<noteq> y"
nitpick [expect = none]
sorry
@@ -1241,7 +1241,7 @@
fixes classD_const :: "'a \<Rightarrow> 'a"
assumes classD_ax: "classD_const (classD_const x) = classD_const x"
-lemma "P (x\<Colon>'a\<Colon>classD)"
+lemma "P (x::'a::classD)"
nitpick [expect = genuine]
oops
@@ -1249,23 +1249,23 @@
class classE = classC + classD
-lemma "P (x\<Colon>'a\<Colon>classE)"
+lemma "P (x::'a::classE)"
nitpick [expect = genuine]
oops
text {* OFCLASS: *}
-lemma "OFCLASS('a\<Colon>type, type_class)"
+lemma "OFCLASS('a::type, type_class)"
nitpick [expect = none]
apply intro_classes
done
-lemma "OFCLASS('a\<Colon>classC, type_class)"
+lemma "OFCLASS('a::classC, type_class)"
nitpick [expect = none]
apply intro_classes
done
-lemma "OFCLASS('a\<Colon>type, classC_class)"
+lemma "OFCLASS('a::type, classC_class)"
nitpick [expect = genuine]
oops
@@ -1274,19 +1274,19 @@
consts inverse :: "'a \<Rightarrow> 'a"
defs (overloaded)
-inverse_bool: "inverse (b\<Colon>bool) \<equiv> \<not> b"
-inverse_set: "inverse (S\<Colon>'a set) \<equiv> -S"
+inverse_bool: "inverse (b::bool) \<equiv> \<not> b"
+inverse_set: "inverse (S::'a set) \<equiv> -S"
inverse_pair: "inverse p \<equiv> (inverse (fst p), inverse (snd p))"
lemma "inverse b"
nitpick [expect = genuine]
oops
-lemma "P (inverse (S\<Colon>'a set))"
+lemma "P (inverse (S::'a set))"
nitpick [expect = genuine]
oops
-lemma "P (inverse (p\<Colon>'a\<times>'b))"
+lemma "P (inverse (p::'a\<times>'b))"
nitpick [expect = genuine]
oops
--- a/src/HOL/Nitpick_Examples/Special_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Special_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -131,7 +131,7 @@
sorry
lemma "\<forall>a. g a = a
- \<Longrightarrow> \<exists>b\<^sub>1 b\<^sub>2 b\<^sub>3 b\<^sub>4 b\<^sub>5 b\<^sub>6 b\<^sub>7 b\<^sub>8 b\<^sub>9 b\<^sub>10 (b\<^sub>11\<Colon>nat).
+ \<Longrightarrow> \<exists>b\<^sub>1 b\<^sub>2 b\<^sub>3 b\<^sub>4 b\<^sub>5 b\<^sub>6 b\<^sub>7 b\<^sub>8 b\<^sub>9 b\<^sub>10 (b\<^sub>11::nat).
b\<^sub>1 < b\<^sub>11 \<and> f5 g x = f5 (\<lambda>a. if b\<^sub>1 < b\<^sub>11 then a else h b\<^sub>2) x"
nitpick [expect = potential]
nitpick [dont_specialize, expect = none]
@@ -140,7 +140,7 @@
sorry
lemma "\<forall>a. g a = a
- \<Longrightarrow> \<exists>b\<^sub>1 b\<^sub>2 b\<^sub>3 b\<^sub>4 b\<^sub>5 b\<^sub>6 b\<^sub>7 b\<^sub>8 b\<^sub>9 b\<^sub>10 (b\<^sub>11\<Colon>nat).
+ \<Longrightarrow> \<exists>b\<^sub>1 b\<^sub>2 b\<^sub>3 b\<^sub>4 b\<^sub>5 b\<^sub>6 b\<^sub>7 b\<^sub>8 b\<^sub>9 b\<^sub>10 (b\<^sub>11::nat).
b\<^sub>1 < b\<^sub>11
\<and> f5 g x = f5 (\<lambda>a. if b\<^sub>1 < b\<^sub>11 then
a
@@ -154,7 +154,7 @@
sorry
lemma "\<forall>a. g a = a
- \<Longrightarrow> \<exists>b\<^sub>1 b\<^sub>2 b\<^sub>3 b\<^sub>4 b\<^sub>5 b\<^sub>6 b\<^sub>7 b\<^sub>8 b\<^sub>9 b\<^sub>10 (b\<^sub>11\<Colon>nat).
+ \<Longrightarrow> \<exists>b\<^sub>1 b\<^sub>2 b\<^sub>3 b\<^sub>4 b\<^sub>5 b\<^sub>6 b\<^sub>7 b\<^sub>8 b\<^sub>9 b\<^sub>10 (b\<^sub>11::nat).
b\<^sub>1 < b\<^sub>11
\<and> f5 g x = f5 (\<lambda>a. if b\<^sub>1 \<ge> b\<^sub>11 then
a
--- a/src/HOL/Nitpick_Examples/Typedef_Nits.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nitpick_Examples/Typedef_Nits.thy Thu Sep 03 15:50:40 2015 +0200
@@ -14,7 +14,7 @@
nitpick_params [verbose, card = 1-4, sat_solver = MiniSat_JNI, max_threads = 1,
timeout = 240]
-definition "three = {0\<Colon>nat, 1, 2}"
+definition "three = {0::nat, 1, 2}"
typedef three = three
unfolding three_def by blast
@@ -22,37 +22,37 @@
definition B :: three where "B \<equiv> Abs_three 1"
definition C :: three where "C \<equiv> Abs_three 2"
-lemma "x = (y\<Colon>three)"
+lemma "x = (y::three)"
nitpick [expect = genuine]
oops
-definition "one_or_two = {undefined False\<Colon>'a, undefined True}"
+definition "one_or_two = {undefined False::'a, undefined True}"
typedef 'a one_or_two = "one_or_two :: 'a set"
unfolding one_or_two_def by auto
-lemma "x = (y\<Colon>unit one_or_two)"
+lemma "x = (y::unit one_or_two)"
nitpick [expect = none]
sorry
-lemma "x = (y\<Colon>bool one_or_two)"
+lemma "x = (y::bool one_or_two)"
nitpick [expect = genuine]
oops
-lemma "undefined False \<longleftrightarrow> undefined True \<Longrightarrow> x = (y\<Colon>bool one_or_two)"
+lemma "undefined False \<longleftrightarrow> undefined True \<Longrightarrow> x = (y::bool one_or_two)"
nitpick [expect = none]
sorry
-lemma "undefined False \<longleftrightarrow> undefined True \<Longrightarrow> \<exists>x (y\<Colon>bool one_or_two). x \<noteq> y"
+lemma "undefined False \<longleftrightarrow> undefined True \<Longrightarrow> \<exists>x (y::bool one_or_two). x \<noteq> y"
nitpick [card = 1, expect = potential] (* unfortunate *)
oops
-lemma "\<exists>x (y\<Colon>bool one_or_two). x \<noteq> y"
+lemma "\<exists>x (y::bool one_or_two). x \<noteq> y"
nitpick [card = 1, expect = potential] (* unfortunate *)
nitpick [card = 2, expect = none]
oops
-definition "bounded = {n\<Colon>nat. finite (UNIV \<Colon> 'a set) \<longrightarrow> n < card (UNIV \<Colon> 'a set)}"
+definition "bounded = {n::nat. finite (UNIV :: 'a set) \<longrightarrow> n < card (UNIV :: 'a set)}"
typedef 'a bounded = "bounded(TYPE('a))"
unfolding bounded_def
@@ -60,23 +60,23 @@
apply (case_tac "card UNIV = 0")
by auto
-lemma "x = (y\<Colon>unit bounded)"
+lemma "x = (y::unit bounded)"
nitpick [expect = none]
sorry
-lemma "x = (y\<Colon>bool bounded)"
+lemma "x = (y::bool bounded)"
nitpick [expect = genuine]
oops
-lemma "x \<noteq> (y\<Colon>bool bounded) \<Longrightarrow> z = x \<or> z = y"
+lemma "x \<noteq> (y::bool bounded) \<Longrightarrow> z = x \<or> z = y"
nitpick [expect = potential] (* unfortunate *)
sorry
-lemma "x \<noteq> (y\<Colon>(bool \<times> bool) bounded) \<Longrightarrow> z = x \<or> z = y"
+lemma "x \<noteq> (y::(bool \<times> bool) bounded) \<Longrightarrow> z = x \<or> z = y"
nitpick [card = 1-5, expect = genuine]
oops
-lemma "True \<equiv> ((\<lambda>x\<Colon>bool. x) = (\<lambda>x. x))"
+lemma "True \<equiv> ((\<lambda>x::bool. x) = (\<lambda>x. x))"
nitpick [expect = none]
by (rule True_def)
@@ -183,7 +183,7 @@
nitpick [card = 1, expect = none]
by (rule Rep_rat_inverse)
-typedef check = "{x\<Colon>nat. x < 2}" by (rule exI[of _ 0], auto)
+typedef check = "{x::nat. x < 2}" by (rule exI[of _ 0], auto)
lemma "Rep_check (Abs_check n) = n \<Longrightarrow> n < 2"
nitpick [card = 1-3, expect = none]
--- a/src/HOL/Nominal/Examples/Fsub.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nominal/Examples/Fsub.thy Thu Sep 03 15:50:40 2015 +0200
@@ -17,7 +17,7 @@
section {* Types for Names, Nominal Datatype Declaration for Types and Terms *}
no_syntax
- "_Map" :: "maplets => 'a ~=> 'b" ("(1[_])")
+ "_Map" :: "maplets => 'a \<rightharpoonup> 'b" ("(1[_])")
text {* The main point of this solution is to use names everywhere (be they bound,
binding or free). In System \FSUB{} there are two kinds of names corresponding to
--- a/src/HOL/Nominal/Examples/Pattern.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Nominal/Examples/Pattern.thy Thu Sep 03 15:50:40 2015 +0200
@@ -5,7 +5,7 @@
begin
no_syntax
- "_Map" :: "maplets => 'a ~=> 'b" ("(1[_])")
+ "_Map" :: "maplets => 'a \<rightharpoonup> 'b" ("(1[_])")
atom_decl name
--- a/src/HOL/Number_Theory/UniqueFactorization.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Number_Theory/UniqueFactorization.thy Thu Sep 03 15:50:40 2015 +0200
@@ -725,7 +725,7 @@
(is "_ = ?z")
proof -
have [arith]: "?z > 0"
- by (rule setprod_pos_nat) auto
+ by auto
have aux: "\<And>p. prime p \<Longrightarrow> multiplicity p ?z = min (multiplicity p x) (multiplicity p y)"
apply (subst multiplicity_prod_prime_powers_nat)
apply auto
@@ -759,7 +759,7 @@
(is "_ = ?z")
proof -
have [arith]: "?z > 0"
- by (rule setprod_pos_nat, auto)
+ by auto
have aux: "\<And>p. prime p \<Longrightarrow> multiplicity p ?z = max (multiplicity p x) (multiplicity p y)"
apply (subst multiplicity_prod_prime_powers_nat)
apply auto
--- a/src/HOL/Old_Number_Theory/Primes.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Old_Number_Theory/Primes.thy Thu Sep 03 15:50:40 2015 +0200
@@ -108,7 +108,7 @@
declare nat_mult_dvd_cancel_disj[presburger]
lemma nat_mult_dvd_cancel_disj'[presburger]:
- "(m\<Colon>nat)*k dvd n*k \<longleftrightarrow> k = 0 \<or> m dvd n" unfolding mult.commute[of m k] mult.commute[of n k] by presburger
+ "(m::nat)*k dvd n*k \<longleftrightarrow> k = 0 \<or> m dvd n" unfolding mult.commute[of m k] mult.commute[of n k] by presburger
lemma divides_mul_l: "(a::nat) dvd b ==> (c * a) dvd (c * b)"
by presburger
--- a/src/HOL/Option.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Option.thy Thu Sep 03 15:50:40 2015 +0200
@@ -17,89 +17,86 @@
lemma [case_names None Some, cases type: option]:
-- \<open>for backward compatibility -- names of variables differ\<close>
"(y = None \<Longrightarrow> P) \<Longrightarrow> (\<And>a. y = Some a \<Longrightarrow> P) \<Longrightarrow> P"
-by (rule option.exhaust)
+ by (rule option.exhaust)
lemma [case_names None Some, induct type: option]:
-- \<open>for backward compatibility -- names of variables differ\<close>
"P None \<Longrightarrow> (\<And>option. P (Some option)) \<Longrightarrow> P option"
-by (rule option.induct)
+ by (rule option.induct)
text \<open>Compatibility:\<close>
-
setup \<open>Sign.mandatory_path "option"\<close>
-
lemmas inducts = option.induct
lemmas cases = option.case
-
setup \<open>Sign.parent_path\<close>
-lemma not_None_eq [iff]: "(x ~= None) = (EX y. x = Some y)"
+lemma not_None_eq [iff]: "x \<noteq> None \<longleftrightarrow> (\<exists>y. x = Some y)"
by (induct x) auto
-lemma not_Some_eq [iff]: "(ALL y. x ~= Some y) = (x = None)"
+lemma not_Some_eq [iff]: "(\<forall>y. x \<noteq> Some y) \<longleftrightarrow> x = None"
by (induct x) auto
-text\<open>Although it may appear that both of these equalities are helpful
+text \<open>Although it may appear that both of these equalities are helpful
only when applied to assumptions, in practice it seems better to give
them the uniform iff attribute.\<close>
lemma inj_Some [simp]: "inj_on Some A"
-by (rule inj_onI) simp
+ by (rule inj_onI) simp
lemma case_optionE:
- assumes c: "(case x of None => P | Some y => Q y)"
+ assumes c: "(case x of None \<Rightarrow> P | Some y \<Rightarrow> Q y)"
obtains
(None) "x = None" and P
| (Some) y where "x = Some y" and "Q y"
using c by (cases x) simp_all
lemma split_option_all: "(\<forall>x. P x) \<longleftrightarrow> P None \<and> (\<forall>x. P (Some x))"
-by (auto intro: option.induct)
+ by (auto intro: option.induct)
lemma split_option_ex: "(\<exists>x. P x) \<longleftrightarrow> P None \<or> (\<exists>x. P (Some x))"
-using split_option_all[of "\<lambda>x. \<not>P x"] by blast
+ using split_option_all[of "\<lambda>x. \<not> P x"] by blast
lemma UNIV_option_conv: "UNIV = insert None (range Some)"
-by(auto intro: classical)
+ by (auto intro: classical)
lemma rel_option_None1 [simp]: "rel_option P None x \<longleftrightarrow> x = None"
-by(cases x) simp_all
+ by (cases x) simp_all
lemma rel_option_None2 [simp]: "rel_option P x None \<longleftrightarrow> x = None"
-by(cases x) simp_all
+ by (cases x) simp_all
-lemma rel_option_inf: "inf (rel_option A) (rel_option B) = rel_option (inf A B)" (is "?lhs = ?rhs")
-proof(rule antisym)
- show "?lhs \<le> ?rhs" by(auto elim!: option.rel_cases)
-qed(auto elim: option.rel_mono_strong)
+lemma rel_option_inf: "inf (rel_option A) (rel_option B) = rel_option (inf A B)"
+ (is "?lhs = ?rhs")
+proof (rule antisym)
+ show "?lhs \<le> ?rhs" by (auto elim: option.rel_cases)
+ show "?rhs \<le> ?lhs" by (auto elim: option.rel_mono_strong)
+qed
lemma rel_option_reflI:
"(\<And>x. x \<in> set_option y \<Longrightarrow> P x x) \<Longrightarrow> rel_option P y y"
-by(cases y) auto
+ by (cases y) auto
subsubsection \<open>Operations\<close>
-lemma ospec [dest]: "(ALL x:set_option A. P x) ==> A = Some x ==> P x"
+lemma ospec [dest]: "(\<forall>x\<in>set_option A. P x) \<Longrightarrow> A = Some x \<Longrightarrow> P x"
by simp
setup \<open>map_theory_claset (fn ctxt => ctxt addSD2 ("ospec", @{thm ospec}))\<close>
-lemma elem_set [iff]: "(x : set_option xo) = (xo = Some x)"
+lemma elem_set [iff]: "(x \<in> set_option xo) = (xo = Some x)"
by (cases xo) auto
lemma set_empty_eq [simp]: "(set_option xo = {}) = (xo = None)"
by (cases xo) auto
-lemma map_option_case: "map_option f y = (case y of None => None | Some x => Some (f x))"
+lemma map_option_case: "map_option f y = (case y of None \<Rightarrow> None | Some x \<Rightarrow> Some (f x))"
by (auto split: option.split)
-lemma map_option_is_None [iff]:
- "(map_option f opt = None) = (opt = None)"
+lemma map_option_is_None [iff]: "(map_option f opt = None) = (opt = None)"
by (simp add: map_option_case split add: option.split)
-lemma map_option_eq_Some [iff]:
- "(map_option f xo = Some y) = (EX z. xo = Some z & f z = y)"
+lemma map_option_eq_Some [iff]: "(map_option f xo = Some y) = (\<exists>z. xo = Some z \<and> f z = y)"
by (simp add: map_option_case split add: option.split)
lemma map_option_o_case_sum [simp]:
@@ -107,121 +104,124 @@
by (rule o_case_sum)
lemma map_option_cong: "x = y \<Longrightarrow> (\<And>a. y = Some a \<Longrightarrow> f a = g a) \<Longrightarrow> map_option f x = map_option g y"
-by (cases x) auto
+ by (cases x) auto
functor map_option: map_option
-by(simp_all add: option.map_comp fun_eq_iff option.map_id)
+ by (simp_all add: option.map_comp fun_eq_iff option.map_id)
-lemma case_map_option [simp]:
- "case_option g h (map_option f x) = case_option g (h \<circ> f) x"
+lemma case_map_option [simp]: "case_option g h (map_option f x) = case_option g (h \<circ> f) x"
by (cases x) simp_all
lemma rel_option_iff:
"rel_option R x y = (case (x, y) of (None, None) \<Rightarrow> True
| (Some x, Some y) \<Rightarrow> R x y
| _ \<Rightarrow> False)"
-by (auto split: prod.split option.split)
+ by (auto split: prod.split option.split)
+
-definition is_none :: "'a option \<Rightarrow> bool"
-where [code_post]: "is_none x \<longleftrightarrow> x = None"
+context
+begin
+
+qualified definition is_none :: "'a option \<Rightarrow> bool"
+ where [code_post]: "is_none x \<longleftrightarrow> x = None"
lemma is_none_simps [simp]:
"is_none None"
"\<not> is_none (Some x)"
-by(simp_all add: is_none_def)
+ by (simp_all add: is_none_def)
lemma is_none_code [code]:
"is_none None = True"
"is_none (Some x) = False"
-by simp_all
+ by simp_all
lemma rel_option_unfold:
"rel_option R x y \<longleftrightarrow>
(is_none x \<longleftrightarrow> is_none y) \<and> (\<not> is_none x \<longrightarrow> \<not> is_none y \<longrightarrow> R (the x) (the y))"
-by(simp add: rel_option_iff split: option.split)
+ by (simp add: rel_option_iff split: option.split)
lemma rel_optionI:
"\<lbrakk> is_none x \<longleftrightarrow> is_none y; \<lbrakk> \<not> is_none x; \<not> is_none y \<rbrakk> \<Longrightarrow> P (the x) (the y) \<rbrakk>
\<Longrightarrow> rel_option P x y"
-by(simp add: rel_option_unfold)
+ by (simp add: rel_option_unfold)
lemma is_none_map_option [simp]: "is_none (map_option f x) \<longleftrightarrow> is_none x"
-by(simp add: is_none_def)
+ by (simp add: is_none_def)
lemma the_map_option: "\<not> is_none x \<Longrightarrow> the (map_option f x) = f (the x)"
-by(clarsimp simp add: is_none_def)
+ by (auto simp add: is_none_def)
-primrec bind :: "'a option \<Rightarrow> ('a \<Rightarrow> 'b option) \<Rightarrow> 'b option" where
-bind_lzero: "bind None f = None" |
-bind_lunit: "bind (Some x) f = f x"
+qualified primrec bind :: "'a option \<Rightarrow> ('a \<Rightarrow> 'b option) \<Rightarrow> 'b option"
+where
+ bind_lzero: "bind None f = None"
+| bind_lunit: "bind (Some x) f = f x"
lemma is_none_bind: "is_none (bind f g) \<longleftrightarrow> is_none f \<or> is_none (g (the f))"
-by(cases f) simp_all
+ by (cases f) simp_all
lemma bind_runit[simp]: "bind x Some = x"
-by (cases x) auto
+ by (cases x) auto
lemma bind_assoc[simp]: "bind (bind x f) g = bind x (\<lambda>y. bind (f y) g)"
-by (cases x) auto
+ by (cases x) auto
lemma bind_rzero[simp]: "bind x (\<lambda>x. None) = None"
-by (cases x) auto
+ by (cases x) auto
-lemma bind_cong: "x = y \<Longrightarrow> (\<And>a. y = Some a \<Longrightarrow> f a = g a) \<Longrightarrow> bind x f = bind y g"
-by (cases x) auto
+qualified lemma bind_cong: "x = y \<Longrightarrow> (\<And>a. y = Some a \<Longrightarrow> f a = g a) \<Longrightarrow> bind x f = bind y g"
+ by (cases x) auto
-lemma bind_split: "P (bind m f)
- \<longleftrightarrow> (m = None \<longrightarrow> P None) \<and> (\<forall>v. m=Some v \<longrightarrow> P (f v))"
- by (cases m) auto
+lemma bind_split: "P (bind m f) \<longleftrightarrow> (m = None \<longrightarrow> P None) \<and> (\<forall>v. m = Some v \<longrightarrow> P (f v))"
+ by (cases m) auto
-lemma bind_split_asm: "P (bind m f) = (\<not>(
- m=None \<and> \<not>P None
- \<or> (\<exists>x. m=Some x \<and> \<not>P (f x))))"
+lemma bind_split_asm: "P (bind m f) \<longleftrightarrow> \<not> (m = None \<and> \<not> P None \<or> (\<exists>x. m = Some x \<and> \<not> P (f x)))"
by (cases m) auto
lemmas bind_splits = bind_split bind_split_asm
lemma bind_eq_Some_conv: "bind f g = Some x \<longleftrightarrow> (\<exists>y. f = Some y \<and> g y = Some x)"
-by(cases f) simp_all
+ by (cases f) simp_all
lemma map_option_bind: "map_option f (bind x g) = bind x (map_option f \<circ> g)"
-by(cases x) simp_all
+ by (cases x) simp_all
lemma bind_option_cong:
"\<lbrakk> x = y; \<And>z. z \<in> set_option y \<Longrightarrow> f z = g z \<rbrakk> \<Longrightarrow> bind x f = bind y g"
-by(cases y) simp_all
+ by (cases y) simp_all
lemma bind_option_cong_simp:
"\<lbrakk> x = y; \<And>z. z \<in> set_option y =simp=> f z = g z \<rbrakk> \<Longrightarrow> bind x f = bind y g"
-unfolding simp_implies_def by(rule bind_option_cong)
+ unfolding simp_implies_def by (rule bind_option_cong)
-lemma bind_option_cong_code: "x = y \<Longrightarrow> bind x f = bind y f" by simp
+lemma bind_option_cong_code: "x = y \<Longrightarrow> bind x f = bind y f"
+ by simp
+
+end
+
setup \<open>Code_Simp.map_ss (Simplifier.add_cong @{thm bind_option_cong_code})\<close>
-definition these :: "'a option set \<Rightarrow> 'a set"
-where
- "these A = the ` {x \<in> A. x \<noteq> None}"
+context
+begin
-lemma these_empty [simp]:
- "these {} = {}"
+qualified definition these :: "'a option set \<Rightarrow> 'a set"
+ where "these A = the ` {x \<in> A. x \<noteq> None}"
+
+lemma these_empty [simp]: "these {} = {}"
by (simp add: these_def)
-lemma these_insert_None [simp]:
- "these (insert None A) = these A"
+lemma these_insert_None [simp]: "these (insert None A) = these A"
by (auto simp add: these_def)
-lemma these_insert_Some [simp]:
- "these (insert (Some x) A) = insert x (these A)"
+lemma these_insert_Some [simp]: "these (insert (Some x) A) = insert x (these A)"
proof -
have "{y \<in> insert (Some x) A. y \<noteq> None} = insert (Some x) {y \<in> A. y \<noteq> None}"
by auto
then show ?thesis by (simp add: these_def)
qed
-lemma in_these_eq:
- "x \<in> these A \<longleftrightarrow> Some x \<in> A"
+lemma in_these_eq: "x \<in> these A \<longleftrightarrow> Some x \<in> A"
proof
assume "Some x \<in> A"
then obtain B where "A = insert (Some x) B" by auto
@@ -231,30 +231,26 @@
then show "Some x \<in> A" by (auto simp add: these_def)
qed
-lemma these_image_Some_eq [simp]:
- "these (Some ` A) = A"
+lemma these_image_Some_eq [simp]: "these (Some ` A) = A"
by (auto simp add: these_def intro!: image_eqI)
-lemma Some_image_these_eq:
- "Some ` these A = {x\<in>A. x \<noteq> None}"
+lemma Some_image_these_eq: "Some ` these A = {x\<in>A. x \<noteq> None}"
by (auto simp add: these_def image_image intro!: image_eqI)
-lemma these_empty_eq:
- "these B = {} \<longleftrightarrow> B = {} \<or> B = {None}"
+lemma these_empty_eq: "these B = {} \<longleftrightarrow> B = {} \<or> B = {None}"
by (auto simp add: these_def)
-lemma these_not_empty_eq:
- "these B \<noteq> {} \<longleftrightarrow> B \<noteq> {} \<and> B \<noteq> {None}"
+lemma these_not_empty_eq: "these B \<noteq> {} \<longleftrightarrow> B \<noteq> {} \<and> B \<noteq> {None}"
by (auto simp add: these_empty_eq)
-hide_const (open) bind these
-hide_fact (open) bind_cong
+end
subsection \<open>Transfer rules for the Transfer package\<close>
context
begin
+
interpretation lifting_syntax .
lemma option_bind_transfer [transfer_rule]:
@@ -264,7 +260,7 @@
lemma pred_option_parametric [transfer_rule]:
"((A ===> op =) ===> rel_option A ===> op =) pred_option pred_option"
-by(rule rel_funI)+(auto simp add: rel_option_unfold is_none_def dest: rel_funD)
+ by (rule rel_funI)+ (auto simp add: rel_option_unfold Option.is_none_def dest: rel_funD)
end
@@ -276,17 +272,15 @@
by (auto simp add: UNIV_option_conv elim: finite_imageD intro: inj_Some)
instance option :: (finite) finite
- by default (simp add: UNIV_option_conv)
+ by standard (simp add: UNIV_option_conv)
subsubsection \<open>Code generator setup\<close>
lemma equal_None_code_unfold [code_unfold]:
- "HOL.equal x None \<longleftrightarrow> is_none x"
- "HOL.equal None = is_none"
- by (auto simp add: equal is_none_def)
-
-hide_const (open) is_none
+ "HOL.equal x None \<longleftrightarrow> Option.is_none x"
+ "HOL.equal None = Option.is_none"
+ by (auto simp add: equal Option.is_none_def)
code_printing
type_constructor option \<rightharpoonup>
--- a/src/HOL/Orderings.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Orderings.thy Thu Sep 03 15:50:40 2015 +0200
@@ -1034,21 +1034,21 @@
context order
begin
-definition mono :: "('a \<Rightarrow> 'b\<Colon>order) \<Rightarrow> bool" where
+definition mono :: "('a \<Rightarrow> 'b::order) \<Rightarrow> bool" where
"mono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)"
lemma monoI [intro?]:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
shows "(\<And>x y. x \<le> y \<Longrightarrow> f x \<le> f y) \<Longrightarrow> mono f"
unfolding mono_def by iprover
lemma monoD [dest?]:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
shows "mono f \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
unfolding mono_def by iprover
lemma monoE:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
assumes "mono f"
assumes "x \<le> y"
obtains "f x \<le> f y"
@@ -1056,21 +1056,21 @@
from assms show "f x \<le> f y" by (simp add: mono_def)
qed
-definition antimono :: "('a \<Rightarrow> 'b\<Colon>order) \<Rightarrow> bool" where
+definition antimono :: "('a \<Rightarrow> 'b::order) \<Rightarrow> bool" where
"antimono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<ge> f y)"
lemma antimonoI [intro?]:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
shows "(\<And>x y. x \<le> y \<Longrightarrow> f x \<ge> f y) \<Longrightarrow> antimono f"
unfolding antimono_def by iprover
lemma antimonoD [dest?]:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
shows "antimono f \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<ge> f y"
unfolding antimono_def by iprover
lemma antimonoE:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
assumes "antimono f"
assumes "x \<le> y"
obtains "f x \<ge> f y"
@@ -1078,7 +1078,7 @@
from assms show "f x \<ge> f y" by (simp add: antimono_def)
qed
-definition strict_mono :: "('a \<Rightarrow> 'b\<Colon>order) \<Rightarrow> bool" where
+definition strict_mono :: "('a \<Rightarrow> 'b::order) \<Rightarrow> bool" where
"strict_mono f \<longleftrightarrow> (\<forall>x y. x < y \<longrightarrow> f x < f y)"
lemma strict_monoI [intro?]:
@@ -1112,7 +1112,7 @@
begin
lemma mono_invE:
- fixes f :: "'a \<Rightarrow> 'b\<Colon>order"
+ fixes f :: "'a \<Rightarrow> 'b::order"
assumes "mono f"
assumes "f x < f y"
obtains "x \<le> y"
@@ -1180,10 +1180,10 @@
lemma max_absorb2: "x \<le> y \<Longrightarrow> max x y = y"
by (simp add: max_def)
-lemma min_absorb2: "(y\<Colon>'a\<Colon>order) \<le> x \<Longrightarrow> min x y = y"
+lemma min_absorb2: "(y::'a::order) \<le> x \<Longrightarrow> min x y = y"
by (simp add:min_def)
-lemma max_absorb1: "(y\<Colon>'a\<Colon>order) \<le> x \<Longrightarrow> max x y = x"
+lemma max_absorb1: "(y::'a::order) \<le> x \<Longrightarrow> max x y = x"
by (simp add: max_def)
@@ -1409,7 +1409,7 @@
le_bool_def [simp]: "P \<le> Q \<longleftrightarrow> P \<longrightarrow> Q"
definition
- [simp]: "(P\<Colon>bool) < Q \<longleftrightarrow> \<not> P \<and> Q"
+ [simp]: "(P::bool) < Q \<longleftrightarrow> \<not> P \<and> Q"
definition
[simp]: "\<bottom> \<longleftrightarrow> False"
@@ -1457,7 +1457,7 @@
le_fun_def: "f \<le> g \<longleftrightarrow> (\<forall>x. f x \<le> g x)"
definition
- "(f\<Colon>'a \<Rightarrow> 'b) < g \<longleftrightarrow> f \<le> g \<and> \<not> (g \<le> f)"
+ "(f::'a \<Rightarrow> 'b) < g \<longleftrightarrow> f \<le> g \<and> \<not> (g \<le> f)"
instance ..
@@ -1620,4 +1620,3 @@
lemmas linorder_antisym_conv3 = linorder_class.antisym_conv3
end
-
--- a/src/HOL/Power.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Power.thy Thu Sep 03 15:50:40 2015 +0200
@@ -762,6 +762,10 @@
"(x - y)\<^sup>2 = x\<^sup>2 + y\<^sup>2 - 2 * x * y"
by (simp add: algebra_simps power2_eq_square mult_2_right)
+lemma (in comm_ring_1) power2_commute:
+ "(x - y)\<^sup>2 = (y - x)\<^sup>2"
+ by (simp add: algebra_simps power2_eq_square)
+
text \<open>Simprules for comparisons where common factors can be cancelled.\<close>
@@ -796,7 +800,7 @@
Premises cannot be weakened: consider the case where @{term "i=0"},
@{term "m=1"} and @{term "n=0"}.\<close>
lemma nat_power_less_imp_less:
- assumes nonneg: "0 < (i\<Colon>nat)"
+ assumes nonneg: "0 < (i::nat)"
assumes less: "i ^ m < i ^ n"
shows "m < n"
proof (cases "i = 1")
--- a/src/HOL/Probability/Borel_Space.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Probability/Borel_Space.thy Thu Sep 03 15:50:40 2015 +0200
@@ -81,7 +81,7 @@
by simp
lemma borel_measurableI:
- fixes f :: "'a \<Rightarrow> 'x\<Colon>topological_space"
+ fixes f :: "'a \<Rightarrow> 'x::topological_space"
assumes "\<And>S. open S \<Longrightarrow> f -` S \<inter> space M \<in> sets M"
shows "f \<in> borel_measurable M"
unfolding borel_def
@@ -452,7 +452,7 @@
by (rule borel_measurable_continuous_Pair) (intro continuous_intros)
lemma [measurable]:
- fixes a b :: "'a\<Colon>linorder_topology"
+ fixes a b :: "'a::linorder_topology"
shows lessThan_borel: "{..< a} \<in> sets borel"
and greaterThan_borel: "{a <..} \<in> sets borel"
and greaterThanLessThan_borel: "{a<..<b} \<in> sets borel"
@@ -473,7 +473,7 @@
by auto
lemma eucl_ivals[measurable]:
- fixes a b :: "'a\<Colon>ordered_euclidean_space"
+ fixes a b :: "'a::ordered_euclidean_space"
shows "{x. x <e a} \<in> sets borel"
and "{x. a <e x} \<in> sets borel"
and "{..a} \<in> sets borel"
@@ -597,7 +597,7 @@
using assms by (intro borel_eq_sigmaI1[where X="range G" and F="(\<lambda>(i, j). F i j)"]) auto
lemma borel_eq_box:
- "borel = sigma UNIV (range (\<lambda> (a, b). box a b :: 'a \<Colon> euclidean_space set))"
+ "borel = sigma UNIV (range (\<lambda> (a, b). box a b :: 'a :: euclidean_space set))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI1[OF borel_def])
fix M :: "'a set" assume "M \<in> {S. open S}"
@@ -611,13 +611,13 @@
lemma halfspace_gt_in_halfspace:
assumes i: "i \<in> A"
- shows "{x\<Colon>'a. a < x \<bullet> i} \<in>
- sigma_sets UNIV ((\<lambda> (a, i). {x\<Colon>'a\<Colon>euclidean_space. x \<bullet> i < a}) ` (UNIV \<times> A))"
+ shows "{x::'a. a < x \<bullet> i} \<in>
+ sigma_sets UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. x \<bullet> i < a}) ` (UNIV \<times> A))"
(is "?set \<in> ?SIGMA")
proof -
interpret sigma_algebra UNIV ?SIGMA
by (intro sigma_algebra_sigma_sets) simp_all
- have *: "?set = (\<Union>n. UNIV - {x\<Colon>'a. x \<bullet> i < a + 1 / real (Suc n)})"
+ have *: "?set = (\<Union>n. UNIV - {x::'a. x \<bullet> i < a + 1 / real (Suc n)})"
proof (safe, simp_all add: not_less)
fix x :: 'a assume "a < x \<bullet> i"
with reals_Archimedean[of "x \<bullet> i - a"]
@@ -673,7 +673,7 @@
qed auto
lemma borel_eq_halfspace_ge:
- "borel = sigma UNIV ((\<lambda> (a, i). {x\<Colon>'a\<Colon>euclidean_space. a \<le> x \<bullet> i}) ` (UNIV \<times> Basis))"
+ "borel = sigma UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. a \<le> x \<bullet> i}) ` (UNIV \<times> Basis))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI2[OF borel_eq_halfspace_less])
fix a :: real and i :: 'a assume i: "(a, i) \<in> UNIV \<times> Basis"
@@ -683,7 +683,7 @@
qed auto
lemma borel_eq_halfspace_greater:
- "borel = sigma UNIV ((\<lambda> (a, i). {x\<Colon>'a\<Colon>euclidean_space. a < x \<bullet> i}) ` (UNIV \<times> Basis))"
+ "borel = sigma UNIV ((\<lambda> (a, i). {x::'a::euclidean_space. a < x \<bullet> i}) ` (UNIV \<times> Basis))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI2[OF borel_eq_halfspace_le])
fix a :: real and i :: 'a assume "(a, i) \<in> (UNIV \<times> Basis)"
@@ -694,7 +694,7 @@
qed auto
lemma borel_eq_atMost:
- "borel = sigma UNIV (range (\<lambda>a. {..a\<Colon>'a\<Colon>ordered_euclidean_space}))"
+ "borel = sigma UNIV (range (\<lambda>a. {..a::'a::ordered_euclidean_space}))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_le])
fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
@@ -713,7 +713,7 @@
qed auto
lemma borel_eq_greaterThan:
- "borel = sigma UNIV (range (\<lambda>a\<Colon>'a\<Colon>ordered_euclidean_space. {x. a <e x}))"
+ "borel = sigma UNIV (range (\<lambda>a::'a::ordered_euclidean_space. {x. a <e x}))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_le])
fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
@@ -740,7 +740,7 @@
qed auto
lemma borel_eq_lessThan:
- "borel = sigma UNIV (range (\<lambda>a\<Colon>'a\<Colon>ordered_euclidean_space. {x. x <e a}))"
+ "borel = sigma UNIV (range (\<lambda>a::'a::ordered_euclidean_space. {x. x <e a}))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI4[OF borel_eq_halfspace_ge])
fix a :: real and i :: 'a assume "(a, i) \<in> UNIV \<times> Basis"
@@ -766,7 +766,7 @@
qed auto
lemma borel_eq_atLeastAtMost:
- "borel = sigma UNIV (range (\<lambda>(a,b). {a..b} \<Colon>'a\<Colon>ordered_euclidean_space set))"
+ "borel = sigma UNIV (range (\<lambda>(a,b). {a..b} ::'a::ordered_euclidean_space set))"
(is "_ = ?SIGMA")
proof (rule borel_eq_sigmaI5[OF borel_eq_atMost])
fix a::'a
@@ -828,7 +828,7 @@
qed simp_all
lemma borel_measurable_halfspacesI:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>euclidean_space"
+ fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
assumes F: "borel = sigma UNIV (F ` (UNIV \<times> Basis))"
and S_eq: "\<And>a i. S a i = f -` F (a,i) \<inter> space M"
shows "f \<in> borel_measurable M = (\<forall>i\<in>Basis. \<forall>a::real. S a i \<in> sets M)"
@@ -843,22 +843,22 @@
qed
lemma borel_measurable_iff_halfspace_le:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>euclidean_space"
+ fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
shows "f \<in> borel_measurable M = (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. f w \<bullet> i \<le> a} \<in> sets M)"
by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_le]) auto
lemma borel_measurable_iff_halfspace_less:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>euclidean_space"
+ fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. f w \<bullet> i < a} \<in> sets M)"
by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_less]) auto
lemma borel_measurable_iff_halfspace_ge:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>euclidean_space"
+ fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
shows "f \<in> borel_measurable M = (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. a \<le> f w \<bullet> i} \<in> sets M)"
by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_ge]) auto
lemma borel_measurable_iff_halfspace_greater:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>euclidean_space"
+ fixes f :: "'a \<Rightarrow> 'c::euclidean_space"
shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i\<in>Basis. \<forall>a. {w \<in> space M. a < f w \<bullet> i} \<in> sets M)"
by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_greater]) auto
--- a/src/HOL/Probability/Caratheodory.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Probability/Caratheodory.thy Thu Sep 03 15:50:40 2015 +0200
@@ -516,11 +516,10 @@
finally show ?thesis .
qed
def C \<equiv> "(split BB) o prod_decode"
- have C: "!!n. C n \<in> M"
- apply (rule_tac p="prod_decode n" in PairE)
- apply (simp add: C_def)
- apply (metis BB subsetD rangeI)
- done
+ from BB have "\<And>i j. BB i j \<in> M"
+ by (rule range_subsetD)
+ then have C: "\<And>n. C n \<in> M"
+ by (simp add: C_def split_def)
have sbC: "(\<Union>i. A i) \<subseteq> (\<Union>i. C i)"
proof (auto simp add: C_def)
fix x i
--- a/src/HOL/Product_Type.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Product_Type.thy Thu Sep 03 15:50:40 2015 +0200
@@ -189,7 +189,7 @@
end
lemma [code]:
- "HOL.equal (u\<Colon>unit) v \<longleftrightarrow> True" unfolding equal unit_eq [of u] unit_eq [of v] by rule+
+ "HOL.equal (u::unit) v \<longleftrightarrow> True" unfolding equal unit_eq [of u] unit_eq [of v] by rule+
code_printing
type_constructor unit \<rightharpoonup>
@@ -224,7 +224,7 @@
definition Pair_Rep :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool" where
"Pair_Rep a b = (\<lambda>x y. x = a \<and> y = b)"
-definition "prod = {f. \<exists>a b. f = Pair_Rep (a\<Colon>'a) (b\<Colon>'b)}"
+definition "prod = {f. \<exists>a b. f = Pair_Rep (a::'a) (b::'b)}"
typedef ('a, 'b) prod (infixr "*" 20) = "prod :: ('a \<Rightarrow> 'b \<Rightarrow> bool) set"
unfolding prod_def by auto
@@ -284,9 +284,6 @@
subsubsection \<open>Tuple syntax\<close>
-abbreviation (input) split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
- "split \<equiv> case_prod"
-
text \<open>
Patterns -- extends pre-defined type @{typ pttrn} used in
abstractions.
@@ -310,6 +307,11 @@
"%(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>
@@ -435,13 +437,13 @@
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]: "split f (a, b) = f a b"
+lemma split_conv [simp, code]: "case_prod f (a, b) = f a b"
by (fact prod.case)
-lemma splitI: "f a b \<Longrightarrow> split f (a, b)"
+lemma splitI: "f a b \<Longrightarrow> case_prod f (a, b)"
by (rule split_conv [THEN iffD2])
-lemma splitD: "split f (a, b) \<Longrightarrow> f a b"
+lemma splitD: "case_prod f (a, b) \<Longrightarrow> f a b"
by (rule split_conv [THEN iffD1])
lemma split_Pair [simp]: "(\<lambda>(x, y). (x, y)) = id"
@@ -451,13 +453,13 @@
-- \<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: "split (f \<circ> g) x = f (g (fst x)) (snd x)"
+lemma split_comp: "case_prod (f \<circ> g) x = f (g (fst x)) (snd x)"
by (cases x) simp
-lemma split_twice: "split f (split g p) = split (\<lambda>x y. split f (g x y)) p"
- by (cases p) simp
+lemma split_twice: "case_prod f (case_prod g p) = case_prod (\<lambda>x y. case_prod f (g x y)) p"
+ by (fact prod.case_distrib)
-lemma The_split: "The (split P) = (THE xy. P (fst xy) (snd xy))"
+lemma The_split: "The (case_prod P) = (THE xy. P (fst xy) (snd xy))"
by (simp add: case_prod_unfold)
lemmas split_weak_cong = prod.case_cong_weak
@@ -602,31 +604,31 @@
lemmas split_split_asm [no_atp] = prod.split_asm
text \<open>
- \medskip @{term split} used as a logical connective or set former.
+ \medskip @{const case_prod} 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 |] ==> split c p"
+lemma splitI2: "!!p. [| !!a b. p = (a, b) ==> c a b |] ==> case_prod c p"
apply (simp only: split_tupled_all)
apply (simp (no_asm_simp))
done
-lemma splitI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> split c p x"
+lemma splitI2': "!!p. [| !!a b. (a, b) = p ==> c a b x |] ==> case_prod c p x"
apply (simp only: split_tupled_all)
apply (simp (no_asm_simp))
done
-lemma splitE: "split c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
+lemma splitE: "case_prod c p ==> (!!x y. p = (x, y) ==> c x y ==> Q) ==> Q"
by (induct p) auto
-lemma splitE': "split c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
+lemma splitE': "case_prod c p z ==> (!!x y. p = (x, y) ==> c x y z ==> Q) ==> Q"
by (induct p) auto
lemma splitE2:
- "[| Q (split P z); !!x y. [|z = (x, y); Q (P x y)|] ==> R |] ==> R"
+ "[| Q (case_prod P z); !!x y. [|z = (x, y); Q (P x y)|] ==> R |] ==> R"
proof -
- assume q: "Q (split P z)"
+ assume q: "Q (case_prod P z)"
assume r: "!!x y. [|z = (x, y); Q (P x y)|] ==> R"
show R
apply (rule r surjective_pairing)+
@@ -634,17 +636,17 @@
done
qed
-lemma splitD': "split R (a,b) c ==> R a b c"
+lemma splitD': "case_prod R (a,b) c ==> R a b c"
by simp
-lemma mem_splitI: "z: c a b ==> z: split c (a, b)"
+lemma mem_splitI: "z: c a b ==> z: case_prod c (a, b)"
by simp
-lemma mem_splitI2: "!!p. [| !!a b. p = (a, b) ==> z: c a b |] ==> z: split c p"
+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_splitE:
- assumes "z \<in> split c p"
+ assumes "z \<in> case_prod c p"
obtains x y where "p = (x, y)" and "z \<in> c x y"
using assms by (rule splitE2)
@@ -672,10 +674,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) = split P"
+lemma split_eta_SetCompr2 [simp, no_atp]: "(%u. EX x y. u = (x, y) & P x y) = case_prod P"
by (rule ext) fast
-lemma split_part [simp]: "(%(a,b). P & Q a b) = (%ab. P & split Q ab)"
+lemma split_part [simp]: "(%(a,b). P & Q a b) = (%ab. P & case_prod Q ab)"
-- \<open>Allows simplifications of nested splits in case of independent predicates.\<close>
by (rule ext) blast
@@ -685,7 +687,7 @@
*)
lemma split_comp_eq:
fixes f :: "'a => 'b => 'c" and g :: "'d => 'a"
- shows "(%u. f (g (fst u)) (snd u)) = (split (%x. f (g x)))"
+ shows "(%u. f (g (fst u)) (snd u)) = (case_prod (%x. f (g x)))"
by (rule ext) auto
lemma pair_imageI [intro]: "(a, b) : A ==> f a b : (%(a, b). f a b) ` A"
@@ -773,12 +775,8 @@
"(!!a b c d e f g. P (a, b, c, d, e, f, g)) ==> P x"
by (cases x) blast
-lemma split_def:
- "split = (\<lambda>c p. c (fst p) (snd p))"
- by (fact case_prod_unfold)
-
definition internal_split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
- "internal_split == split"
+ "internal_split == case_prod"
lemma internal_split_conv: "internal_split c (a, b) = c a b"
by (simp only: internal_split_def split_conv)
@@ -805,11 +803,11 @@
lemma curryE: "curry f a b \<Longrightarrow> (f (a, b) \<Longrightarrow> Q) \<Longrightarrow> Q"
by (simp add: curry_def)
-lemma curry_split [simp]: "curry (split f) = f"
- by (simp add: curry_def split_def)
+lemma curry_split [simp]: "curry (case_prod f) = f"
+ by (simp add: curry_def case_prod_unfold)
-lemma split_curry [simp]: "split (curry f) = f"
- by (simp add: curry_def split_def)
+lemma split_curry [simp]: "case_prod (curry f) = f"
+ by (simp add: curry_def case_prod_unfold)
lemma curry_K: "curry (\<lambda>x. c) = (\<lambda>x y. c)"
by(simp add: fun_eq_iff)
@@ -1120,11 +1118,11 @@
by (blast elim: equalityE)
lemma SetCompr_Sigma_eq:
- "Collect (split (%x y. P x & Q x y)) = (SIGMA x:Collect P. Collect (Q x))"
+ "Collect (case_prod (%x y. P x & 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"
- by blast
+ by (fact SetCompr_Sigma_eq)
lemma UN_Times_distrib:
"(UN (a,b):(A <*> B). E a <*> F b) = (UNION A E) <*> (UNION B F)"
@@ -1287,7 +1285,7 @@
unfolding image_def
proof(rule set_eqI,rule iffI)
fix x :: "'a \<times> 'c"
- assume "x \<in> {y\<Colon>'a \<times> 'c. \<exists>x\<Colon>'b \<times> 'd\<in>A \<times> B. y = map_prod f g x}"
+ assume "x \<in> {y::'a \<times> 'c. \<exists>x::'b \<times> 'd\<in>A \<times> B. y = map_prod f g x}"
then obtain y where "y \<in> A \<times> B" and "x = map_prod f g y" by blast
from \<open>image f A = A'\<close> and \<open>y \<in> A \<times> B\<close> have "f (fst y) \<in> A'" by auto
moreover from \<open>image g B = B'\<close> and \<open>y \<in> A \<times> B\<close> have "g (snd y) \<in> B'" by auto
@@ -1357,16 +1355,17 @@
subsection \<open>Legacy theorem bindings and duplicates\<close>
-lemma PairE:
- obtains x y where "p = (x, y)"
- by (fact prod.exhaust)
+abbreviation (input) split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
+ "split \<equiv> case_prod"
+lemmas PairE = prod.exhaust
lemmas Pair_eq = prod.inject
lemmas fst_conv = prod.sel(1)
lemmas snd_conv = prod.sel(2)
lemmas pair_collapse = prod.collapse
lemmas split = split_conv
lemmas Pair_fst_snd_eq = prod_eq_iff
+lemmas split_def = case_prod_unfold
hide_const (open) prod
--- a/src/HOL/Proofs/Extraction/Euclid.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Proofs/Extraction/Euclid.thy Thu Sep 03 15:50:40 2015 +0200
@@ -123,7 +123,7 @@
qed
qed
-lemma dvd_prod [iff]: "n dvd (PROD m\<Colon>nat:#mset (n # ns). m)"
+lemma dvd_prod [iff]: "n dvd (PROD m::nat:#mset (n # ns). m)"
by (simp add: msetprod_Un msetprod_singleton)
definition all_prime :: "nat list \<Rightarrow> bool" where
@@ -140,13 +140,13 @@
lemma split_all_prime:
assumes "all_prime ms" and "all_prime ns"
- shows "\<exists>qs. all_prime qs \<and> (PROD m\<Colon>nat:#mset qs. m) =
- (PROD m\<Colon>nat:#mset ms. m) * (PROD m\<Colon>nat:#mset ns. m)" (is "\<exists>qs. ?P qs \<and> ?Q qs")
+ shows "\<exists>qs. all_prime qs \<and> (PROD m::nat:#mset qs. m) =
+ (PROD m::nat:#mset ms. m) * (PROD m::nat:#mset ns. m)" (is "\<exists>qs. ?P qs \<and> ?Q qs")
proof -
from assms have "all_prime (ms @ ns)"
by (simp add: all_prime_append)
- moreover from assms have "(PROD m\<Colon>nat:#mset (ms @ ns). m) =
- (PROD m\<Colon>nat:#mset ms. m) * (PROD m\<Colon>nat:#mset ns. m)"
+ moreover from assms have "(PROD m::nat:#mset (ms @ ns). m) =
+ (PROD m::nat:#mset ms. m) * (PROD m::nat:#mset ns. m)"
by (simp add: msetprod_Un)
ultimately have "?P (ms @ ns) \<and> ?Q (ms @ ns)" ..
then show ?thesis ..
@@ -154,11 +154,11 @@
lemma all_prime_nempty_g_one:
assumes "all_prime ps" and "ps \<noteq> []"
- shows "Suc 0 < (PROD m\<Colon>nat:#mset ps. m)"
+ shows "Suc 0 < (PROD m::nat:#mset ps. m)"
using `ps \<noteq> []` `all_prime ps` unfolding One_nat_def [symmetric] by (induct ps rule: list_nonempty_induct)
(simp_all add: all_prime_simps msetprod_singleton msetprod_Un prime_gt_1_nat less_1_mult del: One_nat_def)
-lemma factor_exists: "Suc 0 < n \<Longrightarrow> (\<exists>ps. all_prime ps \<and> (PROD m\<Colon>nat:#mset ps. m) = n)"
+lemma factor_exists: "Suc 0 < n \<Longrightarrow> (\<exists>ps. all_prime ps \<and> (PROD m::nat:#mset ps. m) = n)"
proof (induct n rule: nat_wf_ind)
case (1 n)
from `Suc 0 < n`
@@ -169,21 +169,21 @@
assume "\<exists>m k. Suc 0 < m \<and> Suc 0 < k \<and> m < n \<and> k < n \<and> n = m * k"
then obtain m k where m: "Suc 0 < m" and k: "Suc 0 < k" and mn: "m < n"
and kn: "k < n" and nmk: "n = m * k" by iprover
- from mn and m have "\<exists>ps. all_prime ps \<and> (PROD m\<Colon>nat:#mset ps. m) = m" by (rule 1)
- then obtain ps1 where "all_prime ps1" and prod_ps1_m: "(PROD m\<Colon>nat:#mset ps1. m) = m"
+ from mn and m have "\<exists>ps. all_prime ps \<and> (PROD m::nat:#mset ps. m) = m" by (rule 1)
+ then obtain ps1 where "all_prime ps1" and prod_ps1_m: "(PROD m::nat:#mset ps1. m) = m"
by iprover
- from kn and k have "\<exists>ps. all_prime ps \<and> (PROD m\<Colon>nat:#mset ps. m) = k" by (rule 1)
- then obtain ps2 where "all_prime ps2" and prod_ps2_k: "(PROD m\<Colon>nat:#mset ps2. m) = k"
+ from kn and k have "\<exists>ps. all_prime ps \<and> (PROD m::nat:#mset ps. m) = k" by (rule 1)
+ then obtain ps2 where "all_prime ps2" and prod_ps2_k: "(PROD m::nat:#mset ps2. m) = k"
by iprover
from `all_prime ps1` `all_prime ps2`
- have "\<exists>ps. all_prime ps \<and> (PROD m\<Colon>nat:#mset ps. m) =
- (PROD m\<Colon>nat:#mset ps1. m) * (PROD m\<Colon>nat:#mset ps2. m)"
+ have "\<exists>ps. all_prime ps \<and> (PROD m::nat:#mset ps. m) =
+ (PROD m::nat:#mset ps1. m) * (PROD m::nat:#mset ps2. m)"
by (rule split_all_prime)
with prod_ps1_m prod_ps2_k nmk show ?thesis by simp
next
assume "prime n" then have "all_prime [n]" by (simp add: all_prime_simps)
- moreover have "(PROD m\<Colon>nat:#mset [n]. m) = n" by (simp add: msetprod_singleton)
- ultimately have "all_prime [n] \<and> (PROD m\<Colon>nat:#mset [n]. m) = n" ..
+ moreover have "(PROD m::nat:#mset [n]. m) = n" by (simp add: msetprod_singleton)
+ ultimately have "all_prime [n] \<and> (PROD m::nat:#mset [n]. m) = n" ..
then show ?thesis ..
qed
qed
@@ -193,7 +193,7 @@
shows "\<exists>p. prime p \<and> p dvd n"
proof -
from N obtain ps where "all_prime ps"
- and prod_ps: "n = (PROD m\<Colon>nat:#mset ps. m)" using factor_exists
+ and prod_ps: "n = (PROD m::nat:#mset ps. m)" using factor_exists
by simp iprover
with N have "ps \<noteq> []"
by (auto simp add: all_prime_nempty_g_one msetprod_empty)
--- a/src/HOL/Proofs/ex/XML_Data.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Proofs/ex/XML_Data.thy Thu Sep 03 15:50:40 2015 +0200
@@ -14,8 +14,9 @@
ML {*
fun export_proof thy thm =
let
- val {prop, hyps, shyps, ...} = Thm.rep_thm thm;
- val (_, prop) = Logic.unconstrainT shyps (Logic.list_implies (hyps, prop));
+ val (_, prop) =
+ Logic.unconstrainT (Thm.shyps_of thm)
+ (Logic.list_implies (Thm.hyps_of thm, Thm.prop_of thm));
val prf =
Proofterm.proof_of (Proofterm.strip_thm (Thm.proof_body_of thm)) |>
Reconstruct.reconstruct_proof thy prop |>
--- a/src/HOL/Quickcheck_Random.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Quickcheck_Random.thy Thu Sep 03 15:50:40 2015 +0200
@@ -131,7 +131,7 @@
\<Rightarrow> Random.seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
definition random_fun_lift :: "(Random.seed \<Rightarrow> ('b \<times> (unit \<Rightarrow> term)) \<times> Random.seed)
- \<Rightarrow> Random.seed \<Rightarrow> (('a\<Colon>term_of \<Rightarrow> 'b\<Colon>typerep) \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
+ \<Rightarrow> Random.seed \<Rightarrow> (('a::term_of \<Rightarrow> 'b::typerep) \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
where
"random_fun_lift f =
random_fun_aux TYPEREP('a) TYPEREP('b) (op =) Code_Evaluation.term_of f Random.split_seed"
--- a/src/HOL/Quotient_Examples/Quotient_Int.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Quotient_Examples/Quotient_Int.thy Thu Sep 03 15:50:40 2015 +0200
@@ -22,10 +22,10 @@
begin
quotient_definition
- "0 \<Colon> int" is "(0\<Colon>nat, 0\<Colon>nat)" done
+ "0 :: int" is "(0::nat, 0::nat)" done
quotient_definition
- "1 \<Colon> int" is "(1\<Colon>nat, 0\<Colon>nat)" done
+ "1 :: int" is "(1::nat, 0::nat)" done
fun
plus_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
@@ -33,7 +33,7 @@
"plus_int_raw (x, y) (u, v) = (x + u, y + v)"
quotient_definition
- "(op +) \<Colon> (int \<Rightarrow> int \<Rightarrow> int)" is "plus_int_raw" by auto
+ "(op +) :: (int \<Rightarrow> int \<Rightarrow> int)" is "plus_int_raw" by auto
fun
uminus_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
@@ -41,10 +41,10 @@
"uminus_int_raw (x, y) = (y, x)"
quotient_definition
- "(uminus \<Colon> (int \<Rightarrow> int))" is "uminus_int_raw" by auto
+ "(uminus :: (int \<Rightarrow> int))" is "uminus_int_raw" by auto
definition
- minus_int_def: "z - w = z + (-w\<Colon>int)"
+ minus_int_def: "z - w = z + (-w::int)"
fun
times_int_raw :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
@@ -95,13 +95,13 @@
le_int_def: "(op \<le>) :: int \<Rightarrow> int \<Rightarrow> bool" is "le_int_raw" by auto
definition
- less_int_def: "(z\<Colon>int) < w = (z \<le> w \<and> z \<noteq> w)"
+ less_int_def: "(z::int) < w = (z \<le> w \<and> z \<noteq> w)"
definition
- zabs_def: "\<bar>i\<Colon>int\<bar> = (if i < 0 then - i else i)"
+ zabs_def: "\<bar>i::int\<bar> = (if i < 0 then - i else i)"
definition
- zsgn_def: "sgn (i\<Colon>int) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"
+ zsgn_def: "sgn (i::int) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"
instance ..
@@ -182,10 +182,10 @@
begin
definition
- "(inf \<Colon> int \<Rightarrow> int \<Rightarrow> int) = min"
+ "(inf :: int \<Rightarrow> int \<Rightarrow> int) = min"
definition
- "(sup \<Colon> int \<Rightarrow> int \<Rightarrow> int) = max"
+ "(sup :: int \<Rightarrow> int \<Rightarrow> int) = max"
instance
by default
@@ -245,7 +245,7 @@
by (rule zmult_zless_mono2)
show "\<bar>i\<bar> = (if i < 0 then -i else i)"
by (simp only: zabs_def)
- show "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
+ show "sgn (i::int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
by (simp only: zsgn_def)
qed
--- a/src/HOL/Quotient_Examples/Quotient_Rat.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Quotient_Examples/Quotient_Rat.thy Thu Sep 03 15:50:40 2015 +0200
@@ -32,10 +32,10 @@
begin
quotient_definition
- "0 \<Colon> rat" is "(0\<Colon>int, 1\<Colon>int)" by simp
+ "0 :: rat" is "(0::int, 1::int)" by simp
quotient_definition
- "1 \<Colon> rat" is "(1\<Colon>int, 1\<Colon>int)" by simp
+ "1 :: rat" is "(1::int, 1::int)" by simp
fun times_rat_raw where
"times_rat_raw (a :: int, b :: int) (c, d) = (a * c, b * d)"
@@ -54,10 +54,10 @@
"uminus_rat_raw (a :: int, b :: int) = (-a, b)"
quotient_definition
- "(uminus \<Colon> (rat \<Rightarrow> rat))" is "uminus_rat_raw" by fastforce
+ "(uminus :: (rat \<Rightarrow> rat))" is "uminus_rat_raw" by fastforce
definition
- minus_rat_def: "a - b = a + (-b\<Colon>rat)"
+ minus_rat_def: "a - b = a + (-b::rat)"
fun le_rat_raw where
"le_rat_raw (a :: int, b) (c, d) \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)"
@@ -92,13 +92,13 @@
qed
definition
- less_rat_def: "(z\<Colon>rat) < w = (z \<le> w \<and> z \<noteq> w)"
+ less_rat_def: "(z::rat) < w = (z \<le> w \<and> z \<noteq> w)"
definition
- rabs_rat_def: "\<bar>i\<Colon>rat\<bar> = (if i < 0 then - i else i)"
+ rabs_rat_def: "\<bar>i::rat\<bar> = (if i < 0 then - i else i)"
definition
- sgn_rat_def: "sgn (i\<Colon>rat) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"
+ sgn_rat_def: "sgn (i::rat) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"
instance by intro_classes
(auto simp add: rabs_rat_def sgn_rat_def)
@@ -259,7 +259,7 @@
assume "b \<noteq> 0"
then have "a * b \<le> (a div b + 1) * b * b"
by (metis mult.commute div_mult_self1_is_id less_int_def linorder_le_cases zdiv_mono1 zdiv_mono1_neg zle_add1_eq_le)
- then show "\<exists>z\<Colon>int. a * b \<le> z * b * b" by auto
+ then show "\<exists>z::int. a * b \<le> z * b * b" by auto
qed
qed
*)
--- a/src/HOL/Rat.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Rat.thy Thu Sep 03 15:50:40 2015 +0200
@@ -808,58 +808,54 @@
context field_char_0
begin
-definition
- Rats :: "'a set" where
- "Rats = range of_rat"
-
-notation (xsymbols)
- Rats ("\<rat>")
+definition Rats :: "'a set" ("\<rat>")
+ where "\<rat> = range of_rat"
end
-lemma Rats_of_rat [simp]: "of_rat r \<in> Rats"
+lemma Rats_of_rat [simp]: "of_rat r \<in> \<rat>"
by (simp add: Rats_def)
-lemma Rats_of_int [simp]: "of_int z \<in> Rats"
+lemma Rats_of_int [simp]: "of_int z \<in> \<rat>"
by (subst of_rat_of_int_eq [symmetric], rule Rats_of_rat)
-lemma Rats_of_nat [simp]: "of_nat n \<in> Rats"
+lemma Rats_of_nat [simp]: "of_nat n \<in> \<rat>"
by (subst of_rat_of_nat_eq [symmetric], rule Rats_of_rat)
-lemma Rats_number_of [simp]: "numeral w \<in> Rats"
+lemma Rats_number_of [simp]: "numeral w \<in> \<rat>"
by (subst of_rat_numeral_eq [symmetric], rule Rats_of_rat)
-lemma Rats_0 [simp]: "0 \<in> Rats"
+lemma Rats_0 [simp]: "0 \<in> \<rat>"
apply (unfold Rats_def)
apply (rule range_eqI)
apply (rule of_rat_0 [symmetric])
done
-lemma Rats_1 [simp]: "1 \<in> Rats"
+lemma Rats_1 [simp]: "1 \<in> \<rat>"
apply (unfold Rats_def)
apply (rule range_eqI)
apply (rule of_rat_1 [symmetric])
done
-lemma Rats_add [simp]: "\<lbrakk>a \<in> Rats; b \<in> Rats\<rbrakk> \<Longrightarrow> a + b \<in> Rats"
+lemma Rats_add [simp]: "\<lbrakk>a \<in> \<rat>; b \<in> \<rat>\<rbrakk> \<Longrightarrow> a + b \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_add [symmetric])
done
-lemma Rats_minus [simp]: "a \<in> Rats \<Longrightarrow> - a \<in> Rats"
+lemma Rats_minus [simp]: "a \<in> \<rat> \<Longrightarrow> - a \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_minus [symmetric])
done
-lemma Rats_diff [simp]: "\<lbrakk>a \<in> Rats; b \<in> Rats\<rbrakk> \<Longrightarrow> a - b \<in> Rats"
+lemma Rats_diff [simp]: "\<lbrakk>a \<in> \<rat>; b \<in> \<rat>\<rbrakk> \<Longrightarrow> a - b \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_diff [symmetric])
done
-lemma Rats_mult [simp]: "\<lbrakk>a \<in> Rats; b \<in> Rats\<rbrakk> \<Longrightarrow> a * b \<in> Rats"
+lemma Rats_mult [simp]: "\<lbrakk>a \<in> \<rat>; b \<in> \<rat>\<rbrakk> \<Longrightarrow> a * b \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_mult [symmetric])
@@ -867,7 +863,7 @@
lemma nonzero_Rats_inverse:
fixes a :: "'a::field_char_0"
- shows "\<lbrakk>a \<in> Rats; a \<noteq> 0\<rbrakk> \<Longrightarrow> inverse a \<in> Rats"
+ shows "\<lbrakk>a \<in> \<rat>; a \<noteq> 0\<rbrakk> \<Longrightarrow> inverse a \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (erule nonzero_of_rat_inverse [symmetric])
@@ -875,7 +871,7 @@
lemma Rats_inverse [simp]:
fixes a :: "'a::{field_char_0, field}"
- shows "a \<in> Rats \<Longrightarrow> inverse a \<in> Rats"
+ shows "a \<in> \<rat> \<Longrightarrow> inverse a \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_inverse [symmetric])
@@ -883,7 +879,7 @@
lemma nonzero_Rats_divide:
fixes a b :: "'a::field_char_0"
- shows "\<lbrakk>a \<in> Rats; b \<in> Rats; b \<noteq> 0\<rbrakk> \<Longrightarrow> a / b \<in> Rats"
+ shows "\<lbrakk>a \<in> \<rat>; b \<in> \<rat>; b \<noteq> 0\<rbrakk> \<Longrightarrow> a / b \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (erule nonzero_of_rat_divide [symmetric])
@@ -891,7 +887,7 @@
lemma Rats_divide [simp]:
fixes a b :: "'a::{field_char_0, field}"
- shows "\<lbrakk>a \<in> Rats; b \<in> Rats\<rbrakk> \<Longrightarrow> a / b \<in> Rats"
+ shows "\<lbrakk>a \<in> \<rat>; b \<in> \<rat>\<rbrakk> \<Longrightarrow> a / b \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_divide [symmetric])
@@ -899,7 +895,7 @@
lemma Rats_power [simp]:
fixes a :: "'a::field_char_0"
- shows "a \<in> Rats \<Longrightarrow> a ^ n \<in> Rats"
+ shows "a \<in> \<rat> \<Longrightarrow> a ^ n \<in> \<rat>"
apply (auto simp add: Rats_def)
apply (rule range_eqI)
apply (rule of_rat_power [symmetric])
--- a/src/HOL/Real.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Real.thy Thu Sep 03 15:50:40 2015 +0200
@@ -491,7 +491,7 @@
by transfer (simp add: ac_simps realrel_def)
show "(a + b) * c = a * c + b * c"
by transfer (simp add: distrib_right realrel_def)
- show "(0\<Colon>real) \<noteq> (1\<Colon>real)"
+ show "(0::real) \<noteq> (1::real)"
by transfer (simp add: realrel_def)
show "a \<noteq> 0 \<Longrightarrow> inverse a * a = 1"
apply transfer
@@ -1163,7 +1163,7 @@
lemma real_of_int_div4: "real (n div x) <= real (n::int) / real x"
by (insert real_of_int_div2 [of n x], simp)
-lemma Ints_real_of_int [simp]: "real (x::int) \<in> Ints"
+lemma Ints_real_of_int [simp]: "real (x::int) \<in> \<int>"
unfolding real_of_int_def by (rule Ints_of_int)
@@ -1300,10 +1300,10 @@
apply (simp only: real_of_int_of_nat_eq)
done
-lemma Nats_real_of_nat [simp]: "real (n::nat) \<in> Nats"
+lemma Nats_real_of_nat [simp]: "real (n::nat) \<in> \<nat>"
unfolding real_of_nat_def by (rule of_nat_in_Nats)
-lemma Ints_real_of_nat [simp]: "real (n::nat) \<in> Ints"
+lemma Ints_real_of_nat [simp]: "real (n::nat) \<in> \<int>"
unfolding real_of_nat_def by (rule Ints_of_nat)
subsection \<open>The Archimedean Property of the Reals\<close>
@@ -1975,7 +1975,7 @@
instantiation real :: equal
begin
-definition "HOL.equal (x\<Colon>real) y \<longleftrightarrow> x - y = 0"
+definition "HOL.equal (x::real) y \<longleftrightarrow> x - y = 0"
instance proof
qed (simp add: equal_real_def)
--- a/src/HOL/Real_Vector_Spaces.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Real_Vector_Spaces.thy Thu Sep 03 15:50:40 2015 +0200
@@ -358,55 +358,52 @@
subsection \<open>The Set of Real Numbers\<close>
-definition Reals :: "'a::real_algebra_1 set" where
- "Reals = range of_real"
+definition Reals :: "'a::real_algebra_1 set" ("\<real>")
+ where "\<real> = range of_real"
-notation (xsymbols)
- Reals ("\<real>")
-
-lemma Reals_of_real [simp]: "of_real r \<in> Reals"
+lemma Reals_of_real [simp]: "of_real r \<in> \<real>"
by (simp add: Reals_def)
-lemma Reals_of_int [simp]: "of_int z \<in> Reals"
+lemma Reals_of_int [simp]: "of_int z \<in> \<real>"
by (subst of_real_of_int_eq [symmetric], rule Reals_of_real)
-lemma Reals_of_nat [simp]: "of_nat n \<in> Reals"
+lemma Reals_of_nat [simp]: "of_nat n \<in> \<real>"
by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real)
-lemma Reals_numeral [simp]: "numeral w \<in> Reals"
+lemma Reals_numeral [simp]: "numeral w \<in> \<real>"
by (subst of_real_numeral [symmetric], rule Reals_of_real)
-lemma Reals_0 [simp]: "0 \<in> Reals"
+lemma Reals_0 [simp]: "0 \<in> \<real>"
apply (unfold Reals_def)
apply (rule range_eqI)
apply (rule of_real_0 [symmetric])
done
-lemma Reals_1 [simp]: "1 \<in> Reals"
+lemma Reals_1 [simp]: "1 \<in> \<real>"
apply (unfold Reals_def)
apply (rule range_eqI)
apply (rule of_real_1 [symmetric])
done
-lemma Reals_add [simp]: "\<lbrakk>a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> a + b \<in> Reals"
+lemma Reals_add [simp]: "\<lbrakk>a \<in> \<real>; b \<in> \<real>\<rbrakk> \<Longrightarrow> a + b \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_add [symmetric])
done
-lemma Reals_minus [simp]: "a \<in> Reals \<Longrightarrow> - a \<in> Reals"
+lemma Reals_minus [simp]: "a \<in> \<real> \<Longrightarrow> - a \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_minus [symmetric])
done
-lemma Reals_diff [simp]: "\<lbrakk>a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> a - b \<in> Reals"
+lemma Reals_diff [simp]: "\<lbrakk>a \<in> \<real>; b \<in> \<real>\<rbrakk> \<Longrightarrow> a - b \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_diff [symmetric])
done
-lemma Reals_mult [simp]: "\<lbrakk>a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> a * b \<in> Reals"
+lemma Reals_mult [simp]: "\<lbrakk>a \<in> \<real>; b \<in> \<real>\<rbrakk> \<Longrightarrow> a * b \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_mult [symmetric])
@@ -414,7 +411,7 @@
lemma nonzero_Reals_inverse:
fixes a :: "'a::real_div_algebra"
- shows "\<lbrakk>a \<in> Reals; a \<noteq> 0\<rbrakk> \<Longrightarrow> inverse a \<in> Reals"
+ shows "\<lbrakk>a \<in> \<real>; a \<noteq> 0\<rbrakk> \<Longrightarrow> inverse a \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (erule nonzero_of_real_inverse [symmetric])
@@ -422,7 +419,7 @@
lemma Reals_inverse:
fixes a :: "'a::{real_div_algebra, division_ring}"
- shows "a \<in> Reals \<Longrightarrow> inverse a \<in> Reals"
+ shows "a \<in> \<real> \<Longrightarrow> inverse a \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_inverse [symmetric])
@@ -435,7 +432,7 @@
lemma nonzero_Reals_divide:
fixes a b :: "'a::real_field"
- shows "\<lbrakk>a \<in> Reals; b \<in> Reals; b \<noteq> 0\<rbrakk> \<Longrightarrow> a / b \<in> Reals"
+ shows "\<lbrakk>a \<in> \<real>; b \<in> \<real>; b \<noteq> 0\<rbrakk> \<Longrightarrow> a / b \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (erule nonzero_of_real_divide [symmetric])
@@ -443,7 +440,7 @@
lemma Reals_divide [simp]:
fixes a b :: "'a::{real_field, field}"
- shows "\<lbrakk>a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> a / b \<in> Reals"
+ shows "\<lbrakk>a \<in> \<real>; b \<in> \<real>\<rbrakk> \<Longrightarrow> a / b \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_divide [symmetric])
@@ -451,7 +448,7 @@
lemma Reals_power [simp]:
fixes a :: "'a::{real_algebra_1}"
- shows "a \<in> Reals \<Longrightarrow> a ^ n \<in> Reals"
+ shows "a \<in> \<real> \<Longrightarrow> a ^ n \<in> \<real>"
apply (auto simp add: Reals_def)
apply (rule range_eqI)
apply (rule of_real_power [symmetric])
--- a/src/HOL/SPARK/Examples/RIPEMD-160/Round.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/SPARK/Examples/RIPEMD-160/Round.thy Thu Sep 03 15:50:40 2015 +0200
@@ -427,7 +427,7 @@
h4 = ce_init\<rparr>"
have steps_to_steps':
"steps
- (\<lambda>n\<Colon>nat. word_of_int (x (int n)))
+ (\<lambda>n::nat. word_of_int (x (int n)))
(from_chain ?INIT_CHAIN, from_chain ?INIT_CHAIN)
80 =
from_chain_pair (
--- a/src/HOL/String.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/String.thy Thu Sep 03 15:50:40 2015 +0200
@@ -128,9 +128,9 @@
ML_file "Tools/string_syntax.ML"
lemma UNIV_char:
- "UNIV = image (split Char) (UNIV \<times> UNIV)"
+ "UNIV = image (case_prod Char) (UNIV \<times> UNIV)"
proof (rule UNIV_eq_I)
- fix x show "x \<in> image (split Char) (UNIV \<times> UNIV)" by (cases x) auto
+ fix x show "x \<in> image (case_prod Char) (UNIV \<times> UNIV)" by (cases x) auto
qed
lemma size_char [code, simp]:
@@ -218,7 +218,7 @@
"Enum.enum_ex P \<longleftrightarrow> list_ex P (Enum.enum :: char list)"
lemma enum_char_product_enum_nibble:
- "(Enum.enum :: char list) = map (split Char) (List.product Enum.enum Enum.enum)"
+ "(Enum.enum :: char list) = map (case_prod Char) (List.product Enum.enum Enum.enum)"
by (simp add: enum_char_def enum_nibble_def)
instance proof
@@ -374,7 +374,7 @@
definition size_literal :: "literal \<Rightarrow> nat"
where
- [code]: "size_literal (s\<Colon>literal) = 0"
+ [code]: "size_literal (s::literal) = 0"
instance ..
--- a/src/HOL/Sum_Type.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Sum_Type.thy Thu Sep 03 15:50:40 2015 +0200
@@ -98,7 +98,7 @@
proof -
fix P
fix s :: "'a + 'b"
- assume x: "\<And>x\<Colon>'a. P (Inl x)" and y: "\<And>y\<Colon>'b. P (Inr y)"
+ assume x: "\<And>x::'a. P (Inl x)" and y: "\<And>y::'b. P (Inr y)"
then show "P s" by (auto intro: sumE [of s])
qed (auto dest: Inl_inject Inr_inject simp add: Inl_not_Inr)
@@ -155,7 +155,7 @@
lemma surjective_sum: "case_sum (\<lambda>x::'a. f (Inl x)) (\<lambda>y::'b. f (Inr y)) = f"
proof
fix s :: "'a + 'b"
- show "(case s of Inl (x\<Colon>'a) \<Rightarrow> f (Inl x) | Inr (y\<Colon>'b) \<Rightarrow> f (Inr y)) = f s"
+ show "(case s of Inl (x::'a) \<Rightarrow> f (Inl x) | Inr (y::'b) \<Rightarrow> f (Inr y)) = f s"
by (cases s) simp_all
qed
@@ -186,7 +186,7 @@
assumes "Suml f = Suml g" shows "f = g"
proof
fix x :: 'a
- let ?s = "Inl x \<Colon> 'a + 'b"
+ let ?s = "Inl x :: 'a + 'b"
from assms have "Suml f ?s = Suml g ?s" by simp
then show "f x = g x" by simp
qed
@@ -195,7 +195,7 @@
assumes "Sumr f = Sumr g" shows "f = g"
proof
fix x :: 'b
- let ?s = "Inr x \<Colon> 'a + 'b"
+ let ?s = "Inr x :: 'a + 'b"
from assms have "Sumr f ?s = Sumr g ?s" by simp
then show "f x = g x" by simp
qed
--- a/src/HOL/TPTP/THF_Arith.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/TPTP/THF_Arith.thy Thu Sep 03 15:50:40 2015 +0200
@@ -16,17 +16,17 @@
overloading rat_is_int \<equiv> "is_int :: rat \<Rightarrow> bool"
begin
- definition "rat_is_int (q\<Colon>rat) \<longleftrightarrow> (\<exists>n\<Colon>int. q = of_int n)"
+ definition "rat_is_int (q::rat) \<longleftrightarrow> (\<exists>n::int. q = of_int n)"
end
overloading real_is_int \<equiv> "is_int :: real \<Rightarrow> bool"
begin
- definition "real_is_int (x\<Colon>real) \<longleftrightarrow> x \<in> \<int>"
+ definition "real_is_int (x::real) \<longleftrightarrow> x \<in> \<int>"
end
overloading real_is_rat \<equiv> "is_rat :: real \<Rightarrow> bool"
begin
- definition "real_is_rat (x\<Colon>real) \<longleftrightarrow> x \<in> \<rat>"
+ definition "real_is_rat (x::real) \<longleftrightarrow> x \<in> \<rat>"
end
consts
@@ -36,32 +36,32 @@
overloading rat_to_int \<equiv> "to_int :: rat \<Rightarrow> int"
begin
- definition "rat_to_int (q\<Colon>rat) = floor q"
+ definition "rat_to_int (q::rat) = floor q"
end
overloading real_to_int \<equiv> "to_int :: real \<Rightarrow> int"
begin
- definition "real_to_int (x\<Colon>real) = floor x"
+ definition "real_to_int (x::real) = floor x"
end
overloading int_to_rat \<equiv> "to_rat :: int \<Rightarrow> rat"
begin
- definition "int_to_rat (n\<Colon>int) = (of_int n\<Colon>rat)"
+ definition "int_to_rat (n::int) = (of_int n::rat)"
end
overloading real_to_rat \<equiv> "to_rat :: real \<Rightarrow> rat"
begin
- definition "real_to_rat (x\<Colon>real) = (inv of_rat x\<Colon>rat)"
+ definition "real_to_rat (x::real) = (inv of_rat x::rat)"
end
overloading int_to_real \<equiv> "to_real :: int \<Rightarrow> real"
begin
- definition "int_to_real (n\<Colon>int) = real n"
+ definition "int_to_real (n::int) = real n"
end
overloading rat_to_real \<equiv> "to_real :: rat \<Rightarrow> real"
begin
- definition "rat_to_real (x\<Colon>rat) = (of_rat x\<Colon>real)"
+ definition "rat_to_real (x::rat) = (of_rat x::real)"
end
declare
@@ -75,16 +75,16 @@
int_to_real_def [simp]
rat_to_real_def [simp]
-lemma to_rat_is_int [intro, simp]: "is_int (to_rat (n\<Colon>int))"
+lemma to_rat_is_int [intro, simp]: "is_int (to_rat (n::int))"
by (metis int_to_rat_def rat_is_int_def)
-lemma to_real_is_int [intro, simp]: "is_int (to_real (n\<Colon>int))"
+lemma to_real_is_int [intro, simp]: "is_int (to_real (n::int))"
by (metis Ints_real_of_int int_to_real_def real_is_int_def)
-lemma to_real_is_rat [intro, simp]: "is_rat (to_real (q\<Colon>rat))"
+lemma to_real_is_rat [intro, simp]: "is_rat (to_real (q::rat))"
by (metis Rats_of_rat rat_to_real_def real_is_rat_def)
-lemma inj_of_rat [intro, simp]: "inj (of_rat\<Colon>rat\<Rightarrow>real)"
+lemma inj_of_rat [intro, simp]: "inj (of_rat::rat\<Rightarrow>real)"
by (metis injI of_rat_eq_iff)
end
--- a/src/HOL/TPTP/TPTP_Parser/tptp_parser.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/TPTP/TPTP_Parser/tptp_parser.ML Thu Sep 03 15:50:40 2015 +0200
@@ -65,7 +65,7 @@
fun parse_file' lookahead file_name =
parse_expression
file_name
- (File.open_input TextIO.inputAll (Path.explode file_name))
+ (File.read (Path.explode file_name))
end
val parse_file = parse_file' LOOKAHEAD
--- a/src/HOL/TPTP/TPTP_Proof_Reconstruction_Test.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/TPTP/TPTP_Proof_Reconstruction_Test.thy Thu Sep 03 15:50:40 2015 +0200
@@ -348,7 +348,7 @@
(*FIXME move these examples elsewhere*)
(*
-lemma "\<forall>(Xj\<Colon>TPTP_Interpret.ind) Xk\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>(Xj::TPTP_Interpret.ind) Xk::TPTP_Interpret.ind.
bnd_cCKB6_BLACK Xj Xk \<longrightarrow>
bnd_cCKB6_BLACK (bnd_s (bnd_s (bnd_s Xj))) (bnd_s Xk)"
apply (tactic {*nth (nth just_the_tacs 0) 0*})
--- a/src/HOL/TPTP/TPTP_Proof_Reconstruction_Test_Units.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/TPTP/TPTP_Proof_Reconstruction_Test_Units.thy Thu Sep 03 15:50:40 2015 +0200
@@ -27,8 +27,8 @@
(*
(* SEU581^2.p_nux *)
(* (Annotated_step ("inode1", "bind"), *)
-lemma "\<forall>(SV5\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- SV6\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>(SV5::TPTP_Interpret.ind \<Rightarrow> bool)
+ SV6::TPTP_Interpret.ind.
(bnd_in (bnd_dsetconstr bnd_sK1_A bnd_sK2_SY15)
(bnd_powerset bnd_sK1_A) =
bnd_in (bnd_dsetconstr SV6 SV5)
@@ -66,7 +66,7 @@
done
(* (Annotated_step ("inode2", "bind"), *)
-lemma "\<forall>(SV7\<Colon>TPTP_Interpret.ind) SV8\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>(SV7::TPTP_Interpret.ind) SV8::TPTP_Interpret.ind.
(bnd_subset SV8 SV7 =
bnd_subset (bnd_dsetconstr bnd_sK1_A bnd_sK2_SY15)
bnd_sK1_A) =
@@ -303,12 +303,12 @@
(*SEU882^5*)
(*
lemma
- "\<forall>(SV2\<Colon>TPTP_Interpret.ind)
- SV1\<Colon>TPTP_Interpret.ind \<Rightarrow> TPTP_Interpret.ind.
+ "\<forall>(SV2::TPTP_Interpret.ind)
+ SV1::TPTP_Interpret.ind \<Rightarrow> TPTP_Interpret.ind.
(SV1 SV2 = bnd_sK1_Xy) =
False
\<Longrightarrow>
- \<forall>SV2\<Colon>TPTP_Interpret.ind.
+ \<forall>SV2::TPTP_Interpret.ind.
(bnd_sK1_Xy = bnd_sK1_Xy) =
False"
ML_prf {*
@@ -462,12 +462,12 @@
SEU602_2_bnd_in :: "TPTP_Interpret.ind \<Rightarrow> TPTP_Interpret.ind \<Rightarrow> bool"
(* (Annotated_step ("113", "extuni_func"), *)
-lemma "\<forall>SV49\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+lemma "\<forall>SV49::TPTP_Interpret.ind \<Rightarrow> bool.
(SV49 =
- (\<lambda>SY23\<Colon>TPTP_Interpret.ind.
+ (\<lambda>SY23::TPTP_Interpret.ind.
\<not> SEU602_2_bnd_in SY23 SEU602_2_bnd_sK2_SY17)) =
False \<Longrightarrow>
- \<forall>SV49\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ \<forall>SV49::TPTP_Interpret.ind \<Rightarrow> bool.
(SV49 (SEU602_2_bnd_sK7_E SV49) =
(\<not> SEU602_2_bnd_in (SEU602_2_bnd_sK7_E SV49) SEU602_2_bnd_sK2_SY17)) =
False"
@@ -478,12 +478,12 @@
SEV405_5_bnd_sK1_SY2 :: "(TPTP_Interpret.ind \<Rightarrow> bool) \<Rightarrow> TPTP_Interpret.ind"
SEV405_5_bnd_cA :: bool
-lemma "\<forall>SV1\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
- (\<forall>SY2\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>SV1::TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<forall>SY2::TPTP_Interpret.ind.
\<not> (\<not> (\<not> SV1 SY2 \<or> SEV405_5_bnd_cA) \<or>
\<not> (\<not> SEV405_5_bnd_cA \<or> SV1 SY2))) =
False \<Longrightarrow>
- \<forall>SV1\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ \<forall>SV1::TPTP_Interpret.ind \<Rightarrow> bool.
(\<not> (\<not> (\<not> SV1 (SEV405_5_bnd_sK1_SY2 SV1) \<or> SEV405_5_bnd_cA) \<or>
\<not> (\<not> SEV405_5_bnd_cA \<or> SV1 (SEV405_5_bnd_sK1_SY2 SV1)))) =
False"
@@ -1046,28 +1046,28 @@
\<Rightarrow> TPTP_Interpret.ind
\<Rightarrow> TPTP_Interpret.ind \<Rightarrow> TPTP_Interpret.ind \<Rightarrow> bool"
-lemma "\<forall>(SV4\<Colon>TPTP_Interpret.ind) (SV8\<Colon>TPTP_Interpret.ind)
- (SV6\<Colon>TPTP_Interpret.ind) (SV2\<Colon>TPTP_Interpret.ind)
- (SV3\<Colon>TPTP_Interpret.ind) SV1\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>(SV4::TPTP_Interpret.ind) (SV8::TPTP_Interpret.ind)
+ (SV6::TPTP_Interpret.ind) (SV2::TPTP_Interpret.ind)
+ (SV3::TPTP_Interpret.ind) SV1::TPTP_Interpret.ind.
((SV1 \<noteq> SV3) = False \<or> PUZ107_5_bnd_sK1_SX0 SV1 SV2 SV6 SV8 = False) \<or>
PUZ107_5_bnd_sK1_SX0 SV3 SV4 SV6 SV8 = False \<Longrightarrow>
-\<forall>(SV4\<Colon>TPTP_Interpret.ind) (SV8\<Colon>TPTP_Interpret.ind)
- (SV6\<Colon>TPTP_Interpret.ind) (SV2\<Colon>TPTP_Interpret.ind)
- (SV3\<Colon>TPTP_Interpret.ind) SV1\<Colon>TPTP_Interpret.ind.
+\<forall>(SV4::TPTP_Interpret.ind) (SV8::TPTP_Interpret.ind)
+ (SV6::TPTP_Interpret.ind) (SV2::TPTP_Interpret.ind)
+ (SV3::TPTP_Interpret.ind) SV1::TPTP_Interpret.ind.
((SV1 = SV3) = True \<or> PUZ107_5_bnd_sK1_SX0 SV1 SV2 SV6 SV8 = False) \<or>
PUZ107_5_bnd_sK1_SX0 SV3 SV4 SV6 SV8 = False"
by (tactic {*nonfull_extcnf_combined_tac @{context} [Not_neg]*})
lemma "
-\<forall>(SV8\<Colon>TPTP_Interpret.ind) (SV6\<Colon>TPTP_Interpret.ind)
- (SV4\<Colon>TPTP_Interpret.ind) (SV2\<Colon>TPTP_Interpret.ind)
- (SV3\<Colon>TPTP_Interpret.ind) SV1\<Colon>TPTP_Interpret.ind.
+\<forall>(SV8::TPTP_Interpret.ind) (SV6::TPTP_Interpret.ind)
+ (SV4::TPTP_Interpret.ind) (SV2::TPTP_Interpret.ind)
+ (SV3::TPTP_Interpret.ind) SV1::TPTP_Interpret.ind.
((SV1 \<noteq> SV3 \<or> SV2 \<noteq> SV4) = False \<or>
PUZ107_5_bnd_sK1_SX0 SV1 SV2 SV6 SV8 = False) \<or>
PUZ107_5_bnd_sK1_SX0 SV3 SV4 SV6 SV8 = False \<Longrightarrow>
-\<forall>(SV4\<Colon>TPTP_Interpret.ind) (SV8\<Colon>TPTP_Interpret.ind)
- (SV6\<Colon>TPTP_Interpret.ind) (SV2\<Colon>TPTP_Interpret.ind)
- (SV3\<Colon>TPTP_Interpret.ind) SV1\<Colon>TPTP_Interpret.ind.
+\<forall>(SV4::TPTP_Interpret.ind) (SV8::TPTP_Interpret.ind)
+ (SV6::TPTP_Interpret.ind) (SV2::TPTP_Interpret.ind)
+ (SV3::TPTP_Interpret.ind) SV1::TPTP_Interpret.ind.
((SV1 \<noteq> SV3) = False \<or> PUZ107_5_bnd_sK1_SX0 SV1 SV2 SV6 SV8 = False) \<or>
PUZ107_5_bnd_sK1_SX0 SV3 SV4 SV6 SV8 = False"
by (tactic {*nonfull_extcnf_combined_tac @{context} [Or_neg]*})
@@ -1081,70 +1081,70 @@
NUM016_5_bnd_less :: "TPTP_Interpret.ind \<Rightarrow> TPTP_Interpret.ind \<Rightarrow> bool"
(* (Annotated_step ("6", "unfold_def"), *)
-lemma "((((((((((((\<forall>X\<Colon>TPTP_Interpret.ind. \<not> NUM016_5_bnd_less X X) \<and>
- (\<forall>(X\<Colon>TPTP_Interpret.ind)
- Y\<Colon>TPTP_Interpret.ind.
+lemma "((((((((((((\<forall>X::TPTP_Interpret.ind. \<not> NUM016_5_bnd_less X X) \<and>
+ (\<forall>(X::TPTP_Interpret.ind)
+ Y::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_less X Y \<or> \<not> NUM016_5_bnd_less Y X)) \<and>
- (\<forall>X\<Colon>TPTP_Interpret.ind. NUM016_5_bnd_divides X X)) \<and>
- (\<forall>(X\<Colon>TPTP_Interpret.ind)
- (Y\<Colon>TPTP_Interpret.ind)
- Z\<Colon>TPTP_Interpret.ind.
+ (\<forall>X::TPTP_Interpret.ind. NUM016_5_bnd_divides X X)) \<and>
+ (\<forall>(X::TPTP_Interpret.ind)
+ (Y::TPTP_Interpret.ind)
+ Z::TPTP_Interpret.ind.
(\<not> NUM016_5_bnd_divides X Y \<or> \<not> NUM016_5_bnd_divides Y Z) \<or>
NUM016_5_bnd_divides X Z)) \<and>
- (\<forall>(X\<Colon>TPTP_Interpret.ind) Y\<Colon>TPTP_Interpret.ind.
+ (\<forall>(X::TPTP_Interpret.ind) Y::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_divides X Y \<or> \<not> NUM016_5_bnd_less Y X)) \<and>
- (\<forall>X\<Colon>TPTP_Interpret.ind.
+ (\<forall>X::TPTP_Interpret.ind.
NUM016_5_bnd_less X (NUM016_5_bnd_factorial_plus_one X))) \<and>
- (\<forall>(X\<Colon>TPTP_Interpret.ind) Y\<Colon>TPTP_Interpret.ind.
+ (\<forall>(X::TPTP_Interpret.ind) Y::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_divides X (NUM016_5_bnd_factorial_plus_one Y) \<or>
NUM016_5_bnd_less Y X)) \<and>
- (\<forall>X\<Colon>TPTP_Interpret.ind.
+ (\<forall>X::TPTP_Interpret.ind.
NUM016_5_bnd_prime X \<or>
NUM016_5_bnd_divides (NUM016_5_bnd_prime_divisor X) X)) \<and>
- (\<forall>X\<Colon>TPTP_Interpret.ind.
+ (\<forall>X::TPTP_Interpret.ind.
NUM016_5_bnd_prime X \<or>
NUM016_5_bnd_prime (NUM016_5_bnd_prime_divisor X))) \<and>
- (\<forall>X\<Colon>TPTP_Interpret.ind.
+ (\<forall>X::TPTP_Interpret.ind.
NUM016_5_bnd_prime X \<or>
NUM016_5_bnd_less (NUM016_5_bnd_prime_divisor X) X)) \<and>
NUM016_5_bnd_prime NUM016_5_bnd_a) \<and>
- (\<forall>X\<Colon>TPTP_Interpret.ind.
+ (\<forall>X::TPTP_Interpret.ind.
(\<not> NUM016_5_bnd_prime X \<or> \<not> NUM016_5_bnd_less NUM016_5_bnd_a X) \<or>
NUM016_5_bnd_less (NUM016_5_bnd_factorial_plus_one NUM016_5_bnd_a) X)) =
True \<Longrightarrow>
- (\<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ (\<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> \<not> (\<not> (\<forall>SX0::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_less SX0 SX0) \<or>
- \<not> (\<forall>(SX0\<Colon>TPTP_Interpret.ind)
- SX1\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>(SX0::TPTP_Interpret.ind)
+ SX1::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_less SX0 SX1 \<or> \<not> NUM016_5_bnd_less SX1 SX0)) \<or>
- \<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>SX0::TPTP_Interpret.ind.
NUM016_5_bnd_divides SX0 SX0)) \<or>
- \<not> (\<forall>(SX0\<Colon>TPTP_Interpret.ind)
- (SX1\<Colon>TPTP_Interpret.ind)
- SX2\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>(SX0::TPTP_Interpret.ind)
+ (SX1::TPTP_Interpret.ind)
+ SX2::TPTP_Interpret.ind.
(\<not> NUM016_5_bnd_divides SX0 SX1 \<or>
\<not> NUM016_5_bnd_divides SX1 SX2) \<or>
NUM016_5_bnd_divides SX0 SX2)) \<or>
- \<not> (\<forall>(SX0\<Colon>TPTP_Interpret.ind)
- SX1\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>(SX0::TPTP_Interpret.ind)
+ SX1::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_divides SX0 SX1 \<or>
\<not> NUM016_5_bnd_less SX1 SX0)) \<or>
- \<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>SX0::TPTP_Interpret.ind.
NUM016_5_bnd_less SX0 (NUM016_5_bnd_factorial_plus_one SX0))) \<or>
- \<not> (\<forall>(SX0\<Colon>TPTP_Interpret.ind) SX1\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>(SX0::TPTP_Interpret.ind) SX1::TPTP_Interpret.ind.
\<not> NUM016_5_bnd_divides SX0 (NUM016_5_bnd_factorial_plus_one SX1) \<or>
NUM016_5_bnd_less SX1 SX0)) \<or>
- \<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>SX0::TPTP_Interpret.ind.
NUM016_5_bnd_prime SX0 \<or>
NUM016_5_bnd_divides (NUM016_5_bnd_prime_divisor SX0) SX0)) \<or>
- \<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>SX0::TPTP_Interpret.ind.
NUM016_5_bnd_prime SX0 \<or> NUM016_5_bnd_prime (NUM016_5_bnd_prime_divisor SX0))) \<or>
- \<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>SX0::TPTP_Interpret.ind.
NUM016_5_bnd_prime SX0 \<or>
NUM016_5_bnd_less (NUM016_5_bnd_prime_divisor SX0)
SX0)) \<or>
\<not> NUM016_5_bnd_prime NUM016_5_bnd_a) \<or>
- \<not> (\<forall>SX0\<Colon>TPTP_Interpret.ind.
+ \<not> (\<forall>SX0::TPTP_Interpret.ind.
(\<not> NUM016_5_bnd_prime SX0 \<or> \<not> NUM016_5_bnd_less NUM016_5_bnd_a SX0) \<or>
NUM016_5_bnd_less (NUM016_5_bnd_factorial_plus_one NUM016_5_bnd_a)
SX0))) =
@@ -1248,7 +1248,7 @@
(*test that nullary skolem terms are OK*)
(* (Annotated_step ("79", "extcnf_forall_neg"), *)
-lemma "(\<forall>SX0\<Colon>TPTP_Interpret.ind.
+lemma "(\<forall>SX0::TPTP_Interpret.ind.
AGT037_2_bnd_possibly_likes AGT037_2_bnd_jan AGT037_2_bnd_cola SX0) =
False \<Longrightarrow>
AGT037_2_bnd_possibly_likes AGT037_2_bnd_jan AGT037_2_bnd_cola AGT037_2_bnd_sK1_SX0 =
@@ -1256,27 +1256,27 @@
by (tactic {*nonfull_extcnf_combined_tac @{context} [Existential_Var]*})
(* (Annotated_step ("202", "extcnf_forall_neg"), *)
-lemma "\<forall>(SV13\<Colon>TPTP_Interpret.ind) (SV39\<Colon>AGT037_2_bnd_mu) (SV29\<Colon>AGT037_2_bnd_mu)
- SV45\<Colon>TPTP_Interpret.ind.
- ((((\<forall>SY68\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>(SV13::TPTP_Interpret.ind) (SV39::AGT037_2_bnd_mu) (SV29::AGT037_2_bnd_mu)
+ SV45::TPTP_Interpret.ind.
+ ((((\<forall>SY68::TPTP_Interpret.ind.
\<not> AGT037_2_bnd_a1 SV45 SY68 \<or>
AGT037_2_bnd_likes SV29 SV39 SY68) =
False \<or>
- (\<not> (\<forall>SY69\<Colon>TPTP_Interpret.ind.
+ (\<not> (\<forall>SY69::TPTP_Interpret.ind.
\<not> AGT037_2_bnd_a2 SV45 SY69 \<or>
AGT037_2_bnd_likes SV29 SV39 SY69)) =
True) \<or>
AGT037_2_bnd_likes SV29 SV39 SV45 = False) \<or>
AGT037_2_bnd_very_much_likes SV29 SV39 SV45 = True) \<or>
AGT037_2_bnd_a3 SV13 SV45 = False \<Longrightarrow>
- \<forall>(SV29\<Colon>AGT037_2_bnd_mu) (SV39\<Colon>AGT037_2_bnd_mu) (SV13\<Colon>TPTP_Interpret.ind)
- SV45\<Colon>TPTP_Interpret.ind.
+ \<forall>(SV29::AGT037_2_bnd_mu) (SV39::AGT037_2_bnd_mu) (SV13::TPTP_Interpret.ind)
+ SV45::TPTP_Interpret.ind.
((((\<not> AGT037_2_bnd_a1 SV45
(AGT037_2_bnd_sK5_SY68 SV13 SV39 SV29 SV45) \<or>
AGT037_2_bnd_likes SV29 SV39
(AGT037_2_bnd_sK5_SY68 SV13 SV39 SV29 SV45)) =
False \<or>
- (\<not> (\<forall>SY69\<Colon>TPTP_Interpret.ind.
+ (\<not> (\<forall>SY69::TPTP_Interpret.ind.
\<not> AGT037_2_bnd_a2 SV45 SY69 \<or>
AGT037_2_bnd_likes SV29 SV39 SY69)) =
True) \<or>
@@ -1555,10 +1555,10 @@
bnd_addition bnd_sK2_X2 bnd_sK1_X1) =
True \<Longrightarrow>
(bnd_sup
- (\<lambda>SX0\<Colon>TPTP_Interpret.ind.
+ (\<lambda>SX0::TPTP_Interpret.ind.
SX0 = bnd_sK1_X1 \<or> SX0 = bnd_sK2_X2) \<noteq>
bnd_sup
- (\<lambda>SX0\<Colon>TPTP_Interpret.ind.
+ (\<lambda>SX0::TPTP_Interpret.ind.
SX0 = bnd_sK2_X2 \<or> SX0 = bnd_sK1_X1)) =
True"
by (tactic {*rtac (leo2_tac @{context} (hd prob_names) "20") 1*})
@@ -2011,60 +2011,60 @@
(* (Annotated_step ("12", "unfold_def"), *)
lemma "bnd_mor =
- (\<lambda>(X\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- (Y\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) U\<Colon>TPTP_Interpret.ind.
+ (\<lambda>(X::TPTP_Interpret.ind \<Rightarrow> bool)
+ (Y::TPTP_Interpret.ind \<Rightarrow> bool) U::TPTP_Interpret.ind.
X U \<or> Y U) \<and>
bnd_mnot =
- (\<lambda>(X\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) U\<Colon>TPTP_Interpret.ind.
+ (\<lambda>(X::TPTP_Interpret.ind \<Rightarrow> bool) U::TPTP_Interpret.ind.
\<not> X U) \<and>
bnd_mimplies =
- (\<lambda>U\<Colon>TPTP_Interpret.ind \<Rightarrow> bool. bnd_mor (bnd_mnot U)) \<and>
+ (\<lambda>U::TPTP_Interpret.ind \<Rightarrow> bool. bnd_mor (bnd_mnot U)) \<and>
bnd_mbox_s4 =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) X\<Colon>TPTP_Interpret.ind.
- \<forall>Y\<Colon>TPTP_Interpret.ind. bnd_irel X Y \<longrightarrow> P Y) \<and>
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool) X::TPTP_Interpret.ind.
+ \<forall>Y::TPTP_Interpret.ind. bnd_irel X Y \<longrightarrow> P Y) \<and>
bnd_mand =
- (\<lambda>(X\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- (Y\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) U\<Colon>TPTP_Interpret.ind.
+ (\<lambda>(X::TPTP_Interpret.ind \<Rightarrow> bool)
+ (Y::TPTP_Interpret.ind \<Rightarrow> bool) U::TPTP_Interpret.ind.
X U \<and> Y U) \<and>
bnd_ixor =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_inot (bnd_iequiv P Q)) \<and>
bnd_ivalid = All \<and>
- bnd_itrue = (\<lambda>W\<Colon>TPTP_Interpret.ind. True) \<and>
+ bnd_itrue = (\<lambda>W::TPTP_Interpret.ind. True) \<and>
bnd_isatisfiable = Ex \<and>
bnd_ior =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_mor (bnd_mbox_s4 P) (bnd_mbox_s4 Q)) \<and>
bnd_inot =
- (\<lambda>P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>P::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_mnot (bnd_mbox_s4 P)) \<and>
bnd_iinvalid =
- (\<lambda>Phi\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
- \<forall>W\<Colon>TPTP_Interpret.ind. \<not> Phi W) \<and>
+ (\<lambda>Phi::TPTP_Interpret.ind \<Rightarrow> bool.
+ \<forall>W::TPTP_Interpret.ind. \<not> Phi W) \<and>
bnd_iimplies =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_mimplies (bnd_mbox_s4 P) (bnd_mbox_s4 Q)) \<and>
bnd_iimplied =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool. bnd_iimplies Q P) \<and>
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool. bnd_iimplies Q P) \<and>
bnd_ifalse = bnd_inot bnd_itrue \<and>
bnd_iequiv =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_iand (bnd_iimplies P Q) (bnd_iimplies Q P)) \<and>
bnd_icountersatisfiable =
- (\<lambda>Phi\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
- \<exists>W\<Colon>TPTP_Interpret.ind. \<not> Phi W) \<and>
- bnd_iatom = (\<lambda>P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool. P) \<and>
+ (\<lambda>Phi::TPTP_Interpret.ind \<Rightarrow> bool.
+ \<exists>W::TPTP_Interpret.ind. \<not> Phi W) \<and>
+ bnd_iatom = (\<lambda>P::TPTP_Interpret.ind \<Rightarrow> bool. P) \<and>
bnd_iand = bnd_mand \<and>
- (\<forall>(X\<Colon>TPTP_Interpret.ind) (Y\<Colon>TPTP_Interpret.ind)
- Z\<Colon>TPTP_Interpret.ind.
+ (\<forall>(X::TPTP_Interpret.ind) (Y::TPTP_Interpret.ind)
+ Z::TPTP_Interpret.ind.
bnd_irel X Y \<and> bnd_irel Y Z \<longrightarrow> bnd_irel X Z) \<Longrightarrow>
- (\<forall>(X\<Colon>TPTP_Interpret.ind) (Y\<Colon>TPTP_Interpret.ind)
- Z\<Colon>TPTP_Interpret.ind.
+ (\<forall>(X::TPTP_Interpret.ind) (Y::TPTP_Interpret.ind)
+ Z::TPTP_Interpret.ind.
bnd_irel X Y \<and> bnd_irel Y Z \<longrightarrow> bnd_irel X Z) =
True"
(* by (tactic {*tectoc @{context}*}) *)
@@ -2072,61 +2072,61 @@
(* (Annotated_step ("11", "unfold_def"), *)
lemma "bnd_mor =
- (\<lambda>(X\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- (Y\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) U\<Colon>TPTP_Interpret.ind.
+ (\<lambda>(X::TPTP_Interpret.ind \<Rightarrow> bool)
+ (Y::TPTP_Interpret.ind \<Rightarrow> bool) U::TPTP_Interpret.ind.
X U \<or> Y U) \<and>
bnd_mnot =
- (\<lambda>(X\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) U\<Colon>TPTP_Interpret.ind.
+ (\<lambda>(X::TPTP_Interpret.ind \<Rightarrow> bool) U::TPTP_Interpret.ind.
\<not> X U) \<and>
bnd_mimplies =
- (\<lambda>U\<Colon>TPTP_Interpret.ind \<Rightarrow> bool. bnd_mor (bnd_mnot U)) \<and>
+ (\<lambda>U::TPTP_Interpret.ind \<Rightarrow> bool. bnd_mor (bnd_mnot U)) \<and>
bnd_mbox_s4 =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) X\<Colon>TPTP_Interpret.ind.
- \<forall>Y\<Colon>TPTP_Interpret.ind. bnd_irel X Y \<longrightarrow> P Y) \<and>
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool) X::TPTP_Interpret.ind.
+ \<forall>Y::TPTP_Interpret.ind. bnd_irel X Y \<longrightarrow> P Y) \<and>
bnd_mand =
- (\<lambda>(X\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- (Y\<Colon>TPTP_Interpret.ind \<Rightarrow> bool) U\<Colon>TPTP_Interpret.ind.
+ (\<lambda>(X::TPTP_Interpret.ind \<Rightarrow> bool)
+ (Y::TPTP_Interpret.ind \<Rightarrow> bool) U::TPTP_Interpret.ind.
X U \<and> Y U) \<and>
bnd_ixor =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_inot (bnd_iequiv P Q)) \<and>
bnd_ivalid = All \<and>
- bnd_itrue = (\<lambda>W\<Colon>TPTP_Interpret.ind. True) \<and>
+ bnd_itrue = (\<lambda>W::TPTP_Interpret.ind. True) \<and>
bnd_isatisfiable = Ex \<and>
bnd_ior =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_mor (bnd_mbox_s4 P) (bnd_mbox_s4 Q)) \<and>
bnd_inot =
- (\<lambda>P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>P::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_mnot (bnd_mbox_s4 P)) \<and>
bnd_iinvalid =
- (\<lambda>Phi\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
- \<forall>W\<Colon>TPTP_Interpret.ind. \<not> Phi W) \<and>
+ (\<lambda>Phi::TPTP_Interpret.ind \<Rightarrow> bool.
+ \<forall>W::TPTP_Interpret.ind. \<not> Phi W) \<and>
bnd_iimplies =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_mimplies (bnd_mbox_s4 P) (bnd_mbox_s4 Q)) \<and>
bnd_iimplied =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool. bnd_iimplies Q P) \<and>
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool. bnd_iimplies Q P) \<and>
bnd_ifalse = bnd_inot bnd_itrue \<and>
bnd_iequiv =
- (\<lambda>(P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool)
- Q\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<lambda>(P::TPTP_Interpret.ind \<Rightarrow> bool)
+ Q::TPTP_Interpret.ind \<Rightarrow> bool.
bnd_iand (bnd_iimplies P Q) (bnd_iimplies Q P)) \<and>
bnd_icountersatisfiable =
- (\<lambda>Phi\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
- \<exists>W\<Colon>TPTP_Interpret.ind. \<not> Phi W) \<and>
- bnd_iatom = (\<lambda>P\<Colon>TPTP_Interpret.ind \<Rightarrow> bool. P) \<and>
+ (\<lambda>Phi::TPTP_Interpret.ind \<Rightarrow> bool.
+ \<exists>W::TPTP_Interpret.ind. \<not> Phi W) \<and>
+ bnd_iatom = (\<lambda>P::TPTP_Interpret.ind \<Rightarrow> bool. P) \<and>
bnd_iand = bnd_mand \<and>
bnd_ivalid
(bnd_iimplies (bnd_iatom bnd_q) (bnd_iatom bnd_r)) \<Longrightarrow>
- (\<forall>SY161\<Colon>TPTP_Interpret.ind.
- \<not> (\<forall>SY162\<Colon>TPTP_Interpret.ind.
+ (\<forall>SY161::TPTP_Interpret.ind.
+ \<not> (\<forall>SY162::TPTP_Interpret.ind.
bnd_irel SY161 SY162 \<longrightarrow> bnd_q SY162) \<or>
- (\<forall>SY163\<Colon>TPTP_Interpret.ind.
+ (\<forall>SY163::TPTP_Interpret.ind.
bnd_irel SY161 SY163 \<longrightarrow> bnd_r SY163)) =
True"
(* by (tactic {*tectoc @{context}*}) *)
@@ -2147,12 +2147,12 @@
*)
(* (Annotated_step ("11", "extcnf_forall_neg"), *)
-lemma "\<forall>SV1\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
- (\<forall>SY2\<Colon>TPTP_Interpret.ind.
+lemma "\<forall>SV1::TPTP_Interpret.ind \<Rightarrow> bool.
+ (\<forall>SY2::TPTP_Interpret.ind.
\<not> (\<not> (\<not> SV1 SY2 \<or> SEV405_5_bnd_cA) \<or>
\<not> (\<not> SEV405_5_bnd_cA \<or> SV1 SY2))) =
False \<Longrightarrow>
- \<forall>SV1\<Colon>TPTP_Interpret.ind \<Rightarrow> bool.
+ \<forall>SV1::TPTP_Interpret.ind \<Rightarrow> bool.
(\<not> (\<not> (\<not> SV1 (SEV405_5_bnd_sK1_SY2 SV1) \<or> SEV405_5_bnd_cA) \<or>
\<not> (\<not> SEV405_5_bnd_cA \<or> SV1 (SEV405_5_bnd_sK1_SY2 SV1)))) =
False"
@@ -2184,7 +2184,7 @@
(*from SYO198^5.p.out*)
(* [[(Annotated_step ("11", "extcnf_forall_special_pos"), *)
-lemma "(\<forall>SX0\<Colon>bool \<Rightarrow> bool.
+lemma "(\<forall>SX0::bool \<Rightarrow> bool.
\<not> \<not> (\<not> SX0 bnd_sK1_Xx \<or> \<not> SX0 bnd_sK2_Xy)) =
True \<Longrightarrow>
(\<not> \<not> (\<not> True \<or> \<not> True)) = True"
@@ -2192,7 +2192,7 @@
done
(* (Annotated_step ("13", "extcnf_forall_special_pos"), *)
-lemma "(\<forall>SX0\<Colon>bool \<Rightarrow> bool.
+lemma "(\<forall>SX0::bool \<Rightarrow> bool.
\<not> \<not> (\<not> SX0 bnd_sK1_Xx \<or> \<not> SX0 bnd_sK2_Xy)) =
True \<Longrightarrow>
(\<not> \<not> (\<not> bnd_sK1_Xx \<or> \<not> bnd_sK2_Xy)) = True"
@@ -2200,9 +2200,9 @@
done
(* [[(Annotated_step ("8", "polarity_switch"), *)
-lemma "(\<forall>(Xx\<Colon>bool) (Xy\<Colon>bool) Xz\<Colon>bool. True \<and> True \<longrightarrow> True) =
+lemma "(\<forall>(Xx::bool) (Xy::bool) Xz::bool. True \<and> True \<longrightarrow> True) =
False \<Longrightarrow>
- (\<not> (\<forall>(Xx\<Colon>bool) (Xy\<Colon>bool) Xz\<Colon>bool.
+ (\<not> (\<forall>(Xx::bool) (Xy::bool) Xz::bool.
True \<and> True \<longrightarrow> True)) =
True"
apply (tactic {*nonfull_extcnf_combined_tac @{context} [Polarity_switch]*})
--- a/src/HOL/Tools/ATP/atp_proof.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/ATP/atp_proof.ML Thu Sep 03 15:50:40 2015 +0200
@@ -404,7 +404,7 @@
and parse_quantified_formula x =
(($$ tptp_forall >> K AForall || $$ tptp_exists >> K AExists)
--| $$ "[" -- parse_terms --| $$ "]" --| $$ ":" -- parse_literal
- >> (fn ((q, ts), phi) => AQuant (q, map (fn ATerm ((s, []), _) => (s, NONE)) ts, phi))) x
+ >> (fn ((q, ts), phi) => AQuant (q, map (fn ATerm ((s, _), _) => (s, NONE)) ts, phi))) x
val parse_tstp_extra_arguments =
Scan.optional ($$ "," |-- parse_source --| Scan.option ($$ "," |-- skip_term)) dummy_inference
--- a/src/HOL/Tools/ATP/scripts/remote_atp Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/ATP/scripts/remote_atp Thu Sep 03 15:50:40 2015 +0200
@@ -12,7 +12,7 @@
use LWP;
my $SystemOnTPTPFormReplyURL =
- "http://pages.cs.miami.edu/~tptp/cgi-bin/SystemOnTPTPFormReply";
+ "http://www.cs.miami.edu/~tptp/cgi-bin/SystemOnTPTPFormReply";
# default parameters
my %URLParameters = (
--- a/src/HOL/Tools/BNF/bnf_def.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/BNF/bnf_def.ML Thu Sep 03 15:50:40 2015 +0200
@@ -809,7 +809,7 @@
end;
fun maybe_restore lthy_old lthy =
- lthy |> not (Theory.eq_thy (apply2 Proof_Context.theory_of (lthy_old, lthy)))
+ lthy |> not (Context.eq_thy (apply2 Proof_Context.theory_of (lthy_old, lthy)))
? Local_Theory.restore;
val map_bind_def =
--- a/src/HOL/Tools/BNF/bnf_lift.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/BNF/bnf_lift.ML Thu Sep 03 15:50:40 2015 +0200
@@ -6,9 +6,11 @@
Lifting of BNFs through typedefs.
*)
-signature BNF_LIFT = sig
- datatype lift_bnf_option = Plugins_Option of Proof.context -> Plugin_Name.filter | No_Warn_Wits
-
+signature BNF_LIFT =
+sig
+ datatype lift_bnf_option =
+ Plugins_Option of Proof.context -> Plugin_Name.filter
+ | No_Warn_Wits
val copy_bnf:
(((lift_bnf_option list * (binding option * (string * sort option)) list) *
string) * thm option) * (binding * binding) ->
@@ -26,34 +28,39 @@
((((lift_bnf_option list * (binding option * (string * string option)) list) *
string) * string list) * (Facts.ref * Token.src list) option) * (binding * binding) ->
local_theory -> Proof.state
- end
+end
-structure BNF_Lift : BNF_LIFT = struct
+structure BNF_Lift : BNF_LIFT =
+struct
open Ctr_Sugar_Tactics
open BNF_Util
open BNF_Comp
open BNF_Def
-datatype lift_bnf_option = Plugins_Option of Proof.context -> Plugin_Name.filter | No_Warn_Wits
+
+(* typedef_bnf *)
+
+datatype lift_bnf_option =
+ Plugins_Option of Proof.context -> Plugin_Name.filter
+| No_Warn_Wits;
fun typedef_bnf thm wits specs map_b rel_b opts lthy =
let
- val plugins = get_first (fn Plugins_Option f => SOME (f lthy) | _ => NONE) (rev opts)
+ val plugins =
+ get_first (fn Plugins_Option f => SOME (f lthy) | _ => NONE) (rev opts)
|> the_default Plugin_Name.default_filter;
- val no_warn_wits = exists (can (fn Sequential_Option => ())) opts;
+ val no_warn_wits = exists (fn No_Warn_Wits => true | _ => false) opts;
(* extract Rep Abs F RepT AbsT *)
- val (_, [Rep_G, Abs_G, F]) = Thm.prop_of thm
- |> HOLogic.dest_Trueprop
- |> Term.strip_comb;
- val typ_Abs_G = fastype_of Abs_G |> dest_funT;
+ val (_, [Rep_G, Abs_G, F]) = Term.strip_comb (HOLogic.dest_Trueprop (Thm.prop_of thm));
+ val typ_Abs_G = dest_funT (fastype_of Abs_G);
val RepT = fst typ_Abs_G; (* F *)
val AbsT = snd typ_Abs_G; (* G *)
val AbsT_name = fst (dest_Type AbsT);
val tvs = AbsT |> dest_Type |> snd |> map (fst o dest_TVar);
val alpha0s = map (TFree o snd) specs;
-
+
(* instantiate the new type variables newtvs to oldtvs *)
val subst = subst_TVars (tvs ~~ alpha0s);
val typ_subst = typ_subst_TVars (tvs ~~ alpha0s);
@@ -64,8 +71,9 @@
val RepT = typ_subst RepT;
val AbsT = typ_subst AbsT;
- fun flatten_tyargs Ass = map dest_TFree alpha0s |>
- filter (fn T => exists (fn Ts => member (op =) Ts T) Ass);
+ fun flatten_tyargs Ass =
+ map dest_TFree alpha0s
+ |> filter (fn T => exists (fn Ts => member (op =) Ts T) Ass);
val Ds0 = filter (is_none o fst) specs |> map snd;
@@ -74,10 +82,11 @@
bnf_of_typ Dont_Inline (Binding.qualify true AbsT_name) flatten_tyargs []
Ds0 RepT ((empty_comp_cache, empty_unfolds), lthy);
- val set_bs = map (fn T => find_index (fn U => T = U) alpha0s) alphas
+ val set_bs =
+ map (fn T => find_index (fn U => T = U) alpha0s) alphas
|> map (the_default Binding.empty o fst o nth specs);
- val _ = case alphas of [] => error "No live variables." | alphas => alphas;
+ val _ = (case alphas of [] => error "No live variables" | _ => ());
val defs = #map_unfolds unfolds @ flat (#set_unfoldss unfolds) @ #rel_unfolds unfolds;
@@ -113,11 +122,11 @@
(* val map_closed_F = @{term "\<And>f x. x \<in> F \<Longrightarrow> map_F f x \<in> F"}; *)
val (var_fs, names_lthy) = mk_Frees "f" typ_fs names_lthy;
val (var_x, names_lthy) = mk_Frees "x" [typ_aF] names_lthy |>> the_single;
- val mem_x = HOLogic.mk_mem (var_x, aF_set) |> HOLogic.mk_Trueprop;
+ val mem_x = HOLogic.mk_Trueprop (HOLogic.mk_mem (var_x, aF_set));
val map_f = list_comb (map_F, var_fs);
- val mem_map = HOLogic.mk_mem (map_f $ var_x, bF_set) |> HOLogic.mk_Trueprop;
+ val mem_map = HOLogic.mk_Trueprop (HOLogic.mk_mem (map_f $ var_x, bF_set));
val imp_map = Logic.mk_implies (mem_x, mem_map);
- val map_closed_F = Library.foldr (Library.uncurry Logic.all) (var_fs, Logic.all var_x imp_map);
+ val map_closed_F = fold_rev Logic.all var_fs (Logic.all var_x imp_map);
(* val zip_closed_F = @{term "\<And>z. map_F fst z \<in> F \<Longrightarrow> map_F snd z \<in> F \<Longrightarrow> z \<in> F"}; *)
val (var_zs, names_lthy) = mk_Frees "z" [typ_pair] names_lthy;
@@ -126,10 +135,10 @@
val fsts = map (fst o Term.strip_comb o HOLogic.mk_fst) pairs;
val snds = map (fst o Term.strip_comb o HOLogic.mk_snd) pairs;
val map_fst = list_comb (list_comb (map_F_fst, fsts), var_zs);
- val mem_map_fst = HOLogic.mk_mem (map_fst, aF_set) |> HOLogic.mk_Trueprop;
+ val mem_map_fst = HOLogic.mk_Trueprop (HOLogic.mk_mem (map_fst, aF_set));
val map_snd = list_comb (list_comb (map_F_snd, snds), var_zs);
- val mem_map_snd = HOLogic.mk_mem (map_snd, aF_set') |> HOLogic.mk_Trueprop;
- val mem_z = HOLogic.mk_mem (var_z, pairF_set) |> HOLogic.mk_Trueprop;
+ val mem_map_snd = HOLogic.mk_Trueprop (HOLogic.mk_mem (map_snd, aF_set'));
+ val mem_z = HOLogic.mk_Trueprop (HOLogic.mk_mem (var_z, pairF_set));
val imp_zip = Logic.mk_implies (mem_map_fst, Logic.mk_implies (mem_map_snd, mem_z));
val zip_closed_F = Logic.all var_z imp_zip;
@@ -139,15 +148,11 @@
val Iwits = the_default wits_F (Option.map (map (`(map (fn T =>
find_index (fn U => T = U) alphas) o fst o strip_type o fastype_of))) wits);
val wit_closed_Fs =
- map (fn (I, wit_F) =>
+ Iwits |> map (fn (I, wit_F) =>
let
val vars = map (nth var_as) I;
val wit_a = list_comb (wit_F, vars);
- in
- Library.foldr (Library.uncurry Logic.all) (vars,
- HOLogic.mk_mem (wit_a, aF_set) |> HOLogic.mk_Trueprop)
- end)
- Iwits;
+ in fold_rev Logic.all vars (HOLogic.mk_Trueprop (HOLogic.mk_mem (wit_a, aF_set))) end);
val mk_wit_goals = mk_wit_goals var_as var_bs
(mk_sets_of_bnf (replicate lives deads) (replicate lives alphas) bnf);
@@ -156,159 +161,166 @@
(case wits of NONE => [] | _ => maps mk_wit_goals Iwits);
val lost_wits = filter_out (fn (J, _) => exists (fn (I, _) => I = J) Iwits) wits_F;
- val _ = if null lost_wits orelse no_warn_wits then () else
- lost_wits
- |> map (Syntax.pretty_typ lthy o fastype_of o snd)
- |> Pretty.big_list
- "The following types of nonemptiness witnesses of the raw type's BNF were lost:"
- |> (fn pt => Pretty.chunks [pt,
- Pretty.para "You can specify a liftable witness (e.g., a term of one of the above types\
- \ that satisfies the typedef's invariant)\
- \ using the annotation [wits: <term>]."])
- |> Pretty.string_of
- |> warning;
+ val _ =
+ if null lost_wits orelse no_warn_wits then ()
+ else
+ lost_wits
+ |> map (Syntax.pretty_typ lthy o fastype_of o snd)
+ |> Pretty.big_list
+ "The following types of nonemptiness witnesses of the raw type's BNF were lost:"
+ |> (fn pt => Pretty.chunks [pt,
+ Pretty.para "You can specify a liftable witness (e.g., a term of one of the above types\
+ \ that satisfies the typedef's invariant)\
+ \ using the annotation [wits: <term>]."])
+ |> Pretty.string_of
+ |> warning;
fun after_qed ([map_closed_thm] :: [zip_closed_thm] :: wit_thmss) lthy =
- let
- val (wit_closed_thms, wit_thms) =
- (case wits of
- NONE => (map the_single wit_thmss, wit_thms_of_bnf bnf)
- | _ => chop (length wit_closed_Fs) (map the_single wit_thmss))
-
- (* construct map set bd rel wit *)
- (* val map_G = @{term "\<lambda>f. Abs_G o map_F f o Rep_G"}; *)
- val Abs_Gb = subst_b Abs_G;
- val map_G = Library.foldr (uncurry HOLogic.tupled_lambda)
- (var_fs, HOLogic.mk_comp (HOLogic.mk_comp (Abs_Gb, map_f),
- Rep_G));
+ let
+ val (wit_closed_thms, wit_thms) =
+ (case wits of
+ NONE => (map the_single wit_thmss, wit_thms_of_bnf bnf)
+ | _ => chop (length wit_closed_Fs) (map the_single wit_thmss))
- (* val sets_G = [@{term "set_F o Rep_G"}]; *)
- val sets_F = mk_sets_of_bnf (replicate lives deads) (replicate lives alphas) bnf;
- val sets_G = map (fn set_F => HOLogic.mk_comp (set_F, Rep_G)) sets_F;
-
- (* val bd_G = @{term "bd_F"}; *)
- val bd_F = mk_bd_of_bnf deads alphas bnf;
- val bd_G = bd_F;
+ (* construct map set bd rel wit *)
+ (* val map_G = @{term "\<lambda>f. Abs_G o map_F f o Rep_G"}; *)
+ val Abs_Gb = subst_b Abs_G;
+ val map_G =
+ fold_rev HOLogic.tupled_lambda var_fs
+ (HOLogic.mk_comp (HOLogic.mk_comp (Abs_Gb, map_f), Rep_G));
- (* val rel_G = @{term "\<lambda>R. BNF_Def.vimage2p Rep_G Rep_G (rel_F R)"}; *)
- val rel_F = mk_rel_of_bnf deads alphas betas bnf;
- val (typ_Rs, _) = fastype_of rel_F |> strip_typeN lives;
+ (* val sets_G = [@{term "set_F o Rep_G"}]; *)
+ val sets_F = mk_sets_of_bnf (replicate lives deads) (replicate lives alphas) bnf;
+ val sets_G = map (fn set_F => HOLogic.mk_comp (set_F, Rep_G)) sets_F;
- val (var_Rs, names_lthy) = mk_Frees "R" typ_Rs lthy;
- val Rep_Gb = subst_b Rep_G;
- val rel_G = fold_rev absfree (map dest_Free var_Rs)
- (mk_vimage2p Rep_G Rep_Gb $ list_comb (rel_F, var_Rs));
+ (* val bd_G = @{term "bd_F"}; *)
+ val bd_F = mk_bd_of_bnf deads alphas bnf;
+ val bd_G = bd_F;
+
+ (* val rel_G = @{term "\<lambda>R. BNF_Def.vimage2p Rep_G Rep_G (rel_F R)"}; *)
+ val rel_F = mk_rel_of_bnf deads alphas betas bnf;
+ val (typ_Rs, _) = strip_typeN lives (fastype_of rel_F);
- (* val wits_G = [@{term "Abs_G o wit_F"}]; *)
- val (var_as, _) = mk_Frees "a" alphas names_lthy;
- val wits_G =
- map (fn (I, wit_F) =>
- let
- val vs = map (nth var_as) I;
- in fold_rev absfree (map dest_Free vs) (Abs_G $ (list_comb (wit_F, vs))) end)
- Iwits;
+ val (var_Rs, names_lthy) = mk_Frees "R" typ_Rs lthy;
+ val Rep_Gb = subst_b Rep_G;
+ val rel_G = fold_rev absfree (map dest_Free var_Rs)
+ (mk_vimage2p Rep_G Rep_Gb $ list_comb (rel_F, var_Rs));
- (* tactics *)
- val Rep_thm = thm RS @{thm type_definition.Rep};
- val Abs_inverse_thm = thm RS @{thm type_definition.Abs_inverse};
- val Abs_inject_thm = thm RS @{thm type_definition.Abs_inject};
- val Rep_cases_thm = thm RS @{thm type_definition.Rep_cases};
- val Rep_inverse_thm = thm RS @{thm type_definition.Rep_inverse};
+ (* val wits_G = [@{term "Abs_G o wit_F"}]; *)
+ val (var_as, _) = mk_Frees "a" alphas names_lthy;
+ val wits_G =
+ map (fn (I, wit_F) =>
+ let
+ val vs = map (nth var_as) I;
+ in fold_rev absfree (map dest_Free vs) (Abs_G $ (list_comb (wit_F, vs))) end)
+ Iwits;
- fun map_id0_tac ctxt =
- HEADGOAL (EVERY' [rtac ctxt ext,
- SELECT_GOAL (unfold_thms_tac ctxt [map_id0_of_bnf bnf, id_apply, o_apply,
- Rep_inverse_thm]),
- rtac ctxt refl]);
+ (* tactics *)
+ val Rep_thm = thm RS @{thm type_definition.Rep};
+ val Abs_inverse_thm = thm RS @{thm type_definition.Abs_inverse};
+ val Abs_inject_thm = thm RS @{thm type_definition.Abs_inject};
+ val Rep_cases_thm = thm RS @{thm type_definition.Rep_cases};
+ val Rep_inverse_thm = thm RS @{thm type_definition.Rep_inverse};
- fun map_comp0_tac ctxt =
- HEADGOAL (EVERY' [rtac ctxt ext,
- SELECT_GOAL (unfold_thms_tac ctxt [map_comp0_of_bnf bnf, o_apply,
- Rep_thm RS (map_closed_thm RS Abs_inverse_thm)]),
- rtac ctxt refl]);
+ fun map_id0_tac ctxt =
+ HEADGOAL (EVERY' [rtac ctxt ext,
+ SELECT_GOAL (unfold_thms_tac ctxt [map_id0_of_bnf bnf, id_apply, o_apply,
+ Rep_inverse_thm]),
+ rtac ctxt refl]);
- fun map_cong0_tac ctxt =
- HEADGOAL (EVERY' ([SELECT_GOAL (unfold_thms_tac ctxt [o_apply]),
- rtac ctxt (([Rep_thm RS map_closed_thm, Rep_thm RS map_closed_thm] MRS
- Abs_inject_thm) RS iffD2),
- rtac ctxt (map_cong0_of_bnf bnf)] @ replicate lives (Goal.assume_rule_tac ctxt)));
-
- val set_map0s_tac =
- map (fn set_map => fn ctxt =>
+ fun map_comp0_tac ctxt =
HEADGOAL (EVERY' [rtac ctxt ext,
- SELECT_GOAL (unfold_thms_tac ctxt [set_map, o_apply,
+ SELECT_GOAL (unfold_thms_tac ctxt [map_comp0_of_bnf bnf, o_apply,
Rep_thm RS (map_closed_thm RS Abs_inverse_thm)]),
- rtac ctxt refl]))
- (set_map_of_bnf bnf);
+ rtac ctxt refl]);
- fun card_order_bd_tac ctxt = HEADGOAL (rtac ctxt (bd_card_order_of_bnf bnf));
-
- fun cinfinite_bd_tac ctxt = HEADGOAL (rtac ctxt (bd_cinfinite_of_bnf bnf));
+ fun map_cong0_tac ctxt =
+ HEADGOAL (EVERY' ([SELECT_GOAL (unfold_thms_tac ctxt [o_apply]),
+ rtac ctxt (([Rep_thm RS map_closed_thm, Rep_thm RS map_closed_thm] MRS
+ Abs_inject_thm) RS iffD2),
+ rtac ctxt (map_cong0_of_bnf bnf)] @ replicate lives (Goal.assume_rule_tac ctxt)));
- val set_bds_tac =
- map (fn set_bd => fn ctxt =>
- HEADGOAL (EVERY' [SELECT_GOAL (unfold_thms_tac ctxt [o_apply]), rtac ctxt set_bd]))
- (set_bd_of_bnf bnf);
+ val set_map0s_tac =
+ map (fn set_map => fn ctxt =>
+ HEADGOAL (EVERY' [rtac ctxt ext,
+ SELECT_GOAL (unfold_thms_tac ctxt [set_map, o_apply,
+ Rep_thm RS (map_closed_thm RS Abs_inverse_thm)]),
+ rtac ctxt refl]))
+ (set_map_of_bnf bnf);
+
+ fun card_order_bd_tac ctxt = HEADGOAL (rtac ctxt (bd_card_order_of_bnf bnf));
- fun le_rel_OO_tac ctxt =
- HEADGOAL (EVERY' [rtac ctxt @{thm vimage2p_relcompp_mono},
- rtac ctxt ((rel_OO_of_bnf bnf RS sym) RS @{thm ord_eq_le_trans}),
- rtac ctxt @{thm order_refl}]);
+ fun cinfinite_bd_tac ctxt = HEADGOAL (rtac ctxt (bd_cinfinite_of_bnf bnf));
+
+ val set_bds_tac =
+ map (fn set_bd => fn ctxt =>
+ HEADGOAL (EVERY' [SELECT_GOAL (unfold_thms_tac ctxt [o_apply]), rtac ctxt set_bd]))
+ (set_bd_of_bnf bnf);
+
+ fun le_rel_OO_tac ctxt =
+ HEADGOAL (EVERY' [rtac ctxt @{thm vimage2p_relcompp_mono},
+ rtac ctxt ((rel_OO_of_bnf bnf RS sym) RS @{thm ord_eq_le_trans}),
+ rtac ctxt @{thm order_refl}]);
- fun rel_OO_Grp_tac ctxt =
- HEADGOAL (EVERY' ([SELECT_GOAL (REPEAT_DETERM (HEADGOAL (rtac ctxt ext))),
- SELECT_GOAL (unfold_thms_tac ctxt [@{thm OO_Grp_alt}, mem_Collect_eq,
- o_apply, @{thm vimage2p_def}, in_rel_of_bnf bnf, Bex_def, mem_Collect_eq]),
- rtac ctxt iffI,
- SELECT_GOAL (REPEAT_DETERM (HEADGOAL (eresolve0_tac [exE,conjE]))),
- rtac ctxt (zip_closed_thm OF (replicate 2 (Rep_thm RSN (2, @{thm ssubst_mem}))) RS
- Rep_cases_thm),
- assume_tac ctxt,
- assume_tac ctxt,
- hyp_subst_tac ctxt,
- SELECT_GOAL (REPEAT_DETERM (HEADGOAL (rtac ctxt exI))),
- rtac ctxt conjI] @
- replicate (lives - 1) (rtac ctxt conjI THEN' assume_tac ctxt) @
- [assume_tac ctxt,
- SELECT_GOAL (REPEAT_DETERM (HEADGOAL (rtac ctxt conjI))),
- REPEAT_DETERM_N 2 o
- etac ctxt (trans OF [iffD2 OF [Abs_inject_thm OF
- [map_closed_thm OF [Rep_thm], Rep_thm]], Rep_inverse_thm]),
- SELECT_GOAL (REPEAT_DETERM (HEADGOAL (eresolve0_tac [exE,conjE]))),
- rtac ctxt exI,
- rtac ctxt conjI] @
- replicate (lives - 1) (rtac ctxt conjI THEN' assume_tac ctxt) @
- [assume_tac ctxt,
- rtac ctxt conjI,
- REPEAT_DETERM_N 2 o EVERY'
- [rtac ctxt (iffD1 OF [Abs_inject_thm OF [map_closed_thm OF [Rep_thm], Rep_thm]]),
- etac ctxt (Rep_inverse_thm RS sym RSN (2, trans))]]));
+ fun rel_OO_Grp_tac ctxt =
+ HEADGOAL (EVERY' ([SELECT_GOAL (REPEAT_DETERM (HEADGOAL (rtac ctxt ext))),
+ SELECT_GOAL (unfold_thms_tac ctxt [@{thm OO_Grp_alt}, mem_Collect_eq,
+ o_apply, @{thm vimage2p_def}, in_rel_of_bnf bnf, Bex_def, mem_Collect_eq]),
+ rtac ctxt iffI,
+ SELECT_GOAL (REPEAT_DETERM (HEADGOAL (eresolve0_tac [exE,conjE]))),
+ rtac ctxt (zip_closed_thm OF (replicate 2 (Rep_thm RSN (2, @{thm ssubst_mem}))) RS
+ Rep_cases_thm),
+ assume_tac ctxt,
+ assume_tac ctxt,
+ hyp_subst_tac ctxt,
+ SELECT_GOAL (REPEAT_DETERM (HEADGOAL (rtac ctxt exI))),
+ rtac ctxt conjI] @
+ replicate (lives - 1) (rtac ctxt conjI THEN' assume_tac ctxt) @
+ [assume_tac ctxt,
+ SELECT_GOAL (REPEAT_DETERM (HEADGOAL (rtac ctxt conjI))),
+ REPEAT_DETERM_N 2 o
+ etac ctxt (trans OF [iffD2 OF [Abs_inject_thm OF
+ [map_closed_thm OF [Rep_thm], Rep_thm]], Rep_inverse_thm]),
+ SELECT_GOAL (REPEAT_DETERM (HEADGOAL (eresolve0_tac [exE,conjE]))),
+ rtac ctxt exI,
+ rtac ctxt conjI] @
+ replicate (lives - 1) (rtac ctxt conjI THEN' assume_tac ctxt) @
+ [assume_tac ctxt,
+ rtac ctxt conjI,
+ REPEAT_DETERM_N 2 o EVERY'
+ [rtac ctxt (iffD1 OF [Abs_inject_thm OF [map_closed_thm OF [Rep_thm], Rep_thm]]),
+ etac ctxt (Rep_inverse_thm RS sym RSN (2, trans))]]));
- fun wit_tac ctxt =
- HEADGOAL (EVERY'
- (map (fn thm => (EVERY'
- [SELECT_GOAL (unfold_thms_tac ctxt (o_apply ::
- (wit_closed_thms RL [Abs_inverse_thm]))),
- dtac ctxt thm, assume_tac ctxt]))
- wit_thms));
+ fun wit_tac ctxt =
+ HEADGOAL (EVERY'
+ (map (fn thm => (EVERY'
+ [SELECT_GOAL (unfold_thms_tac ctxt (o_apply ::
+ (wit_closed_thms RL [Abs_inverse_thm]))),
+ dtac ctxt thm, assume_tac ctxt]))
+ wit_thms));
- val tactics = [map_id0_tac, map_comp0_tac, map_cong0_tac] @ set_map0s_tac @
- [card_order_bd_tac, cinfinite_bd_tac] @ set_bds_tac @ [le_rel_OO_tac, rel_OO_Grp_tac];
+ val tactics = [map_id0_tac, map_comp0_tac, map_cong0_tac] @ set_map0s_tac @
+ [card_order_bd_tac, cinfinite_bd_tac] @ set_bds_tac @ [le_rel_OO_tac, rel_OO_Grp_tac];
- val (bnf, lthy) = bnf_def Dont_Inline (user_policy Note_Some) false I
- tactics wit_tac NONE map_b rel_b set_bs
- ((((((Binding.empty, AbsT), map_G), sets_G), bd_G), wits_G), SOME rel_G)
- lthy;
+ val (bnf, lthy) = bnf_def Dont_Inline (user_policy Note_Some) false I
+ tactics wit_tac NONE map_b rel_b set_bs
+ ((((((Binding.empty, AbsT), map_G), sets_G), bd_G), wits_G), SOME rel_G)
+ lthy;
- val bnf = morph_bnf_defs (Morphism.thm_morphism "BNF" (unfold_thms lthy defs)) bnf;
- in
- lthy |> BNF_Def.register_bnf plugins AbsT_name bnf
- end
- | after_qed _ _ = error "should not happen";
+ val bnf = morph_bnf_defs (Morphism.thm_morphism "BNF" (unfold_thms lthy defs)) bnf;
+ in
+ lthy |> BNF_Def.register_bnf plugins AbsT_name bnf
+ end
+ | after_qed _ _ = raise Match;
in
(goals, after_qed, defs, lthy)
end;
+
+(* main commands *)
+
+local
+
fun prepare_common prepare_name prepare_sort prepare_term prepare_thm
(((((plugins, raw_specs), raw_Tname), raw_wits), xthm_opt), (map_b, rel_b)) lthy =
let
@@ -317,16 +329,14 @@
(case xthm_opt of
SOME xthm => prepare_thm lthy xthm
| NONE => Typedef.get_info lthy Tname |> hd |> snd |> #type_definition);
- val wits = Option.map (map (prepare_term lthy)) raw_wits;
- val specs = map (apsnd (apsnd
- (the_default @{sort type} o Option.map (prepare_sort lthy)))) raw_specs;
+ val wits = (Option.map o map) (prepare_term lthy) raw_wits;
+ val specs =
+ map (apsnd (apsnd (the_default @{sort type} o Option.map (prepare_sort lthy)))) raw_specs;
- (* analyze theorem here*)
- fun is_typedef (t as (Const ("Typedef.type_definition", _) $ _ $ _ $ _)) = t
- | is_typedef t = raise TERM("not a typedef",[t]);
-
- val _ = (HOLogic.dest_Trueprop o Thm.prop_of) input_thm |> is_typedef
- handle TERM _ => error "Unsupported type of a theorem. Only type_definition is supported.";
+ val _ =
+ (case HOLogic.dest_Trueprop (Thm.prop_of input_thm) of
+ Const (@{const_name type_definition}, _) $ _ $ _ $ _ => ()
+ | _ => error "Unsupported type of a theorem: only type_definition is supported");
in
typedef_bnf input_thm wits specs map_b rel_b plugins lthy
end;
@@ -341,23 +351,37 @@
|> Seq.hd) oo
prepare_common prepare_name prepare_sort prepare_term prepare_thm o apfst (apfst (apsnd SOME));
-val lift_bnf_cmd = prepare_lift_bnf
- (fst o dest_Type oo Proof_Context.read_type_name {proper = true, strict = false})
- Syntax.read_sort Syntax.read_term (singleton o Attrib.eval_thms);
-
fun prepare_solve prepare_name prepare_typ prepare_sort prepare_thm tacs =
(fn (goals, after_qed, _, lthy) =>
lthy
|> after_qed (map2 (single oo Goal.prove lthy [] []) goals (tacs (length goals)))) oo
prepare_common prepare_name prepare_typ prepare_sort prepare_thm o apfst (apfst (rpair NONE));
+in
+
+val lift_bnf_cmd =
+ prepare_lift_bnf
+ (fst o dest_Type oo Proof_Context.read_type_name {proper = true, strict = false})
+ Syntax.read_sort Syntax.read_term (singleton o Attrib.eval_thms);
+
fun lift_bnf args tacs = prepare_solve (K I) (K I) (K I) (K I) (K tacs) args;
-val copy_bnf = prepare_solve (K I) (K I) (K I) (K I)
- (fn n => replicate n (fn {context = ctxt, prems = _} => rtac ctxt UNIV_I 1));
-val copy_bnf_cmd = prepare_solve
- (fst o dest_Type oo Proof_Context.read_type_name {proper = true, strict = false})
- Syntax.read_sort Syntax.read_term (singleton o Attrib.eval_thms)
- (fn n => replicate n (fn {context = ctxt, prems = _} => rtac ctxt UNIV_I 1));
+
+val copy_bnf =
+ prepare_solve (K I) (K I) (K I) (K I)
+ (fn n => replicate n (fn {context = ctxt, prems = _} => rtac ctxt UNIV_I 1));
+
+val copy_bnf_cmd =
+ prepare_solve
+ (fst o dest_Type oo Proof_Context.read_type_name {proper = true, strict = false})
+ Syntax.read_sort Syntax.read_term (singleton o Attrib.eval_thms)
+ (fn n => replicate n (fn {context = ctxt, prems = _} => rtac ctxt UNIV_I 1));
+
+end;
+
+
+(* outer syntax *)
+
+local
val parse_wits =
@{keyword "["} |-- (Parse.name --| @{keyword ":"} -- Scan.repeat Parse.term >>
@@ -378,6 +402,8 @@
val parse_typedef_thm = Scan.option (Parse.reserved "via" |-- Parse.xthm);
+in
+
val _ =
Outer_Syntax.local_theory_to_proof @{command_keyword lift_bnf}
"register a subtype of a bounded natural functor (BNF) as a BNF"
@@ -390,4 +416,6 @@
((parse_plugins -- parse_type_args_named_constrained -- Parse.type_const --
parse_typedef_thm -- parse_map_rel_bindings) >> copy_bnf_cmd);
-end
+end;
+
+end;
--- a/src/HOL/Tools/Ctr_Sugar/case_translation.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Ctr_Sugar/case_translation.ML Thu Sep 03 15:50:40 2015 +0200
@@ -470,12 +470,13 @@
(SOME cname, ts as _ :: _) =>
let
val (fs, x) = split_last ts;
- fun strip_abs i Us t =
+ fun strip_abs i t =
let
val zs = strip_abs_vars t;
val j = length zs;
val (xs, ys) =
- if j < i then (zs @ map (pair "x") (drop j Us), [])
+ if j < i then (zs @
+ map (pair "x") (drop j (take i (binder_types (fastype_of t)))), [])
else chop i zs;
val u = fold_rev Term.abs ys (strip_abs_body t);
val xs' = map Free
@@ -501,7 +502,7 @@
let
val Us = binder_types U;
val k = length Us;
- val p as (xs, _) = strip_abs k Us t;
+ val p as (xs, _) = strip_abs k t;
in
(Const (s, map fastype_of xs ---> fastype_of x), p, is_dependent k t)
end) (constructors ~~ fs);
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML Thu Sep 03 15:50:40 2015 +0200
@@ -93,7 +93,7 @@
|> Syntax.check_term lthy;
val ((_, (_, raw_def)), lthy') =
Specification.definition (NONE, (Attrib.empty_binding, spec)) lthy;
- val thy_ctxt = Proof_Context.init_global (Proof_Context.theory_of lthy); (* FIXME? *)
+ val thy_ctxt = Proof_Context.init_global (Proof_Context.theory_of lthy');
val def = singleton (Proof_Context.export lthy' thy_ctxt) raw_def;
in
(def, lthy')
--- a/src/HOL/Tools/Function/mutual.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Function/mutual.ML Thu Sep 03 15:50:40 2015 +0200
@@ -182,7 +182,7 @@
| [cond] => (Thm.implies_elim psimp (Thm.assume cond), Thm.implies_intr cond)
| _ => raise General.Fail "Too many conditions"
- val simp_ctxt = fold Thm.declare_hyps (#hyps (Thm.crep_thm simp)) ctxt
+ val simp_ctxt = fold Thm.declare_hyps (Thm.chyps_of simp) ctxt
in
Goal.prove simp_ctxt [] []
(HOLogic.Trueprop $ HOLogic.mk_eq (list_comb (f, args), rhs))
--- a/src/HOL/Tools/Metis/metis_reconstruct.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Metis/metis_reconstruct.ML Thu Sep 03 15:50:40 2015 +0200
@@ -433,7 +433,7 @@
val (prems0, concl) = th |> Thm.prop_of |> Logic.strip_horn
val prems = prems0 |> map normalize_literal |> distinct Term.aconv_untyped
val goal = Logic.list_implies (prems, concl)
- val ctxt' = fold Thm.declare_hyps (#hyps (Thm.crep_thm th)) ctxt
+ val ctxt' = fold Thm.declare_hyps (Thm.chyps_of th) ctxt
val tac =
cut_tac th 1 THEN
rewrite_goals_tac ctxt' meta_not_not THEN
@@ -727,7 +727,7 @@
val _ = tracing ("SUBSTS (" ^ string_of_int (length substs) ^ "):\n" ^
cat_lines (map string_of_subst_info substs))
*)
- val ctxt' = fold Thm.declare_hyps (#hyps (Thm.crep_thm prems_imp_false)) ctxt
+ val ctxt' = fold Thm.declare_hyps (Thm.chyps_of prems_imp_false) ctxt
fun cut_and_ex_tac axiom =
cut_tac axiom 1 THEN TRY (REPEAT_ALL_NEW (eresolve_tac ctxt' @{thms exE}) 1)
--- a/src/HOL/Tools/Nitpick/nitpick.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Nitpick/nitpick.ML Thu Sep 03 15:50:40 2015 +0200
@@ -220,7 +220,7 @@
(* FIXME: reintroduce code before new release:
val nitpick_thy = Thy_Info.get_theory "Nitpick"
- val _ = Theory.subthy (nitpick_thy, thy) orelse
+ val _ = Context.subthy (nitpick_thy, thy) orelse
error "You must import the theory \"Nitpick\" to use Nitpick"
*)
val {cards_assigns, maxes_assigns, iters_assigns, bitss, bisim_depths,
--- a/src/HOL/Tools/Nitpick/nitpick_hol.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML Thu Sep 03 15:50:40 2015 +0200
@@ -1358,13 +1358,14 @@
(* Ideally we would check against "Complex_Main", not "Hilbert_Choice", but any
theory will do as long as it contains all the "axioms" and "axiomatization"
commands. *)
-fun is_built_in_theory thy = Theory.subthy (thy, @{theory Hilbert_Choice})
+fun is_built_in_theory thy_id =
+ Context.subthy_id (thy_id, Context.theory_id @{theory Hilbert_Choice})
fun all_nondefs_of ctxt subst =
ctxt |> Spec_Rules.get
|> filter (curry (op =) Spec_Rules.Unknown o fst)
|> maps (snd o snd)
- |> filter_out (is_built_in_theory o Thm.theory_of_thm)
+ |> filter_out (is_built_in_theory o Thm.theory_id_of_thm)
|> map (subst_atomic subst o Thm.prop_of)
fun arity_of_built_in_const (s, T) =
--- a/src/HOL/Tools/Qelim/cooper.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Qelim/cooper.ML Thu Sep 03 15:50:40 2015 +0200
@@ -569,7 +569,7 @@
[not_all, all_not_ex, @{thm ex_disj_distrib}]));
fun conv ctxt p =
- Qelim.gen_qelim_conv
+ Qelim.gen_qelim_conv ctxt
(Simplifier.rewrite (put_simpset conv_ss ctxt))
(Simplifier.rewrite (put_simpset presburger_ss ctxt))
(Simplifier.rewrite (put_simpset conv_ss ctxt))
@@ -799,12 +799,12 @@
in h [] ct end
end;
-fun generalize_tac f = CSUBGOAL (fn (p, _) => PRIMITIVE (fn st =>
+fun generalize_tac ctxt f = CSUBGOAL (fn (p, _) => PRIMITIVE (fn st =>
let
- fun all T = Drule.cterm_rule (Thm.instantiate' [SOME T] []) @{cpat "Pure.all"}
- fun gen x t = Thm.apply (all (Thm.ctyp_of_cterm x)) (Thm.lambda x t)
- val ts = sort (fn (a,b) => Term_Ord.fast_term_ord (Thm.term_of a, Thm.term_of b)) (f p)
- val p' = fold_rev gen ts p
+ fun all x t =
+ Thm.apply (Thm.cterm_of ctxt (Logic.all_const (Thm.typ_of_cterm x))) (Thm.lambda x t)
+ val ts = sort (fn (a, b) => Term_Ord.fast_term_ord (Thm.term_of a, Thm.term_of b)) (f p)
+ val p' = fold_rev all ts p
in Thm.implies_intr p' (Thm.implies_elim st (fold Thm.forall_elim ts (Thm.assume p'))) end));
local
@@ -875,7 +875,7 @@
THEN_ALL_NEW Object_Logic.full_atomize_tac ctxt
THEN_ALL_NEW CONVERSION Thm.eta_long_conversion
THEN_ALL_NEW simp_tac simpset_ctxt
- THEN_ALL_NEW (TRY o generalize_tac (int_nat_terms ctxt))
+ THEN_ALL_NEW (TRY o generalize_tac ctxt (int_nat_terms ctxt))
THEN_ALL_NEW Object_Logic.full_atomize_tac ctxt
THEN_ALL_NEW (thin_prems_tac ctxt (is_relevant ctxt))
THEN_ALL_NEW Object_Logic.full_atomize_tac ctxt
--- a/src/HOL/Tools/Qelim/qelim.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Qelim/qelim.ML Thu Sep 03 15:50:40 2015 +0200
@@ -6,7 +6,7 @@
signature QELIM =
sig
- val gen_qelim_conv: conv -> conv -> conv -> (cterm -> 'a -> 'a) -> 'a ->
+ val gen_qelim_conv: Proof.context -> conv -> conv -> conv -> (cterm -> 'a -> 'a) -> 'a ->
('a -> conv) -> ('a -> conv) -> ('a -> conv) -> conv
val standard_qelim_conv: Proof.context ->
(cterm list -> conv) -> (cterm list -> conv) ->
@@ -18,7 +18,7 @@
val all_not_ex = mk_meta_eq @{thm "all_not_ex"};
-fun gen_qelim_conv precv postcv simpex_conv ins env atcv ncv qcv =
+fun gen_qelim_conv ctxt precv postcv simpex_conv ins env atcv ncv qcv =
let
fun conv env p =
case Thm.term_of p of
@@ -41,10 +41,10 @@
in if Thm.is_reflexive th' then Thm.transitive th (qcv env (Thm.rhs_of th))
else Thm.transitive (Thm.transitive th th') (conv env r) end
| Const(@{const_name Ex},_)$ _ => (Thm.eta_long_conversion then_conv conv env) p
- | Const(@{const_name All},_)$_ =>
+ | Const(@{const_name All}, allT)$_ =>
let
+ val T = Thm.ctyp_of ctxt (#1 (Term.dest_funT (#1 (Term.dest_funT allT))))
val p = Thm.dest_arg p
- val ([(_,T)],[]) = Thm.match (@{cpat "All"}, Thm.dest_fun p)
val th = Thm.instantiate' [SOME T] [SOME p] all_not_ex
in Thm.transitive th (conv env (Thm.rhs_of th))
end
@@ -65,7 +65,7 @@
fun standard_qelim_conv ctxt atcv ncv qcv p =
let val pcv = pcv ctxt
- in gen_qelim_conv pcv pcv pcv cons (Drule.cterm_add_frees p []) atcv ncv qcv p end
+ in gen_qelim_conv ctxt pcv pcv pcv cons (Drule.cterm_add_frees p []) atcv ncv qcv p end
end;
--- a/src/HOL/Tools/Quickcheck/narrowing_generators.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Quickcheck/narrowing_generators.ML Thu Sep 03 15:50:40 2015 +0200
@@ -205,7 +205,9 @@
File.read @{path "~~/src/HOL/Tools/Quickcheck/PNF_Narrowing_Engine.hs"}
fun exec verbose code =
- ML_Context.exec (fn () => Secure.use_text ML_Env.local_context (0, "generated code") verbose code)
+ ML_Context.exec (fn () =>
+ Secure.use_text ML_Env.local_context
+ {line = 0, file = "generated code", verbose = verbose, debug = false} code)
fun with_overlord_dir name f =
let
@@ -305,7 +307,7 @@
fun evaluator program _ vs_ty_t deps =
Exn.interruptible_capture (value opts ctxt cookie)
(Code_Target.evaluator ctxt target program deps true vs_ty_t);
- in Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_result o postproc) evaluator t) end;
+ in Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t) end;
(** counterexample generator **)
--- a/src/HOL/Tools/SMT/smt_normalize.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/SMT/smt_normalize.ML Thu Sep 03 15:50:40 2015 +0200
@@ -68,6 +68,7 @@
| Const (@{const_name Pure.all}, _) $ Abs _ =>
Conv.binder_conv (atomize_conv o snd) ctxt then_conv Conv.rewr_conv @{thm atomize_all}
| _ => Conv.all_conv) ct
+ handle CTERM _ => Conv.all_conv ct
val setup_atomize =
fold SMT_Builtin.add_builtin_fun_ext'' [@{const_name Pure.imp}, @{const_name Pure.eq},
--- a/src/HOL/Tools/SMT/smt_solver.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/SMT/smt_solver.ML Thu Sep 03 15:50:40 2015 +0200
@@ -257,7 +257,7 @@
val cprop =
(case try negate (Thm.rhs_of (SMT_Normalize.atomize_conv ctxt concl)) of
SOME ct => ct
- | NONE => raise SMT_Failure.SMT (SMT_Failure.Other_Failure "goal is not a HOL term"))
+ | NONE => raise SMT_Failure.SMT (SMT_Failure.Other_Failure "cannot atomize goal"))
val conjecture = Thm.assume cprop
val facts = map snd xfacts
--- a/src/HOL/Tools/SMT/z3_replay_methods.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/SMT/z3_replay_methods.ML Thu Sep 03 15:50:40 2015 +0200
@@ -522,7 +522,7 @@
fun lemma ctxt (thms as [thm]) t =
(let
- val tab = Termtab.make (map (`Thm.term_of) (#hyps (Thm.crep_thm thm)))
+ val tab = Termtab.make (map (`Thm.term_of) (Thm.chyps_of thm))
val (thm', terms) = intro_hyps tab (dest_prop t) (thm, [])
in
prove_abstract ctxt [thm'] t prop_tac (
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML Thu Sep 03 15:50:40 2015 +0200
@@ -311,10 +311,11 @@
let
fun add stature th = Termtab.update (normalize_vars (Thm.prop_of th), stature)
- val {safeIs, (* safeEs, *) hazIs, (* hazEs, *) ...} = ctxt |> claset_of |> Classical.rep_cs
- val intros = Item_Net.content safeIs @ Item_Net.content hazIs
+ val {safeIs, (* safeEs, *) unsafeIs, (* unsafeEs, *) ...} =
+ ctxt |> claset_of |> Classical.rep_cs
+ val intros = map #1 (Item_Net.content safeIs @ Item_Net.content unsafeIs)
(* Add once it is used:
- val elims = Item_Net.content safeEs @ Item_Net.content hazEs
+ val elims = Item_Net.content safeEs @ Item_Net.content unsafeEs
|> map Classical.classical_rule
*)
val specs = Spec_Rules.get ctxt
@@ -350,7 +351,7 @@
| normalize_eq t = t
fun if_thm_before th th' =
- if Theory.subthy (apply2 Thm.theory_of_thm (th, th')) then th else th'
+ if Context.subthy_id (apply2 Thm.theory_id_of_thm (th, th')) then th else th'
(* Hack: Conflate the facts about a class as seen from the outside with the corresponding low-level
facts, so that MaSh can learn from the low-level proofs. *)
@@ -459,6 +460,7 @@
fun all_facts ctxt generous ho_atp keywords add_ths chained css =
let
val thy = Proof_Context.theory_of ctxt
+ val transfer = Global_Theory.transfer_theories thy;
val global_facts = Global_Theory.facts_of thy
val is_too_complex =
if generous orelse fact_count global_facts >= max_facts_for_complex_check then K false
@@ -492,35 +494,37 @@
NONE => false
| SOME ths' => eq_list Thm.eq_thm_prop (ths, ths'))
in
- snd (fold_rev (fn th => fn (j, accum) =>
- (j - 1,
- if not (member Thm.eq_thm_prop add_ths th) andalso
- (is_likely_tautology_too_meta_or_too_technical th orelse
- is_too_complex (Thm.prop_of th)) then
- accum
- else
- let
- fun get_name () =
- if name0 = "" orelse name0 = local_thisN then
- backquote_thm ctxt th
- else
- let val short_name = Facts.extern ctxt facts name0 in
- if check_thms short_name then
- short_name
- else
- let val long_name = Name_Space.extern ctxt full_space name0 in
- if check_thms long_name then
- long_name
- else
- name0
- end
- end
- |> make_name keywords multi j
- val stature = stature_of_thm global assms chained css name0 th
- val new = ((get_name, stature), th)
- in
- (if multi then apsnd else apfst) (cons new) accum
- end)) ths (n, accum))
+ snd (fold_rev (fn th0 => fn (j, accum) =>
+ let val th = transfer th0 in
+ (j - 1,
+ if not (member Thm.eq_thm_prop add_ths th) andalso
+ (is_likely_tautology_too_meta_or_too_technical th orelse
+ is_too_complex (Thm.prop_of th)) then
+ accum
+ else
+ let
+ fun get_name () =
+ if name0 = "" orelse name0 = local_thisN then
+ backquote_thm ctxt th
+ else
+ let val short_name = Facts.extern ctxt facts name0 in
+ if check_thms short_name then
+ short_name
+ else
+ let val long_name = Name_Space.extern ctxt full_space name0 in
+ if check_thms long_name then
+ long_name
+ else
+ name0
+ end
+ end
+ |> make_name keywords multi j
+ val stature = stature_of_thm global assms chained css name0 th
+ val new = ((get_name, stature), th)
+ in
+ (if multi then apsnd else apfst) (cons new) accum
+ end)
+ end) ths (n, accum))
end)
in
(* The single-theorem names go before the multiple-theorem ones (e.g., "xxx" vs. "xxx(3)"), so
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML Thu Sep 03 15:50:40 2015 +0200
@@ -138,20 +138,18 @@
| MaSh_NB_Ext
| MaSh_kNN_Ext
-(* TODO: eliminate "MASH" environment variable after Isabelle2014 release *)
fun mash_algorithm () =
- let val flag1 = Options.default_string @{system_option MaSh} in
- (case if flag1 <> "none" (* default *) then flag1 else getenv "MASH" of
- "yes" => SOME MaSh_NB_kNN
- | "sml" => SOME MaSh_NB_kNN
- | "nb" => SOME MaSh_NB
- | "knn" => SOME MaSh_kNN
- | "nb_knn" => SOME MaSh_NB_kNN
- | "nb_ext" => SOME MaSh_NB_Ext
- | "knn_ext" => SOME MaSh_kNN_Ext
- | "" => NONE
- | algorithm => (warning ("Unknown MaSh algorithm: " ^ quote algorithm ^ "."); NONE))
- end
+ (case Options.default_string @{system_option MaSh} of
+ "yes" => SOME MaSh_NB_kNN
+ | "sml" => SOME MaSh_NB_kNN
+ | "nb" => SOME MaSh_NB
+ | "knn" => SOME MaSh_kNN
+ | "nb_knn" => SOME MaSh_NB_kNN
+ | "nb_ext" => SOME MaSh_NB_Ext
+ | "knn_ext" => SOME MaSh_kNN_Ext
+ | "none" => NONE
+ | "" => NONE
+ | algorithm => (warning ("Unknown MaSh algorithm: " ^ quote algorithm ^ "."); NONE))
val is_mash_enabled = is_some o mash_algorithm
val the_mash_algorithm = the_default MaSh_NB_kNN o mash_algorithm
@@ -653,7 +651,7 @@
fun load_state ctxt (time_state as (memory_time, _)) =
let val path = state_file () in
- (case try OS.FileSys.modTime (Path.implode path) of
+ (case try OS.FileSys.modTime (File.platform_path path) of
NONE => time_state
| SOME disk_time =>
if Time.>= (memory_time, disk_time) then
@@ -699,7 +697,7 @@
val path = state_file ()
val dirty_facts' =
- (case try OS.FileSys.modTime (Path.implode path) of
+ (case try OS.FileSys.modTime (File.platform_path path) of
NONE => NONE
| SOME disk_time => if Time.<= (disk_time, memory_time) then dirty_facts else NONE)
val (banner, entries) =
@@ -768,30 +766,39 @@
fun class_feature_of s = "s" ^ s
val local_feature = "local"
-fun crude_theory_ord p =
- if Theory.subthy p then
- if Theory.eq_thy p then EQUAL else LESS
- else if Theory.subthy (swap p) then
- GREATER
- else
- (case int_ord (apply2 (length o Theory.ancestors_of) p) of
- EQUAL => string_ord (apply2 Context.theory_name p)
- | order => order)
+fun crude_thm_ord ctxt =
+ let
+ val ancestor_lengths =
+ fold (fn thy => Symtab.update (Context.theory_name thy, length (Context.ancestors_of thy)))
+ (Theory.nodes_of (Proof_Context.theory_of ctxt)) Symtab.empty
+ val ancestor_length = Symtab.lookup ancestor_lengths o Context.theory_id_name
+ fun crude_theory_ord p =
+ if Context.eq_thy_id p then EQUAL
+ else if Context.proper_subthy_id p then LESS
+ else if Context.proper_subthy_id (swap p) then GREATER
+ else
+ (case apply2 ancestor_length p of
+ (SOME m, SOME n) =>
+ (case int_ord (m, n) of
+ EQUAL => string_ord (apply2 Context.theory_id_name p)
+ | ord => ord)
+ | _ => string_ord (apply2 Context.theory_id_name p))
+ in
+ fn p =>
+ (case crude_theory_ord (apply2 Thm.theory_id_of_thm p) of
+ EQUAL =>
+ (* The hack below is necessary because of odd dependencies that are not reflected in the theory
+ comparison. *)
+ let val q = apply2 (nickname_of_thm ctxt) p in
+ (* Hack to put "xxx_def" before "xxxI" and "xxxE" *)
+ (case bool_ord (apply2 (String.isSuffix "_def") (swap q)) of
+ EQUAL => string_ord q
+ | ord => ord)
+ end
+ | ord => ord)
+ end;
-fun crude_thm_ord ctxt p =
- (case crude_theory_ord (apply2 Thm.theory_of_thm p) of
- EQUAL =>
- (* The hack below is necessary because of odd dependencies that are not reflected in the theory
- comparison. *)
- let val q = apply2 (nickname_of_thm ctxt) p in
- (* Hack to put "xxx_def" before "xxxI" and "xxxE" *)
- (case bool_ord (apply2 (String.isSuffix "_def") (swap q)) of
- EQUAL => string_ord q
- | ord => ord)
- end
- | ord => ord)
-
-val thm_less_eq = Theory.subthy o apply2 Thm.theory_of_thm
+val thm_less_eq = Context.subthy_id o apply2 Thm.theory_id_of_thm
fun thm_less p = thm_less_eq p andalso not (thm_less_eq (swap p))
val freezeT = Type.legacy_freeze_type
@@ -1110,12 +1117,11 @@
find_maxes Symtab.empty ([], Graph.maximals G)
end
-fun strict_subthy thyp = Theory.subthy thyp andalso not (Theory.subthy (swap thyp))
-
fun maximal_wrt_access_graph _ _ [] = []
| maximal_wrt_access_graph ctxt access_G ((fact as (_, th)) :: facts) =
- let val thy = Thm.theory_of_thm th in
- fact :: filter_out (fn (_, th') => strict_subthy (Thm.theory_of_thm th', thy)) facts
+ let val thy_id = Thm.theory_id_of_thm th in
+ fact :: filter_out (fn (_, th') =>
+ Context.proper_subthy_id (Thm.theory_id_of_thm th', thy_id)) facts
|> map (nickname_of_thm ctxt o snd)
|> maximal_wrt_graph access_G
end
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML Thu Sep 03 15:50:40 2015 +0200
@@ -167,7 +167,11 @@
SOME var =>
let
val pref = getenv var ^ "/"
- val paths = map (Path.explode o prefix pref) (snd exec)
+ val paths =
+ map (Path.explode o prefix pref)
+ (if ML_System.platform_is_windows then
+ map (suffix ".exe") (snd exec) @ snd exec
+ else snd exec);
in
(case find_first File.exists paths of
SOME path => path
--- a/src/HOL/Tools/Transfer/transfer.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/Transfer/transfer.ML Thu Sep 03 15:50:40 2015 +0200
@@ -709,7 +709,8 @@
(SOLVED' (REPEAT_ALL_NEW (resolve_tac ctxt' rules)
THEN_ALL_NEW (DETERM o eq_rules_tac ctxt' eq_rules)))) 1
handle TERM (_, ts) => raise TERM (err_msg, ts)
- val thm3 = Goal.prove_internal ctxt' [] @{cpat "Trueprop ?P"} (K tac)
+ val goal = Thm.cterm_of ctxt' (HOLogic.mk_Trueprop (Var (("P", 0), @{typ bool})))
+ val thm3 = Goal.prove_internal ctxt' [] goal (K tac)
val tnames = map (fst o dest_TFree o Thm.typ_of o snd) instT
in
thm3
@@ -746,7 +747,8 @@
(SOLVED' (REPEAT_ALL_NEW (resolve_tac ctxt' rules)
THEN_ALL_NEW (DETERM o eq_rules_tac ctxt' eq_rules)))) 1
handle TERM (_, ts) => raise TERM (err_msg, ts)
- val thm3 = Goal.prove_internal ctxt' [] @{cpat "Trueprop ?P"} (K tac)
+ val goal = Thm.cterm_of ctxt' (HOLogic.mk_Trueprop (Var (("P", 0), @{typ bool})))
+ val thm3 = Goal.prove_internal ctxt' [] goal (K tac)
val tnames = map (fst o dest_TFree o Thm.typ_of o snd) instT
in
thm3
--- a/src/HOL/Tools/groebner.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/groebner.ML Thu Sep 03 15:50:40 2015 +0200
@@ -478,8 +478,8 @@
(* Conversion for the equivalence of existential statements where
EX quantifiers are rearranged differently *)
- fun ext T = Drule.cterm_rule (Thm.instantiate' [SOME T] []) @{cpat Ex}
- fun mk_ex v t = Thm.apply (ext (Thm.ctyp_of_cterm v)) (Thm.lambda v t)
+fun ext ctxt T = Thm.cterm_of ctxt (Const (@{const_name Ex}, (T --> @{typ bool}) --> @{typ bool}))
+fun mk_ex ctxt v t = Thm.apply (ext ctxt (Thm.typ_of_cterm v)) (Thm.lambda v t)
fun choose v th th' = case Thm.concl_of th of
@{term Trueprop} $ (Const(@{const_name Ex},_)$_) =>
@@ -494,9 +494,9 @@
in Thm.implies_elim (Thm.implies_elim th0 th) th1 end
| _ => error "" (* FIXME ? *)
-fun simple_choose v th =
- choose v (Thm.assume ((Thm.apply @{cterm Trueprop} o mk_ex v)
- ((Thm.dest_arg o hd o #hyps o Thm.crep_thm) th))) th
+fun simple_choose ctxt v th =
+ choose v (Thm.assume ((Thm.apply @{cterm Trueprop} o mk_ex ctxt v)
+ (Thm.dest_arg (hd (Thm.chyps_of th))))) th
fun mkexi v th =
@@ -507,14 +507,14 @@
(Thm.instantiate' [SOME (Thm.ctyp_of_cterm v)] [SOME p, SOME v] @{thm exI}))
th
end
- fun ex_eq_conv t =
+ fun ex_eq_conv ctxt t =
let
val (p0,q0) = Thm.dest_binop t
val (vs',P) = strip_exists p0
val (vs,_) = strip_exists q0
val th = Thm.assume (Thm.apply @{cterm Trueprop} P)
- val th1 = implies_intr_hyps (fold simple_choose vs' (fold mkexi vs th))
- val th2 = implies_intr_hyps (fold simple_choose vs (fold mkexi vs' th))
+ val th1 = implies_intr_hyps (fold (simple_choose ctxt) vs' (fold mkexi vs th))
+ val th2 = implies_intr_hyps (fold (simple_choose ctxt) vs (fold mkexi vs' th))
val p = (Thm.dest_arg o Thm.dest_arg1 o Thm.cprop_of) th1
val q = (Thm.dest_arg o Thm.dest_arg o Thm.cprop_of) th1
in Thm.implies_elim (Thm.implies_elim (Thm.instantiate' [] [SOME p, SOME q] iffI) th1) th2
@@ -527,7 +527,7 @@
| Var ((s,_),_) => s
| _ => "x"
fun mk_eq s t = Thm.apply (Thm.apply @{cterm "op == :: bool => _"} s) t
- fun mk_exists v th = Drule.arg_cong_rule (ext (Thm.ctyp_of_cterm v))
+ fun mk_exists ctxt v th = Drule.arg_cong_rule (ext ctxt (Thm.typ_of_cterm v))
(Thm.abstract_rule (getname v) v th)
fun simp_ex_conv ctxt =
Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms(39)})
@@ -738,9 +738,10 @@
fun ring ctxt tm =
let
fun mk_forall x p =
- Thm.apply
- (Drule.cterm_rule (Thm.instantiate' [SOME (Thm.ctyp_of_cterm x)] [])
- @{cpat "All:: (?'a => bool) => _"}) (Thm.lambda x p)
+ let
+ val T = Thm.typ_of_cterm x;
+ val all = Thm.cterm_of ctxt (Const (@{const_name All}, (T --> @{typ bool}) --> @{typ bool}))
+ in Thm.apply all (Thm.lambda x p) end
val avs = Drule.cterm_add_frees tm []
val P' = fold mk_forall avs tm
val th1 = initial_conv ctxt (mk_neg P')
@@ -829,9 +830,9 @@
(Drule.binop_cong_rule @{cterm HOL.conj} th1
(Thm.reflexive (Thm.dest_arg (Thm.rhs_of th2))))
val v = Thm.dest_arg1(Thm.dest_arg1(Thm.rhs_of th3))
- val th4 = Conv.fconv_rule (Conv.arg_conv (simp_ex_conv ctxt)) (mk_exists v th3)
- val th5 = ex_eq_conv (mk_eq tm (fold mk_ex (remove op aconvc v vars) (Thm.lhs_of th4)))
- in Thm.transitive th5 (fold mk_exists (remove op aconvc v vars) th4)
+ val th4 = Conv.fconv_rule (Conv.arg_conv (simp_ex_conv ctxt)) (mk_exists ctxt v th3)
+ val th5 = ex_eq_conv ctxt (mk_eq tm (fold (mk_ex ctxt) (remove op aconvc v vars) (Thm.lhs_of th4)))
+ in Thm.transitive th5 (fold (mk_exists ctxt) (remove op aconvc v vars) th4)
end;
end
--- a/src/HOL/Tools/inductive.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/inductive.ML Thu Sep 03 15:50:40 2015 +0200
@@ -860,7 +860,7 @@
let
val Ts = arg_types_of (length params) c;
val xs =
- map Free (Variable.variant_frees lthy intr_ts (mk_names "x" (length Ts) ~~ Ts));
+ map Free (Variable.variant_frees lthy' intr_ts (mk_names "x" (length Ts) ~~ Ts));
in
(name_mx, (apfst Binding.concealed Attrib.empty_binding, fold_rev lambda (params @ xs)
(list_comb (rec_const, params @ make_bool_args' bs i @
@@ -870,14 +870,15 @@
|> fold_map Local_Theory.define specs;
val preds = (case cs of [_] => [rec_const] | _ => map #1 consts_defs);
- val (_, lthy''') = Variable.add_fixes (map (fst o dest_Free) params) lthy'';
- val mono = prove_mono quiet_mode skip_mono predT fp_fun monos lthy''';
- val (_, lthy'''') =
- Local_Theory.note (apfst Binding.concealed Attrib.empty_binding,
- Proof_Context.export lthy''' lthy'' [mono]) lthy'';
-
- in (lthy'''', lthy''', rec_name, mono, fp_def', map (#2 o #2) consts_defs,
- list_comb (rec_const, params), preds, argTs, bs, xs)
+ val (_, ctxt'') = Variable.add_fixes (map (fst o dest_Free) params) lthy'';
+ val mono = prove_mono quiet_mode skip_mono predT fp_fun monos ctxt'';
+ val (_, lthy''') = lthy''
+ |> Local_Theory.note (apfst Binding.concealed Attrib.empty_binding,
+ Proof_Context.export ctxt'' lthy'' [mono]);
+ in
+ (lthy''', Proof_Context.transfer (Proof_Context.theory_of lthy''') ctxt'',
+ rec_name, mono, fp_def', map (#2 o #2) consts_defs,
+ list_comb (rec_const, params), preds, argTs, bs, xs)
end;
fun declare_rules rec_binding coind no_ind cnames
--- a/src/HOL/Tools/lin_arith.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/lin_arith.ML Thu Sep 03 15:50:40 2015 +0200
@@ -786,14 +786,18 @@
val init_arith_data =
Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, number_of, ...} =>
- {add_mono_thms = @{thms add_mono_thms_linordered_semiring}
- @ @{thms add_mono_thms_linordered_field} @ add_mono_thms,
- mult_mono_thms = @{thm mult_strict_left_mono} :: @{thm mult_left_mono}
- :: @{lemma "a = b ==> c * a = c * b" by (rule arg_cong)} :: mult_mono_thms,
+ {add_mono_thms =
+ map Thm.trim_context @{thms add_mono_thms_linordered_semiring add_mono_thms_linordered_field}
+ @ add_mono_thms,
+ mult_mono_thms =
+ map Thm.trim_context
+ (@{thms mult_strict_left_mono mult_left_mono} @
+ [@{lemma "a = b ==> c * a = c * b" by (rule arg_cong)}]) @ mult_mono_thms,
inj_thms = inj_thms,
lessD = lessD,
- neqE = @{thm linorder_neqE_nat} :: @{thm linorder_neqE_linordered_idom} :: neqE,
- simpset = put_simpset HOL_basic_ss @{context} |> Simplifier.add_cong @{thm if_weak_cong} |> simpset_of,
+ neqE = map Thm.trim_context @{thms linorder_neqE_nat linorder_neqE_linordered_idom} @ neqE,
+ simpset =
+ put_simpset HOL_basic_ss @{context} |> Simplifier.add_cong @{thm if_weak_cong} |> simpset_of,
number_of = number_of});
(* FIXME !?? *)
--- a/src/HOL/Tools/sat.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/sat.ML Thu Sep 03 15:50:40 2015 +0200
@@ -226,7 +226,7 @@
val _ = cond_tracing ctxt (fn () => "Using original clause #" ^ string_of_int id)
val raw = CNF.clause2raw_thm ctxt thm
val hyps = sort (lit_ord o apply2 fst) (map_filter (fn chyp =>
- Option.map (rpair chyp) (index_of_literal chyp)) (#hyps (Thm.crep_thm raw)))
+ Option.map (rpair chyp) (index_of_literal chyp)) (Thm.chyps_of raw))
val clause = (raw, hyps)
val _ = Array.update (clauses, id, RAW_CLAUSE clause)
in
--- a/src/HOL/Tools/sat_solver.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/sat_solver.ML Thu Sep 03 15:50:40 2015 +0200
@@ -129,29 +129,29 @@
error "formula is not in CNF"
| write_formula (BoolVar i) =
(i>=1 orelse error "formula contains a variable index less than 1";
- TextIO.output (out, string_of_int i))
+ File.output out (string_of_int i))
| write_formula (Not (BoolVar i)) =
- (TextIO.output (out, "-");
+ (File.output out "-";
write_formula (BoolVar i))
| write_formula (Not _) =
error "formula is not in CNF"
| write_formula (Or (fm1, fm2)) =
(write_formula fm1;
- TextIO.output (out, " ");
+ File.output out " ";
write_formula fm2)
| write_formula (And (fm1, fm2)) =
(write_formula fm1;
- TextIO.output (out, " 0\n");
+ File.output out " 0\n";
write_formula fm2)
val fm' = cnf_True_False_elim fm
val number_of_vars = maxidx fm'
val number_of_clauses = cnf_number_of_clauses fm'
in
- TextIO.output (out, "c This file was generated by SAT_Solver.write_dimacs_cnf_file\n");
- TextIO.output (out, "p cnf " ^ string_of_int number_of_vars ^ " " ^
+ File.output out "c This file was generated by SAT_Solver.write_dimacs_cnf_file\n";
+ File.output out ("p cnf " ^ string_of_int number_of_vars ^ " " ^
string_of_int number_of_clauses ^ "\n");
write_formula fm';
- TextIO.output (out, " 0\n")
+ File.output out " 0\n"
end
in
File.open_output write_cnf_file path
@@ -169,51 +169,51 @@
fun write_sat_file out =
let
fun write_formula True =
- TextIO.output (out, "*()")
+ File.output out "*()"
| write_formula False =
- TextIO.output (out, "+()")
+ File.output out "+()"
| write_formula (BoolVar i) =
(i>=1 orelse error "formula contains a variable index less than 1";
- TextIO.output (out, string_of_int i))
+ File.output out (string_of_int i))
| write_formula (Not (BoolVar i)) =
- (TextIO.output (out, "-");
+ (File.output out "-";
write_formula (BoolVar i))
| write_formula (Not fm) =
- (TextIO.output (out, "-(");
+ (File.output out "-(";
write_formula fm;
- TextIO.output (out, ")"))
+ File.output out ")")
| write_formula (Or (fm1, fm2)) =
- (TextIO.output (out, "+(");
+ (File.output out "+(";
write_formula_or fm1;
- TextIO.output (out, " ");
+ File.output out " ";
write_formula_or fm2;
- TextIO.output (out, ")"))
+ File.output out ")")
| write_formula (And (fm1, fm2)) =
- (TextIO.output (out, "*(");
+ (File.output out "*(";
write_formula_and fm1;
- TextIO.output (out, " ");
+ File.output out " ";
write_formula_and fm2;
- TextIO.output (out, ")"))
+ File.output out ")")
(* optimization to make use of n-ary disjunction/conjunction *)
and write_formula_or (Or (fm1, fm2)) =
(write_formula_or fm1;
- TextIO.output (out, " ");
+ File.output out " ";
write_formula_or fm2)
| write_formula_or fm =
write_formula fm
and write_formula_and (And (fm1, fm2)) =
(write_formula_and fm1;
- TextIO.output (out, " ");
+ File.output out " ";
write_formula_and fm2)
| write_formula_and fm =
write_formula fm
val number_of_vars = Int.max (maxidx fm, 1)
in
- TextIO.output (out, "c This file was generated by SAT_Solver.write_dimacs_sat_file\n");
- TextIO.output (out, "p sat " ^ string_of_int number_of_vars ^ "\n");
- TextIO.output (out, "(");
+ File.output out "c This file was generated by SAT_Solver.write_dimacs_sat_file\n";
+ File.output out ("p sat " ^ string_of_int number_of_vars ^ "\n");
+ File.output out "(";
write_formula fm;
- TextIO.output (out, ")\n")
+ File.output out ")\n"
end
in
File.open_output write_sat_file path
--- a/src/HOL/Tools/semiring_normalizer.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Tools/semiring_normalizer.ML Thu Sep 03 15:50:40 2015 +0200
@@ -123,6 +123,9 @@
Simplifier.rewrite (put_simpset semiring_norm_ss ctxt)
then_conv Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms numeral_1_eq_1}))};
+val divide_const = Thm.cterm_of @{context} (Logic.varify_global @{term "op /"});
+val [divide_tvar] = Term.add_tvars (Thm.term_of divide_const) [];
+
val field_funs =
let
fun numeral_is_const ct =
@@ -142,7 +145,7 @@
let val (a, b) = Rat.quotient_of_rat x
in if b = 1 then Numeral.mk_cnumber cT a
else Thm.apply
- (Thm.apply (Drule.cterm_rule (Thm.instantiate' [SOME cT] []) @{cpat "op /"})
+ (Thm.apply (Thm.instantiate_cterm ([(divide_tvar, cT)], []) divide_const)
(Numeral.mk_cnumber cT a))
(Numeral.mk_cnumber cT b)
end
--- a/src/HOL/Transcendental.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Transcendental.thy Thu Sep 03 15:50:40 2015 +0200
@@ -171,13 +171,13 @@
using powser_times_n_limit_0 [of "inverse x"]
by (simp add: norm_divide divide_simps)
-lemma lim_1_over_n: "((\<lambda>n. 1 / of_nat n) ---> (0::'a\<Colon>real_normed_field)) sequentially"
+lemma lim_1_over_n: "((\<lambda>n. 1 / of_nat n) ---> (0::'a::real_normed_field)) sequentially"
apply (clarsimp simp: lim_sequentially norm_divide dist_norm divide_simps)
apply (auto simp: mult_ac dest!: ex_less_of_nat_mult [of _ 1])
by (metis le_eq_less_or_eq less_trans linordered_comm_semiring_strict_class.comm_mult_strict_left_mono
of_nat_less_0_iff of_nat_less_iff zero_less_mult_iff zero_less_one)
-lemma lim_inverse_n: "((\<lambda>n. inverse(of_nat n)) ---> (0::'a\<Colon>real_normed_field)) sequentially"
+lemma lim_inverse_n: "((\<lambda>n. inverse(of_nat n)) ---> (0::'a::real_normed_field)) sequentially"
using lim_1_over_n
by (simp add: inverse_eq_divide)
@@ -3759,7 +3759,7 @@
using sin_cos_squared_add [of x, unfolded assms]
by simp
-lemma sin_times_pi_eq_0: "sin(x * pi) = 0 \<longleftrightarrow> x \<in> Ints"
+lemma sin_times_pi_eq_0: "sin(x * pi) = 0 \<longleftrightarrow> x \<in> \<int>"
by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_real_of_int real_of_int_def)
lemma cos_one_2pi:
@@ -3875,10 +3875,10 @@
lemma sin_30: "sin (pi / 6) = 1 / 2"
by (simp add: sin_cos_eq cos_60)
-lemma cos_integer_2pi: "n \<in> Ints \<Longrightarrow> cos(2*pi * n) = 1"
+lemma cos_integer_2pi: "n \<in> \<int> \<Longrightarrow> cos(2*pi * n) = 1"
by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute real_of_int_def)
-lemma sin_integer_2pi: "n \<in> Ints \<Longrightarrow> sin(2*pi * n) = 0"
+lemma sin_integer_2pi: "n \<in> \<int> \<Longrightarrow> sin(2*pi * n) = 0"
by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
lemma cos_int_2npi [simp]: "cos (2 * real (n::int) * pi) = 1"
--- a/src/HOL/Transitive_Closure.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Transitive_Closure.thy Thu Sep 03 15:50:40 2015 +0200
@@ -169,8 +169,9 @@
lemma rtrancl_Int_subset: "[| Id \<subseteq> s; (r^* \<inter> s) O r \<subseteq> s|] ==> r^* \<subseteq> s"
apply (rule subsetI)
- apply (rule_tac p="x" in PairE, clarify)
- apply (erule rtrancl_induct, auto)
+ apply auto
+ apply (erule rtrancl_induct)
+ apply auto
done
lemma converse_rtranclp_into_rtranclp:
@@ -409,10 +410,9 @@
lemma trancl_Int_subset: "[| r \<subseteq> s; (r^+ \<inter> s) O r \<subseteq> s|] ==> r^+ \<subseteq> s"
apply (rule subsetI)
- apply (rule_tac p = x in PairE)
- apply clarify
+ apply auto
apply (erule trancl_induct)
- apply auto
+ apply auto
done
lemma trancl_unfold: "r^+ = r Un r^+ O r"
--- a/src/HOL/UNITY/Follows.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/UNITY/Follows.thy Thu Sep 03 15:50:40 2015 +0200
@@ -172,7 +172,7 @@
instantiation multiset :: (order) ordered_ab_semigroup_add
begin
-definition less_multiset :: "'a\<Colon>order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where
+definition less_multiset :: "'a::order multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where
"M' < M \<longleftrightarrow> M' #<# M"
definition less_eq_multiset :: "'a multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where
--- a/src/HOL/Word/Word.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/Word/Word.thy Thu Sep 03 15:50:40 2015 +0200
@@ -43,7 +43,7 @@
"uint a = uint b \<Longrightarrow> a = b"
by (simp add: word_uint_eq_iff)
-definition word_of_int :: "int \<Rightarrow> 'a\<Colon>len0 word"
+definition word_of_int :: "int \<Rightarrow> 'a::len0 word"
where
-- {* representation of words using unsigned or signed bins,
only difference in these is the type class *}
@@ -2707,7 +2707,7 @@
by (auto simp add: word_ubin.eq_norm nth_bintr nth_2p_bin)
lemma nth_w2p:
- "((2\<Colon>'a\<Colon>len word) ^ n) !! m \<longleftrightarrow> m = n \<and> m < len_of TYPE('a\<Colon>len)"
+ "((2::'a::len word) ^ n) !! m \<longleftrightarrow> m = n \<and> m < len_of TYPE('a::len)"
unfolding test_bit_2p [symmetric] word_of_int [symmetric]
by (simp add: of_int_power)
@@ -3736,7 +3736,7 @@
lemma test_bit_split:
"word_split c = (a, b) \<Longrightarrow>
- (\<forall>n\<Colon>nat. b !! n \<longleftrightarrow> n < size b \<and> c !! n) \<and> (\<forall>m\<Colon>nat. a !! m \<longleftrightarrow> m < size a \<and> c !! (m + size b))"
+ (\<forall>n::nat. b !! n \<longleftrightarrow> n < size b \<and> c !! n) \<and> (\<forall>m::nat. a !! m \<longleftrightarrow> m < size a \<and> c !! (m + size b))"
by (simp add: test_bit_split')
lemma test_bit_split_eq: "word_split c = (a, b) <->
--- a/src/HOL/ZF/HOLZF.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ZF/HOLZF.thy Thu Sep 03 15:50:40 2015 +0200
@@ -583,8 +583,8 @@
ultimately have "False" using u by arith
}
note lemma_nat2Nat = this
- have th:"\<And>x y. \<not> (x < y \<and> (\<forall>(m\<Colon>nat). y \<noteq> x + m))" by presburger
- have th': "\<And>x y. \<not> (x \<noteq> y \<and> (\<not> x < y) \<and> (\<forall>(m\<Colon>nat). x \<noteq> y + m))" by presburger
+ have th:"\<And>x y. \<not> (x < y \<and> (\<forall>(m::nat). y \<noteq> x + m))" by presburger
+ have th': "\<And>x y. \<not> (x \<noteq> y \<and> (\<not> x < y) \<and> (\<forall>(m::nat). x \<noteq> y + m))" by presburger
show ?thesis
apply (auto simp add: inj_on_def)
apply (case_tac "x = y")
--- a/src/HOL/ex/Dedekind_Real.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/Dedekind_Real.thy Thu Sep 03 15:50:40 2015 +0200
@@ -102,7 +102,7 @@
preal_inverse_def:
"inverse R == Abs_preal (inverse_set (Rep_preal R))"
-definition "R div S = R * inverse (S\<Colon>preal)"
+definition "R div S = R * inverse (S::preal)"
definition
preal_one_def:
@@ -220,10 +220,10 @@
begin
definition
- "(inf \<Colon> preal \<Rightarrow> preal \<Rightarrow> preal) = min"
+ "(inf :: preal \<Rightarrow> preal \<Rightarrow> preal) = min"
definition
- "(sup \<Colon> preal \<Rightarrow> preal \<Rightarrow> preal) = max"
+ "(sup :: preal \<Rightarrow> preal \<Rightarrow> preal) = max"
instance
by intro_classes
@@ -1229,7 +1229,7 @@
(\<exists>x y u v. x+v \<le> u+y & (x,y) \<in> Rep_Real z & (u,v) \<in> Rep_Real w)"
definition
- real_less_def: "x < (y\<Colon>real) \<longleftrightarrow> x \<le> y \<and> x \<noteq> y"
+ real_less_def: "x < (y::real) \<longleftrightarrow> x \<le> y \<and> x \<noteq> y"
definition
real_abs_def: "abs (r::real) = (if r < 0 then - r else r)"
@@ -1561,10 +1561,10 @@
begin
definition
- "(inf \<Colon> real \<Rightarrow> real \<Rightarrow> real) = min"
+ "(inf :: real \<Rightarrow> real \<Rightarrow> real) = min"
definition
- "(sup \<Colon> real \<Rightarrow> real \<Rightarrow> real) = max"
+ "(sup :: real \<Rightarrow> real \<Rightarrow> real) = max"
instance
by default (auto simp add: inf_real_def sup_real_def max_min_distrib2)
--- a/src/HOL/ex/Eval_Examples.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/Eval_Examples.thy Thu Sep 03 15:50:40 2015 +0200
@@ -43,7 +43,7 @@
text {* a fancy datatype *}
datatype ('a, 'b) foo =
- Foo "'a\<Colon>order" 'b
+ Foo "'a::order" 'b
| Bla "('a, 'b) bar"
| Dummy nat
and ('a, 'b) bar =
--- a/src/HOL/ex/FinFunPred.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/FinFunPred.thy Thu Sep 03 15:50:40 2015 +0200
@@ -15,7 +15,7 @@
definition le_finfun_def [code del]: "f \<le> g \<longleftrightarrow> (\<forall>x. f $ x \<le> g $ x)"
-definition [code del]: "(f\<Colon>'a \<Rightarrow>f 'b) < g \<longleftrightarrow> f \<le> g \<and> \<not> g \<le> f"
+definition [code del]: "(f::'a \<Rightarrow>f 'b) < g \<longleftrightarrow> f \<le> g \<and> \<not> g \<le> f"
instance ..
--- a/src/HOL/ex/Meson_Test.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/Meson_Test.thy Thu Sep 03 15:50:40 2015 +0200
@@ -37,7 +37,7 @@
val horns25 = Meson.make_horns clauses25; (*16 Horn clauses*)
val go25 :: _ = Meson.gocls clauses25;
- val ctxt' = fold Thm.declare_hyps (maps (#hyps o Thm.crep_thm) (go25 :: horns25)) ctxt;
+ val ctxt' = fold Thm.declare_hyps (maps Thm.chyps_of (go25 :: horns25)) ctxt;
Goal.prove ctxt' [] [] @{prop False} (fn _ =>
resolve_tac ctxt' [go25] 1 THEN
Meson.depth_prolog_tac ctxt' horns25);
@@ -63,7 +63,7 @@
val _ = @{assert} (length horns26 = 24);
val go26 :: _ = Meson.gocls clauses26;
- val ctxt' = fold Thm.declare_hyps (maps (#hyps o Thm.crep_thm) (go26 :: horns26)) ctxt;
+ val ctxt' = fold Thm.declare_hyps (maps Thm.chyps_of (go26 :: horns26)) ctxt;
Goal.prove ctxt' [] [] @{prop False} (fn _ =>
resolve_tac ctxt' [go26] 1 THEN
Meson.depth_prolog_tac ctxt' horns26); (*7 ms*)
@@ -90,7 +90,7 @@
val _ = @{assert} (length horns43 = 16);
val go43 :: _ = Meson.gocls clauses43;
- val ctxt' = fold Thm.declare_hyps (maps (#hyps o Thm.crep_thm) (go43 :: horns43)) ctxt;
+ val ctxt' = fold Thm.declare_hyps (maps Thm.chyps_of (go43 :: horns43)) ctxt;
Goal.prove ctxt' [] [] @{prop False} (fn _ =>
resolve_tac ctxt' [go43] 1 THEN
Meson.best_prolog_tac ctxt' Meson.size_of_subgoals horns43); (*7ms*)
--- a/src/HOL/ex/Normalization_by_Evaluation.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/Normalization_by_Evaluation.thy Thu Sep 03 15:50:40 2015 +0200
@@ -99,8 +99,8 @@
lemma "(2::int) < 3" by normalization
lemma "(2::int) <= 3" by normalization
lemma "abs ((-4::int) + 2 * 1) = 2" by normalization
-lemma "4 - 42 * abs (3 + (-7\<Colon>int)) = -164" by normalization
-lemma "(if (0\<Colon>nat) \<le> (x\<Colon>nat) then 0\<Colon>nat else x) = 0" by normalization
+lemma "4 - 42 * abs (3 + (-7::int)) = -164" by normalization
+lemma "(if (0::nat) \<le> (x::nat) then 0::nat else x) = 0" by normalization
lemma "4 = Suc (Suc (Suc (Suc 0)))" by normalization
lemma "nat 4 = Suc (Suc (Suc (Suc 0)))" by normalization
lemma "[Suc 0, 0] = [Suc 0, 0]" by normalization
@@ -127,8 +127,8 @@
lemma "map f [x, y] = [f x, f y]" by normalization
lemma "(map f [x, y], w) = ([f x, f y], w)" by normalization
-lemma "map f [x, y] = [f x \<Colon> 'a\<Colon>semigroup_add, f y]" by normalization
-lemma "map f [x \<Colon> 'a\<Colon>semigroup_add, y] = [f x, f y]" by normalization
-lemma "(map f [x \<Colon> 'a\<Colon>semigroup_add, y], w \<Colon> 'b\<Colon>finite) = ([f x, f y], w)" by normalization
+lemma "map f [x, y] = [f x :: 'a::semigroup_add, f y]" by normalization
+lemma "map f [x :: 'a::semigroup_add, y] = [f x, f y]" by normalization
+lemma "(map f [x :: 'a::semigroup_add, y], w :: 'b::finite) = ([f x, f y], w)" by normalization
end
--- a/src/HOL/ex/Transfer_Ex.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/Transfer_Ex.thy Thu Sep 03 15:50:40 2015 +0200
@@ -8,58 +8,58 @@
lemma ex1: "(x::nat) + y = y + x"
by auto
-lemma "0 \<le> (y\<Colon>int) \<Longrightarrow> 0 \<le> (x\<Colon>int) \<Longrightarrow> x + y = y + x"
+lemma "0 \<le> (y::int) \<Longrightarrow> 0 \<le> (x::int) \<Longrightarrow> x + y = y + x"
by (fact ex1 [transferred])
(* Using new transfer package *)
-lemma "0 \<le> (x\<Colon>int) \<Longrightarrow> 0 \<le> (y\<Colon>int) \<Longrightarrow> x + y = y + x"
+lemma "0 \<le> (x::int) \<Longrightarrow> 0 \<le> (y::int) \<Longrightarrow> x + y = y + x"
by (fact ex1 [untransferred])
lemma ex2: "(a::nat) div b * b + a mod b = a"
by (rule mod_div_equality)
-lemma "0 \<le> (b\<Colon>int) \<Longrightarrow> 0 \<le> (a\<Colon>int) \<Longrightarrow> a div b * b + a mod b = a"
+lemma "0 \<le> (b::int) \<Longrightarrow> 0 \<le> (a::int) \<Longrightarrow> a div b * b + a mod b = a"
by (fact ex2 [transferred])
(* Using new transfer package *)
-lemma "0 \<le> (a\<Colon>int) \<Longrightarrow> 0 \<le> (b\<Colon>int) \<Longrightarrow> a div b * b + a mod b = a"
+lemma "0 \<le> (a::int) \<Longrightarrow> 0 \<le> (b::int) \<Longrightarrow> a div b * b + a mod b = a"
by (fact ex2 [untransferred])
lemma ex3: "ALL (x::nat). ALL y. EX z. z >= x + y"
by auto
-lemma "\<forall>x\<ge>0\<Colon>int. \<forall>y\<ge>0. \<exists>z\<ge>0. x + y \<le> z"
+lemma "\<forall>x\<ge>0::int. \<forall>y\<ge>0. \<exists>z\<ge>0. x + y \<le> z"
by (fact ex3 [transferred nat_int])
(* Using new transfer package *)
-lemma "\<forall>x\<Colon>int\<in>{0..}. \<forall>y\<in>{0..}. \<exists>z\<in>{0..}. x + y \<le> z"
+lemma "\<forall>x::int\<in>{0..}. \<forall>y\<in>{0..}. \<exists>z\<in>{0..}. x + y \<le> z"
by (fact ex3 [untransferred])
lemma ex4: "(x::nat) >= y \<Longrightarrow> (x - y) + y = x"
by auto
-lemma "0 \<le> (x\<Colon>int) \<Longrightarrow> 0 \<le> (y\<Colon>int) \<Longrightarrow> y \<le> x \<Longrightarrow> tsub x y + y = x"
+lemma "0 \<le> (x::int) \<Longrightarrow> 0 \<le> (y::int) \<Longrightarrow> y \<le> x \<Longrightarrow> tsub x y + y = x"
by (fact ex4 [transferred])
(* Using new transfer package *)
-lemma "0 \<le> (y\<Colon>int) \<Longrightarrow> 0 \<le> (x\<Colon>int) \<Longrightarrow> y \<le> x \<Longrightarrow> tsub x y + y = x"
+lemma "0 \<le> (y::int) \<Longrightarrow> 0 \<le> (x::int) \<Longrightarrow> y \<le> x \<Longrightarrow> tsub x y + y = x"
by (fact ex4 [untransferred])
lemma ex5: "(2::nat) * \<Sum>{..n} = n * (n + 1)"
by (induct n rule: nat_induct, auto)
-lemma "0 \<le> (n\<Colon>int) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
+lemma "0 \<le> (n::int) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
by (fact ex5 [transferred])
(* Using new transfer package *)
-lemma "0 \<le> (n\<Colon>int) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
+lemma "0 \<le> (n::int) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
by (fact ex5 [untransferred])
-lemma "0 \<le> (n\<Colon>nat) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
+lemma "0 \<le> (n::nat) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
by (fact ex5 [transferred, transferred])
(* Using new transfer package *)
-lemma "0 \<le> (n\<Colon>nat) \<Longrightarrow> 2 * \<Sum>{..n} = n * (n + 1)"
+lemma "0 \<le> (n::nat) \<Longrightarrow> 2 * \<Sum>{..n} = n * (n + 1)"
by (fact ex5 [untransferred, Transfer.transferred])
end
--- a/src/HOL/ex/Transfer_Int_Nat.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/HOL/ex/Transfer_Int_Nat.thy Thu Sep 03 15:50:40 2015 +0200
@@ -200,7 +200,7 @@
involved are bi-unique. *}
lemma
- assumes "\<And>xs\<Colon>int list. \<lbrakk>list_all (\<lambda>x. x \<ge> 0) xs; xs \<noteq> []\<rbrakk> \<Longrightarrow>
+ assumes "\<And>xs::int list. \<lbrakk>list_all (\<lambda>x. x \<ge> 0) xs; xs \<noteq> []\<rbrakk> \<Longrightarrow>
listsum xs < listsum (map (\<lambda>x. x + 1) xs)"
shows "xs \<noteq> [] \<Longrightarrow> listsum xs < listsum (map Suc xs)"
apply transfer
--- a/src/Provers/Arith/fast_lin_arith.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Provers/Arith/fast_lin_arith.ML Thu Sep 03 15:50:40 2015 +0200
@@ -143,6 +143,8 @@
val map_data = Data.map;
val get_data = Data.get o Context.Proof;
+fun get_neqE ctxt = map (Thm.transfer (Proof_Context.theory_of ctxt)) (#neqE (get_data ctxt));
+
fun map_inj_thms f {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset, number_of} =
{add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms, inj_thms = f inj_thms,
lessD = lessD, neqE = neqE, simpset = simpset, number_of = number_of};
@@ -157,8 +159,8 @@
lessD = lessD, neqE = neqE, simpset = simpset_map (Context.proof_of context) f simpset,
number_of = number_of}) context;
-fun add_inj_thms thms = map_data (map_inj_thms (append thms));
-fun add_lessD thm = map_data (map_lessD (fn thms => thms @ [thm]));
+fun add_inj_thms thms = map_data (map_inj_thms (append (map Thm.trim_context thms)));
+fun add_lessD thm = map_data (map_lessD (fn thms => thms @ [Thm.trim_context thm]));
fun add_simps thms = map_simpset (fn ctxt => ctxt addsimps thms);
fun add_simprocs procs = map_simpset (fn ctxt => ctxt addsimprocs procs);
@@ -168,7 +170,7 @@
lessD = lessD, neqE = neqE, simpset = simpset, number_of = SOME f});
fun number_of ctxt =
- (case Data.get (Context.Proof ctxt) of
+ (case get_data ctxt of
{number_of = SOME f, ...} => f ctxt
| _ => fn _ => fn _ => raise CTERM ("number_of", []));
@@ -377,7 +379,13 @@
fun mkthm ctxt asms (just: injust) =
let
val thy = Proof_Context.theory_of ctxt;
- val {add_mono_thms, mult_mono_thms, inj_thms, lessD, simpset, ...} = get_data ctxt;
+ val {add_mono_thms = add_mono_thms0, mult_mono_thms = mult_mono_thms0,
+ inj_thms = inj_thms0, lessD = lessD0, simpset, ...} = get_data ctxt;
+ val add_mono_thms = map (Thm.transfer thy) add_mono_thms0;
+ val mult_mono_thms = map (Thm.transfer thy) mult_mono_thms0;
+ val inj_thms = map (Thm.transfer thy) inj_thms0;
+ val lessD = map (Thm.transfer thy) lessD0;
+
val number_of = number_of ctxt;
val simpset_ctxt = put_simpset simpset ctxt;
fun only_concl f thm =
@@ -649,7 +657,7 @@
val _ = trace_thm ctxt
["refute_tac (on subgoal " ^ string_of_int i ^ ", with " ^
string_of_int (length justs) ^ " justification(s)):"] state
- val {neqE, ...} = get_data ctxt;
+ val neqE = get_neqE ctxt;
fun just1 j =
(* eliminate inequalities *)
(if split_neq then
@@ -718,7 +726,7 @@
in (ct1, ct2) end;
fun splitasms ctxt (asms : thm list) : splittree =
-let val {neqE, ...} = get_data ctxt
+let val neqE = get_neqE ctxt
fun elim_neq [] (asms', []) = Tip (rev asms')
| elim_neq [] (asms', asms) = Tip (rev asms' @ asms)
| elim_neq (_ :: neqs) (asms', []) = elim_neq neqs ([],rev asms')
--- a/src/Provers/blast.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Provers/blast.ML Thu Sep 03 15:50:40 2015 +0200
@@ -29,7 +29,7 @@
the formulae get into the wrong order (see WRONG below).
With substition for equalities (hyp_subst_tac):
- When substitution affects a haz formula or literal, it is moved
+ When substitution affects an unsage formula or literal, it is moved
back to the list of safe formulae.
But there's no way of putting it in the right place. A "moved" or
"no DETERM" flag would prevent proofs failing here.
@@ -93,7 +93,7 @@
(*Pending formulae carry md (may duplicate) flags*)
type branch =
{pairs: ((term*bool) list * (*safe formulae on this level*)
- (term*bool) list) list, (*haz formulae on this level*)
+ (term*bool) list) list, (*unsafe formulae on this level*)
lits: term list, (*literals: irreducible formulae*)
vars: term option Unsynchronized.ref list, (*variables occurring in branch*)
lim: int}; (*resource limit*)
@@ -497,24 +497,25 @@
(*Tableau rule from elimination rule.
Flag "upd" says that the inference updated the branch.
Flag "dup" requests duplication of the affected formula.*)
-fun fromRule (state as State {ctxt, ...}) vars rl =
- let val thy = Proof_Context.theory_of ctxt
- val trl = rl |> Thm.prop_of |> fromTerm thy |> convertRule state vars
- fun tac (upd, dup,rot) i =
- emtac ctxt upd (if dup then rev_dup_elim ctxt rl else rl) i
- THEN
- rot_subgoals_tac (rot, #2 trl) i
- in Option.SOME (trl, tac) end
+fun fromRule (state as State {ctxt, ...}) vars rl0 =
+ let
+ val thy = Proof_Context.theory_of ctxt
+ val rl = Thm.transfer thy rl0
+ val trl = rl |> Thm.prop_of |> fromTerm thy |> convertRule state vars
+ fun tac (upd, dup,rot) i =
+ emtac ctxt upd (if dup then rev_dup_elim ctxt rl else rl) i THEN
+ rot_subgoals_tac (rot, #2 trl) i
+ in SOME (trl, tac) end
handle
ElimBadPrem => (*reject: prems don't preserve conclusion*)
(if Context_Position.is_visible ctxt then
- warning ("Ignoring weak elimination rule\n" ^ Display.string_of_thm ctxt rl)
+ warning ("Ignoring weak elimination rule\n" ^ Display.string_of_thm ctxt rl0)
else ();
Option.NONE)
| ElimBadConcl => (*ignore: conclusion is not just a variable*)
(cond_tracing (Config.get ctxt trace)
(fn () => "Ignoring ill-formed elimination rule:\n" ^
- "conclusion should be a variable\n" ^ Display.string_of_thm ctxt rl);
+ "conclusion should be a variable\n" ^ Display.string_of_thm ctxt rl0);
Option.NONE);
@@ -531,15 +532,16 @@
(*Tableau rule from introduction rule.
Flag "upd" says that the inference updated the branch.
Flag "dup" requests duplication of the affected formula.
- Since haz rules are now delayed, "dup" is always FALSE for
+ Since unsafe rules are now delayed, "dup" is always FALSE for
introduction rules.*)
-fun fromIntrRule (state as State {ctxt, ...}) vars rl =
- let val thy = Proof_Context.theory_of ctxt
- val trl = rl |> Thm.prop_of |> fromTerm thy |> convertIntrRule state vars
- fun tac (upd,dup,rot) i =
- rmtac ctxt upd (if dup then Classical.dup_intr rl else rl) i
- THEN
- rot_subgoals_tac (rot, #2 trl) i
+fun fromIntrRule (state as State {ctxt, ...}) vars rl0 =
+ let
+ val thy = Proof_Context.theory_of ctxt
+ val rl = Thm.transfer thy rl0
+ val trl = rl |> Thm.prop_of |> fromTerm thy |> convertIntrRule state vars
+ fun tac (upd,dup,rot) i =
+ rmtac ctxt upd (if dup then Classical.dup_intr rl else rl) i THEN
+ rot_subgoals_tac (rot, #2 trl) i
in (trl, tac) end;
@@ -623,7 +625,7 @@
(*Converts all Goals to Nots in the safe parts of a branch. They could
have been moved there from the literals list after substitution (equalSubst).
There can be at most one--this function could be made more efficient.*)
-fun negOfGoals pairs = map (fn (Gs,haz) => (map negOfGoal2 Gs, haz)) pairs;
+fun negOfGoals pairs = map (fn (Gs, unsafe) => (map negOfGoal2 Gs, unsafe)) pairs;
(*Tactic. Convert *Goal* to negated assumption in FIRST position*)
fun negOfGoal_tac ctxt i =
@@ -922,18 +924,18 @@
let val State {ctxt, ntrail, nclosed, ntried, ...} = state;
val trace = Config.get ctxt trace;
val stats = Config.get ctxt stats;
- val {safe0_netpair, safep_netpair, haz_netpair, ...} =
+ val {safe0_netpair, safep_netpair, unsafe_netpair, ...} =
Classical.rep_cs (Classical.claset_of ctxt);
- val safeList = [safe0_netpair, safep_netpair]
- and hazList = [haz_netpair]
+ val safeList = [safe0_netpair, safep_netpair];
+ val unsafeList = [unsafe_netpair];
fun prv (tacs, trs, choices, []) =
(printStats state (trace orelse stats, start, tacs);
cont (tacs, trs, choices)) (*all branches closed!*)
| prv (tacs, trs, choices,
- brs0 as {pairs = ((G,md)::br, haz)::pairs,
+ brs0 as {pairs = ((G,md)::br, unsafe)::pairs,
lits, vars, lim} :: brs) =
(*apply a safe rule only (possibly allowing instantiation);
- defer any haz formulae*)
+ defer any unsafe formulae*)
let exception PRV (*backtrack to precisely this recursion!*)
val ntrl = !ntrail
val nbrs = length brs0
@@ -945,12 +947,12 @@
map (fn prem =>
if (exists isGoal prem)
then {pairs = ((joinMd md prem, []) ::
- negOfGoals ((br, haz)::pairs)),
+ negOfGoals ((br, unsafe)::pairs)),
lits = map negOfGoal lits,
vars = vars',
lim = lim'}
else {pairs = ((joinMd md prem, []) ::
- (br, haz) :: pairs),
+ (br, unsafe) :: pairs),
lits = lits,
vars = vars',
lim = lim'})
@@ -1014,11 +1016,11 @@
[this handler is pruned if possible!]*)
(clearTo state ntrl; closeF Ls)
end
- (*Try to unify a queued formula (safe or haz) with head goal*)
+ (*Try to unify a queued formula (safe or unsafe) with head goal*)
fun closeFl [] = raise CLOSEF
- | closeFl ((br, haz)::pairs) =
+ | closeFl ((br, unsafe)::pairs) =
closeF (map fst br)
- handle CLOSEF => closeF (map fst haz)
+ handle CLOSEF => closeF (map fst unsafe)
handle CLOSEF => closeFl pairs
in
trace_prover state brs0;
@@ -1027,49 +1029,49 @@
prv (Data.hyp_subst_tac ctxt trace :: tacs,
brs0::trs, choices,
equalSubst ctxt
- (G, {pairs = (br,haz)::pairs,
+ (G, {pairs = (br,unsafe)::pairs,
lits = lits, vars = vars, lim = lim})
:: brs)
handle DEST_EQ => closeF lits
- handle CLOSEF => closeFl ((br,haz)::pairs)
+ handle CLOSEF => closeFl ((br,unsafe)::pairs)
handle CLOSEF => deeper rules
handle NEWBRANCHES =>
- (case netMkRules state G vars hazList of
- [] => (*there are no plausible haz rules*)
+ (case netMkRules state G vars unsafeList of
+ [] => (*there are no plausible unsafe rules*)
(cond_tracing trace (fn () => "moving formula to literals");
prv (tacs, brs0::trs, choices,
- {pairs = (br,haz)::pairs,
+ {pairs = (br,unsafe)::pairs,
lits = addLit(G,lits),
vars = vars,
lim = lim} :: brs))
- | _ => (*G admits some haz rules: try later*)
- (cond_tracing trace (fn () => "moving formula to haz list");
+ | _ => (*G admits some unsafe rules: try later*)
+ (cond_tracing trace (fn () => "moving formula to unsafe list");
prv (if isGoal G then negOfGoal_tac ctxt :: tacs
else tacs,
brs0::trs,
choices,
- {pairs = (br, haz@[(negOfGoal G, md)])::pairs,
+ {pairs = (br, unsafe@[(negOfGoal G, md)])::pairs,
lits = lits,
vars = vars,
lim = lim} :: brs)))
end
| prv (tacs, trs, choices,
- {pairs = ([],haz)::(Gs,haz')::pairs, lits, vars, lim} :: brs) =
- (*no more "safe" formulae: transfer haz down a level*)
+ {pairs = ([],unsafe)::(Gs,unsafe')::pairs, lits, vars, lim} :: brs) =
+ (*no more "safe" formulae: transfer unsafe down a level*)
prv (tacs, trs, choices,
- {pairs = (Gs,haz@haz')::pairs,
+ {pairs = (Gs,unsafe@unsafe')::pairs,
lits = lits,
vars = vars,
lim = lim} :: brs)
| prv (tacs, trs, choices,
brs0 as {pairs = [([], (H,md)::Hs)],
lits, vars, lim} :: brs) =
- (*no safe steps possible at any level: apply a haz rule*)
+ (*no safe steps possible at any level: apply a unsafe rule*)
let exception PRV (*backtrack to precisely this recursion!*)
val H = norm H
val ntrl = !ntrail
- val rules = netMkRules state H vars hazList
- (*new premises of haz rules may NOT be duplicated*)
+ val rules = netMkRules state H vars unsafeList
+ (*new premises of unsafe rules may NOT be duplicated*)
fun newPrem (vars,P,dup,lim') prem =
let val Gs' = map (fn Q => (Q,false)) prem
and Hs' = if dup then Hs @ [(negOfGoal H, md)] else Hs
@@ -1078,7 +1080,7 @@
else lits
in {pairs = if exists (match P) prem then [(Gs',Hs')]
(*Recursive in this premise. Don't make new
- "stack frame". New haz premises will end up
+ "stack frame". New unsafe premises will end up
at the BACK of the queue, preventing
exclusion of others*)
else [(Gs',[]), ([],Hs')],
--- a/src/Provers/clasimp.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Provers/clasimp.ML Thu Sep 03 15:50:40 2015 +0200
@@ -90,7 +90,7 @@
Thm.declaration_attribute (fn th =>
Thm.attribute_declaration (add_iff
(Classical.safe_elim NONE, Classical.safe_intro NONE)
- (Classical.haz_elim NONE, Classical.haz_intro NONE)) th
+ (Classical.unsafe_elim NONE, Classical.unsafe_intro NONE)) th
#> Thm.attribute_declaration Simplifier.simp_add th);
val iff_add' =
@@ -122,7 +122,7 @@
fun slow_step_tac' ctxt =
Classical.appWrappers ctxt
- (Classical.instp_step_tac ctxt APPEND' Classical.haz_step_tac ctxt);
+ (Classical.instp_step_tac ctxt APPEND' Classical.unsafe_step_tac ctxt);
in
--- a/src/Provers/classical.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Provers/classical.ML Thu Sep 03 15:50:40 2015 +0200
@@ -4,7 +4,7 @@
Theorem prover for classical reasoning, including predicate calculus, set
theory, etc.
-Rules must be classified as intro, elim, safe, hazardous (unsafe).
+Rules must be classified as intro, elim, safe, unsafe.
A rule is unsafe unless it can be applied blindly without harmful results.
For a rule to be safe, its premises and conclusion should be logically
@@ -76,8 +76,7 @@
val dup_intr: thm -> thm
val dup_step_tac: Proof.context -> int -> tactic
val eq_mp_tac: Proof.context -> int -> tactic
- val haz_step_tac: Proof.context -> int -> tactic
- val joinrules: thm list * thm list -> (bool * thm) list
+ val unsafe_step_tac: Proof.context -> int -> tactic
val mp_tac: Proof.context -> int -> tactic
val safe_tac: Proof.context -> tactic
val safe_steps_tac: Proof.context -> int -> tactic
@@ -97,27 +96,28 @@
sig
include BASIC_CLASSICAL
val classical_rule: Proof.context -> thm -> thm
+ type rule = thm * (thm * thm list) * (thm * thm list)
type netpair = (int * (bool * thm)) Net.net * (int * (bool * thm)) Net.net
val rep_cs: claset ->
- {safeIs: thm Item_Net.T,
- safeEs: thm Item_Net.T,
- hazIs: thm Item_Net.T,
- hazEs: thm Item_Net.T,
+ {safeIs: rule Item_Net.T,
+ safeEs: rule Item_Net.T,
+ unsafeIs: rule Item_Net.T,
+ unsafeEs: rule Item_Net.T,
swrappers: (string * (Proof.context -> wrapper)) list,
uwrappers: (string * (Proof.context -> wrapper)) list,
safe0_netpair: netpair,
safep_netpair: netpair,
- haz_netpair: netpair,
+ unsafe_netpair: netpair,
dup_netpair: netpair,
- xtra_netpair: Context_Rules.netpair}
+ extra_netpair: Context_Rules.netpair}
val get_cs: Context.generic -> claset
val map_cs: (claset -> claset) -> Context.generic -> Context.generic
val safe_dest: int option -> attribute
val safe_elim: int option -> attribute
val safe_intro: int option -> attribute
- val haz_dest: int option -> attribute
- val haz_elim: int option -> attribute
- val haz_intro: int option -> attribute
+ val unsafe_dest: int option -> attribute
+ val unsafe_elim: int option -> attribute
+ val unsafe_intro: int option -> attribute
val rule_del: attribute
val cla_modifiers: Method.modifier parser list
val cla_method:
@@ -193,13 +193,16 @@
(*Uses introduction rules in the normal way, or on negated assumptions,
trying rules in order. *)
fun swap_res_tac ctxt rls =
- let fun addrl rl brls = (false, rl) :: (true, rl RSN (2, Data.swap)) :: brls in
+ let
+ val transfer = Thm.transfer (Proof_Context.theory_of ctxt);
+ fun addrl rl brls = (false, transfer rl) :: (true, transfer rl RSN (2, Data.swap)) :: brls;
+ in
assume_tac ctxt ORELSE'
contr_tac ctxt ORELSE'
biresolve_tac ctxt (fold_rev addrl rls [])
end;
-(*Duplication of hazardous rules, for complete provers*)
+(*Duplication of unsafe rules, for complete provers*)
fun dup_intr th = zero_var_indexes (th RS Data.classical);
fun dup_elim ctxt th =
@@ -209,38 +212,44 @@
(**** Classical rule sets ****)
+type rule = thm * (thm * thm list) * (thm * thm list);
+ (*external form, internal form (possibly swapped), dup form (possibly swapped)*)
+
type netpair = (int * (bool * thm)) Net.net * (int * (bool * thm)) Net.net;
type wrapper = (int -> tactic) -> int -> tactic;
datatype claset =
CS of
- {safeIs : thm Item_Net.T, (*safe introduction rules*)
- safeEs : thm Item_Net.T, (*safe elimination rules*)
- hazIs : thm Item_Net.T, (*unsafe introduction rules*)
- hazEs : thm Item_Net.T, (*unsafe elimination rules*)
- swrappers : (string * (Proof.context -> wrapper)) list, (*for transforming safe_step_tac*)
- uwrappers : (string * (Proof.context -> wrapper)) list, (*for transforming step_tac*)
- safe0_netpair : netpair, (*nets for trivial cases*)
- safep_netpair : netpair, (*nets for >0 subgoals*)
- haz_netpair : netpair, (*nets for unsafe rules*)
- dup_netpair : netpair, (*nets for duplication*)
- xtra_netpair : Context_Rules.netpair}; (*nets for extra rules*)
+ {safeIs: rule Item_Net.T, (*safe introduction rules*)
+ safeEs: rule Item_Net.T, (*safe elimination rules*)
+ unsafeIs: rule Item_Net.T, (*unsafe introduction rules*)
+ unsafeEs: rule Item_Net.T, (*unsafe elimination rules*)
+ swrappers: (string * (Proof.context -> wrapper)) list, (*for transforming safe_step_tac*)
+ uwrappers: (string * (Proof.context -> wrapper)) list, (*for transforming step_tac*)
+ safe0_netpair: netpair, (*nets for trivial cases*)
+ safep_netpair: netpair, (*nets for >0 subgoals*)
+ unsafe_netpair: netpair, (*nets for unsafe rules*)
+ dup_netpair: netpair, (*nets for duplication*)
+ extra_netpair: Context_Rules.netpair}; (*nets for extra rules*)
+
+val empty_rules: rule Item_Net.T =
+ Item_Net.init (Thm.eq_thm_prop o apply2 #1) (single o Thm.full_prop_of o #1);
val empty_netpair = (Net.empty, Net.empty);
val empty_cs =
CS
- {safeIs = Thm.full_rules,
- safeEs = Thm.full_rules,
- hazIs = Thm.full_rules,
- hazEs = Thm.full_rules,
+ {safeIs = empty_rules,
+ safeEs = empty_rules,
+ unsafeIs = empty_rules,
+ unsafeEs = empty_rules,
swrappers = [],
uwrappers = [],
safe0_netpair = empty_netpair,
safep_netpair = empty_netpair,
- haz_netpair = empty_netpair,
+ unsafe_netpair = empty_netpair,
dup_netpair = empty_netpair,
- xtra_netpair = empty_netpair};
+ extra_netpair = empty_netpair};
fun rep_cs (CS args) = args;
@@ -250,16 +259,7 @@
In case of overlap, new rules are tried BEFORE old ones!!
***)
-fun default_context (SOME context) _ = Context.proof_of context
- | default_context NONE th = Proof_Context.init_global (Thm.theory_of_thm th);
-
-(*For use with biresolve_tac. Combines intro rules with swap to handle negated
- assumptions. Pairs elim rules with true. *)
-fun joinrules (intrs, elims) =
- (map (pair true) (elims @ swapify intrs)) @ map (pair false) intrs;
-
-fun joinrules' (intrs, elims) =
- map (pair true) elims @ map (pair false) intrs;
+fun joinrules (intrs, elims) = map (pair true) elims @ map (pair false) intrs;
(*Priority: prefer rules with fewest subgoals,
then rules added most recently (preferring the head of the list).*)
@@ -277,273 +277,290 @@
Count the intr rules double (to account for swapify). Negate to give the
new insertions the lowest priority.*)
fun insert (nI, nE) = insert_tagged_list o (tag_brls (~(2*nI+nE))) o joinrules;
-fun insert' w (nI, nE) = insert_tagged_list o tag_brls' w (~(nI + nE)) o joinrules';
+fun insert' w (nI, nE) = insert_tagged_list o tag_brls' w (~(nI + nE)) o joinrules;
fun delete_tagged_list rls = fold_rev Tactic.delete_tagged_brl rls;
fun delete x = delete_tagged_list (joinrules x);
-fun delete' x = delete_tagged_list (joinrules' x);
+
+fun bad_thm ctxt msg th = error (msg ^ "\n" ^ Display.string_of_thm ctxt th);
-fun bad_thm (SOME context) msg th =
- error (msg ^ "\n" ^ Display.string_of_thm (Context.proof_of context) th)
- | bad_thm NONE msg th = raise THM (msg, 0, [th]);
-
-fun make_elim opt_context th =
- if has_fewer_prems 1 th then bad_thm opt_context "Ill-formed destruction rule" th
+fun make_elim ctxt th =
+ if has_fewer_prems 1 th then bad_thm ctxt "Ill-formed destruction rule" th
else Tactic.make_elim th;
-fun warn_thm (SOME (Context.Proof ctxt)) msg th =
- if Context_Position.is_really_visible ctxt
- then warning (msg ^ Display.string_of_thm ctxt th) else ()
- | warn_thm _ _ _ = ();
+fun warn_thm ctxt msg th =
+ if Context_Position.is_really_visible ctxt
+ then warning (msg ^ Display.string_of_thm ctxt th) else ();
-fun warn_rules opt_context msg rules th =
- Item_Net.member rules th andalso (warn_thm opt_context msg th; true);
+fun warn_rules ctxt msg rules (r: rule) =
+ Item_Net.member rules r andalso (warn_thm ctxt msg (#1 r); true);
-fun warn_claset opt_context th (CS {safeIs, safeEs, hazIs, hazEs, ...}) =
- warn_rules opt_context "Rule already declared as safe introduction (intro!)\n" safeIs th orelse
- warn_rules opt_context "Rule already declared as safe elimination (elim!)\n" safeEs th orelse
- warn_rules opt_context "Rule already declared as introduction (intro)\n" hazIs th orelse
- warn_rules opt_context "Rule already declared as elimination (elim)\n" hazEs th;
+fun warn_claset ctxt r (CS {safeIs, safeEs, unsafeIs, unsafeEs, ...}) =
+ warn_rules ctxt "Rule already declared as safe introduction (intro!)\n" safeIs r orelse
+ warn_rules ctxt "Rule already declared as safe elimination (elim!)\n" safeEs r orelse
+ warn_rules ctxt "Rule already declared as introduction (intro)\n" unsafeIs r orelse
+ warn_rules ctxt "Rule already declared as elimination (elim)\n" unsafeEs r;
-(*** Safe rules ***)
+(*** add rules ***)
-fun addSI w opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if warn_rules opt_context "Ignoring duplicate safe introduction (intro!)\n" safeIs th then cs
+fun add_safe_intro w r
+ (cs as CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ if Item_Net.member safeIs r then cs
else
let
- val ctxt = default_context opt_context th;
- val th' = flat_rule ctxt th;
+ val (th, rl, _) = r;
val (safe0_rls, safep_rls) = (*0 subgoals vs 1 or more*)
- List.partition Thm.no_prems [th'];
+ List.partition (Thm.no_prems o fst) [rl];
val nI = Item_Net.length safeIs + 1;
val nE = Item_Net.length safeEs;
- val _ = warn_claset opt_context th cs;
in
CS
- {safeIs = Item_Net.update th safeIs,
- safe0_netpair = insert (nI,nE) (safe0_rls, []) safe0_netpair,
- safep_netpair = insert (nI,nE) (safep_rls, []) safep_netpair,
+ {safeIs = Item_Net.update r safeIs,
+ safe0_netpair = insert (nI, nE) (map fst safe0_rls, maps snd safe0_rls) safe0_netpair,
+ safep_netpair = insert (nI, nE) (map fst safep_rls, maps snd safep_rls) safep_netpair,
safeEs = safeEs,
- hazIs = hazIs,
- hazEs = hazEs,
+ unsafeIs = unsafeIs,
+ unsafeEs = unsafeEs,
swrappers = swrappers,
uwrappers = uwrappers,
- haz_netpair = haz_netpair,
+ unsafe_netpair = unsafe_netpair,
dup_netpair = dup_netpair,
- xtra_netpair = insert' (the_default 0 w) (nI,nE) ([th], []) xtra_netpair}
+ extra_netpair = insert' (the_default 0 w) (nI, nE) ([th], []) extra_netpair}
end;
-fun addSE w opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if warn_rules opt_context "Ignoring duplicate safe elimination (elim!)\n" safeEs th then cs
- else if has_fewer_prems 1 th then bad_thm opt_context "Ill-formed elimination rule" th
+fun add_safe_elim w r
+ (cs as CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ if Item_Net.member safeEs r then cs
else
let
- val ctxt = default_context opt_context th;
- val th' = classical_rule ctxt (flat_rule ctxt th);
+ val (th, rl, _) = r;
val (safe0_rls, safep_rls) = (*0 subgoals vs 1 or more*)
- List.partition (fn rl => Thm.nprems_of rl=1) [th'];
+ List.partition (fn (rl, _) => Thm.nprems_of rl = 1) [rl];
val nI = Item_Net.length safeIs;
val nE = Item_Net.length safeEs + 1;
- val _ = warn_claset opt_context th cs;
in
CS
- {safeEs = Item_Net.update th safeEs,
- safe0_netpair = insert (nI,nE) ([], safe0_rls) safe0_netpair,
- safep_netpair = insert (nI,nE) ([], safep_rls) safep_netpair,
+ {safeEs = Item_Net.update r safeEs,
+ safe0_netpair = insert (nI, nE) ([], map fst safe0_rls) safe0_netpair,
+ safep_netpair = insert (nI, nE) ([], map fst safep_rls) safep_netpair,
safeIs = safeIs,
- hazIs = hazIs,
- hazEs = hazEs,
+ unsafeIs = unsafeIs,
+ unsafeEs = unsafeEs,
swrappers = swrappers,
uwrappers = uwrappers,
- haz_netpair = haz_netpair,
+ unsafe_netpair = unsafe_netpair,
dup_netpair = dup_netpair,
- xtra_netpair = insert' (the_default 0 w) (nI,nE) ([], [th]) xtra_netpair}
+ extra_netpair = insert' (the_default 0 w) (nI, nE) ([], [th]) extra_netpair}
end;
-fun addSD w opt_context th = addSE w opt_context (make_elim opt_context th);
-
-
-(*** Hazardous (unsafe) rules ***)
-
-fun addI w opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if warn_rules opt_context "Ignoring duplicate introduction (intro)\n" hazIs th then cs
+fun add_unsafe_intro w r
+ (cs as CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ if Item_Net.member unsafeIs r then cs
else
let
- val ctxt = default_context opt_context th;
- val th' = flat_rule ctxt th;
- val nI = Item_Net.length hazIs + 1;
- val nE = Item_Net.length hazEs;
- val _ = warn_claset opt_context th cs;
+ val (th, rl, dup_rl) = r;
+ val nI = Item_Net.length unsafeIs + 1;
+ val nE = Item_Net.length unsafeEs;
in
CS
- {hazIs = Item_Net.update th hazIs,
- haz_netpair = insert (nI, nE) ([th'], []) haz_netpair,
- dup_netpair = insert (nI, nE) ([dup_intr th'], []) dup_netpair,
+ {unsafeIs = Item_Net.update r unsafeIs,
+ unsafe_netpair = insert (nI, nE) ([fst rl], snd rl) unsafe_netpair,
+ dup_netpair = insert (nI, nE) ([fst dup_rl], snd dup_rl) dup_netpair,
safeIs = safeIs,
safeEs = safeEs,
- hazEs = hazEs,
+ unsafeEs = unsafeEs,
+ swrappers = swrappers,
+ uwrappers = uwrappers,
+ safe0_netpair = safe0_netpair,
+ safep_netpair = safep_netpair,
+ extra_netpair = insert' (the_default 1 w) (nI, nE) ([th], []) extra_netpair}
+ end;
+
+fun add_unsafe_elim w r
+ (cs as CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ if Item_Net.member unsafeEs r then cs
+ else
+ let
+ val (th, rl, dup_rl) = r;
+ val nI = Item_Net.length unsafeIs;
+ val nE = Item_Net.length unsafeEs + 1;
+ in
+ CS
+ {unsafeEs = Item_Net.update r unsafeEs,
+ unsafe_netpair = insert (nI, nE) ([], [fst rl]) unsafe_netpair,
+ dup_netpair = insert (nI, nE) ([], [fst dup_rl]) dup_netpair,
+ safeIs = safeIs,
+ safeEs = safeEs,
+ unsafeIs = unsafeIs,
swrappers = swrappers,
uwrappers = uwrappers,
safe0_netpair = safe0_netpair,
safep_netpair = safep_netpair,
- xtra_netpair = insert' (the_default 1 w) (nI, nE) ([th], []) xtra_netpair}
- end
- handle THM ("RSN: no unifiers", _, _) => (*from dup_intr*) (* FIXME !? *)
- bad_thm opt_context "Ill-formed introduction rule" th;
-
-fun addE w opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if warn_rules opt_context "Ignoring duplicate elimination (elim)\n" hazEs th then cs
- else if has_fewer_prems 1 th then bad_thm opt_context "Ill-formed elimination rule" th
- else
- let
- val ctxt = default_context opt_context th;
- val th' = classical_rule ctxt (flat_rule ctxt th);
- val nI = Item_Net.length hazIs;
- val nE = Item_Net.length hazEs + 1;
- val _ = warn_claset opt_context th cs;
- in
- CS
- {hazEs = Item_Net.update th hazEs,
- haz_netpair = insert (nI, nE) ([], [th']) haz_netpair,
- dup_netpair = insert (nI, nE) ([], [dup_elim ctxt th']) dup_netpair,
- safeIs = safeIs,
- safeEs = safeEs,
- hazIs = hazIs,
- swrappers = swrappers,
- uwrappers = uwrappers,
- safe0_netpair = safe0_netpair,
- safep_netpair = safep_netpair,
- xtra_netpair = insert' (the_default 1 w) (nI, nE) ([], [th]) xtra_netpair}
+ extra_netpair = insert' (the_default 1 w) (nI, nE) ([], [th]) extra_netpair}
end;
-fun addD w opt_context th = addE w opt_context (make_elim opt_context th);
+fun trim_context (th, (th1, ths1), (th2, ths2)) =
+ (Thm.trim_context th,
+ (Thm.trim_context th1, map Thm.trim_context ths1),
+ (Thm.trim_context th2, map Thm.trim_context ths2));
+
+fun addSI w ctxt th (cs as CS {safeIs, ...}) =
+ let
+ val th' = flat_rule ctxt th;
+ val rl = (th', swapify [th']);
+ val r = trim_context (th, rl, rl);
+ val _ =
+ warn_rules ctxt "Ignoring duplicate safe introduction (intro!)\n" safeIs r orelse
+ warn_claset ctxt r cs;
+ in add_safe_intro w r cs end;
+fun addSE w ctxt th (cs as CS {safeEs, ...}) =
+ let
+ val _ = has_fewer_prems 1 th andalso bad_thm ctxt "Ill-formed elimination rule" th;
+ val th' = classical_rule ctxt (flat_rule ctxt th);
+ val rl = (th', []);
+ val r = trim_context (th, rl, rl);
+ val _ =
+ warn_rules ctxt "Ignoring duplicate safe elimination (elim!)\n" safeEs r orelse
+ warn_claset ctxt r cs;
+ in add_safe_elim w r cs end;
+
+fun addSD w ctxt th = addSE w ctxt (make_elim ctxt th);
+
+fun addI w ctxt th (cs as CS {unsafeIs, ...}) =
+ let
+ val th' = flat_rule ctxt th;
+ val dup_th' = dup_intr th' handle THM _ => bad_thm ctxt "Ill-formed introduction rule" th;
+ val r = trim_context (th, (th', swapify [th']), (dup_th', swapify [dup_th']));
+ val _ =
+ warn_rules ctxt "Ignoring duplicate introduction (intro)\n" unsafeIs r orelse
+ warn_claset ctxt r cs;
+ in add_unsafe_intro w r cs end;
+
+fun addE w ctxt th (cs as CS {unsafeEs, ...}) =
+ let
+ val _ = has_fewer_prems 1 th andalso bad_thm ctxt "Ill-formed elimination rule" th;
+ val th' = classical_rule ctxt (flat_rule ctxt th);
+ val dup_th' = dup_elim ctxt th' handle THM _ => bad_thm ctxt "Ill-formed elimination rule" th;
+ val r = trim_context (th, (th', []), (dup_th', []));
+ val _ =
+ warn_rules ctxt "Ignoring duplicate elimination (elim)\n" unsafeEs r orelse
+ warn_claset ctxt r cs;
+ in add_unsafe_elim w r cs end;
+
+fun addD w ctxt th = addE w ctxt (make_elim ctxt th);
-(*** Deletion of rules
- Working out what to delete, requires repeating much of the code used
- to insert.
-***)
+(*** delete rules ***)
+
+local
-fun delSI opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if Item_Net.member safeIs th then
- let
- val ctxt = default_context opt_context th;
- val th' = flat_rule ctxt th;
- val (safe0_rls, safep_rls) = List.partition Thm.no_prems [th'];
- in
- CS
- {safe0_netpair = delete (safe0_rls, []) safe0_netpair,
- safep_netpair = delete (safep_rls, []) safep_netpair,
- safeIs = Item_Net.remove th safeIs,
- safeEs = safeEs,
- hazIs = hazIs,
- hazEs = hazEs,
- swrappers = swrappers,
- uwrappers = uwrappers,
- haz_netpair = haz_netpair,
- dup_netpair = dup_netpair,
- xtra_netpair = delete' ([th], []) xtra_netpair}
- end
- else cs;
+fun del_safe_intro (r: rule)
+ (CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ let
+ val (th, rl, _) = r;
+ val (safe0_rls, safep_rls) = List.partition (Thm.no_prems o fst) [rl];
+ in
+ CS
+ {safe0_netpair = delete (map fst safe0_rls, maps snd safe0_rls) safe0_netpair,
+ safep_netpair = delete (map fst safep_rls, maps snd safep_rls) safep_netpair,
+ safeIs = Item_Net.remove r safeIs,
+ safeEs = safeEs,
+ unsafeIs = unsafeIs,
+ unsafeEs = unsafeEs,
+ swrappers = swrappers,
+ uwrappers = uwrappers,
+ unsafe_netpair = unsafe_netpair,
+ dup_netpair = dup_netpair,
+ extra_netpair = delete ([th], []) extra_netpair}
+ end;
-fun delSE opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if Item_Net.member safeEs th then
- let
- val ctxt = default_context opt_context th;
- val th' = classical_rule ctxt (flat_rule ctxt th);
- val (safe0_rls, safep_rls) = List.partition (fn rl => Thm.nprems_of rl = 1) [th'];
- in
- CS
- {safe0_netpair = delete ([], safe0_rls) safe0_netpair,
- safep_netpair = delete ([], safep_rls) safep_netpair,
- safeIs = safeIs,
- safeEs = Item_Net.remove th safeEs,
- hazIs = hazIs,
- hazEs = hazEs,
- swrappers = swrappers,
- uwrappers = uwrappers,
- haz_netpair = haz_netpair,
- dup_netpair = dup_netpair,
- xtra_netpair = delete' ([], [th]) xtra_netpair}
- end
- else cs;
+fun del_safe_elim (r: rule)
+ (CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ let
+ val (th, rl, _) = r;
+ val (safe0_rls, safep_rls) = List.partition (fn (rl, _) => Thm.nprems_of rl = 1) [rl];
+ in
+ CS
+ {safe0_netpair = delete ([], map fst safe0_rls) safe0_netpair,
+ safep_netpair = delete ([], map fst safep_rls) safep_netpair,
+ safeIs = safeIs,
+ safeEs = Item_Net.remove r safeEs,
+ unsafeIs = unsafeIs,
+ unsafeEs = unsafeEs,
+ swrappers = swrappers,
+ uwrappers = uwrappers,
+ unsafe_netpair = unsafe_netpair,
+ dup_netpair = dup_netpair,
+ extra_netpair = delete ([], [th]) extra_netpair}
+ end;
-fun delI opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if Item_Net.member hazIs th then
- let
- val ctxt = default_context opt_context th;
- val th' = flat_rule ctxt th;
- in
- CS
- {haz_netpair = delete ([th'], []) haz_netpair,
- dup_netpair = delete ([dup_intr th'], []) dup_netpair,
- safeIs = safeIs,
- safeEs = safeEs,
- hazIs = Item_Net.remove th hazIs,
- hazEs = hazEs,
- swrappers = swrappers,
- uwrappers = uwrappers,
- safe0_netpair = safe0_netpair,
- safep_netpair = safep_netpair,
- xtra_netpair = delete' ([th], []) xtra_netpair}
- end
- else cs
- handle THM ("RSN: no unifiers", _, _) => (*from dup_intr*) (* FIXME !? *)
- bad_thm opt_context "Ill-formed introduction rule" th;
+fun del_unsafe_intro (r as (th, (th', swapped_th'), (dup_th', swapped_dup_th')))
+ (CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ CS
+ {unsafe_netpair = delete ([th'], swapped_th') unsafe_netpair,
+ dup_netpair = delete ([dup_th'], swapped_dup_th') dup_netpair,
+ safeIs = safeIs,
+ safeEs = safeEs,
+ unsafeIs = Item_Net.remove r unsafeIs,
+ unsafeEs = unsafeEs,
+ swrappers = swrappers,
+ uwrappers = uwrappers,
+ safe0_netpair = safe0_netpair,
+ safep_netpair = safep_netpair,
+ extra_netpair = delete ([th], []) extra_netpair};
-fun delE opt_context th
- (cs as CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- if Item_Net.member hazEs th then
- let
- val ctxt = default_context opt_context th;
- val th' = classical_rule ctxt (flat_rule ctxt th);
- in
- CS
- {haz_netpair = delete ([], [th']) haz_netpair,
- dup_netpair = delete ([], [dup_elim ctxt th']) dup_netpair,
- safeIs = safeIs,
- safeEs = safeEs,
- hazIs = hazIs,
- hazEs = Item_Net.remove th hazEs,
- swrappers = swrappers,
- uwrappers = uwrappers,
- safe0_netpair = safe0_netpair,
- safep_netpair = safep_netpair,
- xtra_netpair = delete' ([], [th]) xtra_netpair}
- end
- else cs;
+fun del_unsafe_elim (r as (th, (th', _), (dup_th', _)))
+ (CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ CS
+ {unsafe_netpair = delete ([], [th']) unsafe_netpair,
+ dup_netpair = delete ([], [dup_th']) dup_netpair,
+ safeIs = safeIs,
+ safeEs = safeEs,
+ unsafeIs = unsafeIs,
+ unsafeEs = Item_Net.remove r unsafeEs,
+ swrappers = swrappers,
+ uwrappers = uwrappers,
+ safe0_netpair = safe0_netpair,
+ safep_netpair = safep_netpair,
+ extra_netpair = delete ([], [th]) extra_netpair};
+
+fun del f rules th cs =
+ fold f (Item_Net.lookup rules (th, (th, []), (th, []))) cs;
+
+in
-(*Delete ALL occurrences of "th" in the claset (perhaps from several lists)*)
-fun delrule opt_context th (cs as CS {safeIs, safeEs, hazIs, hazEs, ...}) =
- let val th' = Tactic.make_elim th in
- if Item_Net.member safeIs th orelse Item_Net.member safeEs th orelse
- Item_Net.member hazIs th orelse Item_Net.member hazEs th orelse
- Item_Net.member safeEs th' orelse Item_Net.member hazEs th'
+fun delrule ctxt th (cs as CS {safeIs, safeEs, unsafeIs, unsafeEs, ...}) =
+ let
+ val th' = Tactic.make_elim th;
+ val r = (th, (th, []), (th, []));
+ val r' = (th', (th', []), (th', []));
+ in
+ if Item_Net.member safeIs r orelse Item_Net.member safeEs r orelse
+ Item_Net.member unsafeIs r orelse Item_Net.member unsafeEs r orelse
+ Item_Net.member safeEs r' orelse Item_Net.member unsafeEs r'
then
- delSI opt_context th
- (delSE opt_context th
- (delI opt_context th
- (delE opt_context th (delSE opt_context th' (delE opt_context th' cs)))))
- else (warn_thm opt_context "Undeclared classical rule\n" th; cs)
+ cs
+ |> del del_safe_intro safeIs th
+ |> del del_safe_elim safeEs th
+ |> del del_safe_elim safeEs th'
+ |> del del_unsafe_intro unsafeIs th
+ |> del del_unsafe_elim unsafeEs th
+ |> del del_unsafe_elim unsafeEs th'
+ else (warn_thm ctxt "Undeclared classical rule\n" th; cs)
end;
+end;
+
(** claset data **)
@@ -551,20 +568,20 @@
(* wrappers *)
fun map_swrappers f
- (CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- CS {safeIs = safeIs, safeEs = safeEs, hazIs = hazIs, hazEs = hazEs,
+ (CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ CS {safeIs = safeIs, safeEs = safeEs, unsafeIs = unsafeIs, unsafeEs = unsafeEs,
swrappers = f swrappers, uwrappers = uwrappers,
safe0_netpair = safe0_netpair, safep_netpair = safep_netpair,
- haz_netpair = haz_netpair, dup_netpair = dup_netpair, xtra_netpair = xtra_netpair};
+ unsafe_netpair = unsafe_netpair, dup_netpair = dup_netpair, extra_netpair = extra_netpair};
fun map_uwrappers f
- (CS {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers,
- safe0_netpair, safep_netpair, haz_netpair, dup_netpair, xtra_netpair}) =
- CS {safeIs = safeIs, safeEs = safeEs, hazIs = hazIs, hazEs = hazEs,
+ (CS {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers,
+ safe0_netpair, safep_netpair, unsafe_netpair, dup_netpair, extra_netpair}) =
+ CS {safeIs = safeIs, safeEs = safeEs, unsafeIs = unsafeIs, unsafeEs = unsafeEs,
swrappers = swrappers, uwrappers = f uwrappers,
safe0_netpair = safe0_netpair, safep_netpair = safep_netpair,
- haz_netpair = haz_netpair, dup_netpair = dup_netpair, xtra_netpair = xtra_netpair};
+ unsafe_netpair = unsafe_netpair, dup_netpair = dup_netpair, extra_netpair = extra_netpair};
(* merge_cs *)
@@ -575,16 +592,16 @@
fun merge_thms add thms1 thms2 =
fold_rev (fn thm => if Item_Net.member thms1 thm then I else add thm) (Item_Net.content thms2);
-fun merge_cs (cs as CS {safeIs, safeEs, hazIs, hazEs, ...},
- cs' as CS {safeIs = safeIs2, safeEs = safeEs2, hazIs = hazIs2, hazEs = hazEs2,
+fun merge_cs (cs as CS {safeIs, safeEs, unsafeIs, unsafeEs, ...},
+ cs' as CS {safeIs = safeIs2, safeEs = safeEs2, unsafeIs = unsafeIs2, unsafeEs = unsafeEs2,
swrappers, uwrappers, ...}) =
if pointer_eq (cs, cs') then cs
else
cs
- |> merge_thms (addSI NONE NONE) safeIs safeIs2
- |> merge_thms (addSE NONE NONE) safeEs safeEs2
- |> merge_thms (addI NONE NONE) hazIs hazIs2
- |> merge_thms (addE NONE NONE) hazEs hazEs2
+ |> merge_thms (add_safe_intro NONE) safeIs safeIs2
+ |> merge_thms (add_safe_elim NONE) safeEs safeEs2
+ |> merge_thms (add_unsafe_intro NONE) unsafeIs unsafeIs2
+ |> merge_thms (add_unsafe_elim NONE) unsafeEs unsafeEs2
|> map_swrappers (fn ws => AList.merge (op =) (K true) (ws, swrappers))
|> map_uwrappers (fn ws => AList.merge (op =) (K true) (ws, uwrappers));
@@ -616,13 +633,13 @@
fun print_claset ctxt =
let
- val {safeIs, safeEs, hazIs, hazEs, swrappers, uwrappers, ...} = rep_claset_of ctxt;
- val pretty_thms = map (Display.pretty_thm_item ctxt) o Item_Net.content;
+ val {safeIs, safeEs, unsafeIs, unsafeEs, swrappers, uwrappers, ...} = rep_claset_of ctxt;
+ val pretty_thms = map (Display.pretty_thm_item ctxt o #1) o Item_Net.content;
in
[Pretty.big_list "safe introduction rules (intro!):" (pretty_thms safeIs),
- Pretty.big_list "introduction rules (intro):" (pretty_thms hazIs),
+ Pretty.big_list "introduction rules (intro):" (pretty_thms unsafeIs),
Pretty.big_list "safe elimination rules (elim!):" (pretty_thms safeEs),
- Pretty.big_list "elimination rules (elim):" (pretty_thms hazEs),
+ Pretty.big_list "elimination rules (elim):" (pretty_thms unsafeEs),
Pretty.strs ("safe wrappers:" :: map #1 swrappers),
Pretty.strs ("unsafe wrappers:" :: map #1 uwrappers)]
|> Pretty.writeln_chunks
@@ -631,7 +648,7 @@
(* old-style declarations *)
-fun decl f (ctxt, ths) = map_claset (fold_rev (f (SOME (Context.Proof ctxt))) ths) ctxt;
+fun decl f (ctxt, ths) = map_claset (fold_rev (f ctxt) ths) ctxt;
val op addSIs = decl (addSI NONE);
val op addSEs = decl (addSE NONE);
@@ -764,17 +781,17 @@
(*These steps could instantiate variables and are therefore unsafe.*)
fun inst_step_tac ctxt = inst0_step_tac ctxt APPEND' instp_step_tac ctxt;
-fun haz_step_tac ctxt =
- biresolve_from_nets_tac ctxt (#haz_netpair (rep_claset_of ctxt));
+fun unsafe_step_tac ctxt =
+ biresolve_from_nets_tac ctxt (#unsafe_netpair (rep_claset_of ctxt));
(*Single step for the prover. FAILS unless it makes progress. *)
fun step_tac ctxt i =
- safe_tac ctxt ORELSE appWrappers ctxt (inst_step_tac ctxt ORELSE' haz_step_tac ctxt) i;
+ safe_tac ctxt ORELSE appWrappers ctxt (inst_step_tac ctxt ORELSE' unsafe_step_tac ctxt) i;
(*Using a "safe" rule to instantiate variables is unsafe. This tactic
allows backtracking from "safe" rules to "unsafe" rules here.*)
fun slow_step_tac ctxt i =
- safe_tac ctxt ORELSE appWrappers ctxt (inst_step_tac ctxt APPEND' haz_step_tac ctxt) i;
+ safe_tac ctxt ORELSE appWrappers ctxt (inst_step_tac ctxt APPEND' unsafe_step_tac ctxt) i;
(**** The following tactics all fail unless they solve one goal ****)
@@ -857,20 +874,21 @@
(* attributes *)
fun attrib f =
- Thm.declaration_attribute (fn th => fn opt_context =>
- map_cs (f (SOME opt_context) th) opt_context);
+ Thm.declaration_attribute (fn th => fn context =>
+ map_cs (f (Context.proof_of context) th) context);
val safe_elim = attrib o addSE;
val safe_intro = attrib o addSI;
val safe_dest = attrib o addSD;
-val haz_elim = attrib o addE;
-val haz_intro = attrib o addI;
-val haz_dest = attrib o addD;
+val unsafe_elim = attrib o addE;
+val unsafe_intro = attrib o addI;
+val unsafe_dest = attrib o addD;
val rule_del =
- Thm.declaration_attribute (fn th => fn opt_context =>
- opt_context |> map_cs (delrule (SOME opt_context) th) |>
- Thm.attribute_declaration Context_Rules.rule_del th);
+ Thm.declaration_attribute (fn th => fn context =>
+ context
+ |> map_cs (delrule (Context.proof_of context) th)
+ |> Thm.attribute_declaration Context_Rules.rule_del th);
@@ -884,11 +902,11 @@
Theory.setup
(Attrib.setup @{binding swapped} (Scan.succeed swapped)
"classical swap of introduction rule" #>
- Attrib.setup @{binding dest} (Context_Rules.add safe_dest haz_dest Context_Rules.dest_query)
+ Attrib.setup @{binding dest} (Context_Rules.add safe_dest unsafe_dest Context_Rules.dest_query)
"declaration of Classical destruction rule" #>
- Attrib.setup @{binding elim} (Context_Rules.add safe_elim haz_elim Context_Rules.elim_query)
+ Attrib.setup @{binding elim} (Context_Rules.add safe_elim unsafe_elim Context_Rules.elim_query)
"declaration of Classical elimination rule" #>
- Attrib.setup @{binding intro} (Context_Rules.add safe_intro haz_intro Context_Rules.intro_query)
+ Attrib.setup @{binding intro} (Context_Rules.add safe_intro unsafe_intro Context_Rules.intro_query)
"declaration of Classical introduction rule" #>
Attrib.setup @{binding rule} (Scan.lift Args.del >> K rule_del)
"remove declaration of intro/elim/dest rule");
@@ -901,9 +919,9 @@
fun some_rule_tac ctxt facts = SUBGOAL (fn (goal, i) =>
let
- val [rules1, rules2, rules4] = Context_Rules.find_rules false facts goal ctxt;
- val {xtra_netpair, ...} = rep_claset_of ctxt;
- val rules3 = Context_Rules.find_rules_netpair true facts goal xtra_netpair;
+ val [rules1, rules2, rules4] = Context_Rules.find_rules ctxt false facts goal;
+ val {extra_netpair, ...} = rep_claset_of ctxt;
+ val rules3 = Context_Rules.find_rules_netpair ctxt true facts goal extra_netpair;
val rules = rules1 @ rules2 @ rules3 @ rules4;
val ruleq = Drule.multi_resolves (SOME ctxt) facts rules;
val _ = Method.trace ctxt rules;
@@ -935,11 +953,11 @@
val cla_modifiers =
[Args.$$$ destN -- Args.bang_colon >> K (Method.modifier (safe_dest NONE) @{here}),
- Args.$$$ destN -- Args.colon >> K (Method.modifier (haz_dest NONE) @{here}),
+ Args.$$$ destN -- Args.colon >> K (Method.modifier (unsafe_dest NONE) @{here}),
Args.$$$ elimN -- Args.bang_colon >> K (Method.modifier (safe_elim NONE) @{here}),
- Args.$$$ elimN -- Args.colon >> K (Method.modifier (haz_elim NONE) @{here}),
+ Args.$$$ elimN -- Args.colon >> K (Method.modifier (unsafe_elim NONE) @{here}),
Args.$$$ introN -- Args.bang_colon >> K (Method.modifier (safe_intro NONE) @{here}),
- Args.$$$ introN -- Args.colon >> K (Method.modifier (haz_intro NONE) @{here}),
+ Args.$$$ introN -- Args.colon >> K (Method.modifier (unsafe_intro NONE) @{here}),
Args.del -- Args.colon >> K (Method.modifier rule_del @{here})];
fun cla_method tac = Method.sections cla_modifiers >> K (SIMPLE_METHOD o tac);
--- a/src/Pure/Concurrent/bash.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Concurrent/bash.ML Thu Sep 03 15:50:40 2015 +0200
@@ -1,7 +1,7 @@
(* Title: Pure/Concurrent/bash.ML
Author: Makarius
-GNU bash processes, with propagation of interrupts.
+GNU bash processes, with propagation of interrupts -- POSIX version.
*)
signature BASH =
@@ -67,18 +67,15 @@
fun terminate NONE = ()
| terminate (SOME pid) =
let
- val sig_test = Posix.Signal.fromWord 0w0;
-
- fun kill_group pid s =
+ fun kill s =
(Posix.Process.kill
(Posix.Process.K_GROUP (Posix.Process.wordToPid (LargeWord.fromInt pid)), s); true)
handle OS.SysErr _ => false;
- fun kill s = (kill_group pid s; kill_group pid sig_test);
-
fun multi_kill count s =
count = 0 orelse
- kill s andalso (OS.Process.sleep (seconds 0.1); multi_kill (count - 1) s);
+ (kill s; kill (Posix.Signal.fromWord 0w0)) andalso
+ (OS.Process.sleep (seconds 0.1); multi_kill (count - 1) s);
val _ =
multi_kill 10 Posix.Signal.int andalso
multi_kill 10 Posix.Signal.term andalso
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/Concurrent/bash.scala Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,104 @@
+/* Title: Pure/Concurrent/bash.scala
+ Author: Makarius
+
+GNU bash processes, with propagation of interrupts.
+*/
+
+package isabelle
+
+
+import java.io.{File => JFile, BufferedReader, InputStreamReader,
+ BufferedWriter, OutputStreamWriter}
+
+
+object Bash
+{
+ /** result **/
+
+ final case class Result(out_lines: List[String], err_lines: List[String], rc: Int)
+ {
+ def out: String = cat_lines(out_lines)
+ def err: String = cat_lines(err_lines)
+ def add_err(s: String): Result = copy(err_lines = err_lines ::: List(s))
+ def set_rc(i: Int): Result = copy(rc = i)
+
+ def check_error: Result =
+ if (rc == Exn.Interrupt.return_code) throw Exn.Interrupt()
+ else if (rc != 0) error(err)
+ else this
+ }
+
+
+
+ /** process **/
+
+ def process(cwd: JFile, env: Map[String, String], redirect: Boolean, args: String*): Process =
+ new Process(cwd, env, redirect, args:_*)
+
+ class Process private [Bash](
+ cwd: JFile, env: Map[String, String], redirect: Boolean, args: String*)
+ extends Prover.System_Process
+ {
+ private val params =
+ List(File.standard_path(Path.explode("~~/lib/scripts/process")), "group", "-", "no_script")
+ private val proc = Isabelle_System.execute_env(cwd, env, redirect, (params ::: args.toList):_*)
+
+
+ // channels
+
+ val stdin: BufferedWriter =
+ new BufferedWriter(new OutputStreamWriter(proc.getOutputStream, UTF8.charset))
+
+ val stdout: BufferedReader =
+ new BufferedReader(new InputStreamReader(proc.getInputStream, UTF8.charset))
+
+ val stderr: BufferedReader =
+ new BufferedReader(new InputStreamReader(proc.getErrorStream, UTF8.charset))
+
+
+ // signals
+
+ private val pid = stdout.readLine
+
+ private def kill(signal: String): Boolean =
+ Exn.Interrupt.postpone {
+ Isabelle_System.kill(signal, pid)
+ Isabelle_System.kill("0", pid)._2 == 0 } getOrElse true
+
+ private def multi_kill(signal: String): Boolean =
+ {
+ var running = true
+ var count = 10
+ while (running && count > 0) {
+ if (kill(signal)) {
+ Exn.Interrupt.postpone {
+ Thread.sleep(100)
+ count -= 1
+ }
+ }
+ else running = false
+ }
+ running
+ }
+
+ def interrupt() { multi_kill("INT") }
+ def terminate() { multi_kill("INT") && multi_kill("TERM") && kill("KILL"); proc.destroy }
+
+
+ // JVM shutdown hook
+
+ private val shutdown_hook = new Thread { override def run = terminate() }
+
+ try { Runtime.getRuntime.addShutdownHook(shutdown_hook) }
+ catch { case _: IllegalStateException => }
+
+ private def cleanup() =
+ try { Runtime.getRuntime.removeShutdownHook(shutdown_hook) }
+ catch { case _: IllegalStateException => }
+
+
+ /* result */
+
+ def join: Int = { val rc = proc.waitFor; cleanup(); rc }
+ }
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/Concurrent/bash_windows.ML Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,94 @@
+(* Title: Pure/Concurrent/bash_windows.ML
+ Author: Makarius
+
+GNU bash processes, with propagation of interrupts -- Windows version.
+*)
+
+signature BASH =
+sig
+ val process: string -> {out: string, err: string, rc: int, terminate: unit -> unit}
+end;
+
+structure Bash: BASH =
+struct
+
+fun cygwin_bash arg =
+ let val cmd = getenv_strict "CYGWIN_ROOT" ^ "\\bin\\bash.exe"
+ in Windows.simpleExecute (cmd, quote cmd ^ " -c " ^ quote arg) end;
+
+val process = uninterruptible (fn restore_attributes => fn script =>
+ let
+ datatype result = Wait | Signal | Result of int;
+ val result = Synchronized.var "bash_result" Wait;
+
+ val id = serial_string ();
+ val script_path = File.tmp_path (Path.basic ("bash_script" ^ id));
+ val out_path = File.tmp_path (Path.basic ("bash_out" ^ id));
+ val err_path = File.tmp_path (Path.basic ("bash_err" ^ id));
+ val pid_path = File.tmp_path (Path.basic ("bash_pid" ^ id));
+
+ fun cleanup_files () =
+ (try File.rm script_path;
+ try File.rm out_path;
+ try File.rm err_path;
+ try File.rm pid_path);
+ val _ = cleanup_files ();
+
+ val system_thread =
+ Simple_Thread.fork {name = "bash", stack_limit = NONE, interrupts = false} (fn () =>
+ Multithreading.with_attributes Multithreading.private_interrupts (fn _ =>
+ let
+ val _ = File.write script_path script;
+ val rc =
+ cygwin_bash
+ ("echo $$ > " ^ File.shell_path pid_path ^ "; exec bash " ^
+ File.shell_path script_path ^
+ " > " ^ File.shell_path out_path ^
+ " 2> " ^ File.shell_path err_path)
+ |> Windows.fromStatus |> SysWord.toInt;
+ val res = if rc = 130 orelse rc = 512 then Signal else Result rc;
+ in Synchronized.change result (K res) end
+ handle exn =>
+ (Synchronized.change result (fn Wait => Signal | res => res); reraise exn)));
+
+ fun read_pid 0 = NONE
+ | read_pid count =
+ (case (Int.fromString (File.read pid_path) handle IO.Io _ => NONE) of
+ NONE => (OS.Process.sleep (seconds 0.1); read_pid (count - 1))
+ | some => some);
+
+ fun terminate NONE = ()
+ | terminate (SOME pid) =
+ let
+ fun kill s =
+ OS.Process.isSuccess (cygwin_bash ("kill -" ^ s ^ " -" ^ string_of_int pid))
+ handle OS.SysErr _ => false;
+ fun multi_kill count s =
+ count = 0 orelse
+ (kill s; kill "0") andalso
+ (OS.Process.sleep (seconds 0.1); multi_kill (count - 1) s);
+ val _ =
+ multi_kill 10 "INT" andalso
+ multi_kill 10 "TERM" andalso
+ multi_kill 10 "KILL";
+ in () end;
+
+ fun cleanup () =
+ (Simple_Thread.interrupt_unsynchronized system_thread;
+ cleanup_files ());
+ in
+ let
+ val _ =
+ restore_attributes (fn () =>
+ Synchronized.guarded_access result (fn Wait => NONE | x => SOME ((), x))) ();
+
+ val out = the_default "" (try File.read out_path);
+ val err = the_default "" (try File.read err_path);
+ val rc = (case Synchronized.value result of Signal => Exn.interrupt () | Result rc => rc);
+ val pid = read_pid 1;
+ val _ = cleanup ();
+ in {out = out, err = err, rc = rc, terminate = fn () => terminate pid} end
+ handle exn => (terminate (read_pid 10); cleanup (); reraise exn)
+ end);
+
+end;
--- a/src/Pure/Concurrent/future.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Concurrent/future.ML Thu Sep 03 15:50:40 2015 +0200
@@ -399,14 +399,12 @@
end) ();
fun identify_result pos res =
- (case res of
- Exn.Exn exn =>
- let val exec_id =
- (case Position.get_id pos of
- NONE => []
- | SOME id => [(Markup.exec_idN, id)])
- in Exn.Exn (Par_Exn.identify exec_id exn) end
- | _ => res);
+ res |> Exn.map_exn (fn exn =>
+ let val exec_id =
+ (case Position.get_id pos of
+ NONE => []
+ | SOME id => [(Markup.exec_idN, id)])
+ in Par_Exn.identify exec_id exn end);
fun assign_result group result res =
let
--- a/src/Pure/GUI/gui.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/GUI/gui.scala Thu Sep 03 15:50:40 2015 +0200
@@ -44,6 +44,10 @@
Platform.is_macos &&
UIManager.getSystemLookAndFeelClassName() == UIManager.getLookAndFeel.getClass.getName
+ def is_windows_laf(): Boolean =
+ Platform.is_windows &&
+ UIManager.getSystemLookAndFeelClassName() == UIManager.getLookAndFeel.getClass.getName
+
/* plain focus traversal, notably for text fields */
--- a/src/Pure/GUI/system_dialog.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/GUI/system_dialog.scala Thu Sep 03 15:50:40 2015 +0200
@@ -7,7 +7,7 @@
package isabelle
-import java.awt.{GraphicsEnvironment, Point, Font}
+import java.awt.{GraphicsEnvironment, Point}
import javax.swing.WindowConstants
import java.io.{File => JFile, BufferedReader, InputStreamReader}
@@ -82,6 +82,7 @@
columns = 65
rows = 24
}
+ if (GUI.is_windows_laf) text.font = (new Label).font
val scroll_text = new ScrollPane(text)
--- a/src/Pure/General/buffer.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/buffer.ML Thu Sep 03 15:50:40 2015 +0200
@@ -11,7 +11,7 @@
val add: string -> T -> T
val markup: Markup.T -> (T -> T) -> T -> T
val content: T -> string
- val output: T -> TextIO.outstream -> unit
+ val output: T -> BinIO.outstream -> unit
end;
structure Buffer: BUFFER =
@@ -29,6 +29,8 @@
in add bg #> body #> add en end;
fun content (Buffer xs) = implode (rev xs);
-fun output (Buffer xs) stream = List.app (fn s => TextIO.output (stream, s)) (rev xs);
+
+fun output (Buffer xs) stream =
+ List.app (fn s => BinIO.output (stream, Byte.stringToBytes s)) (rev xs);
end;
--- a/src/Pure/General/exn.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/exn.ML Thu Sep 03 15:50:40 2015 +0200
@@ -11,8 +11,9 @@
val get_exn: 'a result -> exn option
val capture: ('a -> 'b) -> 'a -> 'b result
val release: 'a result -> 'a
- val map_result: ('a -> 'b) -> 'a result -> 'b result
- val maps_result: ('a -> 'b result) -> 'a result -> 'b result
+ val map_res: ('a -> 'b) -> 'a result -> 'b result
+ val maps_res: ('a -> 'b result) -> 'a result -> 'b result
+ val map_exn: (exn -> exn) -> 'a result -> 'a result
exception Interrupt
val interrupt: unit -> 'a
val is_interrupt: exn -> bool
@@ -44,10 +45,13 @@
fun release (Res y) = y
| release (Exn e) = reraise e;
-fun map_result f (Res x) = Res (f x)
- | map_result f (Exn e) = Exn e;
+fun map_res f (Res x) = Res (f x)
+ | map_res f (Exn e) = Exn e;
-fun maps_result f = (fn Res x => x | Exn e => Exn e) o map_result f;
+fun maps_res f = (fn Res x => x | Exn e => Exn e) o map_res f;
+
+fun map_exn f (Res x) = Res x
+ | map_exn f (Exn e) = Exn (f e);
(* interrupts *)
--- a/src/Pure/General/file.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/file.ML Thu Sep 03 15:50:40 2015 +0200
@@ -6,6 +6,7 @@
signature FILE =
sig
+ val standard_path: Path.T -> string
val platform_path: Path.T -> string
val shell_quote: string -> string
val shell_path: Path.T -> string
@@ -19,9 +20,9 @@
val check_dir: Path.T -> Path.T
val check_file: Path.T -> Path.T
val open_dir: (OS.FileSys.dirstream -> 'a) -> Path.T -> 'a
- val open_input: (TextIO.instream -> 'a) -> Path.T -> 'a
- val open_output: (TextIO.outstream -> 'a) -> Path.T -> 'a
- val open_append: (TextIO.outstream -> 'a) -> Path.T -> 'a
+ val open_input: (BinIO.instream -> 'a) -> Path.T -> 'a
+ val open_output: (BinIO.outstream -> 'a) -> Path.T -> 'a
+ val open_append: (BinIO.outstream -> 'a) -> Path.T -> 'a
val fold_dir: (string -> 'a -> 'a) -> Path.T -> 'a -> 'a
val read_dir: Path.T -> string list
val fold_lines: (string -> 'a -> 'a) -> Path.T -> 'a -> 'a
@@ -31,6 +32,7 @@
val read: Path.T -> string
val write: Path.T -> string -> unit
val append: Path.T -> string -> unit
+ val output: BinIO.outstream -> string -> unit
val write_list: Path.T -> string list -> unit
val append_list: Path.T -> string list -> unit
val write_buffer: Path.T -> Buffer.T -> unit
@@ -42,15 +44,16 @@
(* system path representations *)
-val platform_path = Path.implode o Path.expand;
+val standard_path = Path.implode o Path.expand;
+val platform_path = ml_platform_path o standard_path;
val shell_quote = enclose "'" "'";
-val shell_path = shell_quote o platform_path;
+val shell_path = shell_quote o standard_path;
(* current working directory *)
-val cd = cd o platform_path;
+val cd = cd o standard_path;
val pwd = Path.explode o pwd;
@@ -102,9 +105,9 @@
in
fun open_dir f = with_file OS.FileSys.openDir OS.FileSys.closeDir f o platform_path;
-fun open_input f = with_file TextIO.openIn TextIO.closeIn f o platform_path;
-fun open_output f = with_file TextIO.openOut TextIO.closeOut f o platform_path;
-fun open_append f = with_file TextIO.openAppend TextIO.closeOut f o platform_path;
+fun open_input f = with_file BinIO.openIn BinIO.closeIn f o platform_path;
+fun open_output f = with_file BinIO.openOut BinIO.closeOut f o platform_path;
+fun open_append f = with_file BinIO.openAppend BinIO.closeOut f o platform_path;
end;
@@ -132,7 +135,7 @@
fun fold_chunks terminator f path a = open_input (fn file =>
let
fun read buf x =
- (case TextIO.input file of
+ (case Byte.bytesToString (BinIO.input file) of
"" => (case Buffer.content buf of "" => x | line => f line x)
| input =>
(case String.fields (fn c => c = terminator) input of
@@ -148,15 +151,16 @@
fun read_lines path = rev (fold_lines cons path []);
fun read_pages path = rev (fold_pages cons path []);
-val read = open_input TextIO.inputAll;
+val read = open_input (Byte.bytesToString o BinIO.inputAll);
(* output *)
-fun output txts file = List.app (fn txt => TextIO.output (file, txt)) txts;
+fun output file txt = BinIO.output (file, Byte.stringToBytes txt);
-fun write_list path txts = open_output (output txts) path;
-fun append_list path txts = open_append (output txts) path;
+fun output_list txts file = List.app (output file) txts;
+fun write_list path txts = open_output (output_list txts) path;
+fun append_list path txts = open_append (output_list txts) path;
fun write path txt = write_list path [txt];
fun append path txt = append_list path [txt];
--- a/src/Pure/General/file.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/file.scala Thu Sep 03 15:50:40 2015 +0200
@@ -10,13 +10,101 @@
import java.io.{BufferedWriter, OutputStreamWriter, FileOutputStream, BufferedOutputStream,
OutputStream, InputStream, FileInputStream, BufferedInputStream, BufferedReader,
InputStreamReader, File => JFile, IOException}
+import java.net.{URL, URLDecoder, MalformedURLException}
import java.util.zip.{GZIPInputStream, GZIPOutputStream}
+import java.util.regex.Pattern
import scala.collection.mutable
+import scala.util.matching.Regex
object File
{
+ /* standard path (Cygwin or Posix) */
+
+ def standard_path(path: Path): String = path.expand.implode
+
+ def standard_path(platform_path: String): String =
+ if (Platform.is_windows) {
+ val Platform_Root = new Regex("(?i)" +
+ Pattern.quote(Isabelle_System.get_cygwin_root()) + """(?:\\+|\z)(.*)""")
+ val Drive = new Regex("""([a-zA-Z]):\\*(.*)""")
+
+ platform_path.replace('/', '\\') match {
+ case Platform_Root(rest) => "/" + rest.replace('\\', '/')
+ case Drive(letter, rest) =>
+ "/cygdrive/" + Word.lowercase(letter) +
+ (if (rest == "") "" else "/" + rest.replace('\\', '/'))
+ case path => path.replace('\\', '/')
+ }
+ }
+ else platform_path
+
+ def standard_path(file: JFile): String = standard_path(file.getPath)
+
+ def standard_url(name: String): String =
+ try {
+ val url = new URL(name)
+ if (url.getProtocol == "file")
+ standard_path(URLDecoder.decode(url.getPath, UTF8.charset_name))
+ else name
+ }
+ catch { case _: MalformedURLException => standard_path(name) }
+
+
+ /* platform path (Windows or Posix) */
+
+ private val Cygdrive = new Regex("/cygdrive/([a-zA-Z])($|/.*)")
+ private val Named_Root = new Regex("//+([^/]*)(.*)")
+
+ def platform_path(standard_path: String): String =
+ if (Platform.is_windows) {
+ val result_path = new StringBuilder
+ val rest =
+ standard_path match {
+ case Cygdrive(drive, rest) =>
+ result_path ++= (Word.uppercase(drive) + ":" + JFile.separator)
+ rest
+ case Named_Root(root, rest) =>
+ result_path ++= JFile.separator
+ result_path ++= JFile.separator
+ result_path ++= root
+ rest
+ case path if path.startsWith("/") =>
+ result_path ++= Isabelle_System.get_cygwin_root()
+ path
+ case path => path
+ }
+ for (p <- space_explode('/', rest) if p != "") {
+ val len = result_path.length
+ if (len > 0 && result_path(len - 1) != JFile.separatorChar)
+ result_path += JFile.separatorChar
+ result_path ++= p
+ }
+ result_path.toString
+ }
+ else standard_path
+
+ def platform_path(path: Path): String = platform_path(standard_path(path))
+ def platform_file(path: Path): JFile = new JFile(platform_path(path))
+
+ def platform_url(raw_path: Path): String =
+ {
+ val path = raw_path.expand
+ require(path.is_absolute)
+ val s = platform_path(path).replaceAll(" ", "%20")
+ if (!Platform.is_windows) "file://" + s
+ else if (s.startsWith("\\\\")) "file:" + s.replace('\\', '/')
+ else "file:///" + s.replace('\\', '/')
+ }
+
+
+ /* shell path (bash) */
+
+ def shell_path(path: Path): String = "'" + standard_path(path) + "'"
+ def shell_path(file: JFile): String = "'" + standard_path(file) + "'"
+
+
/* directory content */
def read_dir(dir: Path): List[String] =
@@ -151,4 +239,3 @@
def copy(path1: Path, path2: Path): Unit = copy(path1.file, path2.file)
}
-
--- a/src/Pure/General/path.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/path.scala Thu Sep 03 15:50:40 2015 +0200
@@ -205,7 +205,7 @@
/* platform file */
- def file: JFile = Isabelle_System.platform_file(this)
+ def file: JFile = File.platform_file(this)
def is_file: Boolean = file.isFile
def is_dir: Boolean = file.isDirectory
}
--- a/src/Pure/General/secure.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/secure.ML Thu Sep 03 15:50:40 2015 +0200
@@ -10,8 +10,9 @@
val is_secure: unit -> bool
val deny_secure: string -> unit
val secure_mltext: unit -> unit
- val use_text: use_context -> int * string -> bool -> string -> unit
- val use_file: use_context -> bool -> string -> unit
+ val use_text: use_context ->
+ {line: int, file: string, verbose: bool, debug: bool} -> string -> unit
+ val use_file: use_context -> {verbose: bool, debug: bool} -> string -> unit
val toplevel_pp: string list -> string -> unit
end;
@@ -37,10 +38,9 @@
val raw_use_file = use_file;
val raw_toplevel_pp = toplevel_pp;
-fun use_text context pos verbose txt = (secure_mltext (); raw_use_text context pos verbose txt);
-fun use_file context verbose name = (secure_mltext (); raw_use_file context verbose name);
+fun use_text context flags (text: string) = (secure_mltext (); raw_use_text context flags text);
+fun use_file context flags (file: string) = (secure_mltext (); raw_use_file context flags file);
fun toplevel_pp path pp = (secure_mltext (); raw_toplevel_pp ML_Parse.global_context path pp);
end;
-
--- a/src/Pure/General/sha1_polyml.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/General/sha1_polyml.ML Thu Sep 03 15:50:40 2015 +0200
@@ -18,7 +18,7 @@
in (op ^) (apply2 hex_digit (Integer.div_mod (Char.ord c) 16)) end
val lib_path =
- ("$ML_HOME/" ^ (if ML_System.platform_is_cygwin then "sha1.dll" else "libsha1.so"))
+ ("$ML_HOME/" ^ (if ML_System.platform_is_windows then "sha1.dll" else "libsha1.so"))
|> Path.explode;
val STRING_INPUT_BYTES =
@@ -29,7 +29,8 @@
let
val digest = CInterface.alloc 20 CInterface.Cchar;
val _ =
- CInterface.call3 (CInterface.get_sym (File.platform_path lib_path) "sha1_buffer")
+ CInterface.call3
+ (CInterface.get_sym (File.platform_path lib_path) "sha1_buffer")
(STRING_INPUT_BYTES, CInterface.LONG, CInterface.POINTER)
CInterface.POINTER (str, size str, CInterface.address digest);
in fold (suffix o hex_string digest) (0 upto 19) "" end;
--- a/src/Pure/Isar/calculation.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/calculation.ML Thu Sep 03 15:50:40 2015 +0200
@@ -74,12 +74,12 @@
val sym_add =
Thm.declaration_attribute (fn th =>
- (Data.map o apfst o apsnd) (Thm.add_thm th) #>
+ (Data.map o apfst o apsnd) (Thm.add_thm (Thm.trim_context th)) #>
Thm.attribute_declaration (Context_Rules.elim_query NONE) th);
val sym_del =
Thm.declaration_attribute (fn th =>
- (Data.map o apfst o apsnd) (Thm.del_thm th) #>
+ (Data.map o apfst o apsnd) (Thm.del_thm (Thm.trim_context th)) #>
Thm.attribute_declaration Context_Rules.rule_del th);
--- a/src/Pure/Isar/class.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/class.ML Thu Sep 03 15:50:40 2015 +0200
@@ -219,7 +219,8 @@
(c, (class, ((ty, Free v_ty), false)))) params;
val add_class = Graph.new_node (class,
make_class_data (((map o apply2) fst params, base_sort,
- base_morph, export_morph, some_assm_intro, of_class, some_axiom), ([], operations)))
+ base_morph, export_morph, Option.map Thm.trim_context some_assm_intro,
+ Thm.trim_context of_class, Option.map Thm.trim_context some_axiom), ([], operations)))
#> fold (curry Graph.add_edge class) sups;
in Class_Data.map add_class thy end;
@@ -246,7 +247,7 @@
fun register_def class def_thm thy =
let
- val sym_thm = Thm.symmetric def_thm
+ val sym_thm = Thm.trim_context (Thm.symmetric def_thm)
in
thy
|> (Class_Data.map o Graph.map_node class o map_class_data o apsnd o apfst)
--- a/src/Pure/Isar/code.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/code.ML Thu Sep 03 15:50:40 2015 +0200
@@ -339,7 +339,7 @@
val dataref = (snd o Code_Data.get) theory;
val (datatab, thy) = case Synchronized.value dataref
of SOME (datatab, thy) =>
- if Theory.eq_thy (theory, thy)
+ if Context.eq_thy (theory, thy)
then (datatab, thy)
else (Datatab.empty, theory)
| NONE => (Datatab.empty, theory)
@@ -686,7 +686,7 @@
fun get_head thy cert_thm =
let
- val [head] = (#hyps o Thm.crep_thm) cert_thm;
+ val [head] = Thm.chyps_of cert_thm;
val (_, Const (c, ty)) = (Logic.dest_equals o Thm.term_of) head;
in (typscheme thy (c, ty), head) end;
--- a/src/Pure/Isar/context_rules.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/context_rules.ML Thu Sep 03 15:50:40 2015 +0200
@@ -11,8 +11,8 @@
val netpair_bang: Proof.context -> netpair
val netpair: Proof.context -> netpair
val orderlist: ((int * int) * 'a) list -> 'a list
- val find_rules_netpair: bool -> thm list -> term -> netpair -> thm list
- val find_rules: bool -> thm list -> term -> Proof.context -> thm list list
+ val find_rules_netpair: Proof.context -> bool -> thm list -> term -> netpair -> thm list
+ val find_rules: Proof.context -> bool -> thm list -> term -> thm list list
val print_rules: Proof.context -> unit
val addSWrapper: (Proof.context -> (int -> tactic) -> int -> tactic) -> theory -> theory
val addWrapper: (Proof.context -> (int -> tactic) -> int -> tactic) -> theory -> theory
@@ -76,9 +76,12 @@
Rules {next = next, rules = rules, netpairs = netpairs, wrappers = wrappers};
fun add_rule (i, b) opt_w th (Rules {next, rules, netpairs, wrappers}) =
- let val w = (case opt_w of SOME w => w | NONE => Tactic.subgoals_of_brl (b, th)) in
- make_rules (next - 1) ((w, ((i, b), th)) :: rules)
- (nth_map i (Tactic.insert_tagged_brl ((w, next), (b, th))) netpairs) wrappers
+ let
+ val w = (case opt_w of SOME w => w | NONE => Tactic.subgoals_of_brl (b, th));
+ val th' = Thm.trim_context th;
+ in
+ make_rules (next - 1) ((w, ((i, b), th')) :: rules)
+ (nth_map i (Tactic.insert_tagged_brl ((w, next), (b, th'))) netpairs) wrappers
end;
fun del_rule0 th (rs as Rules {next, rules, netpairs, wrappers}) =
@@ -144,6 +147,8 @@
fun orderlist_no_weight brls =
untaglist (sort (int_ord o apply2 (snd o fst)) brls);
+local
+
fun may_unify weighted t net =
map snd ((if weighted then orderlist else orderlist_no_weight) (Net.unify_term net t));
@@ -152,11 +157,16 @@
fun find_irules w goal = may_unify w (Logic.strip_assums_concl goal);
-fun find_rules_netpair weighted facts goal (inet, enet) =
- find_erules weighted facts enet @ find_irules weighted goal inet;
+in
-fun find_rules weighted facts goals =
- map (find_rules_netpair weighted facts goals) o netpairs;
+fun find_rules_netpair ctxt weighted facts goal (inet, enet) =
+ find_erules weighted facts enet @ find_irules weighted goal inet
+ |> map (Thm.transfer (Proof_Context.theory_of ctxt));
+
+fun find_rules ctxt weighted facts goal =
+ map (find_rules_netpair ctxt weighted facts goal) (netpairs ctxt);
+
+end;
(* wrappers *)
--- a/src/Pure/Isar/element.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/element.ML Thu Sep 03 15:50:40 2015 +0200
@@ -359,7 +359,7 @@
Drule.forall_elim_list (map (Thm.global_cterm_of thy o snd) subst);
fun hyps_rule rule th =
- let val {hyps, ...} = Thm.crep_thm th in
+ let val hyps = Thm.chyps_of th in
Drule.implies_elim_list
(rule (Drule.implies_intr_list hyps th))
(map (Thm.assume o Drule.cterm_rule rule) hyps)
@@ -452,7 +452,7 @@
thm |> fold (fn hyp =>
(case find_first (fn Witness (t, _) => Thm.term_of hyp aconv t) witns of
NONE => I
- | SOME w => Thm.implies_intr hyp #> compose_witness w)) (#hyps (Thm.crep_thm thm));
+ | SOME w => Thm.implies_intr hyp #> compose_witness w)) (Thm.chyps_of thm);
val satisfy_morphism = Morphism.thm_morphism "Element.satisfy" o satisfy_thm;
--- a/src/Pure/Isar/expression.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/expression.ML Thu Sep 03 15:50:40 2015 +0200
@@ -683,9 +683,8 @@
val ([pred_def], defs_thy) =
thy
|> bodyT = propT ? Sign.typed_print_translation [aprop_tr' (length args) name]
- |> Sign.declare_const_global ((Binding.concealed binding, predT), NoSyn) |> snd
- |> Global_Theory.add_defs false
- [((Binding.concealed (Thm.def_binding binding), Logic.mk_equals (head, body)), [])];
+ |> Sign.declare_const_global ((binding, predT), NoSyn) |> snd
+ |> Global_Theory.add_defs false [((Thm.def_binding binding, Logic.mk_equals (head, body)), [])];
val defs_ctxt = Proof_Context.init_global defs_thy |> Variable.declare_term head;
val intro = Goal.prove_global defs_thy [] norm_ts statement
@@ -702,7 +701,7 @@
|> Conjunction.elim_balanced (length ts);
val (_, axioms_ctxt) = defs_ctxt
- |> Assumption.add_assumes (maps (#hyps o Thm.crep_thm) (defs @ conjuncts));
+ |> Assumption.add_assumes (maps Thm.chyps_of (defs @ conjuncts));
val axioms = ts ~~ conjuncts |> map (fn (t, ax) =>
Element.prove_witness axioms_ctxt t
(rewrite_goals_tac axioms_ctxt defs THEN compose_tac axioms_ctxt (false, ax, 0) 1));
@@ -730,7 +729,7 @@
thy'
|> Sign.qualified_path true abinding
|> Global_Theory.note_thmss ""
- [((Binding.concealed (Binding.name introN), []), [([intro], [Locale.unfold_add])])]
+ [((Binding.name introN, []), [([intro], [Locale.unfold_add])])]
||> Sign.restore_naming thy';
in (SOME statement, SOME intro, axioms, thy'') end;
val (b_pred, b_intro, b_axioms, thy'''') =
@@ -745,8 +744,8 @@
thy'''
|> Sign.qualified_path true binding
|> Global_Theory.note_thmss ""
- [((Binding.concealed (Binding.name introN), []), [([intro], [Locale.intro_add])]),
- ((Binding.concealed (Binding.name axiomsN), []),
+ [((Binding.name introN, []), [([intro], [Locale.intro_add])]),
+ ((Binding.name axiomsN, []),
[(map (Drule.export_without_context o Element.conclude_witness ctxt''') axioms,
[])])]
||> Sign.restore_naming thy''';
@@ -815,7 +814,7 @@
val notes =
if is_some asm then
- [("", [((Binding.concealed (Binding.suffix_name ("_" ^ axiomsN) binding), []),
+ [("", [((Binding.suffix_name ("_" ^ axiomsN) binding, []),
[([Assumption.assume pred_ctxt (Thm.cterm_of pred_ctxt (the asm))],
[(Attrib.internal o K) Locale.witness_add])])])]
else [];
--- a/src/Pure/Isar/isar_cmd.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/isar_cmd.ML Thu Sep 03 15:50:40 2015 +0200
@@ -143,7 +143,8 @@
(* old-style defs *)
fun add_defs ((unchecked, overloaded), args) thy =
- (legacy_feature "Old 'defs' command -- use 'definition' (with 'overloading') instead";
+ (legacy_feature ("Old 'defs' command -- use 'definition' (with 'overloading') instead" ^
+ Position.here (Position.thread_data ()));
thy |>
(if unchecked then Global_Theory.add_defs_unchecked_cmd else Global_Theory.add_defs_cmd)
overloaded
--- a/src/Pure/Isar/isar_syn.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/isar_syn.ML Thu Sep 03 15:50:40 2015 +0200
@@ -203,27 +203,39 @@
(* use ML text *)
+fun SML_file_cmd debug files = Toplevel.theory (fn thy =>
+ let
+ val ([{lines, pos, ...}: Token.file], thy') = files thy;
+ val source = Input.source true (cat_lines lines) (pos, pos);
+ val flags: ML_Compiler.flags =
+ {SML = true, exchange = false, redirect = true, verbose = true,
+ debug = debug, writeln = writeln, warning = warning};
+ in
+ thy' |> Context.theory_map
+ (ML_Context.exec (fn () => ML_Context.eval_source flags source))
+ end);
+
val _ =
Outer_Syntax.command @{command_keyword SML_file} "read and evaluate Standard ML file"
- (Resources.provide_parse_files "SML_file" >> (fn files => Toplevel.theory (fn thy =>
- let
- val ([{lines, pos, ...}], thy') = files thy;
- val source = Input.source true (cat_lines lines) (pos, pos);
- val flags =
- {SML = true, exchange = false, redirect = true, verbose = true,
- writeln = writeln, warning = warning};
- in
- thy' |> Context.theory_map
- (ML_Context.exec (fn () => ML_Context.eval_source flags source))
- end)));
+ (Resources.provide_parse_files "SML_file" >> SML_file_cmd NONE);
+
+val _ =
+ Outer_Syntax.command @{command_keyword SML_file_debug}
+ "read and evaluate Standard ML file (with debugger information)"
+ (Resources.provide_parse_files "SML_file_debug" >> SML_file_cmd (SOME true));
+
+val _ =
+ Outer_Syntax.command @{command_keyword SML_file_no_debug}
+ "read and evaluate Standard ML file (no debugger information)"
+ (Resources.provide_parse_files "SML_file_no_debug" >> SML_file_cmd (SOME false));
val _ =
Outer_Syntax.command @{command_keyword SML_export} "evaluate SML within Isabelle/ML environment"
(Parse.ML_source >> (fn source =>
let
- val flags =
+ val flags: ML_Compiler.flags =
{SML = true, exchange = true, redirect = false, verbose = true,
- writeln = writeln, warning = warning};
+ debug = NONE, writeln = writeln, warning = warning};
in
Toplevel.theory
(Context.theory_map (ML_Context.exec (fn () => ML_Context.eval_source flags source)))
@@ -233,9 +245,9 @@
Outer_Syntax.command @{command_keyword SML_import} "evaluate Isabelle/ML within SML environment"
(Parse.ML_source >> (fn source =>
let
- val flags =
+ val flags: ML_Compiler.flags =
{SML = false, exchange = true, redirect = false, verbose = true,
- writeln = writeln, warning = warning};
+ debug = NONE, writeln = writeln, warning = warning};
in
Toplevel.generic_theory
(ML_Context.exec (fn () => ML_Context.eval_source flags source) #>
--- a/src/Pure/Isar/local_defs.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/local_defs.ML Thu Sep 03 15:50:40 2015 +0200
@@ -178,8 +178,8 @@
Pretty.writeln (Pretty.big_list "definitional rewrite rules:"
(map (Display.pretty_thm_item ctxt) (Rules.get (Context.Proof ctxt))));
-val defn_add = Thm.declaration_attribute (Rules.map o Thm.add_thm);
-val defn_del = Thm.declaration_attribute (Rules.map o Thm.del_thm);
+val defn_add = Thm.declaration_attribute (Rules.map o Thm.add_thm o Thm.trim_context);
+val defn_del = Thm.declaration_attribute (Rules.map o Thm.del_thm o Thm.trim_context);
(* meta rewrite rules *)
--- a/src/Pure/Isar/locale.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/locale.ML Thu Sep 03 15:50:40 2015 +0200
@@ -191,7 +191,8 @@
fun register_locale binding parameters spec intros axioms hyp_spec syntax_decls notes dependencies thy =
thy |> Locales.map (Name_Space.define (Context.Theory thy) true
(binding,
- mk_locale ((parameters, spec, intros, axioms, hyp_spec),
+ mk_locale ((parameters, spec, (apply2 o Option.map) Thm.trim_context intros,
+ map Thm.trim_context axioms, hyp_spec),
((map (fn decl => (decl, serial ())) syntax_decls, map (fn n => (n, serial ())) notes),
(map (fn d => (d |> apsnd (rpair Morphism.identity), serial ())) dependencies,
Inttab.empty)))) #> snd);
@@ -205,9 +206,9 @@
fun params_of thy = snd o #parameters o the_locale thy;
-fun intros_of thy = #intros o the_locale thy;
+fun intros_of thy = (apply2 o Option.map) (Thm.transfer thy) o #intros o the_locale thy;
-fun axioms_of thy = #axioms o the_locale thy;
+fun axioms_of thy = map (Thm.transfer thy) o #axioms o the_locale thy;
fun instance_of thy name morph = params_of thy name |>
map (Morphism.term morph o Free o #1);
@@ -573,17 +574,36 @@
(* Theorems *)
-fun add_thmss _ _ [] ctxt = ctxt
- | add_thmss loc kind facts ctxt =
+local
+
+val trim_fact = map Thm.trim_context;
+val trim_srcs = (map o Token.map_facts_src) trim_fact;
+
+fun trim_context_facts facts = facts |> map (fn ((b, atts), args) =>
+ ((b, trim_srcs atts), map (fn (a, more_atts) => (trim_fact a, trim_srcs more_atts)) args));
+
+in
+
+fun add_thmss loc kind facts ctxt =
+ if null facts then ctxt
+ else
+ let
+ val stored_notes = ((kind, trim_context_facts facts), serial ());
+
+ fun global_notes morph thy = thy
+ |> (snd o Attrib.global_notes kind
+ (Attrib.transform_facts (Morphism.transfer_morphism thy $> morph) facts));
+ fun registrations thy =
+ fold_rev (fn (_, morph) => global_notes morph)
+ (registrations_of (Context.Theory thy) loc) thy;
+ in
ctxt
|> Attrib.local_notes kind facts |> snd
|> Proof_Context.background_theory
- ((change_locale loc o apfst o apsnd) (cons ((kind, facts), serial ())) #>
- (* Registrations *)
- (fn thy =>
- fold_rev (fn (_, morph) =>
- snd o Attrib.global_notes kind (Attrib.transform_facts morph facts))
- (registrations_of (Context.Theory thy) loc) thy));
+ ((change_locale loc o apfst o apsnd) (cons stored_notes) #> registrations)
+ end;
+
+end;
(* Declarations *)
@@ -592,8 +612,7 @@
fun add_decl loc decl =
add_thmss loc ""
- [((Binding.concealed Binding.empty,
- [Attrib.internal (fn phi => Thm.declaration_attribute (K (decl phi)))]),
+ [((Binding.empty, [Attrib.internal (fn phi => Thm.declaration_attribute (K (decl phi)))]),
[([Drule.dummy_thm], [])])];
in
@@ -621,16 +640,25 @@
Thm.merge_thms (unfolds1, unfolds2));
);
-val get_witnesses = #1 o Thms.get o Context.Proof;
-val get_intros = #2 o Thms.get o Context.Proof;
-val get_unfolds = #3 o Thms.get o Context.Proof;
+fun get_thms which ctxt =
+ map (Thm.transfer (Proof_Context.theory_of ctxt))
+ (which (Thms.get (Context.Proof ctxt)));
+
+val get_witnesses = get_thms #1;
+val get_intros = get_thms #2;
+val get_unfolds = get_thms #3;
val witness_add =
- Thm.declaration_attribute (fn th => Thms.map (fn (x, y, z) => (Thm.add_thm th x, y, z)));
+ Thm.declaration_attribute (fn th =>
+ Thms.map (fn (x, y, z) => (Thm.add_thm (Thm.trim_context th) x, y, z)));
+
val intro_add =
- Thm.declaration_attribute (fn th => Thms.map (fn (x, y, z) => (x, Thm.add_thm th y, z)));
+ Thm.declaration_attribute (fn th =>
+ Thms.map (fn (x, y, z) => (x, Thm.add_thm (Thm.trim_context th) y, z)));
+
val unfold_add =
- Thm.declaration_attribute (fn th => Thms.map (fn (x, y, z) => (x, y, Thm.add_thm th z)));
+ Thm.declaration_attribute (fn th =>
+ Thms.map (fn (x, y, z) => (x, y, Thm.add_thm (Thm.trim_context th) z)));
(* Tactics *)
--- a/src/Pure/Isar/method.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/method.ML Thu Sep 03 15:50:40 2015 +0200
@@ -239,7 +239,7 @@
let
val rules =
if not (null arg_rules) then arg_rules
- else flat (Context_Rules.find_rules false facts goal ctxt)
+ else flat (Context_Rules.find_rules ctxt false facts goal);
in trace ctxt rules; tac ctxt rules facts i end);
fun meth tac x y = METHOD (HEADGOAL o tac x y);
--- a/src/Pure/Isar/object_logic.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/object_logic.ML Thu Sep 03 15:50:40 2015 +0200
@@ -166,10 +166,10 @@
val get_rulify = #2 o #atomize_rulify o get_data;
fun add_atomize th = map_data (fn (base_sort, judgment, (atomize, rulify)) =>
- (base_sort, judgment, (Thm.add_thm th atomize, rulify)));
+ (base_sort, judgment, (Thm.add_thm (Thm.trim_context th) atomize, rulify)));
fun add_rulify th = map_data (fn (base_sort, judgment, (atomize, rulify)) =>
- (base_sort, judgment, (atomize, Thm.add_thm th rulify)));
+ (base_sort, judgment, (atomize, Thm.add_thm (Thm.trim_context th) rulify)));
val declare_atomize = Thm.declaration_attribute add_atomize;
val declare_rulify = Thm.declaration_attribute add_rulify;
--- a/src/Pure/Isar/obtain.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/obtain.ML Thu Sep 03 15:50:40 2015 +0200
@@ -54,7 +54,7 @@
error "Conclusion in obtained context must be object-logic judgment";
val ((_, [thm']), ctxt') = Variable.import true [thm] ctxt;
- val prems = Drule.strip_imp_prems (#prop (Thm.crep_thm thm'));
+ val prems = Drule.strip_imp_prems (Thm.cprop_of thm');
in
((Drule.implies_elim_list thm' (map Thm.assume prems)
|> Drule.implies_intr_list (map (Drule.norm_hhf_cterm ctxt') As)
--- a/src/Pure/Isar/proof.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/proof.ML Thu Sep 03 15:50:40 2015 +0200
@@ -491,7 +491,7 @@
val thy = Proof_Context.theory_of ctxt;
val _ =
- Theory.subthy (Thm.theory_of_thm goal, thy) orelse
+ Context.subthy_id (Thm.theory_id_of_thm goal, Context.theory_id thy) orelse
error "Bad background theory of goal state";
val _ = Thm.no_prems goal orelse error (Proof_Display.string_of_goal ctxt goal);
--- a/src/Pure/Isar/proof_display.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/proof_display.ML Thu Sep 03 15:50:40 2015 +0200
@@ -7,11 +7,11 @@
signature PROOF_DISPLAY =
sig
val pp_context: Proof.context -> Pretty.T
- val pp_thm: thm -> Pretty.T
- val pp_typ: theory -> typ -> Pretty.T
- val pp_term: theory -> term -> Pretty.T
- val pp_ctyp: ctyp -> Pretty.T
- val pp_cterm: cterm -> Pretty.T
+ val pp_thm: (unit -> theory) -> thm -> Pretty.T
+ val pp_typ: (unit -> theory) -> typ -> Pretty.T
+ val pp_term: (unit -> theory) -> term -> Pretty.T
+ val pp_ctyp: (unit -> theory) -> ctyp -> Pretty.T
+ val pp_cterm: (unit -> theory) -> cterm -> Pretty.T
val pretty_theorems_diff: bool -> theory list -> theory -> Pretty.T list
val pretty_theorems: bool -> theory -> Pretty.T list
val pretty_full_theory: bool -> theory -> Pretty.T
@@ -38,24 +38,23 @@
Pretty.quote (Pretty.big_list "proof context:" (Proof_Context.pretty_context ctxt))
else Pretty.str "<context>");
-fun default_context thy0 =
+fun default_context mk_thy =
(case Context.thread_data () of
SOME (Context.Proof ctxt) => ctxt
| SOME (Context.Theory thy) =>
(case try Syntax.init_pretty_global thy of
SOME ctxt => ctxt
- | NONE => Syntax.init_pretty_global thy0)
- | NONE => Syntax.init_pretty_global thy0);
+ | NONE => Syntax.init_pretty_global (mk_thy ()))
+ | NONE => Syntax.init_pretty_global (mk_thy ()));
+
+fun pp_thm mk_thy th =
+ Display.pretty_thm_raw (default_context mk_thy) {quote = true, show_hyps = false} th;
-fun pp_thm th =
- let val ctxt = default_context (Thm.theory_of_thm th);
- in Display.pretty_thm_raw ctxt {quote = true, show_hyps = false} th end;
+fun pp_typ mk_thy T = Pretty.quote (Syntax.pretty_typ (default_context mk_thy) T);
+fun pp_term mk_thy t = Pretty.quote (Syntax.pretty_term (default_context mk_thy) t);
-fun pp_typ thy T = Pretty.quote (Syntax.pretty_typ (default_context thy) T);
-fun pp_term thy t = Pretty.quote (Syntax.pretty_term (default_context thy) t);
-
-fun pp_ctyp cT = pp_typ (Thm.theory_of_ctyp cT) (Thm.typ_of cT);
-fun pp_cterm ct = pp_term (Thm.theory_of_cterm ct) (Thm.term_of ct);
+fun pp_ctyp mk_thy cT = pp_typ mk_thy (Thm.typ_of cT);
+fun pp_cterm mk_thy ct = pp_term mk_thy (Thm.term_of ct);
(* theorems and theory *)
--- a/src/Pure/Isar/runtime.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/runtime.ML Thu Sep 03 15:50:40 2015 +0200
@@ -10,6 +10,7 @@
exception EXCURSION_FAIL of exn * string
exception TOPLEVEL_ERROR
val exn_context: Proof.context option -> exn -> exn
+ val thread_context: exn -> exn
type error = ((serial * string) * string option)
val exn_messages_ids: exn -> error list
val exn_messages: exn -> (serial * string) list
@@ -41,6 +42,9 @@
fun exn_context NONE exn = exn
| exn_context (SOME ctxt) exn = if Exn.is_interrupt exn then exn else CONTEXT (ctxt, exn);
+fun thread_context exn =
+ exn_context (Option.map Context.proof_of (Context.thread_data ())) exn;
+
(* exn_message *)
--- a/src/Pure/Isar/spec_rules.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/spec_rules.ML Thu Sep 03 15:50:40 2015 +0200
@@ -21,7 +21,7 @@
structure Spec_Rules: SPEC_RULES =
struct
-(* maintain rules *)
+(* rules *)
datatype rough_classification = Unknown | Equational | Inductive | Co_Inductive;
type spec = rough_classification * (term list * thm list);
@@ -40,11 +40,30 @@
val merge = Item_Net.merge;
);
-val get = Item_Net.content o Rules.get o Context.Proof;
-val get_global = Item_Net.content o Rules.get o Context.Theory;
+
+(* get *)
+
+fun get_generic context =
+ let
+ val thy = Context.theory_of context;
+ val transfer = Global_Theory.transfer_theories thy;
+ in Item_Net.content (Rules.get context) |> (map o apsnd o apsnd o map) transfer end;
+
+val get = get_generic o Context.Proof;
+val get_global = get_generic o Context.Theory;
-val retrieve = Item_Net.retrieve o Rules.get o Context.Proof;
-val retrieve_global = Item_Net.retrieve o Rules.get o Context.Theory;
+
+(* retrieve *)
+
+fun retrieve_generic context =
+ Item_Net.retrieve (Rules.get context)
+ #> (map o apsnd o apsnd o map) (Thm.transfer (Context.theory_of context));
+
+val retrieve = retrieve_generic o Context.Proof;
+val retrieve_global = retrieve_generic o Context.Theory;
+
+
+(* add *)
fun add class (ts, ths) lthy =
let
@@ -56,11 +75,12 @@
val (ts', ths') =
Morphism.fact phi (map Drule.mk_term cts @ ths)
|> chop (length cts)
- |>> map (Thm.term_of o Drule.dest_term);
+ |>> map (Thm.term_of o Drule.dest_term)
+ ||> map Thm.trim_context;
in Rules.map (Item_Net.update (class, (ts', ths'))) end)
end;
fun add_global class spec =
- Context.theory_map (Rules.map (Item_Net.update (class, spec)));
+ Context.theory_map (Rules.map (Item_Net.update (class, (apsnd o map) Thm.trim_context spec)));
end;
--- a/src/Pure/Isar/subgoal.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/subgoal.ML Thu Sep 03 15:50:40 2015 +0200
@@ -114,9 +114,9 @@
:
C
*)
-fun lift_subgoals params asms th =
+fun lift_subgoals ctxt params asms th =
let
- fun lift ct = fold_rev Thm.all_name params (Drule.list_implies (asms, ct));
+ fun lift ct = fold_rev (Thm.all_name ctxt) params (Drule.list_implies (asms, ct));
val unlift =
fold (Thm.elim_implies o Thm.assume) asms o
Drule.forall_elim_list (map #2 params) o Thm.assume;
@@ -129,7 +129,7 @@
val idx = Thm.maxidx_of st0 + 1;
val ps = map #2 params;
val ((subgoal_inst, st2), ctxt2) = lift_import idx ps st1 ctxt1;
- val (subgoals, st3) = lift_subgoals params asms st2;
+ val (subgoals, st3) = lift_subgoals ctxt2 params asms st2;
val result = st3
|> Goal.conclude
|> Drule.implies_intr_list asms
--- a/src/Pure/Isar/token.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Isar/token.ML Thu Sep 03 15:50:40 2015 +0200
@@ -77,6 +77,8 @@
val map_values: (value -> value) -> src -> src
val declare_maxidx: T -> Proof.context -> Proof.context
val declare_maxidx_src: src -> Proof.context -> Proof.context
+ val map_facts: (thm list -> thm list) -> T -> T
+ val map_facts_src: (thm list -> thm list) -> src -> src
val transform: morphism -> T -> T
val transform_src: morphism -> src -> src
val init_assignable: T -> T
@@ -437,6 +439,17 @@
and declare_maxidx_src src = fold declare_maxidx (args_of_src src);
+(* fact values *)
+
+fun map_facts f =
+ map_value (fn v =>
+ (case v of
+ Source src => Source (map_facts_src f src)
+ | Fact (a, ths) => Fact (a, f ths)
+ | _ => v))
+and map_facts_src f = map_args (map_facts f);
+
+
(* transform *)
fun transform phi =
--- a/src/Pure/ML-Systems/compiler_polyml.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML-Systems/compiler_polyml.ML Thu Sep 03 15:50:40 2015 +0200
@@ -12,32 +12,34 @@
in
fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context)
- (start_line, name) verbose txt =
+ {line, file, verbose, debug} text =
let
- val line = Unsynchronized.ref start_line;
+ val current_line = Unsynchronized.ref line;
val in_buffer =
- Unsynchronized.ref (String.explode (tune_source (ml_positions start_line name txt)));
+ Unsynchronized.ref (String.explode (tune_source (ml_positions line file text)));
val out_buffer = Unsynchronized.ref ([]: string list);
fun output () = drop_newline (implode (rev (! out_buffer)));
fun get () =
(case ! in_buffer of
[] => NONE
- | c :: cs => (in_buffer := cs; if c = #"\n" then line := ! line + 1 else (); SOME c));
+ | c :: cs =>
+ (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c));
fun put s = out_buffer := s :: ! out_buffer;
- fun put_message {message = msg1, hard, location = {startLine = line, ...}, context} =
+ fun put_message {message = msg1, hard, location = {startLine = message_line, ...}, context} =
(put (if hard then "Error: " else "Warning: ");
PolyML.prettyPrint (put, 76) msg1;
(case context of NONE => () | SOME msg2 => PolyML.prettyPrint (put, 76) msg2);
- put ("At" ^ str_of_pos line name ^ "\n"));
+ put ("At" ^ str_of_pos message_line file ^ "\n"));
val parameters =
[PolyML.Compiler.CPOutStream put,
PolyML.Compiler.CPNameSpace name_space,
PolyML.Compiler.CPErrorMessageProc put_message,
- PolyML.Compiler.CPLineNo (fn () => ! line),
- PolyML.Compiler.CPFileName name,
- PolyML.Compiler.CPPrintInAlphabeticalOrder false];
+ PolyML.Compiler.CPLineNo (fn () => ! current_line),
+ PolyML.Compiler.CPFileName file,
+ PolyML.Compiler.CPPrintInAlphabeticalOrder false] @
+ ML_Compiler_Parameters.debug debug;
val _ =
(while not (List.null (! in_buffer)) do
PolyML.compiler (get, parameters) ())
@@ -48,11 +50,10 @@
error (output ()); reraise exn);
in if verbose then print (output ()) else () end;
-fun use_file context verbose name =
+fun use_file context {verbose, debug} file =
let
- val instream = TextIO.openIn name;
- val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream);
- in use_text context (1, name) verbose txt end;
+ val instream = TextIO.openIn file;
+ val text = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream);
+ in use_text context {line = 1, file = file, verbose = verbose, debug = debug} text end;
end;
-
--- a/src/Pure/ML-Systems/ml_debugger.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML-Systems/ml_debugger.ML Thu Sep 03 15:50:40 2015 +0200
@@ -6,6 +6,10 @@
signature ML_DEBUGGER =
sig
+ type exn_id
+ val exn_id: exn -> exn_id
+ val print_exn_id: exn_id -> string
+ val eq_exn_id: exn_id * exn_id -> bool
val on_entry: (string * 'location -> unit) option -> unit
val on_exit: (string * 'location -> unit) option -> unit
val on_exit_exception: (string * 'location -> exn -> unit) option -> unit
@@ -22,6 +26,18 @@
structure ML_Debugger: ML_DEBUGGER =
struct
+(* exceptions *)
+
+abstype exn_id = Exn_Id of string
+with
+
+fun exn_id exn = Exn_Id (General.exnName exn);
+fun print_exn_id (Exn_Id name) = name;
+fun eq_exn_id (Exn_Id name1, Exn_Id name2) = name1 = name2; (*over-approximation*)
+
+end;
+
+
(* hooks *)
fun on_entry _ = ();
--- a/src/Pure/ML-Systems/ml_debugger_polyml-5.5.3.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML-Systems/ml_debugger_polyml-5.5.3.ML Thu Sep 03 15:50:40 2015 +0200
@@ -6,6 +6,10 @@
signature ML_DEBUGGER =
sig
+ type exn_id
+ val exn_id: exn -> exn_id
+ val print_exn_id: exn_id -> string
+ val eq_exn_id: exn_id * exn_id -> bool
type location
val on_entry: (string * location -> unit) option -> unit
val on_exit: (string * location -> unit) option -> unit
@@ -23,6 +27,25 @@
structure ML_Debugger: ML_DEBUGGER =
struct
+(* exceptions *)
+
+abstype exn_id = Exn_Id of string * int Unsynchronized.ref
+with
+
+fun exn_id exn =
+ Exn_Id (General.exnName exn, RunCall.run_call2 RuntimeCalls.POLY_SYS_load_word (exn, 0));
+
+fun print_exn_id (Exn_Id (name, _)) = name;
+fun eq_exn_id (Exn_Id (_, id1), Exn_Id (_, id2)) = PolyML.pointerEq (id1, id2);
+
+end;
+
+val _ =
+ PolyML.addPrettyPrinter (fn _ => fn _ => fn exn_id =>
+ let val s = print_exn_id exn_id
+ in ml_pretty (ML_Pretty.String (s, size s)) end);
+
+
(* hooks *)
type location = PolyML.location;
--- a/src/Pure/ML-Systems/ml_system.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML-Systems/ml_system.ML Thu Sep 03 15:50:40 2015 +0200
@@ -10,7 +10,7 @@
val is_polyml: bool
val is_smlnj: bool
val platform: string
- val platform_is_cygwin: bool
+ val platform_is_windows: bool
val share_common_data: unit -> unit
val save_state: string -> unit
end;
@@ -23,7 +23,7 @@
val is_smlnj = String.isPrefix "smlnj" name;
val SOME platform = OS.Process.getEnv "ML_PLATFORM";
-val platform_is_cygwin = String.isSuffix "cygwin" platform;
+val platform_is_windows = String.isSuffix "windows" platform;
fun share_common_data () = ();
fun save_state _ = raise Fail "Cannot save state -- undefined operation";
--- a/src/Pure/ML-Systems/polyml.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML-Systems/polyml.ML Thu Sep 03 15:50:40 2015 +0200
@@ -4,9 +4,23 @@
Compatibility wrapper for Poly/ML.
*)
-val ml_initial_val =
- List.filter (fn (a, _) => a <> "use" andalso a <> "exit" andalso a <> "commit")
- (#allVal PolyML.globalNameSpace ());
+(* initial ML name space *)
+
+structure ML_Name_Space =
+struct
+ open PolyML.NameSpace;
+ type T = PolyML.NameSpace.nameSpace;
+ val global = PolyML.globalNameSpace;
+ val initial_val =
+ List.filter (fn (a, _) => a <> "use" andalso a <> "exit" andalso a <> "commit")
+ (#allVal global ());
+ val initial_type = #allType global ();
+ val initial_fixity = #allFix global ();
+ val initial_structure = #allStruct global ();
+ val initial_signature = #allSig global ();
+ val initial_functor = #allFunct global ();
+ val forget_global_structure = PolyML.Compiler.forgetStructure;
+end;
(* ML system operations *)
@@ -17,14 +31,16 @@
then use "ML-Systems/share_common_data_polyml-5.3.0.ML"
else ();
+fun ml_platform_path (s: string) = s;
+fun ml_standard_path (s: string) = s;
+
+if ML_System.platform_is_windows then use "ML-Systems/windows_path.ML" else ();
+
structure ML_System =
struct
-
-open ML_System;
-
-fun share_common_data () = PolyML.shareCommonData PolyML.rootFunction;
-val save_state = PolyML.SaveState.saveState;
-
+ open ML_System;
+ fun share_common_data () = PolyML.shareCommonData PolyML.rootFunction;
+ val save_state = PolyML.SaveState.saveState o ml_platform_path;
end;
@@ -159,19 +175,14 @@
structure ML_Name_Space =
struct
- open PolyML.NameSpace;
- type T = PolyML.NameSpace.nameSpace;
- val global = PolyML.globalNameSpace;
- val initial_val = ml_initial_val;
- val initial_type = #allType global ();
- val initial_fixity = #allFix global ();
- val initial_structure = #allStruct global ();
- val initial_signature = #allSig global ();
- val initial_functor = #allFunct global ();
- val forget_global_structure = PolyML.Compiler.forgetStructure;
+ open ML_Name_Space;
val display_val = pretty_ml o PolyML.NameSpace.displayVal;
end;
+use "ML-Systems/ml_compiler_parameters.ML";
+if ML_System.name = "polyml-5.5.3"
+then use "ML-Systems/ml_compiler_parameters_polyml-5.5.3.ML" else ();
+
use "ML-Systems/use_context.ML";
use "ML-Systems/ml_positions.ML";
use "ML-Systems/compiler_polyml.ML";
@@ -186,12 +197,8 @@
if ML_System.name = "polyml-5.5.3"
then use "ML-Systems/ml_parse_tree_polyml-5.5.3.ML" else ();
-use "ML-Systems/ml_compiler_parameters.ML";
-if ML_System.name = "polyml-5.5.3"
-then use "ML-Systems/ml_compiler_parameters_polyml-5.5.3.ML" else ();
-
fun toplevel_pp context (_: string list) pp =
- use_text context (1, "pp") false
+ use_text context {line = 1, file = "pp", verbose = false, debug = false}
("PolyML.addPrettyPrinter (fn _ => fn _ => ml_pretty o Pretty.to_ML o (" ^ pp ^ "))");
fun ml_make_string struct_name =
@@ -201,5 +208,6 @@
(* ML debugger *)
-use "ML-Systems/ml_debugger.ML";
-if ML_System.name = "polyml-5.5.3" then use "ML-Systems/ml_debugger_polyml-5.5.3.ML" else ();
+if ML_System.name = "polyml-5.5.3"
+then use "ML-Systems/ml_debugger_polyml-5.5.3.ML"
+else use "ML-Systems/ml_debugger.ML";
--- a/src/Pure/ML-Systems/smlnj.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML-Systems/smlnj.ML Thu Sep 03 15:50:40 2015 +0200
@@ -82,7 +82,8 @@
(* ML command execution *)
-fun use_text ({tune_source, print, error, ...}: use_context) (line, name) verbose txt =
+fun use_text ({tune_source, print, error, ...}: use_context)
+ {line, file, verbose, debug = _: bool} text =
let
val ref out_orig = Control.Print.out;
@@ -93,19 +94,19 @@
in String.substring (str, 0, Int.max (0, size str - 1)) end;
in
Control.Print.out := out;
- Backend.Interact.useStream (TextIO.openString (tune_source (ml_positions line name txt)))
+ Backend.Interact.useStream (TextIO.openString (tune_source (ml_positions line file text)))
handle exn =>
(Control.Print.out := out_orig;
- error ((if name = "" then "" else "Error in " ^ name ^ "\n") ^ output ()); raise exn);
+ error ((if file = "" then "" else "Error in " ^ file ^ "\n") ^ output ()); raise exn);
Control.Print.out := out_orig;
if verbose then print (output ()) else ()
end;
-fun use_file context verbose name =
+fun use_file context {verbose, debug} file =
let
- val instream = TextIO.openIn name;
- val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream);
- in use_text context (1, name) verbose txt end;
+ val instream = TextIO.openIn file;
+ val text = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream);
+ in use_text context {line = 1, file = file, verbose = verbose, debug = debug} text end;
(* toplevel pretty printing *)
@@ -123,7 +124,7 @@
in pprint end;
fun toplevel_pp context path pp =
- use_text context (1, "pp") false
+ use_text context {line = 1, file = "pp", verbose = false, debug = false}
("CompilerPPTable.install_pp [" ^ String.concatWith "," (map (fn s => "\"" ^ s ^ "\"") path) ^
"] (fn pps => ml_pprint pps o Pretty.to_ML o (" ^ pp ^ "))");
@@ -167,6 +168,9 @@
(* ML system operations *)
+fun ml_platform_path (s: string) = s;
+fun ml_standard_path (s: string) = s;
+
use "ML-Systems/ml_system.ML";
structure ML_System =
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/ML-Systems/windows_path.ML Thu Sep 03 15:50:40 2015 +0200
@@ -0,0 +1,35 @@
+(* Title: Pure/ML-Systems/windows_path.ML
+ Author: Makarius
+
+Windows file-system paths.
+*)
+
+fun ml_platform_path path =
+ if String.isPrefix "/" path andalso not (String.isPrefix "//" path) then
+ (case String.tokens (fn c => c = #"/") path of
+ "cygdrive" :: drive :: arcs =>
+ let
+ val vol =
+ (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
+ | arcs =>
+ (case OS.Process.getEnv "CYGWIN_ROOT" of
+ SOME root =>
+ OS.Path.concat (root, OS.Path.toString {vol = "", arcs = arcs, isAbs = false})
+ | NONE => raise Fail "Unknown environment variable CYGWIN_ROOT"))
+ else String.translate (fn #"/" => "\\" | c => String.str c) path;
+
+fun ml_standard_path path =
+ let
+ val {vol, arcs, isAbs} = OS.Path.fromString path;
+ val path' = String.translate (fn #"\\" => "/" | c => String.str c) path;
+ in
+ if isAbs then
+ (case String.explode vol of
+ [d, #":"] =>
+ String.concatWith "/" ("/cygdrive" :: String.str (Char.toLower d) :: arcs)
+ | _ => path')
+ else path'
+ end;
--- a/src/Pure/ML/ml_compiler.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML/ml_compiler.ML Thu Sep 03 15:50:40 2015 +0200
@@ -8,7 +8,7 @@
sig
type flags =
{SML: bool, exchange: bool, redirect: bool, verbose: bool,
- writeln: string -> unit, warning: string -> unit}
+ debug: bool option, writeln: string -> unit, warning: string -> unit}
val flags: flags
val verbose: bool -> flags -> flags
val eval: flags -> Position.T -> ML_Lex.token list -> unit
@@ -19,23 +19,26 @@
type flags =
{SML: bool, exchange: bool, redirect: bool, verbose: bool,
- writeln: string -> unit, warning: string -> unit};
+ debug: bool option, writeln: string -> unit, warning: string -> unit};
val flags: flags =
{SML = false, exchange = false, redirect = false, verbose = false,
- writeln = writeln, warning = warning};
+ debug = NONE, writeln = writeln, warning = warning};
fun verbose b (flags: flags) =
- {SML = #SML flags, exchange = #exchange flags, redirect = #redirect flags, verbose = b,
- writeln = #writeln flags, warning = #warning flags};
+ {SML = #SML flags, exchange = #exchange flags, redirect = #redirect flags,
+ verbose = b, debug = #debug flags, writeln = #writeln flags, warning = #warning flags};
fun eval (flags: flags) pos toks =
let
val _ = if #SML flags then error ("Standard ML is unsupported on " ^ ML_System.name) else ();
val line = the_default 1 (Position.line_of pos);
val file = the_default "ML" (Position.file_of pos);
+ val debug = the_default false (#debug flags);
val text = ML_Lex.flatten toks;
- in Secure.use_text ML_Env.local_context (line, file) (#verbose flags) text end;
+ in
+ Secure.use_text ML_Env.local_context
+ {line = line, file = file, verbose = #verbose flags, debug = debug} text
+ end;
end;
-
--- a/src/Pure/ML/ml_compiler_polyml.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML/ml_compiler_polyml.ML Thu Sep 03 15:50:40 2015 +0200
@@ -225,6 +225,11 @@
(* compiler invocation *)
+ val debug =
+ (case #debug flags of
+ SOME debug => debug
+ | NONE => ML_Options.debugger_enabled opt_context);
+
val parameters =
[PolyML.Compiler.CPOutStream write,
PolyML.Compiler.CPNameSpace space,
@@ -235,7 +240,8 @@
PolyML.Compiler.CPPrintDepth ML_Options.get_print_depth,
PolyML.Compiler.CPCompilerResultFun result_fun,
PolyML.Compiler.CPPrintInAlphabeticalOrder false] @
- ML_Compiler_Parameters.debug (ML_Options.debugger_enabled opt_context);
+ ML_Compiler_Parameters.debug debug;
+
val _ =
(while not (List.null (! input_buffer)) do
PolyML.compiler (get, parameters) ())
@@ -257,4 +263,3 @@
end;
end;
-
--- a/src/Pure/ML/ml_file.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ML/ml_file.ML Thu Sep 03 15:50:40 2015 +0200
@@ -7,21 +7,33 @@
structure ML_File: sig end =
struct
+fun ML_file_cmd debug files = Toplevel.generic_theory (fn gthy =>
+ let
+ val [{src_path, lines, digest, pos}: Token.file] = files (Context.theory_of gthy);
+ val provide = Resources.provide (src_path, digest);
+ val source = Input.source true (cat_lines lines) (pos, pos);
+ val flags: ML_Compiler.flags =
+ {SML = false, exchange = false, redirect = true, verbose = true,
+ debug = debug, writeln = writeln, warning = warning};
+ in
+ gthy
+ |> ML_Context.exec (fn () => ML_Context.eval_source flags source)
+ |> Local_Theory.propagate_ml_env
+ |> Context.mapping provide (Local_Theory.background_theory provide)
+ end);
+
val _ =
- Outer_Syntax.command ("ML_file", @{here}) "ML text from file"
- (Resources.parse_files "ML_file" >> (fn files => Toplevel.generic_theory (fn gthy =>
- let
- val [{src_path, lines, digest, pos}] = files (Context.theory_of gthy);
- val provide = Resources.provide (src_path, digest);
- val source = Input.source true (cat_lines lines) (pos, pos);
- val flags =
- {SML = false, exchange = false, redirect = true, verbose = true,
- writeln = writeln, warning = warning};
- in
- gthy
- |> ML_Context.exec (fn () => ML_Context.eval_source flags source)
- |> Local_Theory.propagate_ml_env
- |> Context.mapping provide (Local_Theory.background_theory provide)
- end)));
+ Outer_Syntax.command ("ML_file", @{here}) "read and evaluate Isabelle/ML file"
+ (Resources.parse_files "ML_file" >> ML_file_cmd NONE);
+
+val _ =
+ Outer_Syntax.command ("ML_file_debug", @{here})
+ "read and evaluate Isabelle/ML file (with debugger information)"
+ (Resources.parse_files "ML_file_debug" >> ML_file_cmd (SOME true));
+
+val _ =
+ Outer_Syntax.command ("ML_file_no_debug", @{here})
+ "read and evaluate Isabelle/ML file (no debugger information)"
+ (Resources.parse_files "ML_file_no_debug" >> ML_file_cmd (SOME false));
end;
--- a/src/Pure/PIDE/document.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/document.ML Thu Sep 03 15:50:40 2015 +0200
@@ -364,7 +364,7 @@
| SOME content => content);
fun resolve_blob state (blob_digest: blob_digest) =
- blob_digest |> Exn.map_result (fn (file_node, raw_digest) =>
+ blob_digest |> Exn.map_res (fn (file_node, raw_digest) =>
(file_node, Option.map (the_blob state) raw_digest));
fun blob_reports pos (blob_digest: blob_digest) =
@@ -544,7 +544,7 @@
|> Option.map (fn thy => (thy, (pos, Theory.get_markup thy))));
val parents =
- if null parents_reports then [Thy_Info.get_theory "Pure"] else map #1 parents_reports;
+ if null parents_reports then [Thy_Info.pure_theory ()] else map #1 parents_reports;
val _ = Position.reports (map #2 parents_reports);
in Resources.begin_theory master_dir header parents end;
--- a/src/Pure/PIDE/document.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/document.scala Thu Sep 03 15:50:40 2015 +0200
@@ -347,9 +347,10 @@
if name == file_name
} yield cmd).toList
- def undefined_blobs: List[Node.Name] =
+ def undefined_blobs(pred: Node.Name => Boolean): List[Node.Name] =
(for {
- (_, node) <- iterator
+ (node_name, node) <- iterator
+ if pred(node_name)
cmd <- node.load_commands.iterator
name <- cmd.blobs_undefined.iterator
} yield name).toList
@@ -632,8 +633,8 @@
def recent_finished: Change = history.undo_list.find(_.is_finished) getOrElse fail
def recent_stable: Change = history.undo_list.find(is_stable) getOrElse fail
- def tip_stable: Boolean = is_stable(history.tip)
- def tip_version: Version = history.tip.version.get_finished
+ def stable_tip_version: Option[Version] =
+ if (is_stable(history.tip)) Some(history.tip.version.get_finished) else None
def continue_history(
previous: Future[Version],
--- a/src/Pure/PIDE/execution.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/execution.ML Thu Sep 03 15:50:40 2015 +0200
@@ -108,7 +108,8 @@
val _ = status task [Markup.running];
val result =
Exn.capture (Future.interruptible_task e) ()
- |> Future.identify_result pos;
+ |> Future.identify_result pos
+ |> Exn.map_exn Runtime.thread_context;
val _ = status task [Markup.joined];
val _ =
(case result of
--- a/src/Pure/PIDE/protocol.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/protocol.scala Thu Sep 03 15:50:40 2015 +0200
@@ -368,7 +368,7 @@
variant(List(
{ case Document.Node.Edits(a) => (Nil, list(pair(option(id), option(id)))(a)) },
{ case Document.Node.Deps(header) =>
- val master_dir = Isabelle_System.posix_path_url(name.master_dir)
+ val master_dir = File.standard_url(name.master_dir)
val theory = Long_Name.base_name(name.theory)
val imports = header.imports.map({ case (a, _) => a.node })
val keywords = header.keywords.map({ case (a, b, _) => (a, b) })
--- a/src/Pure/PIDE/session.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/session.scala Thu Sep 03 15:50:40 2015 +0200
@@ -238,7 +238,7 @@
def current_state(): Document.State = global_state.value
def recent_syntax(name: Document.Node.Name): Prover.Syntax =
- current_state().recent_finished.version.get_finished.nodes(name).syntax getOrElse
+ global_state.value.recent_finished.version.get_finished.nodes(name).syntax getOrElse
resources.base_syntax
--- a/src/Pure/PIDE/xml.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/xml.ML Thu Sep 03 15:50:40 2015 +0200
@@ -44,7 +44,7 @@
val output_markup: Markup.T -> Output.output * Output.output
val string_of: tree -> string
val pretty: int -> tree -> Pretty.T
- val output: tree -> TextIO.outstream -> unit
+ val output: tree -> BinIO.outstream -> unit
val parse_comments: string list -> unit * string list
val parse_string : string -> string option
val parse_element: string list -> tree * string list
--- a/src/Pure/PIDE/xml.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/PIDE/xml.scala Thu Sep 03 15:50:40 2015 +0200
@@ -28,8 +28,8 @@
}
case class Text(content: String) extends Tree
- def elem(name: String, body: List[Tree]) = Elem(Markup(name, Nil), body)
- def elem(name: String) = Elem(Markup(name, Nil), Nil)
+ def elem(name: String, body: List[Tree]) = XML.Elem(Markup(name, Nil), body)
+ def elem(name: String) = XML.Elem(Markup(name, Nil), Nil)
type Body = List[Tree]
@@ -43,14 +43,14 @@
object Wrapped_Elem
{
def apply(markup: Markup, body1: Body, body2: Body): XML.Elem =
- Elem(Markup(XML_ELEM, (XML_NAME, markup.name) :: markup.properties),
- Elem(Markup(XML_BODY, Nil), body1) :: body2)
+ XML.Elem(Markup(XML_ELEM, (XML_NAME, markup.name) :: markup.properties),
+ XML.Elem(Markup(XML_BODY, Nil), body1) :: body2)
def unapply(tree: Tree): Option[(Markup, Body, Body)] =
tree match {
case
- Elem(Markup(XML_ELEM, (XML_NAME, name) :: props),
- Elem(Markup(XML_BODY, Nil), body1) :: body2) =>
+ XML.Elem(Markup(XML_ELEM, (XML_NAME, name) :: props),
+ XML.Elem(Markup(XML_BODY, Nil), body1) :: body2) =>
Some(Markup(name, props), body1, body2)
case _ => None
}
@@ -63,9 +63,9 @@
{
def traverse(x: A, t: Tree): A =
t match {
- case Wrapped_Elem(_, _, ts) => (x /: ts)(traverse)
- case Elem(_, ts) => (x /: ts)(traverse)
- case Text(s) => op(x, s)
+ case XML.Wrapped_Elem(_, _, ts) => (x /: ts)(traverse)
+ case XML.Elem(_, ts) => (x /: ts)(traverse)
+ case XML.Text(s) => op(x, s)
}
(a /: body)(traverse)
}
@@ -109,13 +109,13 @@
def elem(markup: Markup) { s ++= markup.name; markup.properties.foreach(attrib) }
def tree(t: Tree): Unit =
t match {
- case Elem(markup, Nil) =>
+ case XML.Elem(markup, Nil) =>
s ++= "<"; elem(markup); s ++= "/>"
- case Elem(markup, ts) =>
+ case XML.Elem(markup, ts) =>
s ++= "<"; elem(markup); s ++= ">"
ts.foreach(tree)
s ++= "</"; s ++= markup.name; s ++= ">"
- case Text(txt) => text(txt)
+ case XML.Text(txt) => text(txt)
}
body.foreach(tree)
s.toString
--- a/src/Pure/Proof/extraction.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Proof/extraction.ML Thu Sep 03 15:50:40 2015 +0200
@@ -364,7 +364,7 @@
let
val S = Sign.defaultS thy;
val ((atyp_map, constraints, _), prop') =
- Logic.unconstrainT (#shyps (Thm.rep_thm thm)) (Thm.prop_of thm);
+ Logic.unconstrainT (Thm.shyps_of thm) (Thm.prop_of thm);
val atyps = fold_types (fold_atyps (insert (op =))) (Thm.prop_of thm) [];
val Ts = map_filter (fn ((v, i), _) => if member (op =) vs v then
SOME (TVar (("'" ^ v, i), [])) else NONE)
@@ -399,7 +399,7 @@
typeof_eqns = add_rule ([], Logic.dest_equals (map_types
Type.strip_sorts (Thm.prop_of (Drule.abs_def thm)))) typeof_eqns,
types = types,
- realizers = realizers, defs = insert Thm.eq_thm thm defs,
+ realizers = realizers, defs = insert Thm.eq_thm_prop (Thm.trim_context thm) defs,
expand = expand, prep = prep}
else
{realizes_eqns = realizes_eqns, typeof_eqns = typeof_eqns, types = types,
@@ -486,7 +486,8 @@
val procs = maps (rev o fst o snd) types;
val rtypes = map fst types;
val typroc = typeof_proc [];
- val prep = the_default (K I) prep thy' o ProofRewriteRules.elim_defs thy' false defs o
+ val prep = the_default (K I) prep thy' o
+ ProofRewriteRules.elim_defs thy' false (map (Thm.transfer thy) defs) o
Reconstruct.expand_proof thy' (map (rpair NONE) ("" :: expand));
val rrews = Net.merge (K false) (#net realizes_eqns, #net typeof_eqns);
--- a/src/Pure/Pure.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Pure.thy Thu Sep 03 15:50:40 2015 +0200
@@ -21,7 +21,7 @@
"definition" "abbreviation" "type_notation" "no_type_notation" "notation"
"no_notation" "axiomatization" "theorems" "lemmas" "declare"
"hide_class" "hide_type" "hide_const" "hide_fact" :: thy_decl
- and "SML_file" :: thy_load % "ML"
+ and "SML_file" "SML_file_debug" "SML_file_no_debug" :: thy_load % "ML"
and "SML_import" "SML_export" :: thy_decl % "ML"
and "ML" :: thy_decl % "ML"
and "ML_prf" :: prf_decl % "proof" (* FIXME % "ML" ?? *)
--- a/src/Pure/ROOT Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ROOT Thu Sep 03 15:50:40 2015 +0200
@@ -34,6 +34,7 @@
"ML-Systems/universal.ML"
"ML-Systems/unsynchronized.ML"
"ML-Systems/use_context.ML"
+ "ML-Systems/windows_path.ML"
session Pure =
global_theories Pure
@@ -69,9 +70,11 @@
"ML-Systems/universal.ML"
"ML-Systems/unsynchronized.ML"
"ML-Systems/use_context.ML"
+ "ML-Systems/windows_path.ML"
"Concurrent/bash.ML"
"Concurrent/bash_sequential.ML"
+ "Concurrent/bash_windows.ML"
"Concurrent/cache.ML"
"Concurrent/counter.ML"
"Concurrent/event_timer.ML"
--- a/src/Pure/ROOT.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/ROOT.ML Thu Sep 03 15:50:40 2015 +0200
@@ -41,10 +41,10 @@
val use_text = Secure.use_text;
val use_file = Secure.use_file;
-fun use s =
- Position.setmp_thread_data (Position.file_only s)
+fun use file =
+ Position.setmp_thread_data (Position.file_only file)
(fn () =>
- Secure.use_file ML_Parse.global_context true s
+ Secure.use_file ML_Parse.global_context {verbose = true, debug = false} file
handle ERROR msg => (writeln msg; error "ML error")) ();
val toplevel_pp = Secure.toplevel_pp;
@@ -115,9 +115,9 @@
if Multithreading.available then ()
else use "Concurrent/single_assignment_sequential.ML";
-if Multithreading.available
-then use "Concurrent/bash.ML"
-else use "Concurrent/bash_sequential.ML";
+if not Multithreading.available then use "Concurrent/bash_sequential.ML"
+else if ML_System.platform_is_windows then use "Concurrent/bash_windows.ML"
+else use "Concurrent/bash.ML";
use "Concurrent/par_exn.ML";
use "Concurrent/task_queue.ML";
@@ -344,9 +344,10 @@
toplevel_pp ["Task_Queue", "group"] "Pretty.str o Task_Queue.str_of_group";
toplevel_pp ["Position", "T"] "Pretty.position";
toplevel_pp ["Binding", "binding"] "Binding.pp";
-toplevel_pp ["Thm", "thm"] "Proof_Display.pp_thm";
-toplevel_pp ["Thm", "cterm"] "Proof_Display.pp_cterm";
-toplevel_pp ["Thm", "ctyp"] "Proof_Display.pp_ctyp";
+toplevel_pp ["Thm", "thm"] "Proof_Display.pp_thm Thy_Info.pure_theory";
+toplevel_pp ["Thm", "cterm"] "Proof_Display.pp_cterm Thy_Info.pure_theory";
+toplevel_pp ["Thm", "ctyp"] "Proof_Display.pp_ctyp Thy_Info.pure_theory";
+toplevel_pp ["typ"] "Proof_Display.pp_typ Thy_Info.pure_theory";
toplevel_pp ["Context", "theory"] "Context.pretty_thy";
toplevel_pp ["Context", "Proof", "context"] "Proof_Display.pp_context";
toplevel_pp ["Ast", "ast"] "Ast.pretty_ast";
@@ -364,9 +365,7 @@
use "ML/ml_file.ML";
Runtime.toplevel_program (fn () => Thy_Info.use_thy ("Pure", Position.none));
Context.set_thread_data NONE;
-structure Pure = struct val thy = Thy_Info.get_theory "Pure" end;
-
-toplevel_pp ["typ"] "Proof_Display.pp_typ Pure.thy";
+structure Pure = struct val thy = Thy_Info.pure_theory () end;
(* ML toplevel commands *)
@@ -378,4 +377,3 @@
val cd = File.cd o Path.explode;
Proofterm.proofs := 0;
-
--- a/src/Pure/Syntax/syntax_phases.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Syntax/syntax_phases.ML Thu Sep 03 15:50:40 2015 +0200
@@ -353,7 +353,7 @@
val parse_rules = Syntax.parse_rules syn;
val (ambig_msgs, asts) = parse_asts ctxt false root input;
val results =
- (map o apsnd o Exn.maps_result)
+ (map o apsnd o Exn.maps_res)
(Ast.normalize ctxt parse_rules #> Exn.interruptible_capture (ast_to_term ctxt tr)) asts;
in (ambig_msgs, results) end;
@@ -405,7 +405,7 @@
val results' =
if parsed_len > 1 then
- (grouped 10 (Par_List.map_name "Syntax_Phases.parse_term") o apsnd o Exn.maps_result)
+ (grouped 10 (Par_List.map_name "Syntax_Phases.parse_term") o apsnd o Exn.maps_res)
check results
else results;
val reports' = fst (hd results');
--- a/src/Pure/System/isabelle_process.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/System/isabelle_process.scala Thu Sep 03 15:50:40 2015 +0200
@@ -19,9 +19,7 @@
val cmdline =
Isabelle_System.getenv_strict("ISABELLE_PROCESS") ::
(system_channel.prover_args ::: prover_args)
- val process =
- new Isabelle_System.Managed_Process(null, null, false, cmdline: _*) with
- Prover.System_Process
+ val process = Bash.process(null, null, false, cmdline: _*)
process.stdin.close
process
}
--- a/src/Pure/System/isabelle_system.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/System/isabelle_system.ML Thu Sep 03 15:50:40 2015 +0200
@@ -41,14 +41,17 @@
fun isabelle_tool name args =
(case space_explode ":" (getenv "ISABELLE_TOOLS") |> get_first (fn dir =>
- let val path = File.platform_path (Path.append (Path.explode dir) (Path.basic name)) in
- if can OS.FileSys.modTime path andalso
- not (OS.FileSys.isDir path) andalso
- OS.FileSys.access (path, [OS.FileSys.A_READ, OS.FileSys.A_EXEC])
+ let
+ val path = Path.append (Path.explode dir) (Path.basic name);
+ val platform_path = File.platform_path path;
+ in
+ if can OS.FileSys.modTime platform_path andalso
+ not (OS.FileSys.isDir platform_path) andalso
+ OS.FileSys.access (platform_path, [OS.FileSys.A_READ, OS.FileSys.A_EXEC])
then SOME path
else NONE
end handle OS.SysErr _ => NONE) of
- SOME path => bash (File.shell_quote path ^ " " ^ args)
+ SOME path => bash (File.shell_path path ^ " " ^ args)
| NONE => (warning ("Unknown Isabelle tool: " ^ name); 2));
fun system_command cmd =
--- a/src/Pure/System/isabelle_system.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/System/isabelle_system.scala Thu Sep 03 15:50:40 2015 +0200
@@ -8,14 +8,9 @@
package isabelle
-import java.util.regex.Pattern
-import java.io.{File => JFile, BufferedReader, InputStreamReader,
- BufferedWriter, OutputStreamWriter, IOException}
+import java.io.{File => JFile, IOException}
import java.nio.file.{Path => JPath, Files, SimpleFileVisitor, FileVisitResult}
import java.nio.file.attribute.BasicFileAttributes
-import java.net.{URL, URLDecoder, MalformedURLException}
-
-import scala.util.matching.Regex
object Isabelle_System
@@ -92,7 +87,7 @@
default(
default(
- default(sys.env + ("ISABELLE_JDK_HOME" -> posix_path(jdk_home())),
+ default(sys.env + ("ISABELLE_JDK_HOME" -> File.standard_path(jdk_home())),
"TEMP_WINDOWS" -> temp_windows),
"HOME" -> user_home),
"ISABELLE_APP" -> "true")
@@ -155,91 +150,6 @@
/** file-system operations **/
- /* jvm_path */
-
- private val Cygdrive = new Regex("/cygdrive/([a-zA-Z])($|/.*)")
- private val Named_Root = new Regex("//+([^/]*)(.*)")
-
- def jvm_path(posix_path: String): String =
- if (Platform.is_windows) {
- val result_path = new StringBuilder
- val rest =
- posix_path match {
- case Cygdrive(drive, rest) =>
- result_path ++= (Word.uppercase(drive) + ":" + JFile.separator)
- rest
- case Named_Root(root, rest) =>
- result_path ++= JFile.separator
- result_path ++= JFile.separator
- result_path ++= root
- rest
- case path if path.startsWith("/") =>
- result_path ++= get_cygwin_root()
- path
- case path => path
- }
- for (p <- space_explode('/', rest) if p != "") {
- val len = result_path.length
- if (len > 0 && result_path(len - 1) != JFile.separatorChar)
- result_path += JFile.separatorChar
- result_path ++= p
- }
- result_path.toString
- }
- else posix_path
-
-
- /* posix_path */
-
- def posix_path(jvm_path: String): String =
- if (Platform.is_windows) {
- val Platform_Root = new Regex("(?i)" +
- Pattern.quote(get_cygwin_root()) + """(?:\\+|\z)(.*)""")
- val Drive = new Regex("""([a-zA-Z]):\\*(.*)""")
-
- jvm_path.replace('/', '\\') match {
- case Platform_Root(rest) => "/" + rest.replace('\\', '/')
- case Drive(letter, rest) =>
- "/cygdrive/" + Word.lowercase(letter) +
- (if (rest == "") "" else "/" + rest.replace('\\', '/'))
- case path => path.replace('\\', '/')
- }
- }
- else jvm_path
-
- def posix_path(file: JFile): String = posix_path(file.getPath)
-
- def posix_path_url(name: String): String =
- try {
- val url = new URL(name)
- if (url.getProtocol == "file")
- posix_path(URLDecoder.decode(url.getPath, UTF8.charset_name))
- else name
- }
- catch { case _: MalformedURLException => posix_path(name) }
-
-
- /* misc path specifications */
-
- def standard_path(path: Path): String = path.expand.implode
-
- def platform_path(path: Path): String = jvm_path(standard_path(path))
- def platform_file(path: Path): JFile = new JFile(platform_path(path))
-
- def platform_file_url(raw_path: Path): String =
- {
- val path = raw_path.expand
- require(path.is_absolute)
- val s = platform_path(path).replaceAll(" ", "%20")
- if (!Platform.is_windows) "file://" + s
- else if (s.startsWith("\\\\")) "file:" + s.replace('\\', '/')
- else "file:///" + s.replace('\\', '/')
- }
-
- def shell_path(path: Path): String = "'" + standard_path(path) + "'"
- def shell_path(file: JFile): String = "'" + posix_path(file) + "'"
-
-
/* source files of Isabelle/ML bootstrap */
def source_file(path: Path): Option[Path] =
@@ -259,8 +169,8 @@
def mkdirs(path: Path): Unit =
if (!path.is_dir) {
- bash("perl -e \"use File::Path make_path; make_path(" + shell_path(path) + ");\"")
- if (!path.is_dir) error("Failed to create directory: " + quote(platform_path(path)))
+ bash("perl -e \"use File::Path make_path; make_path(" + File.shell_path(path) + ");\"")
+ if (!path.is_dir) error("Failed to create directory: " + quote(File.platform_path(path)))
}
@@ -315,82 +225,13 @@
execute_env(null, null, redirect, args: _*)
- /* managed process */
-
- class Managed_Process(cwd: JFile, env: Map[String, String], redirect: Boolean, args: String*)
- {
- private val params =
- List(standard_path(Path.explode("~~/lib/scripts/process")), "group", "-", "no_script")
- private val proc = execute_env(cwd, env, redirect, (params ::: args.toList):_*)
-
-
- // channels
-
- val stdin: BufferedWriter =
- new BufferedWriter(new OutputStreamWriter(proc.getOutputStream, UTF8.charset))
-
- val stdout: BufferedReader =
- new BufferedReader(new InputStreamReader(proc.getInputStream, UTF8.charset))
-
- val stderr: BufferedReader =
- new BufferedReader(new InputStreamReader(proc.getErrorStream, UTF8.charset))
-
-
- // signals
-
- private val pid = stdout.readLine
-
- private def kill_cmd(signal: String): Int =
- execute(true, "/usr/bin/env", "bash", "-c", "kill -" + signal + " -" + pid).waitFor
-
- private def kill(signal: String): Boolean =
- Exn.Interrupt.postpone { kill_cmd(signal); kill_cmd("0") == 0 } getOrElse true
-
- private def multi_kill(signal: String): Boolean =
- {
- var running = true
- var count = 10
- while (running && count > 0) {
- if (kill(signal)) {
- Exn.Interrupt.postpone {
- Thread.sleep(100)
- count -= 1
- }
- }
- else running = false
- }
- running
- }
-
- def interrupt() { multi_kill("INT") }
- def terminate() { multi_kill("INT") && multi_kill("TERM") && kill("KILL"); proc.destroy }
-
-
- // JVM shutdown hook
-
- private val shutdown_hook = new Thread { override def run = terminate() }
-
- try { Runtime.getRuntime.addShutdownHook(shutdown_hook) }
- catch { case _: IllegalStateException => }
-
- private def cleanup() =
- try { Runtime.getRuntime.removeShutdownHook(shutdown_hook) }
- catch { case _: IllegalStateException => }
-
-
- /* result */
-
- def join: Int = { val rc = proc.waitFor; cleanup(); rc }
- }
-
-
/* tmp files */
private def isabelle_tmp_prefix(): JFile =
{
val path = Path.explode("$ISABELLE_TMP_PREFIX")
path.file.mkdirs // low-level mkdirs
- platform_file(path)
+ File.platform_file(path)
}
def tmp_file[A](name: String, ext: String = ""): JFile =
@@ -449,22 +290,21 @@
}
+ /* kill */
+
+ def kill(signal: String, group_pid: String): (String, Int) =
+ {
+ val bash =
+ if (Platform.is_windows) List(get_cygwin_root() + "\\bin\\bash.exe")
+ else List("/usr/bin/env", "bash")
+ val cmdline = bash ::: List("-c", "kill -" + signal + " -" + group_pid)
+ process_output(raw_execute(null, null, true, cmdline: _*))
+ }
+
+
/* bash */
- final case class Bash_Result(out_lines: List[String], err_lines: List[String], rc: Int)
- {
- def out: String = cat_lines(out_lines)
- def err: String = cat_lines(err_lines)
- def add_err(s: String): Bash_Result = copy(err_lines = err_lines ::: List(s))
- def set_rc(i: Int): Bash_Result = copy(rc = i)
-
- def check_error: Bash_Result =
- if (rc == Exn.Interrupt.return_code) throw Exn.Interrupt()
- else if (rc != 0) error(err)
- else this
- }
-
- private class Limited_Progress(proc: Managed_Process, progress_limit: Option[Long])
+ private class Limited_Progress(proc: Bash.Process, progress_limit: Option[Long])
{
private var count = 0L
def apply(progress: String => Unit)(line: String): Unit = synchronized {
@@ -481,11 +321,11 @@
progress_stdout: String => Unit = (_: String) => (),
progress_stderr: String => Unit = (_: String) => (),
progress_limit: Option[Long] = None,
- strict: Boolean = true): Bash_Result =
+ strict: Boolean = true): Bash.Result =
{
with_tmp_file("isabelle_script") { script_file =>
File.write(script_file, script)
- val proc = new Managed_Process(cwd, env, false, "bash", posix_path(script_file))
+ val proc = Bash.process(cwd, env, false, "bash", File.standard_path(script_file))
proc.stdin.close
val limited = new Limited_Progress(proc, progress_limit)
@@ -503,11 +343,11 @@
catch { case Exn.Interrupt() => proc.terminate; Exn.Interrupt.return_code }
if (strict && rc == Exn.Interrupt.return_code) throw Exn.Interrupt()
- Bash_Result(stdout.join, stderr.join, rc)
+ Bash.Result(stdout.join, stderr.join, rc)
}
}
- def bash(script: String): Bash_Result = bash_env(null, null, script)
+ def bash(script: String): Bash.Result = bash_env(null, null, script)
/* system tools */
@@ -523,7 +363,7 @@
catch { case _: SecurityException => false }
} match {
case Some(dir) =>
- val file = standard_path(dir + Path.basic(name))
+ val file = File.standard_path(dir + Path.basic(name))
process_output(execute(true, (List(file) ::: args.toList): _*))
case None => ("Unknown Isabelle tool: " + name, 2)
}
@@ -533,10 +373,10 @@
bash("exec \"$ISABELLE_OPEN\" '" + arg + "' >/dev/null 2>/dev/null &")
def pdf_viewer(arg: Path): Unit =
- bash("exec \"$PDF_VIEWER\" '" + standard_path(arg) + "' >/dev/null 2>/dev/null &")
+ bash("exec \"$PDF_VIEWER\" '" + File.standard_path(arg) + "' >/dev/null 2>/dev/null &")
- def hg(cmd_line: String, cwd: Path = Path.current): Bash_Result =
- bash("cd " + shell_path(cwd) + " && \"${HG:-hg}\" " + cmd_line)
+ def hg(cmd_line: String, cwd: Path = Path.current): Bash.Result =
+ bash("cd " + File.shell_path(cwd) + " && \"${HG:-hg}\" " + cmd_line)
/** Isabelle resources **/
--- a/src/Pure/System/platform.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/System/platform.scala Thu Sep 03 15:50:40 2015 +0200
@@ -53,8 +53,17 @@
}
+ /* JVM version */
+
+ private val Version = new Regex("""1\.(\d+)\.0_(\d+)""")
+ lazy val jvm_version =
+ System.getProperty("java.version") match {
+ case Version(a, b) => a + "u" + b
+ case a => a
+ }
+
+
/* JVM name */
val jvm_name: String = System.getProperty("java.vm.name", "")
}
-
--- a/src/Pure/System/system_channel.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/System/system_channel.ML Thu Sep 03 15:50:40 2015 +0200
@@ -36,7 +36,7 @@
else Byte.bytesToString (BinIO.inputN (in_stream, n));
fun output (System_Channel (_, out_stream)) s =
- BinIO.output (out_stream, Byte.stringToBytes s);
+ File.output out_stream s;
fun flush (System_Channel (_, out_stream)) =
BinIO.flushOut out_stream;
@@ -48,4 +48,3 @@
in System_Channel (in_stream, out_stream) end;
end;
-
--- a/src/Pure/Thy/thy_header.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Thy/thy_header.ML Thu Sep 03 15:50:40 2015 +0200
@@ -78,7 +78,9 @@
((txtN, @{here}), SOME ((Keyword.document_body, []), [])),
((text_rawN, @{here}), SOME ((Keyword.document_raw, []), [])),
((theoryN, @{here}), SOME ((Keyword.thy_begin, []), ["theory"])),
- (("ML_file", @{here}), SOME ((Keyword.thy_load, []), ["ML"]))];
+ (("ML_file", @{here}), SOME ((Keyword.thy_load, []), ["ML"])),
+ (("ML_file_debug", @{here}), SOME ((Keyword.thy_load, []), ["ML"])),
+ (("ML_file_no_debug", @{here}), SOME ((Keyword.thy_load, []), ["ML"]))];
(* theory data *)
--- a/src/Pure/Thy/thy_header.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Thy/thy_header.scala Thu Sep 03 15:50:40 2015 +0200
@@ -55,7 +55,9 @@
(TXT, Some(((Keyword.DOCUMENT_BODY, Nil), Nil)), None),
(TEXT_RAW, Some(((Keyword.DOCUMENT_RAW, Nil), Nil)), None),
(THEORY, Some((Keyword.THY_BEGIN, Nil), List("theory")), None),
- ("ML_file", Some((Keyword.THY_LOAD, Nil), List("ML")), None))
+ ("ML_file", Some((Keyword.THY_LOAD, Nil), List("ML")), None),
+ ("ML_file_debug", Some((Keyword.THY_LOAD, Nil), List("ML")), None),
+ ("ML_file_no_debug", Some((Keyword.THY_LOAD, Nil), List("ML")), None))
private val bootstrap_keywords =
Keyword.Keywords.empty.add_keywords(bootstrap_header)
--- a/src/Pure/Thy/thy_info.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Thy/thy_info.ML Thu Sep 03 15:50:40 2015 +0200
@@ -10,6 +10,7 @@
val get_names: unit -> string list
val lookup_theory: string -> theory option
val get_theory: string -> theory
+ val pure_theory: unit -> theory
val master_directory: string -> Path.T
val remove_thy: string -> unit
val use_theories:
@@ -100,6 +101,8 @@
SOME theory => theory
| _ => error ("Theory loader: undefined entry for theory " ^ quote name));
+fun pure_theory () = get_theory "Pure";
+
val get_imports = Resources.imports_of o get_theory;
@@ -288,7 +291,8 @@
val name = Path.implode (Path.base path);
val node_name = File.full_path dir (Resources.thy_path path);
fun check_entry (Task (node_name', _, _)) =
- if node_name = node_name' then ()
+ if op = (apply2 File.platform_path (node_name, node_name'))
+ then ()
else
error ("Incoherent imports for theory " ^ quote name ^
Position.here require_pos ^ ":\n" ^
--- a/src/Pure/Thy/thy_output.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Thy/thy_output.ML Thu Sep 03 15:50:40 2015 +0200
@@ -24,6 +24,7 @@
val boolean: string -> bool
val integer: string -> int
val eval_antiq: Toplevel.state -> Antiquote.antiq -> string
+ val report_text: Input.source -> unit
val check_text: Input.source -> Toplevel.state -> unit
val present_thy: theory -> (Toplevel.transition * Toplevel.state) list -> Token.T list -> Buffer.T
val pretty_text: Proof.context -> string -> Pretty.T
@@ -194,8 +195,11 @@
val _ = Position.reports (maps words ants);
in implode (map expand ants) end;
+fun report_text source =
+ Position.report (Input.pos_of source) (Markup.language_document (Input.is_delimited source));
+
fun check_text source state =
- (Position.report (Input.pos_of source) (Markup.language_document (Input.is_delimited source));
+ (report_text source;
if Toplevel.is_skipped_proof state then ()
else ignore (eval_antiquote state source));
--- a/src/Pure/Tools/build.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/build.scala Thu Sep 03 15:50:40 2015 +0200
@@ -586,14 +586,14 @@
pair(list(pair(Path.encode, Path.encode)), pair(string, pair(string,
pair(string, pair(string, list(pair(Options.encode, list(Path.encode)))))))))))))(
(command_timings, (do_output, (info.options, (verbose, (browser_info,
- (info.document_files, (Isabelle_System.posix_path(graph_file), (parent,
+ (info.document_files, (File.standard_path(graph_file), (parent,
(info.chapter, (name, theories)))))))))))
}))
private val env =
- Map("INPUT" -> parent, "TARGET" -> name, "OUTPUT" -> Isabelle_System.standard_path(output),
+ Map("INPUT" -> parent, "TARGET" -> name, "OUTPUT" -> File.standard_path(output),
(if (is_pure(name)) "ISABELLE_PROCESS_OPTIONS" else "ARGS_FILE") ->
- Isabelle_System.posix_path(args_file))
+ File.standard_path(args_file))
private val script =
if (is_pure(name)) {
@@ -653,7 +653,7 @@
else None
}
- def join: Isabelle_System.Bash_Result =
+ def join: Bash.Result =
{
val res = result.join
--- a/src/Pure/Tools/build_doc.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/build_doc.scala Thu Sep 03 15:50:40 2015 +0200
@@ -50,7 +50,7 @@
Build.build(
options.bool.update("browser_info", false).
string.update("document", "pdf").
- string.update("document_output", Isabelle_System.posix_path(output)),
+ string.update("document_output", File.standard_path(output)),
progress, clean_build = true, max_jobs = max_jobs, system_mode = system_mode,
sessions = sessions)
if (rc2 == 0) {
--- a/src/Pure/Tools/check_source.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/check_source.scala Thu Sep 03 15:50:40 2015 +0200
@@ -41,7 +41,7 @@
def check_hg(root: Path)
{
Output.writeln("Checking " + root + " ...")
- Isabelle_System.hg("--repository " + Isabelle_System.shell_path(root) + " root").check_error
+ Isabelle_System.hg("--repository " + File.shell_path(root) + " root").check_error
for {
file <- Isabelle_System.hg("manifest", root).check_error.out_lines
if file.endsWith(".thy") || file.endsWith(".ML")
--- a/src/Pure/Tools/debugger.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/debugger.ML Thu Sep 03 15:50:40 2015 +0200
@@ -66,6 +66,18 @@
in SOME (msg, SOME input') end));
+(* global break *)
+
+local
+ val break = Synchronized.var "Debugger.break" false;
+in
+
+fun is_break () = Synchronized.value break;
+fun set_break b = Synchronized.change break (K b);
+
+end;
+
+
(** thread state **)
@@ -112,10 +124,11 @@
val Stepping (stepping, depth) = get_stepping ();
in stepping andalso (depth < 0 orelse length stack <= depth) end;
-fun continue_stepping () = put_stepping (false, ~1);
-fun step_stepping () = put_stepping (true, ~1);
-fun step_over_stepping () = put_stepping (true, length (get_debugging ()));
-fun step_out_stepping () = put_stepping (true, length (get_debugging ()) - 1);
+fun continue () = put_stepping (false, ~1);
+fun step () = put_stepping (true, ~1);
+fun step_over () = put_stepping (true, length (get_debugging ()));
+fun step_out () = put_stepping (true, length (get_debugging ()) - 1);
+
(** eval ML **)
@@ -131,23 +144,25 @@
fun evaluate {SML, verbose} =
ML_Context.eval
{SML = SML, exchange = false, redirect = false, verbose = verbose,
- writeln = writeln_message, warning = warning_message}
+ debug = SOME false, writeln = writeln_message, warning = warning_message}
Position.none;
+fun eval_setup thread_name index SML context =
+ context
+ |> Context_Position.set_visible_generic false
+ |> ML_Env.add_name_space {SML = SML}
+ (ML_Debugger.debug_name_space (the_debug_state thread_name index));
+
fun eval_context thread_name index SML toks =
let
+ val context = ML_Context.the_generic_context ();
val context1 =
- ML_Context.the_generic_context ()
- |> Context_Position.set_visible_generic false
- |> Config.put_generic ML_Options.debugger false
- |> ML_Env.add_name_space {SML = SML}
- (ML_Debugger.debug_name_space (the_debug_state thread_name index));
- val context2 =
if SML orelse forall (fn Antiquote.Text tok => ML_Lex.is_improper tok | _ => false) toks
- then context1
+ then context
else
let
- val context' = context1
+ val context' = context
+ |> eval_setup thread_name index SML
|> ML_Context.exec (fn () =>
evaluate {SML = SML, verbose = true} (ML_Lex.read "val ML_context = " @ toks));
fun try_exec toks =
@@ -157,7 +172,7 @@
SOME context2 => context2
| NONE => error "Malformed context: expected type theory, Proof.context, Context.generic")
end;
- in context2 end;
+ in context1 |> eval_setup thread_name index SML end;
in
@@ -169,7 +184,8 @@
fun print_vals thread_name index SML txt =
let
- val context = eval_context thread_name index SML (ML_Lex.read_source SML (Input.string txt));
+ val toks = ML_Lex.read_source SML (Input.string txt)
+ val context = eval_context thread_name index SML toks;
val space = ML_Debugger.debug_name_space (the_debug_state thread_name index);
fun print x =
@@ -199,11 +215,11 @@
fun debugger_command thread_name =
(case get_input thread_name of
- [] => (continue_stepping (); false)
- | ["continue"] => (continue_stepping (); false)
- | ["step"] => (step_stepping (); false)
- | ["step_over"] => (step_over_stepping (); false)
- | ["step_out"] => (step_out_stepping (); false)
+ [] => (continue (); false)
+ | ["continue"] => (continue (); false)
+ | ["step"] => (step (); false)
+ | ["step_over"] => (step_over (); false)
+ | ["step_out"] => (step_out (); false)
| ["eval", index, SML, txt1, txt2] =>
(error_wrapper (fn () =>
eval thread_name (Markup.parse_int index) (Markup.parse_bool SML) txt1 txt2); true)
@@ -237,7 +253,8 @@
(init_input ();
ML_Debugger.on_breakpoint
(SOME (fn (_, break) =>
- if not (is_debugging ()) andalso (! break orelse is_stepping ()) then
+ if not (is_debugging ()) andalso (! break orelse is_break () orelse is_stepping ())
+ then
(case Simple_Thread.get_name () of
SOME thread_name => debugger_loop thread_name
| NONE => ())
@@ -248,6 +265,10 @@
(fn [] => (ML_Debugger.on_breakpoint NONE; exit_input ()));
val _ =
+ Isabelle_Process.protocol_command "Debugger.break"
+ (fn [b] => set_break (Markup.parse_bool b));
+
+val _ =
Isabelle_Process.protocol_command "Debugger.breakpoint"
(fn [node_name, id0, breakpoint0, breakpoint_state0] =>
let
--- a/src/Pure/Tools/debugger.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/debugger.scala Thu Sep 03 15:50:40 2015 +0200
@@ -7,25 +7,64 @@
package isabelle
+import scala.collection.immutable.SortedMap
+
+
object Debugger
{
- /* global state */
+ /* context */
sealed case class Debug_State(
pos: Position.T,
function: String)
+ sealed case class Context(thread_name: String, debug_states: List[Debug_State], index: Int = 0)
+ {
+ def size: Int = debug_states.length + 1
+ def reset: Context = copy(index = 0)
+ def select(i: Int) = copy(index = i + 1)
+
+ def thread_state: Option[Debug_State] = debug_states.headOption
+
+ def stack_state: Option[Debug_State] =
+ if (1 <= index && index <= debug_states.length)
+ Some(debug_states(index - 1))
+ else None
+
+ def debug_index: Option[Int] =
+ if (stack_state.isDefined) Some(index - 1)
+ else if (debug_states.nonEmpty) Some(0)
+ else None
+
+ def debug_state: Option[Debug_State] = stack_state orElse thread_state
+ def debug_position: Option[Position.T] = debug_state.map(_.pos)
+
+ override def toString: String =
+ stack_state match {
+ case None => thread_name
+ case Some(d) => d.function
+ }
+ }
+
+
+ /* global state */
+
+ type Threads = SortedMap[String, List[Debug_State]]
+
sealed case class State(
- session: Session = new Session(Resources.empty),
- active: Int = 0,
- active_breakpoints: Set[Long] = Set.empty,
- focus: Option[Position.T] = None, // position of active GUI component
- threads: Map[String, List[Debug_State]] = Map.empty, // thread name ~> stack of debug states
+ session: Session = new Session(Resources.empty), // implicit session
+ active: Int = 0, // active views
+ break: Boolean = false, // break at next possible breakpoint
+ active_breakpoints: Set[Long] = Set.empty, // explicit breakpoint state
+ threads: Threads = SortedMap.empty, // thread name ~> stack of debug states
+ focus: Map[String, Context] = Map.empty, // thread name ~> focus
output: Map[String, Command.Results] = Map.empty) // thread name ~> output messages
{
def set_session(new_session: Session): State =
copy(session = new_session)
+ def set_break(b: Boolean): State = copy(break = b)
+
def is_active: Boolean = active > 0 && session.is_ready
def inc_active: State = copy(active = active + 1)
def dec_active: State = copy(active = active - 1)
@@ -38,15 +77,24 @@
(active_breakpoints1(breakpoint), copy(active_breakpoints = active_breakpoints1))
}
- def set_focus(new_focus: Option[Position.T]): State =
- copy(focus = new_focus)
-
def get_thread(thread_name: String): List[Debug_State] =
threads.getOrElse(thread_name, Nil)
def update_thread(thread_name: String, debug_states: List[Debug_State]): State =
- if (debug_states.isEmpty) copy(threads = threads - thread_name)
- else copy(threads = threads + (thread_name -> debug_states))
+ {
+ val threads1 =
+ if (debug_states.nonEmpty) threads + (thread_name -> debug_states)
+ else threads - thread_name
+ val focus1 =
+ focus.get(thread_name) match {
+ case Some(c) if debug_states.nonEmpty =>
+ focus + (thread_name -> Context(thread_name, debug_states))
+ case _ => focus - thread_name
+ }
+ copy(threads = threads1, focus = focus1)
+ }
+
+ def set_focus(c: Context): State = copy(focus = focus + (c.thread_name -> c))
def get_output(thread_name: String): Command.Results =
output.getOrElse(thread_name, Command.Results.empty)
@@ -154,6 +202,17 @@
state1
})
+ def is_break(): Boolean = global_state.value.break
+ def set_break(b: Boolean)
+ {
+ global_state.change(state => {
+ val state1 = state.set_break(b)
+ state1.session.protocol_command("Debugger.break", b.toString)
+ state1
+ })
+ delay_update.invoke()
+ }
+
def active_breakpoint_state(breakpoint: Long): Option[Boolean] =
{
val state = global_state.value
@@ -178,12 +237,28 @@
})
}
- def focus(new_focus: Option[Position.T]): Boolean =
- global_state.change_result(state => (state.focus != new_focus, state.set_focus(new_focus)))
+ def status(focus: Option[Context]): (Threads, List[XML.Tree]) =
+ {
+ val state = global_state.value
+ val output =
+ focus match {
+ case None => Nil
+ case Some(c) =>
+ (for {
+ (thread_name, results) <- state.output
+ if thread_name == c.thread_name
+ (_, tree) <- results.iterator
+ } yield tree).toList
+ }
+ (state.threads, output)
+ }
- def threads(): Map[String, List[Debug_State]] = global_state.value.threads
-
- def output(): Map[String, Command.Results] = global_state.value.output
+ def focus(): List[Context] = global_state.value.focus.toList.map(_._2)
+ def set_focus(c: Context)
+ {
+ global_state.change(_.set_focus(c))
+ delay_update.invoke()
+ }
def input(thread_name: String, msg: String*): Unit =
global_state.value.session.protocol_command("Debugger.input", (thread_name :: msg.toList):_*)
@@ -199,21 +274,24 @@
delay_update.invoke()
}
- def eval(thread_name: String, index: Int, SML: Boolean, context: String, expression: String)
+ def eval(c: Context, SML: Boolean, context: String, expression: String)
{
global_state.change(state => {
- input(thread_name, "eval",
- index.toString, SML.toString, Symbol.encode(context), Symbol.encode(expression))
- state.clear_output(thread_name)
+ input(c.thread_name, "eval", c.debug_index.getOrElse(0).toString,
+ SML.toString, Symbol.encode(context), Symbol.encode(expression))
+ state.clear_output(c.thread_name)
})
delay_update.invoke()
}
- def print_vals(thread_name: String, index: Int, SML: Boolean, context: String)
+ def print_vals(c: Context, SML: Boolean, context: String)
{
+ require(c.debug_index.isDefined)
+
global_state.change(state => {
- input(thread_name, "print_vals", index.toString, SML.toString, Symbol.encode(context))
- state.clear_output(thread_name)
+ input(c.thread_name, "print_vals", c.debug_index.getOrElse(0).toString,
+ SML.toString, Symbol.encode(context))
+ state.clear_output(c.thread_name)
})
delay_update.invoke()
}
--- a/src/Pure/Tools/find_theorems.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/find_theorems.ML Thu Sep 03 15:50:40 2015 +0200
@@ -380,12 +380,15 @@
fun all_facts_of ctxt =
let
+ val thy = Proof_Context.theory_of ctxt;
+ val transfer = Global_Theory.transfer_theories thy;
val local_facts = Proof_Context.facts_of ctxt;
- val global_facts = Global_Theory.facts_of (Proof_Context.theory_of ctxt);
+ val global_facts = Global_Theory.facts_of thy;
in
- maps Facts.selections
- (Facts.dest_static false [global_facts] local_facts @
- Facts.dest_static false [] global_facts)
+ (Facts.dest_static false [global_facts] local_facts @
+ Facts.dest_static false [] global_facts)
+ |> maps Facts.selections
+ |> map (apsnd transfer)
end;
fun filter_theorems ctxt theorems query =
--- a/src/Pure/Tools/main.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/main.scala Thu Sep 03 15:50:40 2015 +0200
@@ -50,7 +50,9 @@
dirs = dirs, system_mode = system_mode, sessions = List(session)) == 0)
system_dialog.return_code(0)
else {
- system_dialog.title("Isabelle build (" + Isabelle_System.getenv("ML_IDENTIFIER") + ")")
+ system_dialog.title("Isabelle build (" +
+ Isabelle_System.getenv("ML_IDENTIFIER") + " / " +
+ "jdk-" + Platform.jvm_version + "_" + Platform.jvm_platform + ")")
system_dialog.echo("Build started for Isabelle/" + session + " ...")
val (out, rc) =
@@ -102,11 +104,11 @@
Isabelle_System.getenv_strict("JEDIT_OPTIONS").split(" +")
val jedit_settings =
- Array("-settings=" + Isabelle_System.platform_path(Path.explode("$JEDIT_SETTINGS")))
+ Array("-settings=" + File.platform_path(Path.explode("$JEDIT_SETTINGS")))
val more_args =
if (args.isEmpty)
- Array(Isabelle_System.platform_path(Path.explode("$USER_HOME/Scratch.thy")))
+ Array(File.platform_path(Path.explode("$USER_HOME/Scratch.thy")))
else args
@@ -114,11 +116,8 @@
update_environment()
- System.setProperty("jedit.home",
- Isabelle_System.platform_path(Path.explode("$JEDIT_HOME/dist")))
-
- System.setProperty("scala.home",
- Isabelle_System.platform_path(Path.explode("$SCALA_HOME")))
+ System.setProperty("jedit.home", File.platform_path(Path.explode("$JEDIT_HOME/dist")))
+ System.setProperty("scala.home", File.platform_path(Path.explode("$SCALA_HOME")))
val jedit =
Class.forName("org.gjt.sp.jedit.jEdit", true, ClassLoader.getSystemClassLoader)
@@ -228,23 +227,11 @@
{
val isabelle_home = Isabelle_System.getenv("ISABELLE_HOME")
val isabelle_home_user = Isabelle_System.getenv("ISABELLE_HOME_USER")
- val upd =
- if (Platform.is_windows)
- List(
- "ISABELLE_HOME" -> Isabelle_System.jvm_path(isabelle_home),
- "ISABELLE_HOME_USER" -> Isabelle_System.jvm_path(isabelle_home_user),
- "INI_DIR" -> "")
- else
- List(
- "ISABELLE_HOME" -> isabelle_home,
- "ISABELLE_HOME_USER" -> isabelle_home_user)
(env0: Any) => {
val env = env0.asInstanceOf[java.util.Map[String, String]]
- upd.foreach {
- case (x, "") => env.remove(x)
- case (x, y) => env.put(x, y)
- }
+ env.put("ISABELLE_HOME", File.platform_path(isabelle_home))
+ env.put("ISABELLE_HOME_USER", File.platform_path(isabelle_home_user))
}
}
--- a/src/Pure/Tools/named_theorems.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/named_theorems.ML Thu Sep 03 15:50:40 2015 +0200
@@ -50,10 +50,12 @@
fun member ctxt = Item_Net.member o the_entry (Context.Proof ctxt);
-fun content context = rev o Item_Net.content o the_entry context;
+fun content context =
+ rev o map (Thm.transfer (Context.theory_of context)) o Item_Net.content o the_entry context;
+
val get = content o Context.Proof;
-fun add_thm name = map_entry name o Item_Net.update;
+fun add_thm name th = map_entry name (Item_Net.update (Thm.trim_context th));
fun del_thm name = map_entry name o Item_Net.remove;
val add = Thm.declaration_attribute o add_thm;
--- a/src/Pure/Tools/thy_deps.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/Tools/thy_deps.ML Thu Sep 03 15:50:40 2015 +0200
@@ -22,7 +22,7 @@
| gen_thy_deps prep_thy ctxt bounds =
let
val (upper, lower) = apply2 ((Option.map o map) (prep_thy ctxt)) bounds;
- val rel = Theory.subthy o swap;
+ val rel = Context.subthy o swap;
val pred =
(case upper of
SOME Bs => (fn thy => exists (fn B => rel (thy, B)) Bs)
@@ -38,7 +38,7 @@
val thy_deps =
gen_thy_deps (fn ctxt => fn thy =>
let val thy0 = Proof_Context.theory_of ctxt
- in if Theory.subthy (thy, thy0) then thy else raise THEORY ("Bad theory", [thy, thy0]) end);
+ in if Context.subthy (thy, thy0) then thy else raise THEORY ("Bad theory", [thy, thy0]) end);
val thy_deps_cmd = Graph_Display.display_graph oo gen_thy_deps Theory.check;
--- a/src/Pure/build Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/build Thu Sep 03 15:50:40 2015 +0200
@@ -61,11 +61,11 @@
if [ "$TARGET" = RAW ]; then
if [ -z "$OUTPUT" ]; then
"$ISABELLE_PROCESS" \
- -e "use\"$COMPAT\" handle _ => Posix.Process.exit 0w1;" \
+ -e "use \"$COMPAT\" handle _ => OS.Process.exit OS.Process.failure;" \
-q RAW_ML_SYSTEM
else
"$ISABELLE_PROCESS" \
- -e "use\"$COMPAT\" handle _ => Posix.Process.exit 0w1;" \
+ -e "use \"$COMPAT\" handle _ => OS.Process.exit OS.Process.failure;" \
-e "structure Isar = struct fun main () = () end;" \
-e "ml_prompts \"ML> \" \"ML# \";" \
-q -w RAW_ML_SYSTEM "$OUTPUT"
@@ -73,11 +73,11 @@
else
if [ -z "$OUTPUT" ]; then
"$ISABELLE_PROCESS" \
- -e "(use\"$COMPAT\"; use\"ROOT.ML\") handle _ => Posix.Process.exit 0w1;" \
+ -e "(use \"$COMPAT\"; use \"ROOT.ML\") handle _ => OS.Process.exit OS.Process.failure;" \
-q RAW_ML_SYSTEM
else
"$ISABELLE_PROCESS" \
- -e "(use\"$COMPAT\"; use\"ROOT.ML\") handle _ => Posix.Process.exit 0w1;" \
+ -e "(use \"$COMPAT\"; use \"ROOT.ML\") handle _ => OS.Process.exit OS.Process.failure;" \
-e "ml_prompts \"ML> \" \"ML# \";" \
-e "Command_Line.tool0 Session.finish;" \
-e "Options.reset_default ();" \
--- a/src/Pure/build-jars Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/build-jars Thu Sep 03 15:50:40 2015 +0200
@@ -9,6 +9,7 @@
## sources
declare -a SOURCES=(
+ Concurrent/bash.scala
Concurrent/consumer_thread.scala
Concurrent/counter.scala
Concurrent/event_timer.scala
--- a/src/Pure/context.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/context.ML Thu Sep 03 15:50:40 2015 +0200
@@ -28,12 +28,16 @@
sig
include BASIC_CONTEXT
(*theory context*)
+ type theory_id
+ val theory_id: theory -> theory_id
val timing: bool Unsynchronized.ref
type pretty
val parents_of: theory -> theory list
val ancestors_of: theory -> theory list
+ val theory_id_name: theory_id -> string
val theory_name: theory -> string
val PureN: string
+ val display_name: theory_id -> string
val display_names: theory -> string list
val pretty_thy: theory -> Pretty.T
val string_of_thy: theory -> string
@@ -41,13 +45,22 @@
val str_of_thy: theory -> string
val get_theory: theory -> string -> theory
val this_theory: theory -> string -> theory
+ val eq_thy_id: theory_id * theory_id -> bool
val eq_thy: theory * theory -> bool
+ val proper_subthy_id: theory_id * theory_id -> bool
+ val proper_subthy: theory * theory -> bool
+ val subthy_id: theory_id * theory_id -> bool
val subthy: theory * theory -> bool
- val merge: theory * theory -> theory
val finish_thy: theory -> theory
val begin_thy: (theory -> pretty) -> string -> theory list -> theory
(*proof context*)
val raw_transfer: theory -> Proof.context -> Proof.context
+ (*certificate*)
+ datatype certificate = Certificate of theory | Certificate_Id of theory_id
+ val certificate_theory: certificate -> theory
+ val certificate_theory_id: certificate -> theory_id
+ val eq_certificate: certificate * certificate -> bool
+ val join_certificate: certificate * certificate -> certificate
(*generic context*)
datatype generic = Theory of theory | Proof of Proof.context
val cases: (theory -> 'a) -> (Proof.context -> 'a) -> generic -> 'a
@@ -153,36 +166,46 @@
(** datatype theory **)
-datatype theory =
- Theory of
+datatype theory_id =
+ Theory_Id of
(*identity*)
{id: serial, (*identifier*)
ids: Inttab.set} * (*cumulative identifiers -- symbolic body content*)
- (*data*)
- Any.T Datatab.table * (*body content*)
- (*ancestry*)
- {parents: theory list, (*immediate predecessors*)
- ancestors: theory list} * (*all predecessors -- canonical reverse order*)
(*history*)
{name: string, (*official theory name*)
stage: int}; (*counter for anonymous updates*)
+datatype theory =
+ Theory of
+ theory_id *
+ (*ancestry*)
+ {parents: theory list, (*immediate predecessors*)
+ ancestors: theory list} * (*all predecessors -- canonical reverse order*)
+ (*data*)
+ Any.T Datatab.table; (*body content*)
+
exception THEORY of string * theory list;
+fun rep_theory_id (Theory_Id args) = args;
fun rep_theory (Theory args) = args;
-val identity_of = #1 o rep_theory;
-val data_of = #2 o rep_theory;
-val ancestry_of = #3 o rep_theory;
-val history_of = #4 o rep_theory;
+val theory_id = #1 o rep_theory;
+
+val identity_of_id = #1 o rep_theory_id;
+val identity_of = identity_of_id o theory_id;
+val history_of_id = #2 o rep_theory_id;
+val history_of = history_of_id o theory_id;
+val ancestry_of = #2 o rep_theory;
+val data_of = #3 o rep_theory;
fun make_identity id ids = {id = id, ids = ids};
+fun make_history name stage = {name = name, stage = stage};
fun make_ancestry parents ancestors = {parents = parents, ancestors = ancestors};
-fun make_history name stage = {name = name, stage = stage};
+val theory_id_name = #name o history_of_id;
+val theory_name = #name o history_of;
val parents_of = #parents o ancestry_of;
val ancestors_of = #ancestors o ancestry_of;
-val theory_name = #name o history_of;
(* names *)
@@ -190,14 +213,15 @@
val PureN = "Pure";
val finished = ~1;
+fun display_name thy_id =
+ let val {name, stage} = history_of_id thy_id
+ in if stage = finished then name else name ^ ":" ^ string_of_int stage end;
+
fun display_names thy =
let
- val {name, stage} = history_of thy;
- val name' =
- if stage = finished then name
- else name ^ ":" ^ string_of_int stage;
+ val name = display_name (theory_id thy);
val ancestor_names = map theory_name (ancestors_of thy);
- in rev (name' :: ancestor_names) end;
+ in rev (name :: ancestor_names) end;
val pretty_thy = Pretty.str_list "{" "}" o display_names;
val string_of_thy = Pretty.string_of o pretty_thy;
@@ -229,8 +253,8 @@
fun insert_id id ids = Inttab.update (id, ()) ids;
fun merge_ids
- (Theory ({id = id1, ids = ids1, ...}, _, _, _))
- (Theory ({id = id2, ids = ids2, ...}, _, _, _)) =
+ (Theory (Theory_Id ({id = id1, ids = ids1, ...}, _), _, _))
+ (Theory (Theory_Id ({id = id2, ids = ids2, ...}, _), _, _)) =
Inttab.merge (K true) (ids1, ids2)
|> insert_id id1
|> insert_id id2;
@@ -238,12 +262,14 @@
(* equality and inclusion *)
+val eq_thy_id = op = o apply2 (#id o identity_of_id);
val eq_thy = op = o apply2 (#id o identity_of);
-fun proper_subthy (Theory ({id, ...}, _, _, _), Theory ({ids, ...}, _, _, _)) =
- Inttab.defined ids id;
+fun proper_subthy_id (Theory_Id ({id, ...}, _), Theory_Id ({ids, ...}, _)) = Inttab.defined ids id;
+val proper_subthy = proper_subthy_id o apply2 theory_id;
-fun subthy thys = eq_thy thys orelse proper_subthy thys;
+fun subthy_id p = eq_thy_id p orelse proper_subthy_id p;
+val subthy = subthy_id o apply2 theory_id;
(* consistent ancestors *)
@@ -261,40 +287,30 @@
val merge_ancestors = merge eq_thy_consistent;
-(* trivial merge *)
-
-fun merge (thy1, thy2) =
- if eq_thy (thy1, thy2) then thy1
- else if proper_subthy (thy2, thy1) then thy1
- else if proper_subthy (thy1, thy2) then thy2
- else error (cat_lines ["Attempt to perform non-trivial merge of theories:",
- str_of_thy thy1, str_of_thy thy2]);
-
-
(** build theories **)
(* primitives *)
-fun create_thy ids data ancestry history =
- Theory (make_identity (serial ()) ids, data, ancestry, history);
+fun create_thy ids history ancestry data =
+ Theory (Theory_Id (make_identity (serial ()) ids, history), ancestry, data);
val pre_pure_thy =
- create_thy Inttab.empty Datatab.empty (make_ancestry [] []) (make_history PureN 0);
+ create_thy Inttab.empty (make_history PureN 0) (make_ancestry [] []) Datatab.empty;
local
fun change_thy finish f thy =
let
- val Theory ({id, ids}, data, ancestry, {name, stage}) = thy;
- val (data', ancestry') =
+ val Theory (Theory_Id ({id, ids}, {name, stage}), ancestry, data) = thy;
+ val (ancestry', data') =
if stage = finished then
- (extend_data data, make_ancestry [thy] (extend_ancestors thy (ancestors_of thy)))
- else (data, ancestry);
+ (make_ancestry [thy] (extend_ancestors thy (ancestors_of thy)), extend_data data)
+ else (ancestry, data);
val history' = {name = name, stage = if finish then finished else stage + 1};
val ids' = insert_id id ids;
val data'' = f data';
- in create_thy ids' data'' ancestry' history' end;
+ in create_thy ids' history' ancestry' data'' end;
in
@@ -307,17 +323,21 @@
(* named theory nodes *)
+local
+
fun merge_thys pp (thy1, thy2) =
let
val ids = merge_ids thy1 thy2;
- val data = merge_data (pp thy1) (data_of thy1, data_of thy2);
+ val history = make_history "" 0;
val ancestry = make_ancestry [] [];
- val history = make_history "" 0;
- in create_thy ids data ancestry history end;
+ val data = merge_data (pp thy1) (data_of thy1, data_of thy2);
+ in create_thy ids history ancestry data end;
fun maximal_thys thys =
thys |> filter_out (fn thy => exists (fn thy' => proper_subthy (thy, thy')) thys);
+in
+
fun begin_thy pp name imports =
if name = "" then error ("Bad theory name: " ^ quote name)
else
@@ -327,15 +347,17 @@
Library.foldl merge_ancestors ([], map ancestors_of parents)
|> fold extend_ancestors parents;
- val Theory ({ids, ...}, data, _, _) =
+ val Theory (Theory_Id ({ids, ...}, _), _, data) =
(case parents of
[] => error "Missing theory imports"
| [thy] => extend_thy thy
| thy :: thys => Library.foldl (merge_thys pp) (thy, thys));
+ val history = make_history name 0;
val ancestry = make_ancestry parents ancestors;
- val history = make_history name 0;
- in create_thy ids data ancestry history end;
+ in create_thy ids history ancestry data end;
+
+end;
(* theory data *)
@@ -423,6 +445,33 @@
+(*** theory certificate ***)
+
+datatype certificate = Certificate of theory | Certificate_Id of theory_id;
+
+fun certificate_theory (Certificate thy) = thy
+ | certificate_theory (Certificate_Id thy_id) =
+ error ("No content for theory certificate " ^ display_name thy_id);
+
+fun certificate_theory_id (Certificate thy) = theory_id thy
+ | certificate_theory_id (Certificate_Id thy_id) = thy_id;
+
+fun eq_certificate (Certificate thy1, Certificate thy2) = eq_thy (thy1, thy2)
+ | eq_certificate (Certificate_Id thy_id1, Certificate_Id thy_id2) = eq_thy_id (thy_id1, thy_id2)
+ | eq_certificate _ = false;
+
+fun join_certificate (cert1, cert2) =
+ let val (thy_id1, thy_id2) = apply2 certificate_theory_id (cert1, cert2) in
+ if eq_thy_id (thy_id1, thy_id2) then (case cert1 of Certificate _ => cert1 | _ => cert2)
+ else if proper_subthy_id (thy_id2, thy_id1) then cert1
+ else if proper_subthy_id (thy_id1, thy_id2) then cert2
+ else
+ error ("Cannot join unrelated theory certificates " ^
+ display_name thy_id1 ^ " and " ^ display_name thy_id2)
+ end;
+
+
+
(*** generic context ***)
datatype generic = Theory of theory | Proof of Proof.context;
@@ -626,4 +675,3 @@
(*hide private interface*)
structure Context: CONTEXT = Context;
-
--- a/src/Pure/display.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/display.ML Thu Sep 03 15:50:40 2015 +0200
@@ -51,28 +51,31 @@
val show_tags = Config.get ctxt show_tags;
val show_hyps = Config.get ctxt show_hyps;
- val th = Thm.strip_shyps raw_th;
- val {hyps, tpairs, prop, ...} = Thm.rep_thm th;
- val hyps' = if show_hyps then hyps else Thm.undeclared_hyps (Context.Proof ctxt) th;
+ val th = raw_th
+ |> perhaps (try (Thm.transfer (Proof_Context.theory_of ctxt)))
+ |> perhaps (try Thm.strip_shyps);
+
+ val hyps = if show_hyps then Thm.hyps_of th else Thm.undeclared_hyps (Context.Proof ctxt) th;
val extra_shyps = Thm.extra_shyps th;
val tags = Thm.get_tags th;
+ val tpairs = Thm.tpairs_of th;
val q = if quote then Pretty.quote else I;
val prt_term = q o Syntax.pretty_term ctxt;
- val hlen = length extra_shyps + length hyps' + length tpairs;
+ val hlen = length extra_shyps + length hyps + length tpairs;
val hsymbs =
if hlen = 0 then []
else if show_hyps orelse show_hyps' then
[Pretty.brk 2, Pretty.list "[" "]"
- (map (q o Goal_Display.pretty_flexpair ctxt) tpairs @ map prt_term hyps' @
+ (map (q o Goal_Display.pretty_flexpair ctxt) tpairs @ map prt_term hyps @
map (Syntax.pretty_sort ctxt) extra_shyps)]
else [Pretty.brk 2, Pretty.str ("[" ^ replicate_string hlen "." ^ "]")];
val tsymbs =
if null tags orelse not show_tags then []
else [Pretty.brk 1, pretty_tags tags];
- in Pretty.block (prt_term prop :: (hsymbs @ tsymbs)) end;
+ in Pretty.block (prt_term (Thm.prop_of th) :: (hsymbs @ tsymbs)) end;
fun pretty_thm ctxt = pretty_thm_raw ctxt {quote = false, show_hyps = true};
fun pretty_thm_item ctxt th = Pretty.item [pretty_thm ctxt th];
--- a/src/Pure/drule.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/drule.ML Thu Sep 03 15:50:40 2015 +0200
@@ -219,12 +219,16 @@
fun zero_var_indexes_list [] = []
| zero_var_indexes_list ths =
let
- val thy = Theory.merge_list (map Thm.theory_of_thm ths);
val (instT, inst) = Term_Subst.zero_var_indexes_inst (map Thm.full_prop_of ths);
- val insts' =
- (map (apsnd (Thm.global_ctyp_of thy)) instT,
- map (apsnd (Thm.global_cterm_of thy)) inst);
- in map (Thm.adjust_maxidx_thm ~1 o Thm.instantiate insts') ths end;
+
+ val tvars = fold Thm.add_tvars ths [];
+ fun the_tvar v = the (find_first (fn cT => v = dest_TVar (Thm.typ_of cT)) tvars);
+ val instT' = map (fn (v, TVar (b, _)) => (v, Thm.rename_tvar b (the_tvar v))) instT;
+
+ val vars = fold (Thm.add_vars o Thm.instantiate (instT', [])) ths [];
+ fun the_var v = the (find_first (fn ct => v = dest_Var (Thm.term_of ct)) vars);
+ val inst' = map (fn (v, Var (b, _)) => (v, Thm.var (b, Thm.ctyp_of_cterm (the_var v)))) inst;
+ in map (Thm.adjust_maxidx_thm ~1 o Thm.instantiate (instT', inst')) ths end;
val zero_var_indexes = singleton zero_var_indexes_list;
@@ -233,8 +237,7 @@
Frees, or outer quantifiers; all generality expressed by Vars of index 0.**)
(*Discharge all hypotheses.*)
-fun implies_intr_hyps th =
- fold Thm.implies_intr (#hyps (Thm.crep_thm th)) th;
+fun implies_intr_hyps th = fold Thm.implies_intr (Thm.chyps_of th) th;
(*Squash a theorem's flexflex constraints provided it can be done uniquely.
This step can lose information.*)
--- a/src/Pure/facts.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/facts.ML Thu Sep 03 15:50:40 2015 +0200
@@ -228,11 +228,12 @@
fun add_static context {strict, index} (b, ths) (Facts {facts, props}) =
let
+ val ths' = map Thm.trim_context ths;
val (name, facts') =
if Binding.is_empty b then ("", facts)
- else Name_Space.define context strict (b, Static ths) facts;
+ else Name_Space.define context strict (b, Static ths') facts;
val props' = props
- |> index ? fold (fn th => Net.insert_term (K false) (Thm.full_prop_of th, th)) ths;
+ |> index ? fold (fn th => Net.insert_term (K false) (Thm.full_prop_of th, th)) ths';
in (name, make_facts facts' props') end;
--- a/src/Pure/global_theory.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/global_theory.ML Thu Sep 03 15:50:40 2015 +0200
@@ -14,6 +14,7 @@
val hide_fact: bool -> string -> theory -> theory
val get_thms: theory -> xstring -> thm list
val get_thm: theory -> xstring -> thm
+ val transfer_theories: theory -> thm -> thm
val all_thms_of: theory -> bool -> (string * thm) list
val map_facts: ('a -> 'b) -> ('c * ('a list * 'd) list) list -> ('c * ('b list * 'd) list) list
val burrow_fact: ('a list -> 'b list) -> ('a list * 'c) list -> ('b list * 'c) list
@@ -77,12 +78,22 @@
fun get_thm thy xname =
Facts.the_single (xname, Position.none) (get_thms thy xname);
+fun transfer_theories thy =
+ let
+ val theories =
+ fold (fn thy' => Symtab.update (Context.theory_name thy', thy'))
+ (Theory.nodes_of thy) Symtab.empty;
+ fun transfer th =
+ Thm.transfer (the_default thy (Symtab.lookup theories (Thm.theory_name_of_thm th))) th;
+ in transfer end;
+
fun all_thms_of thy verbose =
let
+ val transfer = transfer_theories thy;
val facts = facts_of thy;
fun add (name, ths) =
if not verbose andalso Facts.is_concealed facts name then I
- else append (map (`(Thm.get_name_hint)) ths);
+ else append (map (`(Thm.get_name_hint) o transfer) ths);
in Facts.fold_static add facts [] end;
--- a/src/Pure/goal.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/goal.ML Thu Sep 03 15:50:40 2015 +0200
@@ -209,7 +209,7 @@
| SOME st =>
let
val _ =
- Theory.subthy (Thm.theory_of_thm st, thy) orelse
+ Context.subthy_id (Thm.theory_id_of_thm st, Context.theory_id thy) orelse
err "Bad background theory of goal state";
val res =
(finish ctxt' st
--- a/src/Pure/goal_display.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/goal_display.ML Thu Sep 03 15:50:40 2015 +0200
@@ -114,7 +114,7 @@
val pretty_varsT = pretty_list "type variables:" prt_varsT o varsT_of;
- val {prop, tpairs, ...} = Thm.rep_thm state;
+ val prop = Thm.prop_of state;
val (As, B) = Logic.strip_horn prop;
val ngoals = length As;
in
@@ -124,7 +124,7 @@
pretty_subgoals (take goals_limit As) @
[Pretty.str ("A total of " ^ string_of_int ngoals ^ " subgoals...")]
else pretty_subgoals As) @
- pretty_ffpairs tpairs @
+ pretty_ffpairs (Thm.tpairs_of state) @
(if show_consts then pretty_consts prop else []) @
(if show_types then pretty_vars prop else []) @
(if show_sorts0 then pretty_varsT prop else [])
--- a/src/Pure/item_net.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/item_net.ML Thu Sep 03 15:50:40 2015 +0200
@@ -14,6 +14,7 @@
val retrieve: 'a T -> term -> 'a list
val retrieve_matching: 'a T -> term -> 'a list
val member: 'a T -> 'a -> bool
+ val lookup: 'a T -> 'a -> 'a list
val merge: 'a T * 'a T -> 'a T
val remove: 'a -> 'a T -> 'a T
val update: 'a -> 'a T -> 'a T
@@ -50,6 +51,12 @@
[] => Library.member eq content x
| t :: _ => exists (fn (_, y) => eq (x, y)) (Net.unify_term net t));
+fun lookup (Items {eq, index, content, net, ...}) x =
+ (case index x of
+ [] => content
+ | t :: _ => map #2 (Net.unify_term net t))
+ |> filter (fn y => eq (x, y));
+
fun cons x (Items {eq, index, content, next, net}) =
mk_items eq index (x :: content) (next - 1)
(fold (fn t => Net.insert_term (K false) (t, (next, x))) (index x) net);
--- a/src/Pure/library.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/library.ML Thu Sep 03 15:50:40 2015 +0200
@@ -1029,8 +1029,8 @@
(* current directory *)
-val cd = OS.FileSys.chDir;
-val pwd = OS.FileSys.getDir;
+val cd = OS.FileSys.chDir o ml_platform_path;
+val pwd = ml_standard_path o OS.FileSys.getDir;
(* getenv *)
--- a/src/Pure/more_thm.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/more_thm.ML Thu Sep 03 15:50:40 2015 +0200
@@ -20,11 +20,13 @@
include THM
structure Ctermtab: TABLE
structure Thmtab: TABLE
+ val eq_ctyp: ctyp * ctyp -> bool
val aconvc: cterm * cterm -> bool
+ val add_tvars: thm -> ctyp list -> ctyp list
val add_frees: thm -> cterm list -> cterm list
val add_vars: thm -> cterm list -> cterm list
- val all_name: string * cterm -> cterm -> cterm
- val all: cterm -> cterm -> cterm
+ val all_name: Proof.context -> string * cterm -> cterm -> cterm
+ val all: Proof.context -> cterm -> cterm -> cterm
val mk_binop: cterm -> cterm -> cterm -> cterm
val dest_binop: cterm -> cterm * cterm
val dest_implies: cterm -> cterm * cterm
@@ -110,26 +112,25 @@
(** basic operations **)
-(* collecting cterms *)
+(* collecting ctyps and cterms *)
+val eq_ctyp = op = o apply2 Thm.typ_of;
val op aconvc = op aconv o apply2 Thm.term_of;
+val add_tvars = Thm.fold_atomic_ctyps (fn a => is_TVar (Thm.typ_of a) ? insert eq_ctyp a);
val add_frees = Thm.fold_atomic_cterms (fn a => is_Free (Thm.term_of a) ? insert (op aconvc) a);
val add_vars = Thm.fold_atomic_cterms (fn a => is_Var (Thm.term_of a) ? insert (op aconvc) a);
(* cterm constructors and destructors *)
-fun all_name (x, t) A =
+fun all_name ctxt (x, t) A =
let
- val thy = Thm.theory_of_cterm t;
val T = Thm.typ_of_cterm t;
- in
- Thm.apply (Thm.global_cterm_of thy (Const ("Pure.all", (T --> propT) --> propT)))
- (Thm.lambda_name (x, t) A)
- end;
+ val all_const = Thm.cterm_of ctxt (Const ("Pure.all", (T --> propT) --> propT));
+ in Thm.apply all_const (Thm.lambda_name (x, t) A) end;
-fun all t A = all_name ("", t) A;
+fun all ctxt t A = all_name ctxt ("", t) A;
fun mk_binop c a b = Thm.apply (Thm.apply c a) b;
fun dest_binop ct = (Thm.dest_arg1 ct, Thm.dest_arg ct);
@@ -160,21 +161,19 @@
(* thm order: ignores theory context! *)
-fun thm_ord (th1, th2) =
- let
- val {shyps = shyps1, hyps = hyps1, tpairs = tpairs1, prop = prop1, ...} = Thm.rep_thm th1;
- val {shyps = shyps2, hyps = hyps2, tpairs = tpairs2, prop = prop2, ...} = Thm.rep_thm th2;
- in
- (case Term_Ord.fast_term_ord (prop1, prop2) of
- EQUAL =>
- (case list_ord (prod_ord Term_Ord.fast_term_ord Term_Ord.fast_term_ord) (tpairs1, tpairs2) of
- EQUAL =>
- (case list_ord Term_Ord.fast_term_ord (hyps1, hyps2) of
- EQUAL => list_ord Term_Ord.sort_ord (shyps1, shyps2)
- | ord => ord)
- | ord => ord)
- | ord => ord)
- end;
+fun thm_ord ths =
+ (case Term_Ord.fast_term_ord (apply2 Thm.prop_of ths) of
+ EQUAL =>
+ (case
+ list_ord (prod_ord Term_Ord.fast_term_ord Term_Ord.fast_term_ord)
+ (apply2 Thm.tpairs_of ths)
+ of
+ EQUAL =>
+ (case list_ord Term_Ord.fast_term_ord (apply2 Thm.hyps_of ths) of
+ EQUAL => list_ord Term_Ord.sort_ord (apply2 Thm.shyps_of ths)
+ | ord => ord)
+ | ord => ord)
+ | ord => ord);
(* tables and caches *)
@@ -197,11 +196,9 @@
fun eq_thm_strict ths =
eq_thm ths andalso
- let val (rep1, rep2) = apply2 Thm.rep_thm ths in
- Theory.eq_thy (#thy rep1, #thy rep2) andalso
- #maxidx rep1 = #maxidx rep2 andalso
- #tags rep1 = #tags rep2
- end;
+ Context.eq_thy_id (apply2 Thm.theory_id_of_thm ths) andalso
+ op = (apply2 Thm.maxidx_of ths) andalso
+ op = (apply2 Thm.get_tags ths);
(* pattern equivalence *)
@@ -239,15 +236,14 @@
let
val thm = Thm.strip_shyps raw_thm;
fun err msg = raise THM ("plain_prop_of: " ^ msg, 0, [thm]);
- val {hyps, prop, tpairs, ...} = Thm.rep_thm thm;
in
- if not (null hyps) then
+ if not (null (Thm.hyps_of thm)) then
err "theorem may not contain hypotheses"
else if not (null (Thm.extra_shyps thm)) then
err "theorem may not contain sort hypotheses"
- else if not (null tpairs) then
+ else if not (null (Thm.tpairs_of thm)) then
err "theorem may not contain flex-flex pairs"
- else prop
+ else Thm.prop_of thm
end;
@@ -317,26 +313,39 @@
local
-fun forall_elim_vars_aux strip_vars i th =
+fun dest_all ct =
+ (case Thm.term_of ct of
+ Const ("Pure.all", _) $ Abs (a, _, _) =>
+ let val (x, ct') = Thm.dest_abs NONE (Thm.dest_arg ct)
+ in SOME ((a, Thm.ctyp_of_cterm x), ct') end
+ | _ => NONE);
+
+fun dest_all_list ct =
+ (case dest_all ct of
+ NONE => []
+ | SOME (v, ct') => v :: dest_all_list ct');
+
+fun forall_elim_vars_list vars i th =
let
- val thy = Thm.theory_of_thm th;
- val {tpairs, prop, ...} = Thm.rep_thm th;
- val add_used = Term.fold_aterms
- (fn Var ((x, j), _) => if i = j then insert (op =) x else I | _ => I);
- val used = fold (fn (t, u) => add_used t o add_used u) tpairs (add_used prop []);
- val vars = strip_vars prop;
- val cvars = (Name.variant_list used (map #1 vars), vars)
- |> ListPair.map (fn (x, (_, T)) => Thm.global_cterm_of thy (Var ((x, i), T)));
- in fold Thm.forall_elim cvars th end;
+ val used =
+ (Thm.fold_terms o Term.fold_aterms)
+ (fn Var ((x, j), _) => if i = j then insert (op =) x else I | _ => I) th [];
+ val vars' = (Name.variant_list used (map #1 vars), vars)
+ |> ListPair.map (fn (x, (_, T)) => Thm.var ((x, i), T));
+ in fold Thm.forall_elim vars' th end;
in
-val forall_elim_vars = forall_elim_vars_aux Term.strip_all_vars;
+fun forall_elim_vars i th =
+ forall_elim_vars_list (dest_all_list (Thm.cprop_of th)) i th;
fun forall_elim_var i th =
- forall_elim_vars_aux
- (fn Const ("Pure.all", _) $ Abs (a, T, _) => [(a, T)]
- | _ => raise THM ("forall_elim_vars", i, [th])) i th;
+ let
+ val vars =
+ (case dest_all (Thm.cprop_of th) of
+ SOME (v, _) => [v]
+ | NONE => raise THM ("forall_elim_var", i, [th]));
+ in forall_elim_vars_list vars i th end;
end;
@@ -365,8 +374,8 @@
fun forall_intr_frees th =
let
- val {prop, hyps, tpairs, ...} = Thm.rep_thm th;
- val fixed = fold Term.add_frees (Thm.terms_of_tpairs tpairs @ hyps) [];
+ val fixed =
+ fold Term.add_frees (Thm.terms_of_tpairs (Thm.tpairs_of th) @ Thm.hyps_of th) [];
val frees =
Thm.fold_atomic_cterms (fn a =>
(case Thm.term_of a of
@@ -574,8 +583,11 @@
fun merge _ = empty;
);
-fun register_proofs more_thms = Proofs.map (fn thms => fold cons more_thms thms);
-val join_theory_proofs = Thm.join_proofs o rev o Proofs.get;
+fun register_proofs more_thms =
+ Proofs.map (fold (cons o Thm.trim_context) more_thms);
+
+fun join_theory_proofs thy =
+ Thm.join_proofs (map (Thm.transfer thy) (rev (Proofs.get thy)));
open Thm;
@@ -584,4 +596,3 @@
structure Basic_Thm: BASIC_THM = Thm;
open Basic_Thm;
-
--- a/src/Pure/morphism.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/morphism.ML Thu Sep 03 15:50:40 2015 +0200
@@ -35,6 +35,7 @@
val fact_morphism: string -> (thm list -> thm list) -> morphism
val thm_morphism: string -> (thm -> thm) -> morphism
val transfer_morphism: theory -> morphism
+ val trim_context_morphism: morphism
val identity: morphism
val compose: morphism -> morphism -> morphism
val transform: morphism -> (morphism -> 'a) -> morphism -> 'a
@@ -91,6 +92,7 @@
fun fact_morphism a fact = morphism a {binding = [], typ = [], term = [], fact = [fact]};
fun thm_morphism a thm = morphism a {binding = [], typ = [], term = [], fact = [map thm]};
val transfer_morphism = thm_morphism "transfer" o Thm.transfer;
+val trim_context_morphism = thm_morphism "trim_context" Thm.trim_context;
val identity = morphism "" {binding = [], typ = [], term = [], fact = []};
--- a/src/Pure/pure_syn.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/pure_syn.ML Thu Sep 03 15:50:40 2015 +0200
@@ -43,7 +43,7 @@
val _ =
Outer_Syntax.command ("text_raw", @{here}) "raw LaTeX text"
- (Parse.document_source >> K (Toplevel.keep (fn _ => ())));
+ (Parse.document_source >> (fn s => Toplevel.keep (fn _ => Thy_Output.report_text s)));
val _ =
Outer_Syntax.command ("theory", @{here}) "begin theory"
--- a/src/Pure/raw_simplifier.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/raw_simplifier.ML Thu Sep 03 15:50:40 2015 +0200
@@ -27,7 +27,7 @@
val merge_ss: simpset * simpset -> simpset
val dest_ss: simpset ->
{simps: (string * thm) list,
- procs: (string * cterm list) list,
+ procs: (string * term list) list,
congs: (cong_name * thm) list,
weak_congs: cong_name list,
loopers: string list,
@@ -151,6 +151,10 @@
fo: bool, (*use first-order matching*)
perm: bool}; (*the rewrite rule is permutative*)
+fun trim_context_rrule ({thm, name, lhs, elhs, extra, fo, perm}: rrule) =
+ {thm = Thm.trim_context thm, name = name, lhs = lhs, elhs = Thm.trim_context_cterm elhs,
+ extra = extra, fo = fo, perm = perm};
+
(*
Remarks:
- elhs is used for matching,
@@ -218,7 +222,7 @@
datatype proc =
Proc of
{name: string,
- lhs: cterm,
+ lhs: term,
proc: Proof.context -> cterm -> thm option,
id: stamp * thm list};
@@ -470,7 +474,7 @@
ctxt |> map_simpset1 (fn (rules, prems, depth) =>
let
val rrule2 as {elhs, ...} = mk_rrule2 rrule;
- val rules' = Net.insert_term eq_rrule (Thm.term_of elhs, rrule2) rules;
+ val rules' = Net.insert_term eq_rrule (Thm.term_of elhs, trim_context_rrule rrule2) rules;
in (rules', prems, depth) end)
handle Net.INSERT =>
(cond_warning ctxt (fn () => print_thm ctxt "Ignoring duplicate rewrite rule:" ("", thm));
@@ -573,11 +577,15 @@
(* add/del rules explicitly *)
+local
+
fun comb_simps ctxt comb mk_rrule thms =
let
- val rews = extract_rews ctxt thms;
+ val rews = extract_rews ctxt (map (Thm.transfer (Proof_Context.theory_of ctxt)) thms);
in fold (fold comb o mk_rrule) rews ctxt end;
+in
+
fun ctxt addsimps thms =
comb_simps ctxt insert_rrule (mk_rrule ctxt) thms;
@@ -587,6 +595,8 @@
fun add_simp thm ctxt = ctxt addsimps [thm];
fun del_simp thm ctxt = ctxt delsimps [thm];
+end;
+
(* congs *)
@@ -630,7 +640,7 @@
val a = the (cong_name (head_of lhs)) handle Option.Option =>
raise SIMPLIFIER ("Congruence must start with a constant or free variable", [thm]);
val (xs, weak) = congs;
- val xs' = AList.update (op =) (a, thm) xs;
+ val xs' = AList.update (op =) (a, Thm.trim_context thm) xs;
val weak' = if is_full_cong thm then weak else a :: weak;
in ((xs', weak'), procs, mk_rews, termless, subgoal_tac, loop_tacs, solvers) end);
@@ -659,7 +669,7 @@
datatype simproc =
Simproc of
{name: string,
- lhss: cterm list,
+ lhss: term list,
proc: morphism -> Proof.context -> cterm -> thm option,
id: stamp * thm list};
@@ -668,12 +678,13 @@
fun transform_simproc phi (Simproc {name, lhss, proc, id = (s, ths)}) =
Simproc
{name = name,
- lhss = map (Morphism.cterm phi) lhss,
+ lhss = map (Morphism.term phi) lhss,
proc = Morphism.transform phi proc,
id = (s, Morphism.fact phi ths)};
fun make_simproc {name, lhss, proc, identifier} =
- Simproc {name = name, lhss = lhss, proc = proc, id = (stamp (), 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 =>
@@ -688,10 +699,10 @@
fun add_proc (proc as Proc {name, lhs, ...}) ctxt =
(cond_tracing ctxt (fn () =>
- print_term ctxt ("Adding simplification procedure " ^ quote name ^ " for") (Thm.term_of lhs));
+ print_term ctxt ("Adding simplification procedure " ^ quote name ^ " for") lhs);
ctxt |> map_simpset2
(fn (congs, procs, mk_rews, termless, subgoal_tac, loop_tacs, solvers) =>
- (congs, Net.insert_term eq_proc (Thm.term_of lhs, proc) procs,
+ (congs, Net.insert_term eq_proc (lhs, proc) procs,
mk_rews, termless, subgoal_tac, loop_tacs, solvers))
handle Net.INSERT =>
(cond_warning ctxt (fn () => "Ignoring duplicate simplification procedure " ^ quote name);
@@ -700,7 +711,7 @@
fun del_proc (proc as Proc {name, lhs, ...}) ctxt =
ctxt |> map_simpset2
(fn (congs, procs, mk_rews, termless, subgoal_tac, loop_tacs, solvers) =>
- (congs, Net.delete_term eq_proc (Thm.term_of lhs, proc) procs,
+ (congs, Net.delete_term eq_proc (lhs, proc) procs,
mk_rews, termless, subgoal_tac, loop_tacs, solvers))
handle Net.DELETE =>
(cond_warning ctxt (fn () => "Simplification procedure " ^ quote name ^ " not in simpset");
@@ -917,17 +928,21 @@
fun rewritec (prover, maxt) ctxt t =
let
+ val thy = Proof_Context.theory_of ctxt;
val Simpset ({rules, ...}, {congs, procs, termless, ...}) = simpset_of ctxt;
val eta_thm = Thm.eta_conversion t;
val eta_t' = Thm.rhs_of eta_thm;
val eta_t = Thm.term_of eta_t';
fun rew rrule =
let
- val {thm, name, lhs, elhs, extra, fo, perm} = rrule
+ val {thm = thm0, name, lhs, elhs = elhs0, extra, fo, perm} = rrule;
+ val thm = Thm.transfer thy thm0;
+ val elhs = Thm.transfer_cterm thy elhs0;
val prop = Thm.prop_of thm;
val (rthm, elhs') =
if maxt = ~1 orelse not extra then (thm, elhs)
else (Thm.incr_indexes (maxt + 1) thm, Thm.incr_indexes_cterm (maxt + 1) elhs);
+
val insts =
if fo then Thm.first_order_match (elhs', eta_t')
else Thm.match (elhs', eta_t');
@@ -992,7 +1007,7 @@
fun proc_rews [] = NONE
| proc_rews (Proc {name, proc, lhs, ...} :: ps) =
- if Pattern.matches (Proof_Context.theory_of ctxt) (Thm.term_of lhs, Thm.term_of t) then
+ if Pattern.matches (Proof_Context.theory_of ctxt) (lhs, Thm.term_of t) then
(cond_tracing' ctxt simp_debug (fn () =>
print_term ctxt ("Trying procedure " ^ quote name ^ " on:") eta_t);
(case proc ctxt eta_t' of
@@ -1134,7 +1149,7 @@
(case cong_name h of
SOME a =>
(case AList.lookup (op =) (fst congs) a of
- NONE => appc ()
+ NONE => appc ()
| SOME cong =>
(*post processing: some partial applications h t1 ... tj, j <= length ts,
may be a redex. Example: map (%x. x) = (%xs. xs) wrt map_cong*)
--- a/src/Pure/search.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/search.ML Thu Sep 03 15:50:40 2015 +0200
@@ -1,5 +1,6 @@
(* Title: Pure/search.ML
- Author: Lawrence C Paulson and Norbert Voelker
+ Author: Lawrence C Paulson
+ Author: Norbert Voelker, FernUniversitaet Hagen
Search tacticals.
*)
@@ -41,18 +42,17 @@
(*Searches until "satp" reports proof tree as satisfied.
Suppresses duplicate solutions to minimize search space.*)
fun DEPTH_FIRST satp tac =
- let val tac = tracify trace_DEPTH_FIRST tac
- fun depth used [] = NONE
- | depth used (q::qs) =
- case Seq.pull q of
- NONE => depth used qs
- | SOME(st,stq) =>
- if satp st andalso not (member Thm.eq_thm used st)
- then SOME(st, Seq.make
- (fn()=> depth (st::used) (stq::qs)))
- else depth used (tac st :: stq :: qs)
- in traced_tac (fn st => depth [] [Seq.single st]) end;
-
+ let
+ val tac = tracify trace_DEPTH_FIRST tac
+ fun depth used [] = NONE
+ | depth used (q :: qs) =
+ (case Seq.pull q of
+ NONE => depth used qs
+ | SOME (st, stq) =>
+ if satp st andalso not (member Thm.eq_thm used st) then
+ SOME (st, Seq.make (fn() => depth (st :: used) (stq :: qs)))
+ else depth used (tac st :: stq :: qs));
+ in traced_tac (fn st => depth [] [Seq.single st]) end;
(*Predicate: Does the rule have fewer than n premises?*)
@@ -86,8 +86,8 @@
(**** Iterative deepening with pruning ****)
fun has_vars (Var _) = true
- | has_vars (Abs (_,_,t)) = has_vars t
- | has_vars (f$t) = has_vars f orelse has_vars t
+ | has_vars (Abs (_, _, t)) = has_vars t
+ | has_vars (f $ t) = has_vars f orelse has_vars t
| has_vars _ = false;
(*Counting of primitive inferences is APPROXIMATE, as the step tactic
@@ -95,21 +95,21 @@
(*Pruning of rigid ancestor to prevent backtracking*)
fun prune (new as (k', np':int, rgd', stq), qs) =
- let fun prune_aux (qs, []) = new::qs
- | prune_aux (qs, (k,np,rgd,q)::rqs) =
- if np'+1 = np andalso rgd then
- (if !trace_DEPTH_FIRST then
- tracing ("Pruning " ^
- string_of_int (1+length rqs) ^ " levels")
- else ();
- (*Use OLD k: zero-cost solution; see Stickel, p 365*)
- (k, np', rgd', stq) :: qs)
- else prune_aux ((k,np,rgd,q)::qs, rqs)
- fun take ([], rqs) = ([], rqs)
- | take (arg as ((k,np,rgd,stq)::qs, rqs)) =
- if np' < np then take (qs, (k,np,rgd,stq)::rqs)
- else arg
- in prune_aux (take (qs, [])) end;
+ let
+ fun prune_aux (qs, []) = new :: qs
+ | prune_aux (qs, (k, np, rgd, q) :: rqs) =
+ if np' + 1 = np andalso rgd then
+ (if !trace_DEPTH_FIRST then
+ tracing ("Pruning " ^
+ string_of_int (1+length rqs) ^ " levels")
+ else ();
+ (*Use OLD k: zero-cost solution; see Stickel, p 365*)
+ (k, np', rgd', stq) :: qs)
+ else prune_aux ((k, np, rgd, q) :: qs, rqs)
+ fun take ([], rqs) = ([], rqs)
+ | take (arg as ((k, np, rgd, stq) :: qs, rqs)) =
+ if np' < np then take (qs, (k, np, rgd, stq) :: rqs) else arg;
+ in prune_aux (take (qs, [])) end;
(*Depth-first iterative deepening search for a state that satisfies satp
@@ -118,54 +118,51 @@
to suppress solutions arising from earlier searches, as the accumulated cost
(k) can be wrong.*)
fun THEN_ITER_DEEPEN lim tac0 satp tac1 = traced_tac (fn st =>
- let val countr = Unsynchronized.ref 0
- and tf = tracify trace_DEPTH_FIRST (tac1 1)
- and qs0 = tac0 st
+ let
+ val countr = Unsynchronized.ref 0
+ and tf = tracify trace_DEPTH_FIRST (tac1 1)
+ and qs0 = tac0 st
(*bnd = depth bound; inc = estimate of increment required next*)
- fun depth (bnd,inc) [] =
+ fun depth (bnd, inc) [] =
if bnd > lim then
- (if !trace_DEPTH_FIRST then
- tracing (string_of_int (!countr) ^
- " inferences so far. Giving up at " ^
- string_of_int bnd)
- else ();
- NONE)
+ (if !trace_DEPTH_FIRST then
+ tracing (string_of_int (! countr) ^
+ " inferences so far. Giving up at " ^ string_of_int bnd)
+ else ();
+ NONE)
else
- (if !trace_DEPTH_FIRST then
- tracing (string_of_int (!countr) ^
- " inferences so far. Searching to depth " ^
- string_of_int bnd)
- else ();
- (*larger increments make it run slower for the hard problems*)
- depth (bnd+inc, 10)) [(0, 1, false, qs0)]
- | depth (bnd,inc) ((k,np,rgd,q)::qs) =
- if k>=bnd then depth (bnd,inc) qs
+ (if !trace_DEPTH_FIRST then
+ tracing (string_of_int (!countr) ^
+ " inferences so far. Searching to depth " ^ string_of_int bnd)
+ else ();
+ (*larger increments make it run slower for the hard problems*)
+ depth (bnd + inc, 10)) [(0, 1, false, qs0)]
+ | depth (bnd, inc) ((k, np, rgd, q) :: qs) =
+ if k >= bnd then depth (bnd, inc) qs
else
- case (Unsynchronized.inc countr;
- if !trace_DEPTH_FIRST then
- tracing (string_of_int np ^ implode (map (fn _ => "*") qs))
- else ();
- Seq.pull q) of
- NONE => depth (bnd,inc) qs
- | SOME(st,stq) =>
- if satp st (*solution!*)
- then SOME(st, Seq.make
- (fn()=> depth (bnd,inc) ((k,np,rgd,stq)::qs)))
-
- else
- let val np' = Thm.nprems_of st
- (*rgd' calculation assumes tactic operates on subgoal 1*)
- val rgd' = not (has_vars (hd (Thm.prems_of st)))
- val k' = k+np'-np+1 (*difference in # of subgoals, +1*)
- in if k'+np' >= bnd
- then depth (bnd, Int.min(inc, k'+np'+1-bnd)) qs
- else if np' < np (*solved a subgoal; prune rigid ancestors*)
- then depth (bnd,inc)
- (prune ((k', np', rgd', tf st), (k,np,rgd,stq) :: qs))
- else depth (bnd,inc) ((k', np', rgd', tf st) ::
- (k,np,rgd,stq) :: qs)
- end
- in depth (0,5) [] end);
+ (case
+ (Unsynchronized.inc countr;
+ if !trace_DEPTH_FIRST then
+ tracing (string_of_int np ^ implode (map (fn _ => "*") qs))
+ else ();
+ Seq.pull q) of
+ NONE => depth (bnd, inc) qs
+ | SOME (st, stq) =>
+ if satp st then (*solution!*)
+ SOME(st, Seq.make (fn() => depth (bnd, inc) ((k, np, rgd, stq) :: qs)))
+ else
+ let
+ val np' = Thm.nprems_of st;
+ (*rgd' calculation assumes tactic operates on subgoal 1*)
+ val rgd' = not (has_vars (hd (Thm.prems_of st)));
+ val k' = k + np' - np + 1; (*difference in # of subgoals, +1*)
+ in
+ if k' + np' >= bnd then depth (bnd, Int.min (inc, k' + np' + 1 - bnd)) qs
+ else if np' < np (*solved a subgoal; prune rigid ancestors*)
+ then depth (bnd, inc) (prune ((k', np', rgd', tf st), (k, np, rgd, stq) :: qs))
+ else depth (bnd, inc) ((k', np', rgd', tf st) :: (k, np, rgd, stq) :: qs)
+ end)
+ in depth (0, 5) [] end);
fun ITER_DEEPEN lim = THEN_ITER_DEEPEN lim all_tac;
@@ -200,8 +197,8 @@
val trace_BEST_FIRST = Unsynchronized.ref false;
(*For creating output sequence*)
-fun some_of_list [] = NONE
- | some_of_list (x::l) = SOME (x, Seq.make (fn () => some_of_list l));
+fun some_of_list [] = NONE
+ | some_of_list (x :: l) = SOME (x, Seq.make (fn () => some_of_list l));
(*Check for and delete duplicate proof states*)
fun delete_all_min prf heap =
@@ -214,23 +211,26 @@
Function sizef estimates size of problem remaining (smaller means better).
tactic tac0 sets up the initial priority queue, while tac1 searches it. *)
fun THEN_BEST_FIRST tac0 (satp, sizef) tac1 =
- let val tac = tracify trace_BEST_FIRST tac1
- fun pairsize th = (sizef th, th);
- fun bfs (news,nprf_heap) =
- (case List.partition satp news of
- ([],nonsats) => next(fold_rev Thm_Heap.insert (map pairsize nonsats) nprf_heap)
- | (sats,_) => some_of_list sats)
- and next nprf_heap =
- if Thm_Heap.is_empty nprf_heap then NONE
- else
- let val (n,prf) = Thm_Heap.min nprf_heap
- in if !trace_BEST_FIRST
- then tracing("state size = " ^ string_of_int n)
- else ();
- bfs (Seq.list_of (tac prf),
- delete_all_min prf (Thm_Heap.delete_min nprf_heap))
- end
- fun btac st = bfs (Seq.list_of (tac0 st), Thm_Heap.empty)
+ let
+ val tac = tracify trace_BEST_FIRST tac1;
+ fun pairsize th = (sizef th, th);
+ fun bfs (news, nprf_heap) =
+ (case List.partition satp news of
+ ([], nonsats) => next (fold_rev Thm_Heap.insert (map pairsize nonsats) nprf_heap)
+ | (sats, _) => some_of_list sats)
+ and next nprf_heap =
+ if Thm_Heap.is_empty nprf_heap then NONE
+ else
+ let
+ val (n, prf) = Thm_Heap.min nprf_heap;
+ val _ =
+ if !trace_BEST_FIRST
+ then tracing("state size = " ^ string_of_int n)
+ else ();
+ in
+ bfs (Seq.list_of (tac prf), delete_all_min prf (Thm_Heap.delete_min nprf_heap))
+ end;
+ fun btac st = bfs (Seq.list_of (tac0 st), Thm_Heap.empty)
in traced_tac btac end;
(*Ordinary best-first search, with no initial tactic*)
@@ -238,59 +238,59 @@
(*Breadth-first search to satisfy satpred (including initial state)
SLOW -- SHOULD NOT USE APPEND!*)
-fun gen_BREADTH_FIRST message satpred (tac:tactic) =
- let val tacf = Seq.list_of o tac;
- fun bfs prfs =
- (case List.partition satpred prfs of
- ([],[]) => []
- | ([],nonsats) =>
- (message("breadth=" ^ string_of_int(length nonsats));
- bfs (maps tacf nonsats))
- | (sats,_) => sats)
- in (fn st => Seq.of_list (bfs [st])) end;
+fun gen_BREADTH_FIRST message satpred (tac: tactic) =
+ let
+ val tacf = Seq.list_of o tac;
+ fun bfs prfs =
+ (case List.partition satpred prfs of
+ ([], []) => []
+ | ([], nonsats) =>
+ (message ("breadth=" ^ string_of_int (length nonsats));
+ bfs (maps tacf nonsats))
+ | (sats, _) => sats);
+ in fn st => Seq.of_list (bfs [st]) end;
val BREADTH_FIRST = gen_BREADTH_FIRST tracing;
val QUIET_BREADTH_FIRST = gen_BREADTH_FIRST (K ());
-(* Author: Norbert Voelker, FernUniversitaet Hagen
- Remarks: Implementation of A*-like proof procedure by modification
- of the existing code for BEST_FIRST and best_tac so that the
- current level of search is taken into account.
+(*
+ Implementation of A*-like proof procedure by modification
+ of the existing code for BEST_FIRST and best_tac so that the
+ current level of search is taken into account.
*)
-(*Insertion into priority queue of states, marked with level *)
-fun insert_with_level (lnth: int*int*thm) [] = [lnth]
- | insert_with_level (l,m,th) ((l',n,th') :: nths) =
- if n<m then (l',n,th') :: insert_with_level (l,m,th) nths
- else if n=m andalso Thm.eq_thm(th,th')
- then (l',n,th')::nths
- else (l,m,th)::(l',n,th')::nths;
+(*Insertion into priority queue of states, marked with level*)
+fun insert_with_level (lnth: int * int * thm) [] = [lnth]
+ | insert_with_level (l, m, th) ((l', n, th') :: nths) =
+ if n < m then (l', n, th') :: insert_with_level (l, m, th) nths
+ else if n = m andalso Thm.eq_thm (th, th') then (l', n, th') :: nths
+ else (l, m, th) :: (l', n, th') :: nths;
(*For creating output sequence*)
-fun some_of_list [] = NONE
- | some_of_list (x::l) = SOME (x, Seq.make (fn () => some_of_list l));
+fun some_of_list [] = NONE
+ | some_of_list (x :: xs) = SOME (x, Seq.make (fn () => some_of_list xs));
val trace_ASTAR = Unsynchronized.ref false;
fun THEN_ASTAR tac0 (satp, costf) tac1 =
- let val tf = tracify trace_ASTAR tac1;
- fun bfs (news,nprfs,level) =
- let fun cost thm = (level, costf level thm, thm)
- in (case List.partition satp news of
- ([],nonsats)
- => next (fold_rev (insert_with_level o cost) nonsats nprfs)
- | (sats,_) => some_of_list sats)
- end and
- next [] = NONE
- | next ((level,n,prf)::nprfs) =
- (if !trace_ASTAR
- then tracing("level = " ^ string_of_int level ^
- " cost = " ^ string_of_int n ^
- " queue length =" ^ string_of_int (length nprfs))
- else ();
- bfs (Seq.list_of (tf prf), nprfs,level+1))
- fun tf st = bfs (Seq.list_of (tac0 st), [], 0)
+ let
+ val tf = tracify trace_ASTAR tac1;
+ fun bfs (news, nprfs, level) =
+ let fun cost thm = (level, costf level thm, thm) in
+ (case List.partition satp news of
+ ([], nonsats) => next (fold_rev (insert_with_level o cost) nonsats nprfs)
+ | (sats, _) => some_of_list sats)
+ end
+ and next [] = NONE
+ | next ((level, n, prf) :: nprfs) =
+ (if !trace_ASTAR then
+ tracing ("level = " ^ string_of_int level ^
+ " cost = " ^ string_of_int n ^
+ " queue length =" ^ string_of_int (length nprfs))
+ else ();
+ bfs (Seq.list_of (tf prf), nprfs, level + 1))
+ fun tf st = bfs (Seq.list_of (tac0 st), [], 0);
in traced_tac tf end;
(*Ordinary ASTAR, with no initial tactic*)
--- a/src/Pure/simplifier.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/simplifier.ML Thu Sep 03 15:50:40 2015 +0200
@@ -167,7 +167,7 @@
fun pretty_simproc (name, lhss) =
Pretty.block
(Pretty.mark_str name :: Pretty.str ":" :: Pretty.fbrk ::
- Pretty.fbreaks (map (Pretty.item o single o pretty_term o Thm.term_of) lhss));
+ Pretty.fbreaks (map (Pretty.item o single o pretty_term) lhss));
fun pretty_cong_name (const, name) =
pretty_term ((if const then Const else Free) (name, dummyT));
--- a/src/Pure/tactical.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/tactical.ML Thu Sep 03 15:50:40 2015 +0200
@@ -88,9 +88,9 @@
Like in LCF, ORELSE commits to either tac1 or tac2 immediately.
Does not backtrack to tac2 if tac1 was initially chosen. *)
fun (tac1 ORELSE tac2) st =
- case Seq.pull(tac1 st) of
- NONE => tac2 st
- | sequencecell => Seq.make(fn()=> sequencecell);
+ (case Seq.pull (tac1 st) of
+ NONE => tac2 st
+ | some => Seq.make (fn () => some));
(*The tactical APPEND combines the results of two tactics.
@@ -104,9 +104,9 @@
tac1 THEN tac2 = tac1 THEN_ELSE (tac2, no_tac)
*)
fun (tac THEN_ELSE (tac1, tac2)) st =
- case Seq.pull(tac st) of
- NONE => tac2 st (*failed; try tactic 2*)
- | seqcell => Seq.maps tac1 (Seq.make(fn()=> seqcell)); (*succeeded; use tactic 1*)
+ (case Seq.pull (tac st) of
+ NONE => tac2 st (*failed; try tactic 2*)
+ | some => Seq.maps tac1 (Seq.make (fn () => some))); (*succeeded; use tactic 1*)
(*Versions for combining tactic-valued functions, as in
@@ -127,35 +127,35 @@
(*Conditional tactical: testfun controls which tactic to use next.
Beware: due to eager evaluation, both thentac and elsetac are evaluated.*)
-fun COND testfun thenf elsef = (fn prf =>
- if testfun prf then thenf prf else elsef prf);
+fun COND testfun thenf elsef =
+ (fn st => if testfun st then thenf st else elsef st);
(*Do the tactic or else do nothing*)
fun TRY tac = tac ORELSE all_tac;
+
(*** List-oriented tactics ***)
local
(*This version of EVERY avoids backtracking over repeated states*)
fun EVY (trail, []) st =
- Seq.make (fn()=> SOME(st,
- Seq.make (fn()=> Seq.pull (evyBack trail))))
- | EVY (trail, tac::tacs) st =
- case Seq.pull(tac st) of
- NONE => evyBack trail (*failed: backtrack*)
- | SOME(st',q) => EVY ((st',q,tacs)::trail, tacs) st'
+ Seq.make (fn () => SOME (st, Seq.make (fn () => Seq.pull (evyBack trail))))
+ | EVY (trail, tac :: tacs) st =
+ (case Seq.pull (tac st) of
+ NONE => evyBack trail (*failed: backtrack*)
+ | SOME (st', q) => EVY ((st', q, tacs) :: trail, tacs) st')
and evyBack [] = Seq.empty (*no alternatives*)
- | evyBack ((st',q,tacs)::trail) =
- case Seq.pull q of
- NONE => evyBack trail
- | SOME(st,q') => if Thm.eq_thm (st',st)
- then evyBack ((st',q',tacs)::trail)
- else EVY ((st,q',tacs)::trail, tacs) st
+ | evyBack ((st', q, tacs) :: trail) =
+ (case Seq.pull q of
+ NONE => evyBack trail
+ | SOME (st, q') =>
+ if Thm.eq_thm (st', st)
+ then evyBack ((st', q', tacs) :: trail)
+ else EVY ((st, q', tacs) :: trail, tacs) st);
in
-
-(* EVERY [tac1,...,tacn] equals tac1 THEN ... THEN tacn *)
-fun EVERY tacs = EVY ([], tacs);
+ (* EVERY [tac1,...,tacn] equals tac1 THEN ... THEN tacn *)
+ fun EVERY tacs = EVY ([], tacs);
end;
@@ -188,9 +188,9 @@
(*Pause until a line is typed -- if non-empty then fail. *)
fun pause_tac st =
- (tracing "** Press RETURN to continue:";
- if TextIO.inputLine TextIO.stdIn = SOME "\n" then Seq.single st
- else (tracing "Goodbye"; Seq.empty));
+ (tracing "** Press RETURN to continue:";
+ if TextIO.inputLine TextIO.stdIn = SOME "\n" then Seq.single st
+ else (tracing "Goodbye"; Seq.empty));
exception TRACE_EXIT of thm
and TRACE_QUIT;
@@ -201,21 +201,22 @@
(*Handle all tracing commands for current state and tactic *)
fun exec_trace_command flag (tac, st) =
- case TextIO.inputLine TextIO.stdIn of
- SOME "\n" => tac st
- | SOME "f\n" => Seq.empty
- | SOME "o\n" => (flag := false; tac st)
- | SOME "s\n" => (suppress_tracing := true; tac st)
- | SOME "x\n" => (tracing "Exiting now"; raise (TRACE_EXIT st))
- | SOME "quit\n" => raise TRACE_QUIT
- | _ => (tracing
-"Type RETURN to continue or...\n\
-\ f - to fail here\n\
-\ o - to switch tracing off\n\
-\ s - to suppress tracing until next entry to a tactical\n\
-\ x - to exit at this point\n\
-\ quit - to abort this tracing run\n\
-\** Well? " ; exec_trace_command flag (tac, st));
+ (case TextIO.inputLine TextIO.stdIn of
+ SOME "\n" => tac st
+ | SOME "f\n" => Seq.empty
+ | SOME "o\n" => (flag := false; tac st)
+ | SOME "s\n" => (suppress_tracing := true; tac st)
+ | SOME "x\n" => (tracing "Exiting now"; raise (TRACE_EXIT st))
+ | SOME "quit\n" => raise TRACE_QUIT
+ | _ =>
+ (tracing
+ "Type RETURN to continue or...\n\
+ \ f - to fail here\n\
+ \ o - to switch tracing off\n\
+ \ s - to suppress tracing until next entry to a tactical\n\
+ \ x - to exit at this point\n\
+ \ quit - to abort this tracing run\n\
+ \** Well? "; exec_trace_command flag (tac, st)));
(*Extract from a tactic, a thm->thm seq function that handles tracing*)
@@ -229,38 +230,40 @@
(*Create a tactic whose outcome is given by seqf, handling TRACE_EXIT*)
fun traced_tac seqf st =
- (suppress_tracing := false;
- Seq.make (fn()=> seqf st
- handle TRACE_EXIT st' => SOME(st', Seq.empty)));
+ (suppress_tracing := false;
+ Seq.make (fn () => seqf st handle TRACE_EXIT st' => SOME (st', Seq.empty)));
(*Deterministic REPEAT: only retains the first outcome;
uses less space than REPEAT; tail recursive.
If non-negative, n bounds the number of repetitions.*)
fun REPEAT_DETERM_N n tac =
- let val tac = tracify trace_REPEAT tac
- fun drep 0 st = SOME(st, Seq.empty)
- | drep n st =
- (case Seq.pull(tac st) of
- NONE => SOME(st, Seq.empty)
- | SOME(st',_) => drep (n-1) st')
- in traced_tac (drep n) end;
+ let
+ val tac = tracify trace_REPEAT tac;
+ fun drep 0 st = SOME (st, Seq.empty)
+ | drep n st =
+ (case Seq.pull (tac st) of
+ NONE => SOME(st, Seq.empty)
+ | SOME (st', _) => drep (n - 1) st');
+ in traced_tac (drep n) end;
(*Allows any number of repetitions*)
val REPEAT_DETERM = REPEAT_DETERM_N ~1;
(*General REPEAT: maintains a stack of alternatives; tail recursive*)
fun REPEAT tac =
- let val tac = tracify trace_REPEAT tac
- fun rep qs st =
- case Seq.pull(tac st) of
- NONE => SOME(st, Seq.make(fn()=> repq qs))
- | SOME(st',q) => rep (q::qs) st'
- and repq [] = NONE
- | repq(q::qs) = case Seq.pull q of
- NONE => repq qs
- | SOME(st,q) => rep (q::qs) st
- in traced_tac (rep []) end;
+ let
+ val tac = tracify trace_REPEAT tac;
+ fun rep qs st =
+ (case Seq.pull (tac st) of
+ NONE => SOME (st, Seq.make (fn () => repq qs))
+ | SOME (st', q) => rep (q :: qs) st')
+ and repq [] = NONE
+ | repq (q :: qs) =
+ (case Seq.pull q of
+ NONE => repq qs
+ | SOME (st, q) => rep (q :: qs) st);
+ in traced_tac (rep []) end;
(*Repeat 1 or more times*)
fun REPEAT_DETERM1 tac = DETERM tac THEN REPEAT_DETERM tac;
@@ -288,21 +291,23 @@
(*For n subgoals, performs tac(n) THEN ... THEN tac(1)
Essential to work backwards since tac(i) may add/delete subgoals at i. *)
fun ALLGOALS tac st =
- let fun doall 0 = all_tac
- | doall n = tac(n) THEN doall(n-1)
- in doall (Thm.nprems_of st) st end;
+ let
+ fun doall 0 = all_tac
+ | doall n = tac n THEN doall (n - 1);
+ in doall (Thm.nprems_of st) st end;
(*For n subgoals, performs tac(n) ORELSE ... ORELSE tac(1) *)
fun SOMEGOAL tac st =
- let fun find 0 = no_tac
- | find n = tac(n) ORELSE find(n-1)
- in find (Thm.nprems_of st) st end;
+ let
+ fun find 0 = no_tac
+ | find n = tac n ORELSE find (n - 1);
+ in find (Thm.nprems_of st) st end;
(*For n subgoals, performs tac(1) ORELSE ... ORELSE tac(n).
More appropriate than SOMEGOAL in some cases.*)
fun FIRSTGOAL tac st =
- let fun find (i,n) = if i>n then no_tac else tac(i) ORELSE find (i+1,n)
- in find (1, Thm.nprems_of st) st end;
+ let fun find (i, n) = if i > n then no_tac else tac i ORELSE find (i + 1, n)
+ in find (1, Thm.nprems_of st) st end;
(*First subgoal only.*)
fun HEADGOAL tac = tac 1;
@@ -328,7 +333,8 @@
fun SUBGOAL goalfun =
CSUBGOAL (fn (goal, i) => goalfun (Thm.term_of goal, i));
-fun ASSERT_SUBGOAL (tac: int -> tactic) i st = (Logic.get_goal (Thm.prop_of st) i; tac i st);
+fun ASSERT_SUBGOAL (tac: int -> tactic) i st =
+ (Logic.get_goal (Thm.prop_of st) i; tac i st);
(*Returns all states that have changed in subgoal i, counted from the LAST
subgoal. For stac, for example.*)
--- a/src/Pure/theory.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/theory.ML Thu Sep 03 15:50:40 2015 +0200
@@ -6,13 +6,9 @@
signature THEORY =
sig
- val eq_thy: theory * theory -> bool
- val subthy: theory * theory -> bool
val parents_of: theory -> theory list
val ancestors_of: theory -> theory list
val nodes_of: theory -> theory list
- val merge: theory * theory -> theory
- val merge_list: theory list -> theory
val setup: (theory -> theory) -> unit
val local_setup: (Proof.context -> Proof.context) -> unit
val get_markup: theory -> Markup.T
@@ -40,18 +36,10 @@
(** theory context operations **)
-val eq_thy = Context.eq_thy;
-val subthy = Context.subthy;
-
val parents_of = Context.parents_of;
val ancestors_of = Context.ancestors_of;
fun nodes_of thy = thy :: ancestors_of thy;
-val merge = Context.merge;
-
-fun merge_list [] = raise THEORY ("Empty merge of theories", [])
- | merge_list (thy :: thys) = Library.foldl merge (thy, thys);
-
fun setup f = Context.>> (Context.map_theory f);
fun local_setup f = Context.>> (Context.map_proof f);
--- a/src/Pure/thm.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Pure/thm.ML Thu Sep 03 15:50:40 2015 +0200
@@ -21,20 +21,17 @@
sig
include BASIC_THM
(*certified types*)
- val theory_of_ctyp: ctyp -> theory
val typ_of: ctyp -> typ
val global_ctyp_of: theory -> typ -> ctyp
val ctyp_of: Proof.context -> typ -> ctyp
val dest_ctyp: ctyp -> ctyp list
(*certified terms*)
- val theory_of_cterm: cterm -> theory
val term_of: cterm -> term
val typ_of_cterm: cterm -> typ
val ctyp_of_cterm: cterm -> ctyp
val maxidx_of_cterm: cterm -> int
val global_cterm_of: theory -> term -> cterm
val cterm_of: Proof.context -> term -> cterm
- val transfer_cterm: theory -> cterm -> cterm
val renamed_term: term -> cterm -> cterm
val dest_comb: cterm -> cterm * cterm
val dest_fun: cterm -> cterm
@@ -42,6 +39,8 @@
val dest_fun2: cterm -> cterm
val dest_arg1: cterm -> cterm
val dest_abs: string option -> cterm -> cterm * cterm
+ val rename_tvar: indexname -> ctyp -> ctyp
+ val var: indexname * ctyp -> cterm
val apply: cterm -> cterm -> cterm
val lambda_name: string * cterm -> cterm -> cterm
val lambda: cterm -> cterm -> cterm
@@ -52,30 +51,16 @@
val first_order_match: cterm * cterm ->
((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list
(*theorems*)
- val rep_thm: thm ->
- {thy: theory,
- tags: Properties.T,
- maxidx: int,
- shyps: sort Ord_List.T,
- hyps: term Ord_List.T,
- tpairs: (term * term) list,
- prop: term}
- val crep_thm: thm ->
- {thy: theory,
- tags: Properties.T,
- maxidx: int,
- shyps: sort Ord_List.T,
- hyps: cterm Ord_List.T,
- tpairs: (cterm * cterm) list,
- prop: cterm}
val fold_terms: (term -> 'a -> 'a) -> thm -> 'a -> 'a
+ val fold_atomic_ctyps: (ctyp -> 'a -> 'a) -> thm -> 'a -> 'a
val fold_atomic_cterms: (cterm -> 'a -> 'a) -> thm -> 'a -> 'a
val terms_of_tpairs: (term * term) list -> term list
val full_prop_of: thm -> term
- val theory_of_thm: thm -> theory
+ val theory_id_of_thm: thm -> Context.theory_id
val theory_name_of_thm: thm -> string
val maxidx_of: thm -> int
val maxidx_thm: thm -> int -> int
+ val shyps_of: thm -> sort Ord_List.T
val hyps_of: thm -> term list
val prop_of: thm -> term
val tpairs_of: thm -> (term * term) list
@@ -86,6 +71,13 @@
val major_prem_of: thm -> term
val cprop_of: thm -> cterm
val cprem_of: thm -> int -> cterm
+ val chyps_of: thm -> cterm list
+ exception CONTEXT of string * ctyp list * cterm list * thm list * Context.generic option
+ val theory_of_cterm: cterm -> theory
+ val theory_of_thm: thm -> theory
+ val trim_context_cterm: cterm -> cterm
+ val trim_context: thm -> thm
+ val transfer_cterm: theory -> cterm -> cterm
val transfer: theory -> thm -> thm
val renamed_prop: term -> thm -> thm
val weaken: cterm -> thm -> thm
@@ -156,10 +148,9 @@
(** certified types **)
-abstype ctyp = Ctyp of {thy: theory, T: typ, maxidx: int, sorts: sort Ord_List.T}
+abstype ctyp = Ctyp of {cert: Context.certificate, T: typ, maxidx: int, sorts: sort Ord_List.T}
with
-fun theory_of_ctyp (Ctyp {thy, ...}) = thy;
fun typ_of (Ctyp {T, ...}) = T;
fun global_ctyp_of thy raw_T =
@@ -167,12 +158,12 @@
val T = Sign.certify_typ thy raw_T;
val maxidx = Term.maxidx_of_typ T;
val sorts = Sorts.insert_typ T [];
- in Ctyp {thy = thy, T = T, maxidx = maxidx, sorts = sorts} end;
+ in Ctyp {cert = Context.Certificate thy, T = T, maxidx = maxidx, sorts = sorts} end;
val ctyp_of = global_ctyp_of o Proof_Context.theory_of;
-fun dest_ctyp (Ctyp {thy, T = Type (_, Ts), maxidx, sorts}) =
- map (fn T => Ctyp {thy = thy, T = T, maxidx = maxidx, sorts = sorts}) Ts
+fun dest_ctyp (Ctyp {cert, T = Type (_, Ts), maxidx, sorts}) =
+ map (fn T => Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = sorts}) Ts
| dest_ctyp cT = raise TYPE ("dest_ctyp", [typ_of cT], []);
@@ -180,18 +171,18 @@
(** certified terms **)
(*certified terms with checked typ, maxidx, and sorts*)
-abstype cterm = Cterm of {thy: theory, t: term, T: typ, maxidx: int, sorts: sort Ord_List.T}
+abstype cterm =
+ Cterm of {cert: Context.certificate, t: term, T: typ, maxidx: int, sorts: sort Ord_List.T}
with
exception CTERM of string * cterm list;
-fun theory_of_cterm (Cterm {thy, ...}) = thy;
fun term_of (Cterm {t, ...}) = t;
fun typ_of_cterm (Cterm {T, ...}) = T;
-fun ctyp_of_cterm (Cterm {thy, T, maxidx, sorts, ...}) =
- Ctyp {thy = thy, T = T, maxidx = maxidx, sorts = sorts};
+fun ctyp_of_cterm (Cterm {cert, T, maxidx, sorts, ...}) =
+ Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = sorts};
fun maxidx_of_cterm (Cterm {maxidx, ...}) = maxidx;
@@ -199,76 +190,79 @@
let
val (t, T, maxidx) = Sign.certify_term thy tm;
val sorts = Sorts.insert_term t [];
- in Cterm {thy = thy, t = t, T = T, maxidx = maxidx, sorts = sorts} end;
+ in Cterm {cert = Context.Certificate thy, t = t, T = T, maxidx = maxidx, sorts = sorts} end;
val cterm_of = global_cterm_of o Proof_Context.theory_of;
-fun merge_thys0 (Cterm {thy = thy1, ...}) (Cterm {thy = thy2, ...}) =
- Theory.merge (thy1, thy2);
+fun join_certificate0 (Cterm {cert = cert1, ...}, Cterm {cert = cert2, ...}) =
+ Context.join_certificate (cert1, cert2);
-fun transfer_cterm thy' ct =
- let
- val Cterm {thy, t, T, maxidx, sorts} = ct;
- val _ =
- Theory.subthy (thy, thy') orelse
- raise CTERM ("transfer_cterm: not a super theory", [ct]);
- in
- if Theory.eq_thy (thy, thy') then ct
- else Cterm {thy = thy', t = t, T = T, maxidx = maxidx, sorts = sorts}
- end;
-
-fun renamed_term t' (Cterm {thy, t, T, maxidx, sorts}) =
- if t aconv t' then Cterm {thy = thy, t = t', T = T, maxidx = maxidx, sorts = sorts}
+fun renamed_term t' (Cterm {cert, t, T, maxidx, sorts}) =
+ if t aconv t' then Cterm {cert = cert, t = t', T = T, maxidx = maxidx, sorts = sorts}
else raise TERM ("renamed_term: terms disagree", [t, t']);
(* destructors *)
-fun dest_comb (Cterm {t = c $ a, T, thy, maxidx, sorts}) =
+fun dest_comb (Cterm {t = c $ a, T, cert, maxidx, sorts}) =
let val A = Term.argument_type_of c 0 in
- (Cterm {t = c, T = A --> T, thy = thy, maxidx = maxidx, sorts = sorts},
- Cterm {t = a, T = A, thy = thy, maxidx = maxidx, sorts = sorts})
+ (Cterm {t = c, T = A --> T, cert = cert, maxidx = maxidx, sorts = sorts},
+ Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts})
end
| dest_comb ct = raise CTERM ("dest_comb", [ct]);
-fun dest_fun (Cterm {t = c $ _, T, thy, maxidx, sorts}) =
+fun dest_fun (Cterm {t = c $ _, T, cert, maxidx, sorts}) =
let val A = Term.argument_type_of c 0
- in Cterm {t = c, T = A --> T, thy = thy, maxidx = maxidx, sorts = sorts} end
+ in Cterm {t = c, T = A --> T, cert = cert, maxidx = maxidx, sorts = sorts} end
| dest_fun ct = raise CTERM ("dest_fun", [ct]);
-fun dest_arg (Cterm {t = c $ a, T = _, thy, maxidx, sorts}) =
+fun dest_arg (Cterm {t = c $ a, T = _, cert, maxidx, sorts}) =
let val A = Term.argument_type_of c 0
- in Cterm {t = a, T = A, thy = thy, maxidx = maxidx, sorts = sorts} end
+ in Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts} end
| dest_arg ct = raise CTERM ("dest_arg", [ct]);
-fun dest_fun2 (Cterm {t = c $ _ $ _, T, thy, maxidx, sorts}) =
+fun dest_fun2 (Cterm {t = c $ _ $ _, T, cert, maxidx, sorts}) =
let
val A = Term.argument_type_of c 0;
val B = Term.argument_type_of c 1;
- in Cterm {t = c, T = A --> B --> T, thy = thy, maxidx = maxidx, sorts = sorts} end
+ in Cterm {t = c, T = A --> B --> T, cert = cert, maxidx = maxidx, sorts = sorts} end
| dest_fun2 ct = raise CTERM ("dest_fun2", [ct]);
-fun dest_arg1 (Cterm {t = c $ a $ _, T = _, thy, maxidx, sorts}) =
+fun dest_arg1 (Cterm {t = c $ a $ _, T = _, cert, maxidx, sorts}) =
let val A = Term.argument_type_of c 0
- in Cterm {t = a, T = A, thy = thy, maxidx = maxidx, sorts = sorts} end
+ in Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts} end
| dest_arg1 ct = raise CTERM ("dest_arg1", [ct]);
-fun dest_abs a (Cterm {t = Abs (x, T, t), T = Type ("fun", [_, U]), thy, maxidx, sorts}) =
+fun dest_abs a (Cterm {t = Abs (x, T, t), T = Type ("fun", [_, U]), cert, maxidx, sorts}) =
let val (y', t') = Term.dest_abs (the_default x a, T, t) in
- (Cterm {t = Free (y', T), T = T, thy = thy, maxidx = maxidx, sorts = sorts},
- Cterm {t = t', T = U, thy = thy, maxidx = maxidx, sorts = sorts})
+ (Cterm {t = Free (y', T), T = T, cert = cert, maxidx = maxidx, sorts = sorts},
+ Cterm {t = t', T = U, cert = cert, maxidx = maxidx, sorts = sorts})
end
| dest_abs _ ct = raise CTERM ("dest_abs", [ct]);
(* constructors *)
+fun rename_tvar (a, i) (Ctyp {cert, T, maxidx, sorts}) =
+ let
+ val S =
+ (case T of
+ TFree (_, S) => S
+ | TVar (_, S) => S
+ | _ => raise TYPE ("rename_tvar: no variable", [T], []));
+ val _ = if i < 0 then raise TYPE ("rename_tvar: bad index", [TVar ((a, i), S)], []) else ();
+ in Ctyp {cert = cert, T = TVar ((a, i), S), maxidx = Int.max (i, maxidx), sorts = sorts} end;
+
+fun var ((x, i), Ctyp {cert, T, maxidx, sorts}) =
+ if i < 0 then raise TERM ("var: bad index", [Var ((x, i), T)])
+ else Cterm {cert = cert, t = Var ((x, i), T), T = T, maxidx = Int.max (i, maxidx), sorts = sorts};
+
fun apply
(cf as Cterm {t = f, T = Type ("fun", [dty, rty]), maxidx = maxidx1, sorts = sorts1, ...})
(cx as Cterm {t = x, T, maxidx = maxidx2, sorts = sorts2, ...}) =
if T = dty then
- Cterm {thy = merge_thys0 cf cx,
+ Cterm {cert = join_certificate0 (cf, cx),
t = f $ x,
T = rty,
maxidx = Int.max (maxidx1, maxidx2),
@@ -280,7 +274,7 @@
(x, ct1 as Cterm {t = t1, T = T1, maxidx = maxidx1, sorts = sorts1, ...})
(ct2 as Cterm {t = t2, T = T2, maxidx = maxidx2, sorts = sorts2, ...}) =
let val t = Term.lambda_name (x, t1) t2 in
- Cterm {thy = merge_thys0 ct1 ct2,
+ Cterm {cert = join_certificate0 (ct1, ct2),
t = t, T = T1 --> T2,
maxidx = Int.max (maxidx1, maxidx2),
sorts = Sorts.union sorts1 sorts2}
@@ -291,53 +285,26 @@
(* indexes *)
-fun adjust_maxidx_cterm i (ct as Cterm {thy, t, T, maxidx, sorts}) =
+fun adjust_maxidx_cterm i (ct as Cterm {cert, t, T, maxidx, sorts}) =
if maxidx = i then ct
else if maxidx < i then
- Cterm {maxidx = i, thy = thy, t = t, T = T, sorts = sorts}
+ Cterm {maxidx = i, cert = cert, t = t, T = T, sorts = sorts}
else
- Cterm {maxidx = Int.max (maxidx_of_term t, i), thy = thy, t = t, T = T, sorts = sorts};
+ Cterm {maxidx = Int.max (maxidx_of_term t, i), cert = cert, t = t, T = T, sorts = sorts};
-fun incr_indexes_cterm i (ct as Cterm {thy, t, T, maxidx, sorts}) =
+fun incr_indexes_cterm i (ct as Cterm {cert, t, T, maxidx, sorts}) =
if i < 0 then raise CTERM ("negative increment", [ct])
else if i = 0 then ct
- else Cterm {thy = thy, t = Logic.incr_indexes ([], [], i) t,
+ else Cterm {cert = cert, t = Logic.incr_indexes ([], [], i) t,
T = Logic.incr_tvar i T, maxidx = maxidx + i, sorts = sorts};
-(* matching *)
-
-local
-
-fun gen_match match
- (ct1 as Cterm {t = t1, sorts = sorts1, ...},
- ct2 as Cterm {t = t2, sorts = sorts2, maxidx = maxidx2, ...}) =
- let
- val thy = merge_thys0 ct1 ct2;
- val (Tinsts, tinsts) = match thy (t1, t2) (Vartab.empty, Vartab.empty);
- val sorts = Sorts.union sorts1 sorts2;
- fun mk_cTinst ((a, i), (S, T)) =
- (((a, i), S), Ctyp {T = T, thy = thy, maxidx = maxidx2, sorts = sorts});
- fun mk_ctinst ((x, i), (U, t)) =
- let val T = Envir.subst_type Tinsts U in
- (((x, i), T), Cterm {t = t, T = T, thy = thy, maxidx = maxidx2, sorts = sorts})
- end;
- in (Vartab.fold (cons o mk_cTinst) Tinsts [], Vartab.fold (cons o mk_ctinst) tinsts []) end;
-
-in
-
-val match = gen_match Pattern.match;
-val first_order_match = gen_match Pattern.first_order_match;
-
-end;
-
-
(*** Derivations and Theorems ***)
abstype thm = Thm of
deriv * (*derivation*)
- {thy: theory, (*background theory*)
+ {cert: Context.certificate, (*background theory certificate*)
tags: Properties.T, (*additional annotations/comments*)
maxidx: int, (*maximum index of any Var or TVar*)
shyps: sort Ord_List.T, (*sort hypotheses*)
@@ -356,19 +323,15 @@
fun rep_thm (Thm (_, args)) = args;
-fun crep_thm (Thm (_, {thy, tags, maxidx, shyps, hyps, tpairs, prop})) =
- let fun cterm max t = Cterm {thy = thy, t = t, T = propT, maxidx = max, sorts = shyps} in
- {thy = thy, tags = tags, maxidx = maxidx, shyps = shyps,
- hyps = map (cterm ~1) hyps,
- tpairs = map (apply2 (cterm maxidx)) tpairs,
- prop = cterm maxidx prop}
- end;
-
fun fold_terms f (Thm (_, {tpairs, prop, hyps, ...})) =
fold (fn (t, u) => f t #> f u) tpairs #> f prop #> fold f hyps;
-fun fold_atomic_cterms f (th as Thm (_, {thy, maxidx, shyps, ...})) =
- let fun cterm t T = Cterm {thy = thy, t = t, T = T, maxidx = maxidx, sorts = shyps} in
+fun fold_atomic_ctyps f (th as Thm (_, {cert, maxidx, shyps, ...})) =
+ let fun ctyp T = Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = shyps}
+ in (fold_terms o fold_types o fold_atyps) (f o ctyp) th end;
+
+fun fold_atomic_cterms f (th as Thm (_, {cert, maxidx, shyps, ...})) =
+ let fun cterm t T = Cterm {cert = cert, t = t, T = T, maxidx = maxidx, sorts = shyps} in
(fold_terms o fold_aterms)
(fn t as Const (_, T) => f (cterm t T)
| t as Free (_, T) => f (cterm t T)
@@ -391,22 +354,22 @@
val insert_hyps = Ord_List.insert Term_Ord.fast_term_ord;
val remove_hyps = Ord_List.remove Term_Ord.fast_term_ord;
-
-(* merge theories of cterms/thms -- trivial absorption only *)
+fun join_certificate1 (Cterm {cert = cert1, ...}, Thm (_, {cert = cert2, ...})) =
+ Context.join_certificate (cert1, cert2);
-fun merge_thys1 (Cterm {thy = thy1, ...}) (Thm (_, {thy = thy2, ...})) =
- Theory.merge (thy1, thy2);
-
-fun merge_thys2 (Thm (_, {thy = thy1, ...})) (Thm (_, {thy = thy2, ...})) =
- Theory.merge (thy1, thy2);
+fun join_certificate2 (Thm (_, {cert = cert1, ...}), Thm (_, {cert = cert2, ...})) =
+ Context.join_certificate (cert1, cert2);
(* basic components *)
-val theory_of_thm = #thy o rep_thm;
-val theory_name_of_thm = Context.theory_name o #thy o rep_thm;
+val cert_of = #cert o rep_thm;
+val theory_id_of_thm = Context.certificate_theory_id o cert_of;
+val theory_name_of_thm = Context.theory_id_name o theory_id_of_thm;
+
val maxidx_of = #maxidx o rep_thm;
fun maxidx_thm th i = Int.max (maxidx_of th, i);
+val shyps_of = #shyps o rep_thm;
val hyps_of = #hyps o rep_thm;
val prop_of = #prop o rep_thm;
val tpairs_of = #tpairs o rep_thm;
@@ -421,24 +384,70 @@
prem :: _ => Logic.strip_assums_concl prem
| [] => raise THM ("major_prem_of: rule with no premises", 0, [th]));
-(*the statement of any thm is a cterm*)
-fun cprop_of (Thm (_, {thy, maxidx, shyps, prop, ...})) =
- Cterm {thy = thy, maxidx = maxidx, T = propT, t = prop, sorts = shyps};
+fun cprop_of (Thm (_, {cert, maxidx, shyps, prop, ...})) =
+ Cterm {cert = cert, maxidx = maxidx, T = propT, t = prop, sorts = shyps};
-fun cprem_of (th as Thm (_, {thy, maxidx, shyps, prop, ...})) i =
- Cterm {thy = thy, maxidx = maxidx, T = propT, sorts = shyps,
+fun cprem_of (th as Thm (_, {cert, maxidx, shyps, prop, ...})) i =
+ Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps,
t = Logic.nth_prem (i, prop) handle TERM _ => raise THM ("cprem_of", i, [th])};
-(*explicit transfer to a super theory*)
-fun transfer thy' thm =
+fun chyps_of (Thm (_, {cert, shyps, hyps, ...})) =
+ map (fn t => Cterm {cert = cert, maxidx = ~1, T = propT, sorts = shyps, t = t}) hyps;
+
+
+(* implicit theory context *)
+
+exception CONTEXT of string * ctyp list * cterm list * thm list * Context.generic option;
+
+fun theory_of_cterm (ct as Cterm {cert, ...}) =
+ Context.certificate_theory cert
+ handle ERROR msg => raise CONTEXT (msg, [], [ct], [], NONE);
+
+fun theory_of_thm th =
+ Context.certificate_theory (cert_of th)
+ handle ERROR msg => raise CONTEXT (msg, [], [], [th], NONE);
+
+fun trim_context_cterm ct =
+ (case ct of
+ Cterm {cert = Context.Certificate_Id _, ...} => ct
+ | Cterm {cert = Context.Certificate thy, t, T, maxidx, sorts} =>
+ Cterm {cert = Context.Certificate_Id (Context.theory_id thy),
+ t = t, T = T, maxidx = maxidx, sorts = sorts});
+
+fun trim_context th =
+ (case th of
+ Thm (_, {cert = Context.Certificate_Id _, ...}) => th
+ | Thm (der, {cert = Context.Certificate thy, tags, maxidx, shyps, hyps, tpairs, prop}) =>
+ Thm (der,
+ {cert = Context.Certificate_Id (Context.theory_id thy),
+ tags = tags, maxidx = maxidx, shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}));
+
+fun transfer_cterm thy' ct =
let
- val Thm (der, {thy, tags, maxidx, shyps, hyps, tpairs, prop}) = thm;
- val _ = Theory.subthy (thy, thy') orelse raise THM ("transfer: not a super theory", 0, [thm]);
+ val Cterm {cert, t, T, maxidx, sorts} = ct;
+ val _ =
+ Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse
+ raise CONTEXT ("Cannot transfer: not a super theory", [], [ct], [],
+ SOME (Context.Theory thy'));
+ val cert' = Context.join_certificate (Context.Certificate thy', cert);
in
- if Theory.eq_thy (thy, thy') then thm
+ if Context.eq_certificate (cert, cert') then ct
+ else Cterm {cert = cert', t = t, T = T, maxidx = maxidx, sorts = sorts}
+ end;
+
+fun transfer thy' th =
+ let
+ val Thm (der, {cert, tags, maxidx, shyps, hyps, tpairs, prop}) = th;
+ val _ =
+ Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse
+ raise CONTEXT ("Cannot transfer: not a super theory", [], [], [th],
+ SOME (Context.Theory thy'));
+ val cert' = Context.join_certificate (Context.Certificate thy', cert);
+ in
+ if Context.eq_certificate (cert, cert') then th
else
Thm (der,
- {thy = thy',
+ {cert = cert',
tags = tags,
maxidx = maxidx,
shyps = shyps,
@@ -447,17 +456,54 @@
prop = prop})
end;
+
+(* matching *)
+
+local
+
+fun gen_match match
+ (ct1 as Cterm {t = t1, sorts = sorts1, ...},
+ ct2 as Cterm {t = t2, sorts = sorts2, maxidx = maxidx2, ...}) =
+ let
+ val cert = join_certificate0 (ct1, ct2);
+ val thy = Context.certificate_theory cert
+ handle ERROR msg => raise CONTEXT (msg, [], [ct1, ct2], [], NONE);
+ val (Tinsts, tinsts) = match thy (t1, t2) (Vartab.empty, Vartab.empty);
+ val sorts = Sorts.union sorts1 sorts2;
+ fun mk_cTinst ((a, i), (S, T)) =
+ (((a, i), S), Ctyp {T = T, cert = cert, maxidx = maxidx2, sorts = sorts});
+ fun mk_ctinst ((x, i), (U, t)) =
+ let val T = Envir.subst_type Tinsts U in
+ (((x, i), T), Cterm {t = t, T = T, cert = cert, maxidx = maxidx2, sorts = sorts})
+ end;
+ in (Vartab.fold (cons o mk_cTinst) Tinsts [], Vartab.fold (cons o mk_ctinst) tinsts []) end;
+
+in
+
+val match = gen_match Pattern.match;
+val first_order_match = gen_match Pattern.first_order_match;
+
+end;
+
+
(*implicit alpha-conversion*)
-fun renamed_prop prop' (Thm (der, {thy, tags, maxidx, shyps, hyps, tpairs, prop})) =
+fun renamed_prop prop' (Thm (der, {cert, tags, maxidx, shyps, hyps, tpairs, prop})) =
if prop aconv prop' then
- Thm (der, {thy = thy, tags = tags, maxidx = maxidx, shyps = shyps,
+ Thm (der, {cert = cert, tags = tags, maxidx = maxidx, shyps = shyps,
hyps = hyps, tpairs = tpairs, prop = prop'})
else raise TERM ("renamed_prop: props disagree", [prop, prop']);
-fun make_context NONE thy = Context.Theory thy
- | make_context (SOME ctxt) thy =
- if Theory.subthy (thy, Proof_Context.theory_of ctxt) then Context.Proof ctxt
- else raise THEORY ("Bad context", [thy, Proof_Context.theory_of ctxt]);
+fun make_context ths NONE cert =
+ (Context.Theory (Context.certificate_theory cert)
+ handle ERROR msg => raise CONTEXT (msg, [], [], ths, NONE))
+ | make_context ths (SOME ctxt) cert =
+ let
+ val thy_id = Context.certificate_theory_id cert;
+ val thy_id' = Context.theory_id (Proof_Context.theory_of ctxt);
+ in
+ if Context.subthy_id (thy_id, thy_id') then Context.Proof ctxt
+ else raise CONTEXT ("Bad context", [], [], ths, SOME (Context.Proof ctxt))
+ end;
(*explicit weakening: maps |- B to A |- B*)
fun weaken raw_ct th =
@@ -471,7 +517,7 @@
raise THM ("weaken: assumptions may not contain schematic variables", maxidxA, [])
else
Thm (der,
- {thy = merge_thys1 ct th,
+ {cert = join_certificate1 (ct, th),
tags = tags,
maxidx = maxidx,
shyps = Sorts.union sorts shyps,
@@ -482,10 +528,11 @@
fun weaken_sorts raw_sorts ct =
let
- val Cterm {thy, t, T, maxidx, sorts} = ct;
+ val Cterm {cert, t, T, maxidx, sorts} = ct;
+ val thy = theory_of_cterm ct;
val more_sorts = Sorts.make (map (Sign.certify_sort thy) raw_sorts);
val sorts' = Sorts.union sorts more_sorts;
- in Cterm {thy = thy, t = t, T = T, maxidx = maxidx, sorts = sorts'} end;
+ in Cterm {cert = cert, t = t, T = T, maxidx = maxidx, sorts = sorts'} end;
(*dangling sort constraints of a thm*)
fun extra_shyps (th as Thm (_, {shyps, ...})) =
@@ -536,8 +583,8 @@
| join_promises promises = join_promises_of (Future.joins (map snd promises))
and join_promises_of thms = join_promises (Ord_List.make promise_ord (maps raw_promises_of thms));
-fun fulfill_body (Thm (Deriv {promises, body}, {thy, ...})) =
- Proofterm.fulfill_norm_proof thy (fulfill_promises promises) body
+fun fulfill_body (th as Thm (Deriv {promises, body}, _)) =
+ Proofterm.fulfill_norm_proof (theory_of_thm th) (fulfill_promises promises) body
and fulfill_promises promises =
map fst promises ~~ map fulfill_body (Future.joins (map snd promises));
@@ -571,12 +618,12 @@
(* future rule *)
-fun future_result i orig_thy orig_shyps orig_prop thm =
+fun future_result i orig_cert orig_shyps orig_prop thm =
let
fun err msg = raise THM ("future_result: " ^ msg, 0, [thm]);
- val Thm (Deriv {promises, ...}, {thy, shyps, hyps, tpairs, prop, ...}) = thm;
+ val Thm (Deriv {promises, ...}, {cert, shyps, hyps, tpairs, prop, ...}) = thm;
- val _ = Theory.eq_thy (thy, orig_thy) orelse err "bad theory";
+ val _ = Context.eq_certificate (cert, orig_cert) orelse err "bad theory";
val _ = prop aconv orig_prop orelse err "bad prop";
val _ = null tpairs orelse err "bad tpairs";
val _ = null hyps orelse err "bad hyps";
@@ -587,14 +634,15 @@
fun future future_thm ct =
let
- val Cterm {thy = thy, t = prop, T, maxidx, sorts} = ct;
+ val Cterm {cert = cert, t = prop, T, maxidx, sorts} = ct;
val _ = T <> propT andalso raise CTERM ("future: prop expected", [ct]);
+ val thy = theory_of_cterm ct;
val i = serial ();
- val future = future_thm |> Future.map (future_result i thy sorts prop);
+ val future = future_thm |> Future.map (future_result i cert sorts prop);
in
Thm (make_deriv [(i, future)] [] [] (Proofterm.promise_proof thy i prop),
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -613,8 +661,9 @@
fun name_derivation name (thm as Thm (der, args)) =
let
val Deriv {promises, body} = der;
- val {thy, shyps, hyps, prop, tpairs, ...} = args;
+ val {shyps, hyps, prop, tpairs, ...} = args;
val _ = null tpairs orelse raise THM ("put_name: unsolved flex-flex constraints", 0, [thm]);
+ val thy = theory_of_thm thm;
val ps = map (apsnd (Future.map fulfill_body)) promises;
val (pthm, proof) = Proofterm.thm_proof thy name shyps hyps prop ps body;
@@ -625,23 +674,24 @@
(** Axioms **)
-fun axiom theory name =
+fun axiom thy0 name =
let
fun get_ax thy =
Name_Space.lookup (Theory.axiom_table thy) name
|> Option.map (fn prop =>
let
val der = deriv_rule0 (Proofterm.axm_proof name prop);
+ val cert = Context.Certificate thy;
val maxidx = maxidx_of_term prop;
val shyps = Sorts.insert_term prop [];
in
- Thm (der, {thy = thy, tags = [],
+ Thm (der, {cert = cert, tags = [],
maxidx = maxidx, shyps = shyps, hyps = [], tpairs = [], prop = prop})
end);
in
- (case get_first get_ax (Theory.nodes_of theory) of
+ (case get_first get_ax (Theory.nodes_of thy0) of
SOME thm => thm
- | NONE => raise THEORY ("No axiom " ^ quote name, [theory]))
+ | NONE => raise THEORY ("No axiom " ^ quote name, [thy0]))
end;
(*return additional axioms of this theory node*)
@@ -653,24 +703,24 @@
val get_tags = #tags o rep_thm;
-fun map_tags f (Thm (der, {thy, tags, maxidx, shyps, hyps, tpairs, prop})) =
- Thm (der, {thy = thy, tags = f tags, maxidx = maxidx,
+fun map_tags f (Thm (der, {cert, tags, maxidx, shyps, hyps, tpairs, prop})) =
+ Thm (der, {cert = cert, tags = f tags, maxidx = maxidx,
shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop});
(* technical adjustments *)
-fun norm_proof (Thm (der, args as {thy, ...})) =
- Thm (deriv_rule1 (Proofterm.rew_proof thy) der, args);
+fun norm_proof (th as Thm (der, args)) =
+ Thm (deriv_rule1 (Proofterm.rew_proof (theory_of_thm th)) der, args);
-fun adjust_maxidx_thm i (th as Thm (der, {thy, tags, maxidx, shyps, hyps, tpairs, prop})) =
+fun adjust_maxidx_thm i (th as Thm (der, {cert, tags, maxidx, shyps, hyps, tpairs, prop})) =
if maxidx = i then th
else if maxidx < i then
- Thm (der, {maxidx = i, thy = thy, tags = tags, shyps = shyps,
+ Thm (der, {maxidx = i, cert = cert, tags = tags, shyps = shyps,
hyps = hyps, tpairs = tpairs, prop = prop})
else
- Thm (der, {maxidx = Int.max (maxidx_tpairs tpairs (maxidx_of_term prop), i), thy = thy,
- tags = tags, shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop});
+ Thm (der, {maxidx = Int.max (maxidx_tpairs tpairs (maxidx_of_term prop), i),
+ cert = cert, tags = tags, shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop});
@@ -680,13 +730,13 @@
(*The assumption rule A |- A*)
fun assume raw_ct =
- let val Cterm {thy, t = prop, T, maxidx, sorts} = adjust_maxidx_cterm ~1 raw_ct in
+ let val Cterm {cert, t = prop, T, maxidx, sorts} = adjust_maxidx_cterm ~1 raw_ct in
if T <> propT then
raise THM ("assume: prop", 0, [])
else if maxidx <> ~1 then
raise THM ("assume: variables", maxidx, [])
else Thm (deriv_rule0 (Proofterm.Hyp prop),
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = ~1,
shyps = sorts,
@@ -709,7 +759,7 @@
raise THM ("implies_intr: assumptions must have type prop", 0, [th])
else
Thm (deriv_rule1 (Proofterm.implies_intr_proof A) der,
- {thy = merge_thys1 ct th,
+ {cert = join_certificate1 (ct, th),
tags = [],
maxidx = Int.max (maxidxA, maxidx),
shyps = Sorts.union sorts shyps,
@@ -734,7 +784,7 @@
Const ("Pure.imp", _) $ A $ B =>
if A aconv propA then
Thm (deriv_rule2 (curry Proofterm.%%) der derA,
- {thy = merge_thys2 thAB thA,
+ {cert = join_certificate2 (thAB, thA),
tags = [],
maxidx = Int.max (maxA, maxidx),
shyps = Sorts.union shypsA shyps,
@@ -758,7 +808,7 @@
let
fun result a =
Thm (deriv_rule1 (Proofterm.forall_intr_proof x a) der,
- {thy = merge_thys1 ct th,
+ {cert = join_certificate1 (ct, th),
tags = [],
maxidx = maxidx,
shyps = Sorts.union sorts shyps,
@@ -790,7 +840,7 @@
raise THM ("forall_elim: type mismatch", 0, [th])
else
Thm (deriv_rule1 (Proofterm.% o rpair (SOME t)) der,
- {thy = merge_thys1 ct th,
+ {cert = join_certificate1 (ct, th),
tags = [],
maxidx = Int.max (maxidx, maxt),
shyps = Sorts.union sorts shyps,
@@ -805,9 +855,9 @@
(*Reflexivity
t == t
*)
-fun reflexive (Cterm {thy, t, T = _, maxidx, sorts}) =
+fun reflexive (Cterm {cert, t, T = _, maxidx, sorts}) =
Thm (deriv_rule0 Proofterm.reflexive,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -820,11 +870,11 @@
------
u == t
*)
-fun symmetric (th as Thm (der, {thy, maxidx, shyps, hyps, tpairs, prop, ...})) =
+fun symmetric (th as Thm (der, {cert, maxidx, shyps, hyps, tpairs, prop, ...})) =
(case prop of
(eq as Const ("Pure.eq", _)) $ t $ u =>
Thm (deriv_rule1 Proofterm.symmetric der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = shyps,
@@ -851,7 +901,7 @@
if not (u aconv u') then err "middle term"
else
Thm (deriv_rule2 (Proofterm.transitive u T) der1 der2,
- {thy = merge_thys2 th1 th2,
+ {cert = join_certificate2 (th1, th2),
tags = [],
maxidx = Int.max (max1, max2),
shyps = Sorts.union shyps1 shyps2,
@@ -865,7 +915,7 @@
(%x. t)(u) == t[u/x]
fully beta-reduces the term if full = true
*)
-fun beta_conversion full (Cterm {thy, t, T = _, maxidx, sorts}) =
+fun beta_conversion full (Cterm {cert, t, T = _, maxidx, sorts}) =
let val t' =
if full then Envir.beta_norm t
else
@@ -873,7 +923,7 @@
| _ => raise THM ("beta_conversion: not a redex", 0, []));
in
Thm (deriv_rule0 Proofterm.reflexive,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -882,9 +932,9 @@
prop = Logic.mk_equals (t, t')})
end;
-fun eta_conversion (Cterm {thy, t, T = _, maxidx, sorts}) =
+fun eta_conversion (Cterm {cert, t, T = _, maxidx, sorts}) =
Thm (deriv_rule0 Proofterm.reflexive,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -892,9 +942,9 @@
tpairs = [],
prop = Logic.mk_equals (t, Envir.eta_contract t)});
-fun eta_long_conversion (Cterm {thy, t, T = _, maxidx, sorts}) =
+fun eta_long_conversion (Cterm {cert, t, T = _, maxidx, sorts}) =
Thm (deriv_rule0 Proofterm.reflexive,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -910,13 +960,13 @@
*)
fun abstract_rule a
(Cterm {t = x, T, sorts, ...})
- (th as Thm (der, {thy, maxidx, hyps, shyps, tpairs, prop, ...})) =
+ (th as Thm (der, {cert, maxidx, hyps, shyps, tpairs, prop, ...})) =
let
val (t, u) = Logic.dest_equals prop
handle TERM _ => raise THM ("abstract_rule: premise not an equality", 0, [th]);
val result =
Thm (deriv_rule1 (Proofterm.abstract_rule x a) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = Sorts.union sorts shyps,
@@ -959,7 +1009,7 @@
Const ("Pure.eq", Type ("fun", [tT, _])) $ t $ u) =>
(chktypes fT tT;
Thm (deriv_rule2 (Proofterm.combination f g t u fT) der1 der2,
- {thy = merge_thys2 th1 th2,
+ {cert = join_certificate2 (th1, th2),
tags = [],
maxidx = Int.max (max1, max2),
shyps = Sorts.union shyps1 shyps2,
@@ -986,7 +1036,7 @@
(Const("Pure.imp", _) $ A $ B, Const("Pure.imp", _) $ B' $ A') =>
if A aconv A' andalso B aconv B' then
Thm (deriv_rule2 (Proofterm.equal_intr A B) der1 der2,
- {thy = merge_thys2 th1 th2,
+ {cert = join_certificate2 (th1, th2),
tags = [],
maxidx = Int.max (max1, max2),
shyps = Sorts.union shyps1 shyps2,
@@ -1014,7 +1064,7 @@
Const ("Pure.eq", _) $ A $ B =>
if prop2 aconv A then
Thm (deriv_rule2 (Proofterm.equal_elim A B) der1 der2,
- {thy = merge_thys2 th1 th2,
+ {cert = join_certificate2 (th1, th2),
tags = [],
maxidx = Int.max (max1, max2),
shyps = Sorts.union shyps1 shyps2,
@@ -1033,8 +1083,8 @@
Instantiates the theorem and deletes trivial tpairs. Resulting
sequence may contain multiple elements if the tpairs are not all
flex-flex.*)
-fun flexflex_rule opt_ctxt (th as Thm (der, {thy, maxidx, shyps, hyps, tpairs, prop, ...})) =
- Unify.smash_unifiers (make_context opt_ctxt thy) tpairs (Envir.empty maxidx)
+fun flexflex_rule opt_ctxt (th as Thm (der, {cert, maxidx, shyps, hyps, tpairs, prop, ...})) =
+ Unify.smash_unifiers (make_context [th] opt_ctxt cert) tpairs (Envir.empty maxidx)
|> Seq.map (fn env =>
if Envir.is_empty env then th
else
@@ -1047,7 +1097,7 @@
val maxidx = maxidx_tpairs tpairs' (maxidx_of_term prop');
val shyps = Envir.insert_sorts env shyps;
in
- Thm (der', {thy = thy, tags = [], maxidx = maxidx,
+ Thm (der', {cert = cert, tags = [], maxidx = maxidx,
shyps = shyps, hyps = hyps, tpairs = tpairs', prop = prop'})
end);
@@ -1061,7 +1111,7 @@
fun generalize ([], []) _ th = th
| generalize (tfrees, frees) idx th =
let
- val Thm (der, {thy, maxidx, shyps, hyps, tpairs, prop, ...}) = th;
+ val Thm (der, {cert, maxidx, shyps, hyps, tpairs, prop, ...}) = th;
val _ = idx <= maxidx andalso raise THM ("generalize: bad index", idx, [th]);
val bad_type =
@@ -1082,7 +1132,7 @@
val maxidx' = maxidx_tpairs tpairs' (maxidx_of_term prop');
in
Thm (deriv_rule1 (Proofterm.generalize (tfrees, frees) idx) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx',
shyps = shyps,
@@ -1103,27 +1153,35 @@
fun pretty_typing thy t T = Pretty.block
[Syntax.pretty_term_global thy t, Pretty.str " ::", Pretty.brk 1, Syntax.pretty_typ_global thy T];
-fun add_inst (v as (_, T), cu) (thy, sorts) =
+fun add_inst (v as (_, T), cu) (cert, sorts) =
let
- val Cterm {t = u, T = U, thy = thy2, sorts = sorts_u, maxidx = maxidx_u, ...} = cu;
- val thy' = Theory.merge (thy, thy2);
+ val Cterm {t = u, T = U, cert = cert2, sorts = sorts_u, maxidx = maxidx_u, ...} = cu;
+ val cert' = Context.join_certificate (cert, cert2);
val sorts' = Sorts.union sorts_u sorts;
in
- if T = U then ((v, (u, maxidx_u)), (thy', sorts'))
+ if T = U then ((v, (u, maxidx_u)), (cert', sorts'))
else
- raise TYPE (Pretty.string_of (Pretty.block
- [Pretty.str "instantiate: type conflict",
- Pretty.fbrk, pretty_typing thy' (Var v) T,
- Pretty.fbrk, pretty_typing thy' u U]), [T, U], [Var v, u])
+ let
+ val msg =
+ (case cert' of
+ Context.Certificate thy' =>
+ Pretty.string_of (Pretty.block
+ [Pretty.str "instantiate: type conflict",
+ Pretty.fbrk, pretty_typing thy' (Var v) T,
+ Pretty.fbrk, pretty_typing thy' u U])
+ | Context.Certificate_Id _ => "instantiate: type conflict");
+ in raise TYPE (msg, [T, U], [Var v, u]) end
end;
-fun add_instT (v as (_, S), cU) (thy, sorts) =
+fun add_instT (v as (_, S), cU) (cert, sorts) =
let
- val Ctyp {T = U, thy = thy2, sorts = sorts_U, maxidx = maxidx_U, ...} = cU;
- val thy' = Theory.merge (thy, thy2);
+ val Ctyp {T = U, cert = cert2, sorts = sorts_U, maxidx = maxidx_U, ...} = cU;
+ val cert' = Context.join_certificate (cert, cert2);
+ val thy' = Context.certificate_theory cert'
+ handle ERROR msg => raise CONTEXT (msg, [cU], [], [], NONE);
val sorts' = Sorts.union sorts_U sorts;
in
- if Sign.of_sort thy' (U, S) then ((v, (U, maxidx_U)), (thy', sorts'))
+ if Sign.of_sort thy' (U, S) then ((v, (U, maxidx_U)), (cert', sorts'))
else raise TYPE ("Type not of sort " ^ Syntax.string_of_sort_global thy' S, [U], [])
end;
@@ -1135,9 +1193,11 @@
fun instantiate ([], []) th = th
| instantiate (instT, inst) th =
let
- val Thm (der, {thy, hyps, shyps, tpairs, prop, ...}) = th;
- val (inst', (instT', (thy', shyps'))) =
- (thy, shyps) |> fold_map add_inst inst ||> fold_map add_instT instT;
+ val Thm (der, {cert, hyps, shyps, tpairs, prop, ...}) = th;
+ val (inst', (instT', (cert', shyps'))) =
+ (cert, shyps) |> fold_map add_inst inst ||> fold_map add_instT instT
+ handle CONTEXT (msg, cTs, cts, ths, context) =>
+ raise CONTEXT (msg, cTs, cts, th :: ths, context);
val subst = Term_Subst.instantiate_maxidx (instT', inst');
val (prop', maxidx1) = subst prop ~1;
val (tpairs', maxidx') =
@@ -1145,7 +1205,7 @@
in
Thm (deriv_rule1
(fn d => Proofterm.instantiate (map (apsnd #1) instT', map (apsnd #1) inst') d) der,
- {thy = thy',
+ {cert = cert',
tags = [],
maxidx = maxidx',
shyps = shyps',
@@ -1158,14 +1218,14 @@
fun instantiate_cterm ([], []) ct = ct
| instantiate_cterm (instT, inst) ct =
let
- val Cterm {thy, t, T, sorts, ...} = ct;
- val (inst', (instT', (thy', sorts'))) =
- (thy, sorts) |> fold_map add_inst inst ||> fold_map add_instT instT;
+ val Cterm {cert, t, T, sorts, ...} = ct;
+ val (inst', (instT', (cert', sorts'))) =
+ (cert, sorts) |> fold_map add_inst inst ||> fold_map add_instT instT;
val subst = Term_Subst.instantiate_maxidx (instT', inst');
val substT = Term_Subst.instantiateT_maxidx instT';
val (t', maxidx1) = subst t ~1;
val (T', maxidx') = substT T maxidx1;
- in Cterm {thy = thy', t = t', T = T', sorts = sorts', maxidx = maxidx'} end
+ in Cterm {cert = cert', t = t', T = T', sorts = sorts', maxidx = maxidx'} end
handle TYPE (msg, _, _) => raise CTERM (msg, [ct]);
end;
@@ -1173,12 +1233,12 @@
(*The trivial implication A ==> A, justified by assume and forall rules.
A can contain Vars, not so for assume!*)
-fun trivial (Cterm {thy, t = A, T, maxidx, sorts}) =
+fun trivial (Cterm {cert, t = A, T, maxidx, sorts}) =
if T <> propT then
raise THM ("trivial: the term must have type prop", 0, [])
else
Thm (deriv_rule0 (Proofterm.AbsP ("H", NONE, Proofterm.PBound 0)),
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -1193,13 +1253,15 @@
*)
fun of_class (cT, raw_c) =
let
- val Ctyp {thy, T, ...} = cT;
+ val Ctyp {cert, T, ...} = cT;
+ val thy = Context.certificate_theory cert
+ handle ERROR msg => raise CONTEXT (msg, [cT], [], [], NONE);
val c = Sign.certify_class thy raw_c;
val Cterm {t = prop, maxidx, sorts, ...} = global_cterm_of thy (Logic.mk_of_class (T, c));
in
if Sign.of_sort thy (T, [c]) then
Thm (deriv_rule0 (Proofterm.OfClass (T, c)),
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = sorts,
@@ -1211,8 +1273,9 @@
(*Remove extra sorts that are witnessed by type signature information*)
fun strip_shyps (thm as Thm (_, {shyps = [], ...})) = thm
- | strip_shyps (thm as Thm (der, {thy, tags, maxidx, shyps, hyps, tpairs, prop})) =
+ | strip_shyps (thm as Thm (der, {cert, tags, maxidx, shyps, hyps, tpairs, prop})) =
let
+ val thy = theory_of_thm thm;
val algebra = Sign.classes_of thy;
val present = (fold_terms o fold_types o fold_atyps_sorts) (insert (eq_fst op =)) thm [];
@@ -1224,7 +1287,7 @@
in
Thm (deriv_rule_unconditional
(Proofterm.strip_shyps_proof algebra present witnessed extra') der,
- {thy = thy, tags = tags, maxidx = maxidx,
+ {cert = cert, tags = tags, maxidx = maxidx,
shyps = shyps', hyps = hyps, tpairs = tpairs, prop = prop})
end;
@@ -1232,7 +1295,8 @@
fun unconstrainT (thm as Thm (der, args)) =
let
val Deriv {promises, body} = der;
- val {thy, shyps, hyps, tpairs, prop, ...} = args;
+ val {cert, shyps, hyps, tpairs, prop, ...} = args;
+ val thy = theory_of_thm thm;
fun err msg = raise THM ("unconstrainT: " ^ msg, 0, [thm]);
val _ = null hyps orelse err "illegal hyps";
@@ -1246,7 +1310,7 @@
val der' = make_deriv [] [] [pthm] proof;
in
Thm (der',
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx_of_term prop',
shyps = [[]], (*potentially redundant*)
@@ -1256,7 +1320,7 @@
end;
(* Replace all TFrees not fixed or in the hyps by new TVars *)
-fun varifyT_global' fixed (Thm (der, {thy, maxidx, shyps, hyps, tpairs, prop, ...})) =
+fun varifyT_global' fixed (Thm (der, {cert, maxidx, shyps, hyps, tpairs, prop, ...})) =
let
val tfrees = fold Term.add_tfrees hyps fixed;
val prop1 = attach_tpairs tpairs prop;
@@ -1264,7 +1328,7 @@
val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2);
in
(al, Thm (deriv_rule1 (Proofterm.varify_proof prop tfrees) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = Int.max (0, maxidx),
shyps = shyps,
@@ -1276,14 +1340,14 @@
val varifyT_global = #2 o varifyT_global' [];
(* Replace all TVars by TFrees that are often new *)
-fun legacy_freezeT (Thm (der, {thy, shyps, hyps, tpairs, prop, ...})) =
+fun legacy_freezeT (Thm (der, {cert, shyps, hyps, tpairs, prop, ...})) =
let
val prop1 = attach_tpairs tpairs prop;
val prop2 = Type.legacy_freeze prop1;
val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2);
in
Thm (deriv_rule1 (Proofterm.legacy_freezeT prop1) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx_of_term prop2,
shyps = shyps,
@@ -1316,7 +1380,7 @@
if T <> propT then raise THM ("lift_rule: the term must have type prop", 0, [])
else
Thm (deriv_rule1 (Proofterm.lift_proof gprop inc prop) der,
- {thy = merge_thys1 goal orule,
+ {cert = join_certificate1 (goal, orule),
tags = [],
maxidx = maxidx + inc,
shyps = Sorts.union shyps sorts, (*sic!*)
@@ -1325,12 +1389,12 @@
prop = Logic.list_implies (map lift_all As, lift_all B)})
end;
-fun incr_indexes i (thm as Thm (der, {thy, maxidx, shyps, hyps, tpairs, prop, ...})) =
+fun incr_indexes i (thm as Thm (der, {cert, maxidx, shyps, hyps, tpairs, prop, ...})) =
if i < 0 then raise THM ("negative increment", 0, [thm])
else if i = 0 then thm
else
Thm (deriv_rule1 (Proofterm.incr_indexes i) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx + i,
shyps = shyps,
@@ -1341,8 +1405,8 @@
(*Solve subgoal Bi of proof state B1...Bn/C by assumption. *)
fun assumption opt_ctxt i state =
let
- val Thm (der, {thy, maxidx, shyps, hyps, ...}) = state;
- val context = make_context opt_ctxt thy;
+ val Thm (der, {cert, maxidx, shyps, hyps, ...}) = state;
+ val context = make_context [state] opt_ctxt cert;
val (tpairs, Bs, Bi, C) = dest_state (state, i);
fun newth n (env, tpairs) =
Thm (deriv_rule1
@@ -1360,7 +1424,7 @@
Logic.list_implies (Bs, C)
else (*normalize the new rule fully*)
Envir.norm_term env (Logic.list_implies (Bs, C)),
- thy = thy});
+ cert = cert});
val (close, asms, concl) = Logic.assum_problems (~1, Bi);
val concl' = close concl;
@@ -1377,7 +1441,7 @@
Checks if Bi's conclusion is alpha/eta-convertible to one of its assumptions*)
fun eq_assumption i state =
let
- val Thm (der, {thy, maxidx, shyps, hyps, ...}) = state;
+ val Thm (der, {cert, maxidx, shyps, hyps, ...}) = state;
val (tpairs, Bs, Bi, C) = dest_state (state, i);
val (_, asms, concl) = Logic.assum_problems (~1, Bi);
in
@@ -1385,7 +1449,7 @@
~1 => raise THM ("eq_assumption", 0, [state])
| n =>
Thm (deriv_rule1 (Proofterm.assumption_proof Bs Bi (n + 1)) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = shyps,
@@ -1398,7 +1462,7 @@
(*For rotate_tac: fast rotation of assumptions of subgoal i*)
fun rotate_rule k i state =
let
- val Thm (der, {thy, maxidx, shyps, hyps, ...}) = state;
+ val Thm (der, {cert, maxidx, shyps, hyps, ...}) = state;
val (tpairs, Bs, Bi, C) = dest_state (state, i);
val params = Term.strip_all_vars Bi;
val rest = Term.strip_all_body Bi;
@@ -1414,7 +1478,7 @@
else raise THM ("rotate_rule", k, [state]);
in
Thm (deriv_rule1 (Proofterm.rotate_proof Bs Bi m) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = shyps,
@@ -1429,7 +1493,7 @@
number of premises. Useful with eresolve_tac and underlies defer_tac*)
fun permute_prems j k rl =
let
- val Thm (der, {thy, maxidx, shyps, hyps, tpairs, prop, ...}) = rl;
+ val Thm (der, {cert, maxidx, shyps, hyps, tpairs, prop, ...}) = rl;
val prems = Logic.strip_imp_prems prop
and concl = Logic.strip_imp_concl prop;
val moved_prems = List.drop (prems, j)
@@ -1445,7 +1509,7 @@
else raise THM ("permute_prems: k", k, [rl]);
in
Thm (deriv_rule1 (Proofterm.permute_prems_proof prems j m) der,
- {thy = thy,
+ {cert = cert,
tags = [],
maxidx = maxidx,
shyps = shyps,
@@ -1569,8 +1633,8 @@
tpairs=rtpairs, prop=rprop,...}) = orule
(*How many hyps to skip over during normalization*)
and nlift = Logic.count_prems (strip_all_body Bi) + (if eres_flg then ~1 else 0)
- val thy = merge_thys2 state orule;
- val context = make_context opt_ctxt thy;
+ val cert = join_certificate2 (state, orule);
+ val context = make_context [state, orule] opt_ctxt cert;
(** Add new theorem with prop = '[| Bs; As |] ==> C' to thq **)
fun addth A (As, oldAs, rder', n) ((env, tpairs), thq) =
let val normt = Envir.norm_term env;
@@ -1602,7 +1666,7 @@
hyps = union_hyps rhyps shyps,
tpairs = ntpairs,
prop = Logic.list_implies normp,
- thy = thy})
+ cert = cert})
in Seq.cons th thq end handle COMPOSE => thq;
val (rAs,B) = Logic.strip_prems(nsubgoal, [], rprop)
handle TERM _ => raise THM("bicompose: rule", 0, [orule,state]);
@@ -1683,7 +1747,7 @@
(state, (stpairs, Bs, Bi, C), true);
fun res [] = Seq.empty
| res ((eres_flg, rule)::brules) =
- if Config.get_generic (make_context opt_ctxt (theory_of_thm state))
+ if Config.get_generic (make_context [state] opt_ctxt (cert_of state))
Pattern.unify_trace_failure orelse could_bires (Hs, B, eres_flg, rule)
then Seq.make (*delay processing remainder till needed*)
(fn()=> SOME(compose (eres_flg, lift rule, nprems_of rule),
@@ -1698,13 +1762,13 @@
(* oracle rule *)
fun invoke_oracle thy1 name oracle arg =
- let val Cterm {thy = thy2, t = prop, T, maxidx, sorts} = oracle arg in
+ let val Cterm {cert = cert2, t = prop, T, maxidx, sorts} = oracle arg in
if T <> propT then
raise THM ("Oracle's result must have type prop: " ^ name, 0, [])
else
let val (ora, prf) = Proofterm.oracle_proof name prop in
Thm (make_deriv [] [ora] [] prf,
- {thy = Theory.merge (thy1, thy2),
+ {cert = Context.join_certificate (Context.Certificate thy1, cert2),
tags = [],
maxidx = maxidx,
shyps = sorts,
--- a/src/Tools/Code/code_runtime.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/Code/code_runtime.ML Thu Sep 03 15:50:40 2015 +0200
@@ -80,8 +80,10 @@
val trace = Attrib.setup_config_bool @{binding "code_runtime_trace"} (K false);
fun exec ctxt verbose code =
- (if Config.get ctxt trace then tracing code else ();
- ML_Context.exec (fn () => Secure.use_text ML_Env.local_context (0, "generated code") verbose code));
+ (if Config.get ctxt trace then tracing code else ();
+ ML_Context.exec (fn () =>
+ Secure.use_text ML_Env.local_context
+ {line = 0, file = "generated code", verbose = verbose, debug = false} code));
fun value ctxt (get, put, put_ml) (prelude, value) =
let
@@ -129,7 +131,7 @@
else ()
fun evaluator program _ vs_ty_t deps =
evaluation cookie ctxt (obtain_evaluator ctxt some_target program deps) vs_ty_t args;
- in Code_Thingol.dynamic_value ctxt (Exn.map_result o postproc) evaluator t end;
+ in Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t end;
fun dynamic_value_strict cookie ctxt some_target postproc t args =
Exn.release (dynamic_value_exn cookie ctxt some_target postproc t args);
@@ -146,7 +148,7 @@
fun static_value_exn cookie { ctxt, target, lift_postproc, consts } =
let
val evaluator = Code_Thingol.static_value { ctxt = ctxt,
- lift_postproc = Exn.map_result o lift_postproc, consts = consts }
+ lift_postproc = Exn.map_res o lift_postproc, consts = consts }
(static_evaluator cookie ctxt target);
in fn ctxt' => evaluator ctxt' o reject_vars ctxt' end;
@@ -312,7 +314,7 @@
val cs_code = map (Axclass.unoverload_const thy) consts;
val cTs = map2 (fn (_, T) => fn c => (c, T)) consts cs_code;
val evaluator = Code_Thingol.static_value { ctxt = ctxt,
- lift_postproc = Exn.map_result o lift_postproc, consts = cs_code }
+ lift_postproc = Exn.map_res o lift_postproc, consts = cs_code }
(compile_evaluator cookie ctxt cs_code cTs T);
in fn ctxt' =>
evaluator ctxt' o reject_vars ctxt' o Syntax.check_term ctxt' o Type.constraint T
@@ -538,8 +540,10 @@
let
val thy' = Loaded_Values.put [] thy;
val _ = Context.set_thread_data ((SOME o Context.Theory) thy');
- val _ = Secure.use_text notifying_context
- (0, Path.implode filepath) false (File.read filepath);
+ val _ =
+ Secure.use_text notifying_context
+ {line = 0, file = Path.implode filepath, verbose = false, debug = false}
+ (File.read filepath);
val thy'' = Context.the_theory (Context.the_thread_data ());
val names = Loaded_Values.get thy'';
in (names, thy'') end;
--- a/src/Tools/Code_Generator.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/Code_Generator.thy Thu Sep 03 15:50:40 2015 +0200
@@ -26,7 +26,7 @@
ML_file "~~/src/Tools/Code/code_haskell.ML"
ML_file "~~/src/Tools/Code/code_scala.ML"
-code_datatype "TYPE('a\<Colon>{})"
+code_datatype "TYPE('a::{})"
definition holds :: "prop" where
"holds \<equiv> ((\<lambda>x::prop. x) \<equiv> (\<lambda>x. x))"
@@ -59,4 +59,3 @@
hide_const (open) holds
end
-
--- a/src/Tools/Spec_Check/spec_check.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/Spec_Check/spec_check.ML Thu Sep 03 15:50:40 2015 +0200
@@ -135,7 +135,9 @@
error = #error ML_Env.local_context}
val _ =
Context.setmp_thread_data (SOME (Context.Proof ctxt))
- (fn () => Secure.use_text use_context (0, "generated code") true s) ()
+ (fn () =>
+ Secure.use_text use_context
+ {line = 0, file = "generated code", verbose = true, debug = false} s) ()
in
Gen_Construction.parse_pred (! return)
end;
@@ -143,7 +145,9 @@
(*call the compiler and run the test*)
fun run_test ctxt s =
Context.setmp_thread_data (SOME (Context.Proof ctxt))
- (fn () => Secure.use_text ML_Env.local_context (0, "generated code") false s) ();
+ (fn () =>
+ Secure.use_text ML_Env.local_context
+ {line = 0, file = "generated code", verbose = false, debug = false} s) ();
(*split input into tokens*)
fun input_split s =
--- a/src/Tools/induct.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/induct.ML Thu Sep 03 15:50:40 2015 +0200
@@ -203,8 +203,6 @@
fun filter_rules (rs: rules) th =
filter (fn (_, th') => Thm.eq_thm_prop (th, th')) (Item_Net.content rs);
-fun lookup_rule (rs: rules) = AList.lookup (op =) (Item_Net.content rs);
-
fun pretty_rules ctxt kind rs =
let val thms = map snd (Item_Net.content rs)
in Pretty.big_list kind (map (Display.pretty_thm_item ctxt) thms) end;
@@ -261,16 +259,24 @@
(* access rules *)
-val lookup_casesT = lookup_rule o #1 o #1 o get_local;
-val lookup_casesP = lookup_rule o #2 o #1 o get_local;
-val lookup_inductT = lookup_rule o #1 o #2 o get_local;
-val lookup_inductP = lookup_rule o #2 o #2 o get_local;
-val lookup_coinductT = lookup_rule o #1 o #3 o get_local;
-val lookup_coinductP = lookup_rule o #2 o #3 o get_local;
+local
+fun lookup_rule which ctxt =
+ AList.lookup (op =) (Item_Net.content (which (get_local ctxt)))
+ #> Option.map (Thm.transfer (Proof_Context.theory_of ctxt));
fun find_rules which how ctxt x =
- map snd (Item_Net.retrieve (which (get_local ctxt)) (how x));
+ Item_Net.retrieve (which (get_local ctxt)) (how x)
+ |> map (Thm.transfer (Proof_Context.theory_of ctxt) o snd);
+
+in
+
+val lookup_casesT = lookup_rule (#1 o #1);
+val lookup_casesP = lookup_rule (#2 o #1);
+val lookup_inductT = lookup_rule (#1 o #2);
+val lookup_inductP = lookup_rule (#2 o #2);
+val lookup_coinductT = lookup_rule (#1 o #3);
+val lookup_coinductP = lookup_rule (#2 o #3);
val find_casesT = find_rules (#1 o #1) Net.encode_type;
val find_casesP = find_rules (#2 o #1) I;
@@ -279,6 +285,8 @@
val find_coinductT = find_rules (#1 o #3) Net.encode_type;
val find_coinductP = find_rules (#2 o #3) I;
+end;
+
(** attributes **)
@@ -289,7 +297,7 @@
Thm.mixed_attribute (fn (context, thm) =>
let
val thm' = g thm;
- val context' = Data.map (f (name, thm')) context;
+ val context' = Data.map (f (name, Thm.trim_context thm')) context;
in (context', thm') end);
fun del_att which =
--- a/src/Tools/jEdit/etc/options Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/etc/options Thu Sep 03 15:50:40 2015 +0200
@@ -119,6 +119,7 @@
option quasi_keyword_color : string = "9966FFFF"
option improper_color : string = "FF5050FF"
option operator_color : string = "323232FF"
+option caret_debugger_color : string = "FF9966FF"
option caret_invisible_color : string = "50000080"
option completion_color : string = "0000FFFF"
option search_color : string = "66FFFF64"
--- a/src/Tools/jEdit/src/active.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/active.scala Thu Sep 03 15:50:40 2015 +0200
@@ -34,7 +34,7 @@
val graph_file = Isabelle_System.tmp_file("graph")
File.write(graph_file, XML.content(body))
Isabelle_System.bash_env(null,
- Map("GRAPH_FILE" -> Isabelle_System.posix_path(graph_file)),
+ Map("GRAPH_FILE" -> File.standard_path(graph_file)),
"\"$ISABELLE_TOOL\" browser -c \"$GRAPH_FILE\" &")
}
--- a/src/Tools/jEdit/src/debugger_dockable.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/debugger_dockable.scala Thu Sep 03 15:50:40 2015 +0200
@@ -10,11 +10,13 @@
import isabelle._
import java.awt.{BorderLayout, Dimension}
-import java.awt.event.{ComponentEvent, ComponentAdapter, KeyEvent, FocusAdapter, FocusEvent}
+import java.awt.event.{ComponentEvent, ComponentAdapter, KeyEvent, FocusAdapter, FocusEvent,
+ MouseEvent, MouseAdapter}
import javax.swing.{JTree, JMenuItem}
import javax.swing.tree.{DefaultMutableTreeNode, DefaultTreeModel, TreeSelectionModel}
import javax.swing.event.{TreeSelectionEvent, TreeSelectionListener}
+import scala.collection.immutable.SortedMap
import scala.swing.{Button, Label, Component, ScrollPane, SplitPane, Orientation,
CheckBox, BorderPanel}
import scala.swing.event.ButtonClicked
@@ -26,19 +28,6 @@
object Debugger_Dockable
{
- /* state entries */
-
- sealed case class Thread_Entry(thread_name: String, debug_states: List[Debugger.Debug_State])
- {
- override def toString: String = thread_name
- }
-
- sealed case class Stack_Entry(debug_state: Debugger.Debug_State, index: Int)
- {
- override def toString: String = debug_state.function
- }
-
-
/* breakpoints */
def toggle_breakpoint(command: Command, breakpoint: Long)
@@ -82,7 +71,7 @@
/* component state -- owned by GUI thread */
private var current_snapshot = Document.Snapshot.init
- private var current_threads: Map[String, List[Debugger.Debug_State]] = Map.empty
+ private var current_threads: Debugger.Threads = SortedMap.empty
private var current_output: List[XML.Tree] = Nil
@@ -105,24 +94,10 @@
GUI_Thread.require {}
val new_snapshot = PIDE.editor.current_node_snapshot(view).getOrElse(current_snapshot)
- val new_threads = Debugger.threads()
- val new_output =
- {
- val output = Debugger.output()
- val current_thread_selection = thread_selection()
- (for {
- (thread_name, results) <- output
- if current_thread_selection.isEmpty || current_thread_selection.get == thread_name
- (_, tree) <- results.iterator
- } yield tree).toList
- }
+ val (new_threads, new_output) = Debugger.status(tree_selection())
- if (new_threads != current_threads) {
- val thread_entries =
- (for ((a, b) <- new_threads.iterator)
- yield Debugger_Dockable.Thread_Entry(a, b)).toList.sortBy(_.thread_name)
- update_tree(thread_entries)
- }
+ if (new_threads != current_threads)
+ update_tree(new_threads)
if (new_output != current_output)
pretty_text_area.update(new_snapshot, Command.Results.empty, Pretty.separate(new_output))
@@ -141,48 +116,39 @@
tree.setRowHeight(0)
tree.getSelectionModel.setSelectionMode(TreeSelectionModel.SINGLE_TREE_SELECTION)
- def tree_selection(): Option[(Debugger_Dockable.Thread_Entry, Option[Int])] =
- tree.getSelectionPath match {
- case null => None
- case path =>
- path.getPath.toList.map(n => n.asInstanceOf[DefaultMutableTreeNode].getUserObject) match {
- case List(_, t: Debugger_Dockable.Thread_Entry) =>
- Some((t, None))
- case List(_, t: Debugger_Dockable.Thread_Entry, s: Debugger_Dockable.Stack_Entry) =>
- Some((t, Some(s.index)))
+ def tree_selection(): Option[Debugger.Context] =
+ tree.getLastSelectedPathComponent match {
+ case node: DefaultMutableTreeNode =>
+ node.getUserObject match {
+ case c: Debugger.Context => Some(c)
case _ => None
}
- }
-
- def thread_selection(): Option[String] = tree_selection().map(sel => sel._1.thread_name)
-
- def focus_selection(): Option[Position.T] =
- tree_selection() match {
- case Some((t, opt_index)) =>
- val i = opt_index getOrElse 0
- if (i < t.debug_states.length) Some(t.debug_states(i).pos) else None
case _ => None
}
- private def update_tree(thread_entries: List[Debugger_Dockable.Thread_Entry])
+ def thread_selection(): Option[String] = tree_selection().map(_.thread_name)
+
+ private def update_tree(threads: Debugger.Threads)
{
- val new_thread_selection =
- thread_selection() match {
- case Some(thread_name) if thread_entries.exists(t => t.thread_name == thread_name) =>
- Some(thread_name)
- case _ => thread_entries.headOption.map(_.thread_name)
+ val thread_contexts =
+ (for ((a, b) <- threads.iterator)
+ yield Debugger.Context(a, b)).toList
+
+ val new_tree_selection =
+ tree_selection() match {
+ case Some(c) if thread_contexts.contains(c) => Some(c)
+ case Some(c) if thread_contexts.exists(t => c.thread_name == t.thread_name) =>
+ Some(c.reset)
+ case _ => thread_contexts.headOption
}
tree.clearSelection
root.removeAllChildren
- for (thread_entry <- thread_entries) {
- val thread_node = new DefaultMutableTreeNode(thread_entry)
- for ((debug_state, i) <- thread_entry.debug_states.zipWithIndex) {
- val stack_node =
- new DefaultMutableTreeNode(Debugger_Dockable.Stack_Entry(debug_state, i))
- thread_node.add(stack_node)
- }
+ for (thread <- thread_contexts) {
+ val thread_node = new DefaultMutableTreeNode(thread)
+ for ((debug_state, i) <- thread.debug_states.zipWithIndex)
+ thread_node.add(new DefaultMutableTreeNode(thread.select(i)))
root.add(thread_node)
}
@@ -191,12 +157,12 @@
tree.expandRow(0)
for (i <- Range.inclusive(tree.getRowCount - 1, 1, -1)) tree.expandRow(i)
- new_thread_selection match {
- case Some(thread_name) =>
+ new_tree_selection match {
+ case Some(c) =>
val i =
- (for (t <- thread_entries.iterator.takeWhile(t => t.thread_name != thread_name))
- yield 1 + t.debug_states.length).sum
- tree.addSelectionRow(i + 1)
+ (for (t <- thread_contexts.iterator.takeWhile(t => c.thread_name != t.thread_name))
+ yield t.size).sum
+ tree.addSelectionRow(i + c.index + 1)
case None =>
}
@@ -206,21 +172,30 @@
def update_vals()
{
tree_selection() match {
- case Some((t, None)) =>
- Debugger.clear_output(t.thread_name)
- case Some((t, Some(i))) if i < t.debug_states.length =>
- Debugger.print_vals(t.thread_name, i, sml_button.selected, context_field.getText)
- case _ =>
+ case Some(c) if c.stack_state.isDefined =>
+ Debugger.print_vals(c, sml_button.selected, context_field.getText)
+ case Some(c) =>
+ Debugger.clear_output(c.thread_name)
+ case None =>
}
}
tree.addTreeSelectionListener(
new TreeSelectionListener {
override def valueChanged(e: TreeSelectionEvent) {
- update_focus(focus_selection())
+ update_focus()
update_vals()
}
})
+ tree.addMouseListener(
+ new MouseAdapter {
+ override def mouseClicked(e: MouseEvent)
+ {
+ val click = tree.getPathForLocation(e.getX, e.getY)
+ if (click != null && e.getClickCount == 1)
+ update_focus()
+ }
+ })
private val tree_pane = new ScrollPane(Component.wrap(tree))
tree_pane.horizontalScrollBarPolicy = ScrollPane.BarPolicy.Always
@@ -230,6 +205,12 @@
/* controls */
+ private val break_button = new CheckBox("Break") {
+ tooltip = "Break running threads at next possible breakpoint"
+ selected = Debugger.is_break()
+ reactions += { case ButtonClicked(_) => Debugger.set_break(selected) }
+ }
+
private val continue_button = new Button("Continue") {
tooltip = "Continue program on current thread, until next breakpoint"
reactions += { case ButtonClicked(_) => thread_selection().map(Debugger.continue(_)) }
@@ -256,6 +237,12 @@
private val context_field =
new Completion_Popup.History_Text_Field("isabelle-debugger-context")
{
+ override def processKeyEvent(evt: KeyEvent)
+ {
+ if (evt.getID == KeyEvent.KEY_PRESSED && evt.getKeyCode == KeyEvent.VK_ENTER)
+ eval_expression()
+ super.processKeyEvent(evt)
+ }
setColumns(20)
setToolTipText(context_label.tooltip)
setFont(GUI.imitate_font(getFont, Font_Info.main_family(), 1.2))
@@ -289,9 +276,8 @@
context_field.addCurrentToHistory()
expression_field.addCurrentToHistory()
tree_selection() match {
- case Some((t, opt_index)) if t.debug_states.nonEmpty =>
- Debugger.eval(t.thread_name, opt_index getOrElse 0,
- sml_button.selected, context_field.getText, expression_field.getText)
+ case Some(c) if c.debug_index.isDefined =>
+ Debugger.eval(c, sml_button.selected, context_field.getText, expression_field.getText)
case _ =>
}
}
@@ -305,7 +291,7 @@
private val controls =
new Wrap_Panel(Wrap_Panel.Alignment.Right)(
- continue_button, step_button, step_over_button, step_out_button,
+ break_button, continue_button, step_button, step_over_button, step_out_button,
context_label, Component.wrap(context_field),
expression_label, Component.wrap(expression_field), eval_button, sml_button,
pretty_text_area.search_label, pretty_text_area.search_field, zoom)
@@ -317,14 +303,19 @@
override def focusOnDefaultComponent { eval_button.requestFocus }
addFocusListener(new FocusAdapter {
- override def focusGained(e: FocusEvent) { update_focus(focus_selection()) }
- override def focusLost(e: FocusEvent) { update_focus(None) }
+ override def focusGained(e: FocusEvent) { update_focus() }
})
- private def update_focus(focus: Option[Position.T])
+ private def update_focus()
{
- if (Debugger.focus(focus) && focus.isDefined)
- PIDE.editor.hyperlink_position(false, current_snapshot, focus.get).foreach(_.follow(view))
+ for (c <- tree_selection()) {
+ Debugger.set_focus(c)
+ for {
+ pos <- c.debug_position
+ link <- PIDE.editor.hyperlink_position(false, current_snapshot, pos)
+ } link.follow(view)
+ }
+ JEdit_Lib.jedit_text_areas(view.getBuffer).foreach(_.repaint())
}
@@ -346,7 +337,10 @@
GUI_Thread.later { handle_resize() }
case Debugger.Update =>
- GUI_Thread.later { handle_update() }
+ GUI_Thread.later {
+ break_button.selected = Debugger.is_break()
+ handle_update()
+ }
}
override def init()
@@ -363,7 +357,6 @@
PIDE.session.global_options -= main
PIDE.session.debugger_updates -= main
delay_resize.revoke()
- update_focus(None)
Debugger.exit()
jEdit.propertiesChanged()
}
--- a/src/Tools/jEdit/src/document_model.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/document_model.scala Thu Sep 03 15:50:40 2015 +0200
@@ -264,6 +264,8 @@
}
}
+ def is_stable(): Boolean = !pending_edits.is_pending();
+
def snapshot(): Document.Snapshot =
session.snapshot(node_name, pending_edits.snapshot())
--- a/src/Tools/jEdit/src/documentation_dockable.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/documentation_dockable.scala Thu Sep 03 15:50:40 2015 +0200
@@ -54,10 +54,10 @@
{
node.getUserObject match {
case Text_File(_, path) =>
- PIDE.editor.goto_file(true, view, Isabelle_System.platform_path(path))
+ PIDE.editor.goto_file(true, view, File.platform_path(path))
case Documentation(_, _, path) =>
if (path.is_file)
- PIDE.editor.goto_file(true, view, Isabelle_System.platform_path(path))
+ PIDE.editor.goto_file(true, view, File.platform_path(path))
else {
Future.fork {
try { Doc.view(path) }
--- a/src/Tools/jEdit/src/isabelle.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/isabelle.scala Thu Sep 03 15:50:40 2015 +0200
@@ -19,7 +19,7 @@
import org.gjt.sp.jedit.textarea.{JEditTextArea, StructureMatcher}
import org.gjt.sp.jedit.syntax.TokenMarker
import org.gjt.sp.jedit.gui.{DockableWindowManager, CompleteWord}
-import org.gjt.sp.jedit.options.PluginOptions
+import org.jedit.options.CombinedOptions
object Isabelle
@@ -361,7 +361,7 @@
def plugin_options(frame: Frame)
{
GUI_Thread.require {}
- new org.gjt.sp.jedit.options.PluginOptions(frame, "plugin.isabelle.jedit.Plugin")
+ jEdit.setProperty("Plugin Options.last", "isabelle-general")
+ new CombinedOptions(frame, 1)
}
}
-
--- a/src/Tools/jEdit/src/isabelle_logic.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/isabelle_logic.scala Thu Sep 03 15:50:40 2015 +0200
@@ -83,7 +83,7 @@
val name = session_args().last
val content = Build.session_content(PIDE.options.value, inlined_files, dirs, name)
content.copy(known_theories =
- content.known_theories.mapValues(name => name.map(Isabelle_System.jvm_path(_))))
+ content.known_theories.mapValues(name => name.map(File.platform_path(_))))
}
}
--- a/src/Tools/jEdit/src/jedit_editor.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/jedit_editor.scala Thu Sep 03 15:50:40 2015 +0200
@@ -49,6 +49,13 @@
def invoke(): Unit = delay_flush.invoke()
+ def stable_tip_version(): Option[Document.Version] =
+ GUI_Thread.require {
+ if (removed_nodes.isEmpty && PIDE.document_models().forall(_.is_stable))
+ session.current_state().stable_tip_version
+ else None
+ }
+
/* current situation */
@@ -218,7 +225,7 @@
if (Path.is_wellformed(source_name)) {
if (Path.is_valid(source_name)) {
val path = Path.explode(source_name)
- Some(Isabelle_System.platform_path(Isabelle_System.source_file(path) getOrElse path))
+ Some(File.platform_path(Isabelle_System.source_file(path) getOrElse path))
}
else None
}
@@ -272,6 +279,23 @@
}
}
+ def is_hyperlink_position(snapshot: Document.Snapshot,
+ text_offset: Text.Offset, pos: Position.T): Boolean =
+ {
+ pos match {
+ case Position.Id_Offset0(id, offset) if offset > 0 =>
+ snapshot.state.find_command(snapshot.version, id) match {
+ case Some((node, command)) if snapshot.version.nodes(command.node_name) eq node =>
+ node.command_start(command) match {
+ case Some(start) => text_offset == start + command.chunk.decode(offset)
+ case None => false
+ }
+ case _ => false
+ }
+ case _ => false
+ }
+ }
+
def hyperlink_position(focus: Boolean, snapshot: Document.Snapshot, pos: Position.T)
: Option[Hyperlink] =
pos match {
--- a/src/Tools/jEdit/src/jedit_lib.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/jedit_lib.scala Thu Sep 03 15:50:40 2015 +0200
@@ -308,8 +308,7 @@
{
val name1 =
if (name.startsWith("idea-icons/")) {
- val file =
- Isabelle_System.platform_file_url(Path.explode("$JEDIT_HOME/dist/jars/idea-icons.jar"))
+ val file = File.platform_url(Path.explode("$JEDIT_HOME/dist/jars/idea-icons.jar"))
"jar:" + file + "!/" + name
}
else name
--- a/src/Tools/jEdit/src/jedit_resources.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/jedit_resources.scala Thu Sep 03 15:50:40 2015 +0200
@@ -56,14 +56,14 @@
{
val path = source_path.expand
if (dir == "" || path.is_absolute)
- MiscUtilities.resolveSymlinks(Isabelle_System.platform_path(path))
+ MiscUtilities.resolveSymlinks(File.platform_path(path))
else if (path.is_current) dir
else {
val vfs = VFSManager.getVFSForPath(dir)
if (vfs.isInstanceOf[FileVFS])
MiscUtilities.resolveSymlinks(
- vfs.constructPath(dir, Isabelle_System.platform_path(path)))
- else vfs.constructPath(dir, Isabelle_System.standard_path(path))
+ vfs.constructPath(dir, File.platform_path(path)))
+ else vfs.constructPath(dir, File.standard_path(path))
}
}
@@ -111,6 +111,9 @@
/* theory text edits */
+ def undefined_blobs(nodes: Document.Nodes): List[Document.Node.Name] =
+ nodes.undefined_blobs(node => !loaded_theories(node.theory))
+
override def commit(change: Session.Change)
{
if (change.syntax_changed.nonEmpty)
@@ -123,7 +126,7 @@
} model.syntax_changed()
}
if (change.deps_changed ||
- PIDE.options.bool("jedit_auto_resolve") && change.version.nodes.undefined_blobs.nonEmpty)
+ PIDE.options.bool("jedit_auto_resolve") && undefined_blobs(change.version.nodes).nonEmpty)
PIDE.deps_changed()
}
}
--- a/src/Tools/jEdit/src/plugin.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/plugin.scala Thu Sep 03 15:50:40 2015 +0200
@@ -14,7 +14,6 @@
import scala.swing.{ListView, ScrollPane}
import org.gjt.sp.jedit.{jEdit, EBMessage, EBPlugin, Buffer, View, Debug, PerspectiveManager}
-import org.jedit.options.CombinedOptions
import org.gjt.sp.jedit.gui.AboutDialog
import org.gjt.sp.jedit.textarea.{JEditTextArea, TextArea}
import org.gjt.sp.jedit.buffer.JEditBuffer
@@ -221,9 +220,10 @@
val aux_files =
if (PIDE.options.bool("jedit_auto_resolve")) {
- val snapshot = PIDE.snapshot(view)
- if (snapshot.is_outdated) Nil
- else snapshot.version.nodes.undefined_blobs.map(_.node)
+ PIDE.editor.stable_tip_version() match {
+ case Some(version) => PIDE.resources.undefined_blobs(version.nodes).map(_.node)
+ case None => Nil
+ }
}
else Nil
--- a/src/Tools/jEdit/src/rendering.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/rendering.scala Thu Sep 03 15:50:40 2015 +0200
@@ -251,6 +251,7 @@
val intensify_color = color_value("intensify_color")
val breakpoint_disabled_color = color_value("breakpoint_disabled_color")
val breakpoint_enabled_color = color_value("breakpoint_enabled_color")
+ val caret_debugger_color = color_value("caret_debugger_color")
val quoted_color = color_value("quoted_color")
val antiquoted_color = color_value("antiquoted_color")
val antiquote_color = color_value("antiquote_color")
--- a/src/Tools/jEdit/src/rich_text_area.scala Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/jEdit/src/rich_text_area.scala Thu Sep 03 15:50:40 2015 +0200
@@ -349,11 +349,19 @@
private def caret_enabled: Boolean =
caret_visible && (!text_area.hasFocus || text_area.isCaretVisible)
- private def caret_color(rendering: Rendering): Color =
+ private def caret_color(rendering: Rendering, offset: Text.Offset): Color =
{
- if (text_area.isCaretVisible)
- text_area.getPainter.getCaretColor
- else rendering.caret_invisible_color
+ if (text_area.isCaretVisible) text_area.getPainter.getCaretColor
+ else {
+ val debug_positions =
+ (for {
+ c <- Debugger.focus().iterator
+ pos <- c.debug_position.iterator
+ } yield pos).toList
+ if (debug_positions.exists(PIDE.editor.is_hyperlink_position(rendering.snapshot, offset, _)))
+ rendering.caret_debugger_color
+ else rendering.caret_invisible_color
+ }
}
private def paint_chunk_list(rendering: Rendering,
@@ -416,7 +424,7 @@
val astr = new AttributedString(s2)
astr.addAttribute(TextAttribute.FONT, chunk_font)
- astr.addAttribute(TextAttribute.FOREGROUND, caret_color(rendering))
+ astr.addAttribute(TextAttribute.FOREGROUND, caret_color(rendering, r.start))
astr.addAttribute(TextAttribute.SWAP_COLORS, TextAttribute.SWAP_COLORS_ON)
gfx.drawString(astr.getIterator, x1 + string_width(s1), y)
@@ -604,7 +612,7 @@
val astr = new AttributedString(" ")
astr.addAttribute(TextAttribute.FONT, painter.getFont)
- astr.addAttribute(TextAttribute.FOREGROUND, caret_color(rendering))
+ astr.addAttribute(TextAttribute.FOREGROUND, caret_color(rendering, caret))
astr.addAttribute(TextAttribute.SWAP_COLORS, TextAttribute.SWAP_COLORS_ON)
val clip = gfx.getClip
--- a/src/Tools/nbe.ML Thu Sep 03 15:50:24 2015 +0200
+++ b/src/Tools/nbe.ML Thu Sep 03 15:50:40 2015 +0200
@@ -70,7 +70,7 @@
^ Syntax.string_of_term_global thy eqn);
val _ = if the_list (Axclass.class_of_param thy (snd c_c')) = [class] then ()
else error ("Inconsistent class: " ^ Display.string_of_thm_global thy thm);
- in Triv_Class_Data.map (AList.update (op =) (class, thm)) thy end;
+ in Triv_Class_Data.map (AList.update (op =) (class, Thm.trim_context thm)) thy end;
local
--- a/src/ZF/UNITY/UNITY.thy Thu Sep 03 15:50:24 2015 +0200
+++ b/src/ZF/UNITY/UNITY.thy Thu Sep 03 15:50:40 2015 +0200
@@ -12,10 +12,6 @@
This ZF theory was ported from its HOL equivalent.\<close>
-consts
- "constrains" :: "[i, i] => i" (infixl "co" 60)
- op_unless :: "[i, i] => i" (infixl "unless" 60)
-
definition
program :: i where
"program == {<init, acts, allowed>:
@@ -72,6 +68,14 @@
initially :: "i=>i" where
"initially(A) == {F \<in> program. Init(F)\<subseteq>A}"
+definition "constrains" :: "[i, i] => i" (infixl "co" 60) where
+ "A co B == {F \<in> program. (\<forall>act \<in> Acts(F). act``A\<subseteq>B) & st_set(A)}"
+ --\<open>the condition @{term "st_set(A)"} makes the definition slightly
+ stronger than the HOL one\<close>
+
+definition unless :: "[i, i] => i" (infixl "unless" 60) where
+ "A unless B == (A - B) co (A \<union> B)"
+
definition
stable :: "i=>i" where
"stable(A) == A co A"
@@ -93,15 +97,6 @@
pg_compl :: "i=>i" where
"pg_compl(X)== program - X"
-defs
- constrains_def:
- "A co B == {F \<in> program. (\<forall>act \<in> Acts(F). act``A\<subseteq>B) & st_set(A)}"
- --\<open>the condition @{term "st_set(A)"} makes the definition slightly
- stronger than the HOL one\<close>
-
- unless_def: "A unless B == (A - B) co (A \<union> B)"
-
-
text\<open>SKIP\<close>
lemma SKIP_in_program [iff,TC]: "SKIP \<in> program"
by (force simp add: SKIP_def program_def mk_program_def)