merged
authorkrauss
Fri Sep 13 09:31:45 2013 +0200 (2013-09-13)
changeset 53615f557a4645f61
parent 53614 8c51fc24d83c
parent 53602 0ae3db699a3e
child 53616 ff37dc246b10
merged
NEWS
lib/Tools/build_dialog
src/HOL/Tools/Sledgehammer/MaSh/src/mashTest.py
src/Pure/Tools/build_dialog.scala
     1.1 --- a/Admin/Linux/Isabelle	Thu Sep 12 22:10:17 2013 +0200
     1.2 +++ b/Admin/Linux/Isabelle	Fri Sep 13 09:31:45 2013 +0200
     1.3 @@ -4,25 +4,24 @@
     1.4  #
     1.5  # Main Isabelle application wrapper.
     1.6  
     1.7 +# dereference executable
     1.8  if [ -L "$0" ]; then
     1.9    TARGET="$(LC_ALL=C ls -l "$0" | sed 's/.* -> //')"
    1.10    exec "$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd "$(dirname "$TARGET")"; pwd)/$(basename "$TARGET")" "$@"
    1.11  fi
    1.12  
    1.13  
    1.14 -## settings
    1.15 -
    1.16 -PRG="$(basename "$0")"
    1.17 +# minimal Isabelle environment
    1.18  
    1.19  ISABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; pwd)"
    1.20 -source "$ISABELLE_HOME/lib/scripts/getsettings" || exit 2
    1.21 +source "$ISABELLE_HOME/lib/scripts/isabelle-platform"
    1.22  
    1.23  
    1.24 -## main
    1.25 +# main
    1.26  
    1.27 -declare -a JAVA_ARGS
    1.28 -JAVA_ARGS=({JAVA_ARGS})
    1.29 +exec "$ISABELLE_HOME/contrib/jdk/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}/bin/java" \
    1.30 +  "-Disabelle.home=$ISABELLE_HOME" \
    1.31 +  {JAVA_ARGS} \
    1.32 +  -classpath "{CLASSPATH}" \
    1.33 +  isabelle.Main "$@"
    1.34  
    1.35 -exec "$ISABELLE_HOME/bin/isabelle" java "${JAVA_ARGS[@]}" \
    1.36 -  -classpath "$ISABELLE_HOME/src/Tools/jEdit/dist/jedit.jar" isabelle.Main "$@"
    1.37 -
     2.1 --- a/Admin/Release/CHECKLIST	Thu Sep 12 22:10:17 2013 +0200
     2.2 +++ b/Admin/Release/CHECKLIST	Fri Sep 13 09:31:45 2013 +0200
     2.3 @@ -11,6 +11,8 @@
     2.4  
     2.5  - test 'display_drafts' command;
     2.6  
     2.7 +- test "#!/usr/bin/env isabelle_scala_script";
     2.8 +
     2.9  - check HTML header of library;
    2.10  
    2.11  - check file positions within logic images (hyperlinks etc.);
     3.1 --- a/Admin/Windows/WinRun4J/Isabelle.ini	Thu Sep 12 22:10:17 2013 +0200
     3.2 +++ b/Admin/Windows/WinRun4J/Isabelle.ini	Fri Sep 13 09:31:45 2013 +0200
     3.3 @@ -1,11 +1,4 @@
     3.4  main.class=isabelle.Main
     3.5 -classpath.1=lib\classes\ext\Pure.jar
     3.6 -classpath.2=lib\classes\ext\scala-compiler.jar
     3.7 -classpath.3=lib\classes\ext\scala-library.jar
     3.8 -classpath.4=lib\classes\ext\scala-swing.jar
     3.9 -classpath.5=lib\classes\ext\scala-actors.jar
    3.10 -classpath.6=lib\classes\ext\scala-reflect.jar
    3.11 -classpath.7=src\Tools\jEdit\dist\jedit.jar
    3.12  vm.location=contrib\jdk\x86-cygwin\jre\bin\server\jvm.dll
    3.13  splash.image=lib\logo\isabelle.bmp
    3.14  vmarg.1=-Disabelle.home=%INI_DIR%
     4.1 --- a/Admin/build	Thu Sep 12 22:10:17 2013 +0200
     4.2 +++ b/Admin/build	Fri Sep 13 09:31:45 2013 +0200
     4.3 @@ -74,7 +74,7 @@
     4.4  
     4.5  ## main
     4.6  
     4.7 -#workaround for scalac
     4.8 +#workaround for scalac 2.10.2
     4.9  function stty() { :; }
    4.10  export -f stty
    4.11  
     5.1 --- a/Admin/components/components.sha1	Thu Sep 12 22:10:17 2013 +0200
     5.2 +++ b/Admin/components/components.sha1	Fri Sep 13 09:31:45 2013 +0200
     5.3 @@ -33,6 +33,8 @@
     5.4  06e9be2627ebb95c45a9bcfa025d2eeef086b408  jedit_build-20130104.tar.gz
     5.5  c85c0829b8170f25aa65ec6852f505ce2a50639b  jedit_build-20130628.tar.gz
     5.6  5de3e399be2507f684b49dfd13da45228214bbe4  jedit_build-20130905.tar.gz
     5.7 +87136818fd5528d97288f5b06bd30c787229eb0d  jedit_build-20130910.tar.gz
     5.8 +0bd2bc2d9a491ba5fc8dd99df27c04f11a72e8fa  jfreechart-1.0.14-1.tar.gz
     5.9  8122526f1fc362ddae1a328bdbc2152853186fee  jfreechart-1.0.14.tar.gz
    5.10  6c737137cc597fc920943783382e928ea79e3feb  kodkodi-1.2.16.tar.gz
    5.11  5f95c96bb99927f3a026050f85bd056f37a9189e  kodkodi-1.5.2.tar.gz
    5.12 @@ -58,6 +60,7 @@
    5.13  e6a43b7b3b21295853bd2a63b27ea20bd6102f5f  windows_app-20130906.tar.gz
    5.14  8fe004aead867d4c82425afac481142bd3f01fb0  windows_app-20130908.tar.gz
    5.15  d273abdc7387462f77a127fa43095eed78332b5c  windows_app-20130909.tar.gz
    5.16 +1c36a840320dfa9bac8af25fc289a4df5ea3eccb  xz-java-1.2-1.tar.gz
    5.17  2ae13aa17d0dc95ce254a52f1dba10929763a10d  xz-java-1.2.tar.gz
    5.18  4530a1aa6f4498ee3d78d6000fa71a3f63bd077f  yices-1.0.28.tar.gz
    5.19  12ae71acde43bd7bed1e005c43034b208c0cba4c  z3-3.2.tar.gz
     6.1 --- a/Admin/components/main	Thu Sep 12 22:10:17 2013 +0200
     6.2 +++ b/Admin/components/main	Fri Sep 13 09:31:45 2013 +0200
     6.3 @@ -4,11 +4,11 @@
     6.4  exec_process-1.0.3
     6.5  Haskabelle-2013
     6.6  jdk-7u25
     6.7 -jedit_build-20130905
     6.8 -jfreechart-1.0.14
     6.9 +jedit_build-20130910
    6.10 +jfreechart-1.0.14-1
    6.11  kodkodi-1.5.2
    6.12  polyml-5.5.0-3
    6.13  scala-2.10.2
    6.14  spass-3.8ds
    6.15  z3-3.2
    6.16 -xz-java-1.2
    6.17 +xz-java-1.2-1
     7.1 --- a/Admin/lib/Tools/makedist	Thu Sep 12 22:10:17 2013 +0200
     7.2 +++ b/Admin/lib/Tools/makedist	Fri Sep 13 09:31:45 2013 +0200
     7.3 @@ -168,6 +168,8 @@
     7.4  find . "(" -name \*.thy -o -name \*.ML -o -name \*.scala ")" -perm +111 -print | xargs chmod -f -x
     7.5  find . -print | xargs chmod -f u+rw
     7.6  
     7.7 +export CLASSPATH="$ISABELLE_CLASSPATH"
     7.8 +
     7.9  ./bin/isabelle env ISABELLE_SCALA_BUILD_OPTIONS="$ISABELLE_SCALA_BUILD_OPTIONS -optimise" \
    7.10    ./Admin/build all || fail "Failed to build distribution"
    7.11  
     8.1 --- a/Admin/lib/Tools/makedist_bundle	Thu Sep 12 22:10:17 2013 +0200
     8.2 +++ b/Admin/lib/Tools/makedist_bundle	Fri Sep 13 09:31:45 2013 +0200
     8.3 @@ -51,6 +51,30 @@
     8.4  tar -C "$TMP" -x -z -f "$ARCHIVE" || exit 2
     8.5  
     8.6  
     8.7 +# distribution classpath (based on educated guesses)
     8.8 +
     8.9 +splitarray ":" "$ISABELLE_CLASSPATH"; CLASSPATH_ENTRIES=("${SPLITARRAY[@]}")
    8.10 +declare -a DISTRIBITION_CLASSPATH=()
    8.11 +
    8.12 +for ENTRY in "${CLASSPATH_ENTRIES[@]}"
    8.13 +do
    8.14 +  ENTRY=$(echo "$ENTRY" | perl -n -e "
    8.15 +    if (m,$ISABELLE_HOME/(.*)\$,) { print qq{\$1}; }
    8.16 +    elsif (m,$USER_HOME/.isabelle/contrib/(.*)\$,) { print qq{contrib/\$1}; }
    8.17 +    else { print; };
    8.18 +    print qq{\n};")
    8.19 +  DISTRIBITION_CLASSPATH["${#DISTRIBITION_CLASSPATH[@]}"]="$ENTRY"
    8.20 +done
    8.21 +
    8.22 +DISTRIBITION_CLASSPATH["${#DISTRIBITION_CLASSPATH[@]}"]="src/Tools/jEdit/dist/jedit.jar"
    8.23 +
    8.24 +echo "classpath"
    8.25 +for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
    8.26 +do
    8.27 +  echo "  $ENTRY"
    8.28 +done
    8.29 +
    8.30 +
    8.31  # bundled components
    8.32  
    8.33  init_component "$JEDIT_HOME"
    8.34 @@ -128,9 +152,19 @@
    8.35  case "$PLATFORM_FAMILY" in
    8.36    linux)
    8.37      purge_contrib '-name "x86*-darwin" -o -name "x86*-cygwin" -o -name "x86*-windows"'
    8.38 +
    8.39 +    LINUX_CLASSPATH=""
    8.40 +    for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
    8.41 +    do
    8.42 +      if [ -z "$LINUX_CLASSPATH" ]; then
    8.43 +        LINUX_CLASSPATH="\\\$ISABELLE_HOME/$ENTRY"
    8.44 +      else
    8.45 +        LINUX_CLASSPATH="$LINUX_CLASSPATH:\\\$ISABELLE_HOME/$ENTRY"
    8.46 +      fi
    8.47 +    done
    8.48      cat "$ISABELLE_HOME/Admin/Linux/Isabelle" | \
    8.49 -      perl -p -e "s,{JAVA_ARGS},$JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS,g;" \
    8.50 -        > "$ISABELLE_TARGET/$ISABELLE_NAME"
    8.51 +      perl -p > "$ISABELLE_TARGET/$ISABELLE_NAME" \
    8.52 +        -e "s,{JAVA_ARGS},$JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS,g; s,{CLASSPATH},$LINUX_CLASSPATH,;"
    8.53      chmod +x "$ISABELLE_TARGET/$ISABELLE_NAME"
    8.54      ;;
    8.55    macos)
    8.56 @@ -151,6 +185,7 @@
    8.57  
    8.58      (
    8.59        cat "$ISABELLE_HOME/Admin/Windows/WinRun4J/Isabelle.ini"
    8.60 +
    8.61        declare -a JAVA_ARGS=()
    8.62        eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS $JEDIT_JAVA_OPTIONS $JEDIT_SYSTEM_OPTIONS)"
    8.63        A=2
    8.64 @@ -159,6 +194,14 @@
    8.65          echo -e "vmarg.$A=$ARG\r"
    8.66          A=$[ $A + 1 ]
    8.67        done
    8.68 +
    8.69 +      A=1
    8.70 +      for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
    8.71 +      do
    8.72 +        ENTRY=$(echo "$ENTRY" | perl -p -e 's,/,\\\\,g;')
    8.73 +        echo -e "classpath.$A=$ENTRY\r"
    8.74 +        A=$[ $A + 1 ]
    8.75 +      done
    8.76      ) > "$ISABELLE_TARGET/${ISABELLE_NAME}.ini"
    8.77  
    8.78      cp "$TMP/windows_app/Isabelle.exe" "$ISABELLE_TARGET/${ISABELLE_NAME}.exe"
    8.79 @@ -233,11 +276,10 @@
    8.80            cat "$APP_TEMPLATE/Info.plist-part2"
    8.81          ) | perl -p -e "s,{ISABELLE_NAME},${ISABELLE_NAME},g;" > "$APP/Contents/Info.plist"
    8.82  
    8.83 -        for NAME in Pure.jar scala-compiler.jar scala-library.jar scala-swing.jar scala-actors.jar scala-reflect.jar
    8.84 +        for ENTRY in "${DISTRIBITION_CLASSPATH[@]}"
    8.85          do
    8.86 -          ln -sf "../Resources/${ISABELLE_NAME}/lib/classes/ext/$NAME" "$APP/Contents/Java"
    8.87 +          ln -sf "../Resources/${ISABELLE_NAME}/$ENTRY" "$APP/Contents/Java"
    8.88          done
    8.89 -        ln -sf "../Resources/${ISABELLE_NAME}/src/Tools/jEdit/dist/jedit.jar" "$APP/Contents/Java"
    8.90  
    8.91          cp -R "$APP_TEMPLATE/Resources/." "$APP/Contents/Resources/."
    8.92          cp "$APP_TEMPLATE/../isabelle.icns" "$APP/Contents/Resources/."
     9.1 --- a/NEWS	Thu Sep 12 22:10:17 2013 +0200
     9.2 +++ b/NEWS	Fri Sep 13 09:31:45 2013 +0200
     9.3 @@ -225,7 +225,7 @@
     9.4    - The whole reflection stack has been decomposed into conversions.
     9.5  INCOMPATIBILITY.
     9.6  
     9.7 -* Weaker precendence of syntax for big intersection and union on sets,
     9.8 +* Stronger precedence of syntax for big intersection and union on sets,
     9.9  in accordance with corresponding lattice operations.  INCOMPATIBILITY.
    9.10  
    9.11  * Nested case expressions are now translated in a separate check phase
    9.12 @@ -260,8 +260,7 @@
    9.13  
    9.14  * Locale hierarchy for abstract orderings and (semi)lattices.
    9.15  
    9.16 -* Discontinued theory src/HOL/Library/Eval_Witness.
    9.17 -INCOMPATIBILITY.
    9.18 +* Discontinued theory src/HOL/Library/Eval_Witness.  INCOMPATIBILITY.
    9.19  
    9.20  * Discontinued obsolete src/HOL/IsaMakefile (considered legacy since
    9.21  Isabelle2013).  Use "isabelle build" to operate on Isabelle sessions.
    9.22 @@ -278,9 +277,9 @@
    9.23  Code_Target_Nat and Code_Target_Numeral.  See the tutorial on code
    9.24  generation for details.  INCOMPATIBILITY.
    9.25  
    9.26 -* Complete_Partial_Order.admissible is defined outside the type 
    9.27 -class ccpo, but with mandatory prefix ccpo. Admissibility theorems
    9.28 -lose the class predicate assumption or sort constraint when possible.
    9.29 +* Complete_Partial_Order.admissible is defined outside the type class
    9.30 +ccpo, but with mandatory prefix ccpo. Admissibility theorems lose the
    9.31 +class predicate assumption or sort constraint when possible.
    9.32  INCOMPATIBILITY.
    9.33  
    9.34  * Introduce type class "conditionally_complete_lattice": Like a
    10.1 --- a/README	Thu Sep 12 22:10:17 2013 +0200
    10.2 +++ b/README	Fri Sep 13 09:31:45 2013 +0200
    10.3 @@ -10,14 +10,12 @@
    10.4  Installation
    10.5  
    10.6     Isabelle works on the three main platform families: Linux, Windows,
    10.7 -   and Mac OS X.
    10.8 -
    10.9 -   Completely integrated bundles including the full Isabelle sources,
   10.10 -   documentation, add-on tools and precompiled logic images for
   10.11 -   several platforms are available from the Isabelle web page.
   10.12 +   and Mac OS X.  The fully integrated application bundles from the
   10.13 +   Isabelle web page include sources, documentation, and add-on tools
   10.14 +   for all supported platforms.
   10.15  
   10.16     Some background information may be found in the Isabelle System
   10.17 -   Manual, distributed with the sources (directory doc).
   10.18 +   Manual (directory doc).
   10.19  
   10.20  User interfaces
   10.21  
    11.1 --- a/etc/isar-keywords.el	Thu Sep 12 22:10:17 2013 +0200
    11.2 +++ b/etc/isar-keywords.el	Fri Sep 13 09:31:45 2013 +0200
    11.3 @@ -319,7 +319,6 @@
    11.4      "constant"
    11.5      "constrains"
    11.6      "datatypes"
    11.7 -    "defaults"
    11.8      "defines"
    11.9      "file"
   11.10      "fixes"
    12.1 --- a/etc/settings	Thu Sep 12 22:10:17 2013 +0200
    12.2 +++ b/etc/settings	Fri Sep 13 09:31:45 2013 +0200
    12.3 @@ -15,6 +15,13 @@
    12.4  
    12.5  ISABELLE_JAVA_SYSTEM_OPTIONS="-Dfile.encoding=UTF-8 -server"
    12.6  
    12.7 +classpath "$ISABELLE_HOME/lib/classes/Pure.jar"
    12.8 +classpath "$ISABELLE_HOME/lib/classes/scala-library.jar"
    12.9 +classpath "$ISABELLE_HOME/lib/classes/scala-swing.jar"
   12.10 +classpath "$ISABELLE_HOME/lib/classes/scala-actors.jar"
   12.11 +classpath "$ISABELLE_HOME/lib/classes/scala-compiler.jar"
   12.12 +classpath "$ISABELLE_HOME/lib/classes/scala-reflect.jar"
   12.13 +
   12.14  
   12.15  ###
   12.16  ### Interactive sessions (cf. isabelle tty)
    13.1 --- a/lib/Tools/build_dialog	Thu Sep 12 22:10:17 2013 +0200
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,77 +0,0 @@
    13.4 -#!/usr/bin/env bash
    13.5 -#
    13.6 -# Author: Makarius
    13.7 -#
    13.8 -# DESCRIPTION: build Isabelle session images via GUI dialog
    13.9 -
   13.10 -
   13.11 -## diagnostics
   13.12 -
   13.13 -PRG="$(basename "$0")"
   13.14 -
   13.15 -function usage()
   13.16 -{
   13.17 -  echo
   13.18 -  echo "Usage: isabelle $PRG [OPTIONS]"
   13.19 -  echo
   13.20 -  echo "  Options are:"
   13.21 -  echo "    -L OPTION    default logic via system option"
   13.22 -  echo "    -d DIR       include session directory"
   13.23 -  echo "    -l NAME      logic session name"
   13.24 -  echo "    -s           system build mode: produce output in ISABELLE_HOME"
   13.25 -  echo
   13.26 -  echo "  Build Isabelle logic session image via GUI dialog (default: $ISABELLE_LOGIC)."
   13.27 -  echo
   13.28 -  exit 1
   13.29 -}
   13.30 -
   13.31 -function fail()
   13.32 -{
   13.33 -  echo "$1" >&2
   13.34 -  exit 2
   13.35 -}
   13.36 -
   13.37 -
   13.38 -## process command line
   13.39 -
   13.40 -LOGIC_OPTION=""
   13.41 -declare -a INCLUDE_DIRS=()
   13.42 -LOGIC=""
   13.43 -SYSTEM_MODE=false
   13.44 -
   13.45 -while getopts "L:d:l:s" OPT
   13.46 -do
   13.47 -  case "$OPT" in
   13.48 -    L)
   13.49 -      LOGIC_OPTION="$OPTARG"
   13.50 -      ;;
   13.51 -    d)
   13.52 -      INCLUDE_DIRS["${#INCLUDE_DIRS[@]}"]="$OPTARG"
   13.53 -      ;;
   13.54 -    l)
   13.55 -      LOGIC="$OPTARG"
   13.56 -      ;;
   13.57 -    s)
   13.58 -      SYSTEM_MODE="true"
   13.59 -      ;;
   13.60 -    \?)
   13.61 -      usage
   13.62 -      ;;
   13.63 -  esac
   13.64 -done
   13.65 -
   13.66 -shift $(($OPTIND - 1))
   13.67 -
   13.68 -
   13.69 -# args
   13.70 -
   13.71 -[ "$#" -ne 0 ] && usage
   13.72 -
   13.73 -
   13.74 -## main
   13.75 -
   13.76 -isabelle_admin_build jars || exit $?
   13.77 -
   13.78 -"$ISABELLE_TOOL" java isabelle.Build_Dialog \
   13.79 -  "$LOGIC_OPTION" "$LOGIC" "$SYSTEM_MODE" "${INCLUDE_DIRS[@]}"
   13.80 -
    14.1 --- a/lib/Tools/java	Thu Sep 12 22:10:17 2013 +0200
    14.2 +++ b/lib/Tools/java	Fri Sep 13 09:31:45 2013 +0200
    14.3 @@ -4,9 +4,11 @@
    14.4  #
    14.5  # DESCRIPTION: invoke Java within the Isabelle environment
    14.6  
    14.7 -CLASSPATH="$(jvmpath "$CLASSPATH")"
    14.8 +declare -a JAVA_ARGS; eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS)"
    14.9  
   14.10 -declare -a JAVA_ARGS; eval "JAVA_ARGS=($ISABELLE_JAVA_SYSTEM_OPTIONS)"
   14.11 +[ -n "$CLASSPATH" ] && classpath "$CLASSPATH"
   14.12 +unset CLASSPATH
   14.13 +
   14.14  isabelle_jdk java "${JAVA_ARGS[@]}" \
   14.15 -  "-Djava.ext.dirs=$(jvmpath "$ISABELLE_JAVA_EXT:$ISABELLE_HOME/lib/classes/ext")" "$@"
   14.16 +  -classpath "$(jvmpath "$ISABELLE_CLASSPATH")" "$@"
   14.17  
    15.1 --- a/lib/Tools/scala	Thu Sep 12 22:10:17 2013 +0200
    15.2 +++ b/lib/Tools/scala	Fri Sep 13 09:31:45 2013 +0200
    15.3 @@ -6,6 +6,6 @@
    15.4  
    15.5  isabelle_admin_build jars || exit $?
    15.6  
    15.7 -CLASSPATH="$(jvmpath "$CLASSPATH")"
    15.8  isabelle_scala scala -Dfile.encoding=UTF-8 \
    15.9 -  "-Djava.ext.dirs=$(jvmpath "$ISABELLE_JAVA_EXT:$ISABELLE_HOME/lib/classes/ext")" "$@"
   15.10 +  -classpath "$(jvmpath "$ISABELLE_CLASSPATH")" "$@"
   15.11 +
    16.1 --- a/lib/Tools/scalac	Thu Sep 12 22:10:17 2013 +0200
    16.2 +++ b/lib/Tools/scalac	Fri Sep 13 09:31:45 2013 +0200
    16.3 @@ -6,7 +6,6 @@
    16.4  
    16.5  isabelle_admin_build jars || exit $?
    16.6  
    16.7 -CLASSPATH="$(jvmpath "$CLASSPATH")"
    16.8  isabelle_scala scalac -Dfile.encoding=UTF-8 \
    16.9 -  "-Djava.ext.dirs=$(jvmpath "$ISABELLE_JAVA_EXT:$ISABELLE_HOME/lib/classes/ext")" "$@"
   16.10 +  -classpath "$(jvmpath "$ISABELLE_CLASSPATH")" "$@"
   16.11  
    17.1 --- a/lib/scripts/getsettings	Thu Sep 12 22:10:17 2013 +0200
    17.2 +++ b/lib/scripts/getsettings	Fri Sep 13 09:31:45 2013 +0200
    17.3 @@ -21,16 +21,20 @@
    17.4    ISABELLE_HOME_WINDOWS="$(cygpath -w "$(dirname "$ISABELLE_HOME")")\\$(basename "$ISABELLE_HOME")"
    17.5    ISABELLE_HOME="$(cygpath -u "$ISABELLE_HOME_WINDOWS")"
    17.6  
    17.7 -  CLASSPATH="$(cygpath -i -u -p "$CLASSPATH")"
    17.8    function jvmpath() { cygpath -i -C UTF8 -w -p "$@"; }
    17.9    CYGWIN_ROOT="$(jvmpath "/")"
   17.10 +
   17.11 +  ISABELLE_CLASSPATH="$(cygpath -i -u -p "$CLASSPATH")"
   17.12 +  unset CLASSPATH
   17.13  else
   17.14    if [ -z "$USER_HOME" ]; then
   17.15      USER_HOME="$HOME"
   17.16    fi
   17.17  
   17.18    function jvmpath() { echo "$@"; }
   17.19 -  CLASSPATH="$CLASSPATH"
   17.20 +
   17.21 +  ISABELLE_CLASSPATH="$CLASSPATH"
   17.22 +  unset CLASSPATH
   17.23  fi
   17.24  
   17.25  export ISABELLE_HOME
   17.26 @@ -122,18 +126,18 @@
   17.27    function isabelle_admin_build () { return 0; }
   17.28  fi
   17.29  
   17.30 -#CLASSPATH convenience
   17.31 +#classpath
   17.32  function classpath ()
   17.33  {
   17.34    for X in "$@"
   17.35    do
   17.36 -    if [ -z "$CLASSPATH" ]; then
   17.37 -      CLASSPATH="$X"
   17.38 +    if [ -z "$ISABELLE_CLASSPATH" ]; then
   17.39 +      ISABELLE_CLASSPATH="$X"
   17.40      else
   17.41 -      CLASSPATH="$X:$CLASSPATH"
   17.42 +      ISABELLE_CLASSPATH="$ISABELLE_CLASSPATH:$X"
   17.43      fi
   17.44    done
   17.45 -  export CLASSPATH
   17.46 +  export ISABELLE_CLASSPATH
   17.47  }
   17.48  
   17.49  #arrays
    18.1 --- a/src/Doc/Datatypes/Datatypes.thy	Thu Sep 12 22:10:17 2013 +0200
    18.2 +++ b/src/Doc/Datatypes/Datatypes.thy	Fri Sep 13 09:31:45 2013 +0200
    18.3 @@ -17,7 +17,7 @@
    18.4  generated datatypes and codatatypes. The datatype support is similar to that
    18.5  provided by the earlier package due to Berghofer and Wenzel
    18.6  \cite{Berghofer-Wenzel:1999:TPHOL}, documented in the Isar reference manual
    18.7 -\cite{isabelle-isar-ref}; indeed, replacing the keyword @{command datatype} by
    18.8 +\cite{isabelle-isar-ref}; indeed, replacing the keyword \keyw{datatype} by
    18.9  @{command datatype_new} is usually all that is needed to port existing theories
   18.10  to use the new package.
   18.11  
   18.12 @@ -40,7 +40,7 @@
   18.13  text {*
   18.14  \noindent
   18.15  The package also provides some convenience, notably automatically generated
   18.16 -destructors (discriminators and selectors).
   18.17 +discriminators and selectors.
   18.18  
   18.19  In addition to plain inductive datatypes, the new package supports coinductive
   18.20  datatypes, or \emph{codatatypes}, which may have infinite values. For example,
   18.21 @@ -75,7 +75,7 @@
   18.22  infinitely many direct subtrees.
   18.23  
   18.24  To use the package, it is necessary to import the @{theory BNF} theory, which
   18.25 -can be precompiled into the \textit{HOL-BNF} image. The following commands show
   18.26 +can be precompiled into the \texttt{HOL-BNF} image. The following commands show
   18.27  how to launch jEdit/PIDE with the image loaded and how to build the image
   18.28  without launching jEdit:
   18.29  *}
   18.30 @@ -91,10 +91,12 @@
   18.31  The package, like its predecessor, fully adheres to the LCF philosophy
   18.32  \cite{mgordon79}: The characteristic theorems associated with the specified
   18.33  (co)datatypes are derived rather than introduced axiomatically.%
   18.34 -\footnote{If the \textit{quick\_and\_dirty} option is enabled, some of the
   18.35 +\footnote{If the @{text quick_and_dirty} option is enabled, some of the
   18.36  internal constructions and most of the internal proof obligations are skipped.}
   18.37  The package's metatheory is described in a pair of papers
   18.38 -\cite{traytel-et-al-2012,blanchette-et-al-wit}.
   18.39 +\cite{traytel-et-al-2012,blanchette-et-al-wit}. The central notion is that of a
   18.40 +\emph{bounded natural functor} (BNF)---a well-behaved type constructor for which
   18.41 +nested (co)recursion is supported.
   18.42  
   18.43  This tutorial is organized as follows:
   18.44  
   18.45 @@ -106,23 +108,25 @@
   18.46  
   18.47  \item Section \ref{sec:defining-recursive-functions}, ``Defining Recursive
   18.48  Functions,'' describes how to specify recursive functions using
   18.49 -\keyw{primrec\_new}, @{command fun}, and @{command function}.
   18.50 +@{command primrec_new}, \keyw{fun}, and \keyw{function}.
   18.51  
   18.52  \item Section \ref{sec:defining-codatatypes}, ``Defining Codatatypes,''
   18.53  describes how to specify codatatypes using the @{command codatatype} command.
   18.54  
   18.55  \item Section \ref{sec:defining-corecursive-functions}, ``Defining Corecursive
   18.56  Functions,'' describes how to specify corecursive functions using the
   18.57 -\keyw{primcorec} command.
   18.58 +@{command primcorec} command.
   18.59  
   18.60  \item Section \ref{sec:registering-bounded-natural-functors}, ``Registering
   18.61 -Bounded Natural Functors,'' explains how to set up the package to allow nested
   18.62 -recursion through custom well-behaved type constructors.
   18.63 +Bounded Natural Functors,'' explains how to use the @{command bnf} command
   18.64 +to register arbitrary type constructors as BNFs.
   18.65  
   18.66 -\item Section \ref{sec:generating-free-constructor-theorems}, ``Generating Free
   18.67 -Constructor Theorems,'' explains how to derive convenience theorems for free
   18.68 -constructors, as performed internally by @{command datatype_new} and
   18.69 -@{command codatatype}.
   18.70 +\item Section
   18.71 +\ref{sec:generating-destructors-and-theorems-for-free-constructors},
   18.72 +``Generating Destructors and Theorems for Free Constructors,'' explains how to
   18.73 +use the command @{command wrap_free_constructors} to derive destructor constants
   18.74 +and theorems for freely generated types, as performed internally by @{command
   18.75 +datatype_new} and @{command codatatype}.
   18.76  
   18.77  \item Section \ref{sec:standard-ml-interface}, ``Standard ML Interface,''
   18.78  describes the package's programmatic interface.
   18.79 @@ -149,8 +153,8 @@
   18.80  in.\allowbreak tum.\allowbreak de}}
   18.81  
   18.82  The commands @{command datatype_new} and @{command primrec_new} are expected to
   18.83 -displace @{command datatype} and @{command primrec} in a future release. Authors
   18.84 -of new theories are encouraged to use the new commands, and maintainers of older
   18.85 +displace \keyw{datatype} and \keyw{primrec} in a future release. Authors of new
   18.86 +theories are encouraged to use the new commands, and maintainers of older
   18.87  theories may want to consider upgrading.
   18.88  
   18.89  Comments and bug reports concerning either the tool or this tutorial should be
   18.90 @@ -163,7 +167,6 @@
   18.91  for its appearance. If you have ideas regarding material that should be
   18.92  included, please let the authors know.
   18.93  \end{framed}
   18.94 -
   18.95  *}
   18.96  
   18.97  
   18.98 @@ -171,10 +174,10 @@
   18.99    \label{sec:defining-datatypes} *}
  18.100  
  18.101  text {*
  18.102 -This section describes how to specify datatypes using the @{command datatype_new}
  18.103 -command. The command is first illustrated through concrete examples featuring
  18.104 -different flavors of recursion. More examples can be found in the directory
  18.105 -\verb|~~/src/HOL/BNF/Examples|.
  18.106 +This section describes how to specify datatypes using the @{command
  18.107 +datatype_new} command. The command is first illustrated through concrete
  18.108 +examples featuring different flavors of recursion. More examples can be found in
  18.109 +the directory \verb|~~/src/HOL/BNF/Examples|.
  18.110  *}
  18.111  
  18.112  
  18.113 @@ -253,17 +256,17 @@
  18.114  
  18.115  text {*
  18.116  \noindent
  18.117 -Nonatomic types must be enclosed in double quotes on the right-hand side of the
  18.118 -equal sign, as is customary in Isabelle.
  18.119 +Occurrences of nonatomic types on the right-hand side of the equal sign must be
  18.120 +enclosed in double quotes, as is customary in Isabelle.
  18.121  *}
  18.122  
  18.123  
  18.124  subsubsection {* Mutual Recursion *}
  18.125  
  18.126  text {*
  18.127 -\emph{Mutually recursive} types are introduced simultaneously and may refer to each
  18.128 -other. The example below introduces a pair of types for even and odd natural
  18.129 -numbers:
  18.130 +\emph{Mutually recursive} types are introduced simultaneously and may refer to
  18.131 +each other. The example below introduces a pair of types for even and odd
  18.132 +natural numbers:
  18.133  *}
  18.134  
  18.135      datatype_new enat = EZero | ESuc onat
  18.136 @@ -301,7 +304,7 @@
  18.137  *}
  18.138  
  18.139      datatype_new 'a wrong = Wrong (*<*)'a
  18.140 -    typ (*>*)"'a wrong \<Rightarrow> 'a wrong"
  18.141 +    typ (*>*)"'a wrong \<Rightarrow> 'a"
  18.142  
  18.143  text {*
  18.144  \noindent
  18.145 @@ -312,7 +315,7 @@
  18.146  
  18.147      datatype_new ('a, 'b) fn = Fn "'a \<Rightarrow> 'b"
  18.148      datatype_new 'a also_wrong = Also_Wrong (*<*)'a
  18.149 -    typ (*>*)"('a also_wrong, 'a also_wrong) fn"
  18.150 +    typ (*>*)"('a also_wrong, 'a) fn"
  18.151  
  18.152  text {*
  18.153  \noindent
  18.154 @@ -321,6 +324,12 @@
  18.155  @{text 'a\<^sub>m}. These type arguments are called \emph{live}; the remaining
  18.156  type arguments are called \emph{dead}. In @{typ "'a \<Rightarrow> 'b"} and
  18.157  @{typ "('a, 'b) fn"}, the type variable @{typ 'a} is dead and @{typ 'b} is live.
  18.158 +
  18.159 +Type constructors must be registered as bounded natural functors (BNFs) to have
  18.160 +live arguments. This is done automatically for datatypes and codatatypes
  18.161 +introduced by the @{command datatype_new} and @{command codatatype} commands.
  18.162 +Section~\ref{sec:registering-bounded-natural-functors} explains how to register
  18.163 +arbitrary type constructors as BNFs.
  18.164  *}
  18.165  
  18.166  
  18.167 @@ -336,12 +345,8 @@
  18.168  \begin{itemize}
  18.169  \setlength{\itemsep}{0pt}
  18.170  
  18.171 -\item \relax{Set functions} (or \relax{natural transformations}):
  18.172 -@{text t_set1}, \ldots, @{text t_setm}
  18.173 -
  18.174 -\item \relax{Map function} (or \relax{functorial action}): @{text t_map}
  18.175 -
  18.176 -\item \relax{Relator}: @{text t_rel}
  18.177 +\item \relax{Case combinator}: @{text t_case} (rendered using the familiar
  18.178 +@{text case}--@{text of} syntax)
  18.179  
  18.180  \item \relax{Iterator}: @{text t_fold}
  18.181  
  18.182 @@ -351,16 +356,25 @@
  18.183  @{text "t.is_C\<^sub>n"}
  18.184  
  18.185  \item \relax{Selectors}:
  18.186 -@{text t.un_C11}$, \ldots, @{text t.un_C1k\<^sub>1}, \\
  18.187 +@{text t.un_C\<^sub>11}$, \ldots, @{text t.un_C\<^sub>1k\<^sub>1}, \\
  18.188  \phantom{\relax{Selectors:}} \quad\vdots \\
  18.189 -\phantom{\relax{Selectors:}} @{text t.un_Cn1}$, \ldots, @{text t.un_Cnk\<^sub>n}.
  18.190 +\phantom{\relax{Selectors:}} @{text t.un_C\<^sub>n1}$, \ldots, @{text t.un_C\<^sub>nk\<^sub>n}.
  18.191 +
  18.192 +\item \relax{Set functions} (or \relax{natural transformations}):
  18.193 +@{text t_set1}, \ldots, @{text t_setm}
  18.194 +
  18.195 +\item \relax{Map function} (or \relax{functorial action}): @{text t_map}
  18.196 +
  18.197 +\item \relax{Relator}: @{text t_rel}
  18.198 +
  18.199  \end{itemize}
  18.200  
  18.201  \noindent
  18.202 -The discriminators and selectors are collectively called \emph{destructors}. The
  18.203 -prefix ``@{text "t."}'' is an optional component of the name and is normally
  18.204 -hidden. The set functions, map function, relator, discriminators, and selectors
  18.205 -can be given custom names, as in the example below:
  18.206 +The case combinator, discriminators, and selectors are collectively called
  18.207 +\emph{destructors}. The prefix ``@{text "t."}'' is an optional component of the
  18.208 +name and is normally hidden. The set functions, map function, relator,
  18.209 +discriminators, and selectors can be given custom names, as in the example
  18.210 +below:
  18.211  *}
  18.212  
  18.213  (*<*)
  18.214 @@ -372,7 +386,8 @@
  18.215        Nil ("[]") and
  18.216        Cons (infixr "#" 65)
  18.217  
  18.218 -    hide_const Nil Cons hd tl map
  18.219 +    hide_type list
  18.220 +    hide_const Nil Cons hd tl set map list_all2 list_case list_rec
  18.221  
  18.222      locale dummy_list
  18.223      begin
  18.224 @@ -393,21 +408,18 @@
  18.225  discriminator associated with @{const Cons} is simply
  18.226  @{term "\<lambda>xs. \<not> null xs"}.
  18.227  
  18.228 -The @{text "defaults"} keyword following the @{const Nil} constructor specifies
  18.229 -a default value for selectors associated with other constructors. Here, it is
  18.230 -used to ensure that the tail of the empty list is the empty list (instead of
  18.231 -being left unspecified).
  18.232 +The @{text defaults} clause following the @{const Nil} constructor specifies a
  18.233 +default value for selectors associated with other constructors. Here, it is used
  18.234 +to ensure that the tail of the empty list is itself (instead of being left
  18.235 +unspecified).
  18.236  
  18.237  Because @{const Nil} is a nullary constructor, it is also possible to use
  18.238  @{term "\<lambda>xs. xs = Nil"} as a discriminator. This is specified by
  18.239 -entering ``@{text "="}'' instead of the identifier @{const null} in the
  18.240 -declaration above. Although this may look appealing, the mixture of constructors
  18.241 -and selectors in the resulting characteristic theorems can lead Isabelle's
  18.242 -automation to switch between the constructor and the destructor view in
  18.243 -surprising ways.
  18.244 -*}
  18.245 +entering ``@{text "="}'' instead of the identifier @{const null}. Although this
  18.246 +may look appealing, the mixture of constructors and selectors in the
  18.247 +characteristic theorems can lead Isabelle's automation to switch between the
  18.248 +constructor and the destructor view in surprising ways.
  18.249  
  18.250 -text {*
  18.251  The usual mixfix syntaxes are available for both types and constructors. For
  18.252  example:
  18.253  *}
  18.254 @@ -415,19 +427,23 @@
  18.255  (*<*)
  18.256      end
  18.257  (*>*)
  18.258 -    datatype_new ('a, 'b) prod (infixr "*" 20) =
  18.259 -      Pair 'a 'b
  18.260 +    datatype_new ('a, 'b) prod (infixr "*" 20) = Pair 'a 'b
  18.261 +
  18.262 +text {* \blankline *}
  18.263  
  18.264      datatype_new (set: 'a) list (map: map rel: list_all2) =
  18.265        null: Nil ("[]")
  18.266      | Cons (hd: 'a) (tl: "'a list") (infixr "#" 65)
  18.267  
  18.268  text {*
  18.269 +\noindent
  18.270  Incidentally, this is how the traditional syntaxes can be set up:
  18.271  *}
  18.272  
  18.273      syntax "_list" :: "args \<Rightarrow> 'a list" ("[(_)]")
  18.274  
  18.275 +text {* \blankline *}
  18.276 +
  18.277      translations
  18.278        "[x, xs]" == "x # [xs]"
  18.279        "[x]" == "x # []"
  18.280 @@ -440,49 +456,48 @@
  18.281  Datatype definitions have the following general syntax:
  18.282  
  18.283  @{rail "
  18.284 -  @@{command datatype_new} @{syntax target}? @{syntax dt_options}? \\
  18.285 +  @@{command_def datatype_new} target? @{syntax dt_options}? \\
  18.286      (@{syntax dt_name} '=' (@{syntax ctor} + '|') + @'and')
  18.287    ;
  18.288    @{syntax_def dt_options}: '(' ((@'no_discs_sels' | @'rep_compat') + ',') ')'
  18.289  "}
  18.290  
  18.291 -The syntactic quantity @{syntax target} can be used to specify a local context
  18.292 -(e.g., @{text "(in linorder)"}). It is documented in the Isar reference manual
  18.293 -\cite{isabelle-isar-ref}.
  18.294 -
  18.295 -The optional target is followed by optional options:
  18.296 +The syntactic quantity \synt{target} can be used to specify a local
  18.297 +context---e.g., @{text "(in linorder)"}. It is documented in the Isar reference
  18.298 +manual \cite{isabelle-isar-ref}.
  18.299 +%
  18.300 +The optional target is optionally followed by datatype-specific options:
  18.301  
  18.302  \begin{itemize}
  18.303  \setlength{\itemsep}{0pt}
  18.304  
  18.305  \item
  18.306 -The \keyw{no\_discs\_sels} option indicates that no destructors (i.e.,
  18.307 -discriminators and selectors) should be generated.
  18.308 +The \keyw{no\_discs\_sels} option indicates that no discriminators or selectors
  18.309 +should be generated.
  18.310  
  18.311  \item
  18.312  The \keyw{rep\_compat} option indicates that the names generated by the
  18.313 -package should contain optional (and normally not displayed) @{text "new."}
  18.314 -components to prevent clashes with a later call to @{command rep_datatype}. See
  18.315 +package should contain optional (and normally not displayed) ``@{text "new."}''
  18.316 +components to prevent clashes with a later call to \keyw{rep\_datatype}. See
  18.317  Section~\ref{ssec:datatype-compatibility-issues} for details.
  18.318  \end{itemize}
  18.319  
  18.320  The left-hand sides of the datatype equations specify the name of the type to
  18.321 -define, its type parameters, and optional additional information:
  18.322 +define, its type parameters, and additional information:
  18.323  
  18.324  @{rail "
  18.325 -  @{syntax_def dt_name}: @{syntax tyargs}? @{syntax name}
  18.326 -    @{syntax map_rel}? @{syntax mixfix}?
  18.327 +  @{syntax_def dt_name}: @{syntax tyargs}? name @{syntax map_rel}? mixfix?
  18.328    ;
  18.329 -  @{syntax_def tyargs}: @{syntax typefree} | '(' ((@{syntax name} ':')? @{syntax typefree} + ',') ')'
  18.330 +  @{syntax_def tyargs}: typefree | '(' ((name ':')? typefree + ',') ')'
  18.331    ;
  18.332 -  @{syntax_def map_rel}: '(' ((('map' | 'rel') ':' @{syntax name}) +) ')'
  18.333 +  @{syntax_def map_rel}: '(' ((('map' | 'rel') ':' name) +) ')'
  18.334  "}
  18.335  
  18.336  \noindent
  18.337 -The syntactic quantity @{syntax name} denotes an identifier, @{syntax typefree}
  18.338 -denotes fixed type variable (@{typ 'a}, @{typ 'b}, \ldots), and @{syntax
  18.339 -mixfix} denotes the usual parenthesized mixfix notation. They are documented in
  18.340 -the Isar reference manual \cite{isabelle-isar-ref}.
  18.341 +The syntactic quantity \synt{name} denotes an identifier, \synt{typefree}
  18.342 +denotes fixed type variable (@{typ 'a}, @{typ 'b}, \ldots), and \synt{mixfix}
  18.343 +denotes the usual parenthesized mixfix notation. They are documented in the Isar
  18.344 +reference manual \cite{isabelle-isar-ref}.
  18.345  
  18.346  The optional names preceding the type variables allow to override the default
  18.347  names of the set functions (@{text t_set1}, \ldots, @{text t_setM}).
  18.348 @@ -490,28 +505,32 @@
  18.349  specify exactly the same type variables in the same order.
  18.350  
  18.351  @{rail "
  18.352 -  @{syntax_def ctor}: (@{syntax name} ':')? @{syntax name} (@{syntax ctor_arg} * ) \\
  18.353 -    @{syntax dt_sel_defaults}? @{syntax mixfix}?
  18.354 +  @{syntax_def ctor}: (name ':')? name (@{syntax ctor_arg} * ) \\
  18.355 +    @{syntax dt_sel_defaults}? mixfix?
  18.356  "}
  18.357  
  18.358 +\medskip
  18.359 +
  18.360  \noindent
  18.361  The main constituents of a constructor specification is the name of the
  18.362  constructor and the list of its argument types. An optional discriminator name
  18.363  can be supplied at the front to override the default name
  18.364 -(@{text t.un_C}$_{ij}$).
  18.365 +(@{text t.is_C\<^sub>j}).
  18.366  
  18.367  @{rail "
  18.368 -  @{syntax_def ctor_arg}: @{syntax type} | '(' @{syntax name} ':' @{syntax type} ')'
  18.369 +  @{syntax_def ctor_arg}: type | '(' name ':' type ')'
  18.370  "}
  18.371  
  18.372 +\medskip
  18.373 +
  18.374  \noindent
  18.375  In addition to the type of a constructor argument, it is possible to specify a
  18.376  name for the corresponding selector to override the default name
  18.377 -(@{text t.un_C}$_{ij}$). The same selector names can be reused for several
  18.378 -constructors as long as they have the same type.
  18.379 +(@{text un_C\<^sub>ji}). The same selector names can be reused for several
  18.380 +constructors as long as they share the same type.
  18.381  
  18.382  @{rail "
  18.383 -  @{syntax_def dt_sel_defaults}: '(' @'defaults' (@{syntax name} ':' @{syntax term} +) ')'
  18.384 +  @{syntax_def dt_sel_defaults}: '(' @'defaults' (name ':' term +) ')'
  18.385  "}
  18.386  
  18.387  \noindent
  18.388 @@ -519,28 +538,209 @@
  18.389  @{text "C \<Colon> \<sigma>\<^sub>1 \<Rightarrow> \<dots> \<Rightarrow> \<sigma>\<^sub>p \<Rightarrow> \<sigma>"},
  18.390  default values can be specified for any selector
  18.391  @{text "un_D \<Colon> \<sigma> \<Rightarrow> \<tau>"}
  18.392 -associated with other constructors. The specified default value must have type
  18.393 +associated with other constructors. The specified default value must be of type
  18.394  @{text "\<sigma>\<^sub>1 \<Rightarrow> \<dots> \<Rightarrow> \<sigma>\<^sub>p \<Rightarrow> \<tau>"}
  18.395 -(i.e., it may dependend on @{text C}'s arguments).
  18.396 +(i.e., it may depends on @{text C}'s arguments).
  18.397  *}
  18.398  
  18.399  subsection {* Generated Theorems
  18.400    \label{ssec:datatype-generated-theorems} *}
  18.401  
  18.402  text {*
  18.403 -  * free ctor theorems
  18.404 -    * case syntax
  18.405 +The characteristic theorems generated by @{command datatype_new} are grouped in
  18.406 +two broad categories:
  18.407 +
  18.408 +\begin{itemize}
  18.409 +\item The \emph{free constructor theorems} are properties about the constructors
  18.410 +and destructors that can be derived for any freely generated type. Internally,
  18.411 +the derivation is performed by @{command wrap_free_constructors}.
  18.412 +
  18.413 +\item The \emph{functorial theorems} are properties of datatypes related to
  18.414 +their BNF nature.
  18.415 +
  18.416 +\item The \emph{inductive theorems} are properties of datatypes related to
  18.417 +their inductive nature.
  18.418 +
  18.419 +\end{itemize}
  18.420 +
  18.421 +\noindent
  18.422 +The full list of named theorems can be obtained as usual by entering the
  18.423 +command \keyw{print\_theorems} immediately after the datatype definition.
  18.424 +This list normally excludes low-level theorems that reveal internal
  18.425 +constructions. To make these accessible, add the line
  18.426 +*}
  18.427 +
  18.428 +    declare [[bnf_note_all]]
  18.429 +(*<*)
  18.430 +    declare [[bnf_note_all = false]]
  18.431 +(*>*)
  18.432 +
  18.433 +text {*
  18.434 +\noindent
  18.435 +to the top of the theory file.
  18.436 +*}
  18.437 +
  18.438 +subsubsection {* Free Constructor Theorems *}
  18.439 +
  18.440 +(*<*)
  18.441 +    consts is_Cons :: 'a
  18.442 +(*>*)
  18.443 +
  18.444 +text {*
  18.445 +The first subgroup of properties are concerned with the constructors.
  18.446 +They are listed below for @{typ "'a list"}:
  18.447 +
  18.448 +\begin{indentblock}
  18.449 +\begin{description}
  18.450 +
  18.451 +\item[@{text "t."}\hthm{inject} @{text "[iff, induct_simp]"}\upshape:] ~ \\
  18.452 +@{thm list.inject[no_vars]}
  18.453 +
  18.454 +\item[@{text "t."}\hthm{distinct} @{text "[simp, induct_simp]"}\upshape:] ~ \\
  18.455 +@{thm list.distinct(1)[no_vars]} \\
  18.456 +@{thm list.distinct(2)[no_vars]}
  18.457 +
  18.458 +\item[@{text "t."}\hthm{exhaust} @{text "[cases t, case_names C\<^sub>1 \<dots> C\<^sub>n]"}\upshape:] ~ \\
  18.459 +@{thm list.exhaust[no_vars]}
  18.460 +
  18.461 +\item[@{text "t."}\hthm{nchotomy}\upshape:] ~ \\
  18.462 +@{thm list.nchotomy[no_vars]}
  18.463 +
  18.464 +\end{description}
  18.465 +\end{indentblock}
  18.466 +
  18.467 +\noindent
  18.468 +The next subgroup is concerned with the case combinator:
  18.469 +
  18.470 +\begin{indentblock}
  18.471 +\begin{description}
  18.472 +
  18.473 +\item[@{text "t."}\hthm{case} @{text "[simp]"}\upshape:] ~ \\
  18.474 +@{thm list.case(1)[no_vars]} \\
  18.475 +@{thm list.case(2)[no_vars]}
  18.476 +
  18.477 +\item[@{text "t."}\hthm{case\_cong}\upshape:] ~ \\
  18.478 +@{thm list.case_cong[no_vars]}
  18.479 +
  18.480 +\item[@{text "t."}\hthm{weak\_case\_cong} @{text "[cong]"}\upshape:] ~ \\
  18.481 +@{thm list.weak_case_cong[no_vars]}
  18.482 +
  18.483 +\item[@{text "t."}\hthm{split}\upshape:] ~ \\
  18.484 +@{thm list.split[no_vars]}
  18.485 +
  18.486 +\item[@{text "t."}\hthm{split\_asm}\upshape:] ~ \\
  18.487 +@{thm list.split_asm[no_vars]}
  18.488 +
  18.489 +\item[@{text "t."}\hthm{splits} = @{text "split split_asm"}]
  18.490 +
  18.491 +\end{description}
  18.492 +\end{indentblock}
  18.493 +
  18.494 +\noindent
  18.495 +The third and last subgroup revolves around discriminators and selectors:
  18.496 +
  18.497 +\begin{indentblock}
  18.498 +\begin{description}
  18.499  
  18.500 -  * per-type theorems
  18.501 -    * sets, map, rel
  18.502 -    * induct, fold, rec
  18.503 -    * simps
  18.504 +\item[@{text "t."}\hthm{discs} @{text "[simp]"}\upshape:] ~ \\
  18.505 +@{thm list.discs(1)[no_vars]} \\
  18.506 +@{thm list.discs(2)[no_vars]}
  18.507 +
  18.508 +\item[@{text "t."}\hthm{sels} @{text "[simp]"}\upshape:] ~ \\
  18.509 +@{thm list.sels(1)[no_vars]} \\
  18.510 +@{thm list.sels(2)[no_vars]}
  18.511 +
  18.512 +\item[@{text "t."}\hthm{collapse} @{text "[simp]"}\upshape:] ~ \\
  18.513 +@{thm list.collapse(1)[no_vars]} \\
  18.514 +@{thm list.collapse(2)[no_vars]}
  18.515 +
  18.516 +\item[@{text "t."}\hthm{disc\_exclude}\upshape:] ~ \\
  18.517 +These properties are missing for @{typ "'a list"} because there is only one
  18.518 +proper discriminator. Had the datatype been introduced with a second
  18.519 +discriminator called @{const is_Cons}, they would have read thusly: \\[\jot]
  18.520 +@{prop "null list \<Longrightarrow> \<not> is_Cons list"} \\
  18.521 +@{prop "is_Cons list \<Longrightarrow> \<not> null list"}
  18.522 +
  18.523 +\item[@{text "t."}\hthm{disc\_exhaust} @{text "[case_names C\<^sub>1 \<dots> C\<^sub>n]"}\upshape:] ~ \\
  18.524 +@{thm list.disc_exhaust[no_vars]}
  18.525 +
  18.526 +\item[@{text "t."}\hthm{expand}\upshape:] ~ \\
  18.527 +@{thm list.expand[no_vars]}
  18.528 +
  18.529 +\item[@{text "t."}\hthm{case\_conv}\upshape:] ~ \\
  18.530 +@{thm list.case_conv[no_vars]}
  18.531 +
  18.532 +\end{description}
  18.533 +\end{indentblock}
  18.534 +*}
  18.535 +
  18.536 +
  18.537 +subsubsection {* Functorial Theorems *}
  18.538 +
  18.539 +text {*
  18.540 +The BNF-related theorem are listed below:
  18.541 +
  18.542 +\begin{indentblock}
  18.543 +\begin{description}
  18.544 +
  18.545 +\item[@{text "t."}\hthm{sets} @{text "[code]"}\upshape:] ~ \\
  18.546 +@{thm list.sets(1)[no_vars]} \\
  18.547 +@{thm list.sets(2)[no_vars]}
  18.548 +
  18.549 +\item[@{text "t."}\hthm{map} @{text "[code]"}\upshape:] ~ \\
  18.550 +@{thm list.map(1)[no_vars]} \\
  18.551 +@{thm list.map(2)[no_vars]}
  18.552  
  18.553 -  * multi-type (``common'') theorems
  18.554 -    * induct
  18.555 +\item[@{text "t."}\hthm{rel\_inject} @{text "[code]"}\upshape:] ~ \\
  18.556 +@{thm list.rel_inject(1)[no_vars]} \\
  18.557 +@{thm list.rel_inject(2)[no_vars]}
  18.558 +
  18.559 +\item[@{text "t."}\hthm{rel\_distinct} @{text "[code]"}\upshape:] ~ \\
  18.560 +@{thm list.rel_distinct(1)[no_vars]} \\
  18.561 +@{thm list.rel_distinct(2)[no_vars]}
  18.562 +
  18.563 +\end{description}
  18.564 +\end{indentblock}
  18.565 +*}
  18.566 +
  18.567 +
  18.568 +subsubsection {* Inductive Theorems *}
  18.569 +
  18.570 +text {*
  18.571 +The inductive theorems are listed below:
  18.572 +
  18.573 +\begin{indentblock}
  18.574 +\begin{description}
  18.575 +
  18.576 +\item[@{text "t."}\hthm{induct} @{text "[induct t, case_names C\<^sub>1 \<dots> C\<^sub>n]"}\upshape:] ~ \\
  18.577 +@{thm list.induct[no_vars]}
  18.578  
  18.579 -  * mention what is registered with which attribute
  18.580 -    * and also nameless safes
  18.581 +\item[@{text "t\<^sub>1_\<dots>_t\<^sub>m."}\hthm{induct} @{text "[case_names C\<^sub>1 \<dots> C\<^sub>n]"}\upshape:] ~ \\
  18.582 +Given $m > 1$ mutually recursive datatypes, this induction rule can be used to
  18.583 +prove $m$ properties simultaneously.
  18.584 +
  18.585 +\item[@{text "t."}\hthm{fold} @{text "[code]"}\upshape:] ~ \\
  18.586 +@{thm list.fold(1)[no_vars]} \\
  18.587 +@{thm list.fold(2)[no_vars]}
  18.588 +
  18.589 +\item[@{text "t."}\hthm{rec} @{text "[code]"}\upshape:] ~ \\
  18.590 +@{thm list.rec(1)[no_vars]} \\
  18.591 +@{thm list.rec(2)[no_vars]}
  18.592 +
  18.593 +\end{description}
  18.594 +\end{indentblock}
  18.595 +
  18.596 +\noindent
  18.597 +For convenience, @{command datatype_new} also provides the following collection:
  18.598 +
  18.599 +\begin{indentblock}
  18.600 +\begin{description}
  18.601 +
  18.602 +\item[@{text "t."}\hthm{simps} = @{text t.inject} @{text t.distinct} @{text t.case} @{text t.rec} @{text t.fold} @{text t.map} @{text t.rel_inject}] ~ \\
  18.603 +@{text t.rel_distinct} @{text t.sets}
  18.604 +
  18.605 +\end{description}
  18.606 +\end{indentblock}
  18.607  *}
  18.608  
  18.609  
  18.610 @@ -568,12 +768,16 @@
  18.611        * \keyw{rep\_compat}
  18.612        * \keyw{rep\_datatype}
  18.613        * has some limitations
  18.614 -        * mutually recursive datatypes? (fails with rep\_datatype?)
  18.615 -        * nested datatypes? (fails with datatype\_new?)
  18.616 +        * mutually recursive datatypes? (fails with rep_datatype?)
  18.617 +        * nested datatypes? (fails with datatype_new?)
  18.618      * option 2
  18.619 -      * \keyw{datatype\_compat}
  18.620 +      * @{command datatype_new_compat}
  18.621        * not fully implemented yet?
  18.622  
  18.623 +@{rail "
  18.624 +  @@{command_def datatype_new_compat} types
  18.625 +"}
  18.626 +
  18.627    * register old datatype as new datatype
  18.628      * no clean way yet
  18.629      * if the goal is to do recursion through old datatypes, can register it as
  18.630 @@ -587,11 +791,11 @@
  18.631    \label{sec:defining-recursive-functions} *}
  18.632  
  18.633  text {*
  18.634 -This describes how to specify recursive functions over datatypes
  18.635 -specified using @{command datatype_new}. The focus in on the \keyw{primrec\_new}
  18.636 -command, which supports primitive recursion. A few examples feature the
  18.637 -@{command fun} and @{command function} commands, described in a separate
  18.638 -tutorial \cite{isabelle-function}.
  18.639 +This describes how to specify recursive functions over datatypes specified using
  18.640 +@{command datatype_new}. The focus in on the @{command primrec_new} command,
  18.641 +which supports primitive recursion. A few examples feature the \keyw{fun} and
  18.642 +\keyw{function} commands, described in a separate tutorial
  18.643 +\cite{isabelle-function}.
  18.644  
  18.645  %%% TODO: partial_function?
  18.646  *}
  18.647 @@ -811,10 +1015,10 @@
  18.648  Primitive recursive functions have the following general syntax:
  18.649  
  18.650  @{rail "
  18.651 -  @@{command primrec_new} @{syntax target}? @{syntax \"fixes\"} \\ @'where'
  18.652 +  @@{command_def primrec_new} target? fixes \\ @'where'
  18.653      (@{syntax primrec_equation} + '|')
  18.654    ;
  18.655 -  @{syntax_def primrec_equation}: @{syntax thmdecl}? @{syntax prop}
  18.656 +  @{syntax_def primrec_equation}: thmdecl? prop
  18.657  "}
  18.658  *}
  18.659  
  18.660 @@ -856,11 +1060,12 @@
  18.661  @{keyword consts}.
  18.662  
  18.663  \item
  18.664 -Define the datatype, specifying @{text "un_D\<^sub>0"} as the selector's default value.
  18.665 +Define the datatype, specifying @{text "un_D\<^sub>0"} as the selector's default
  18.666 +value.
  18.667  
  18.668  \item
  18.669 -Define the behavior of @{text "un_D\<^sub>0"} on values of the newly introduced datatype
  18.670 -using the @{command overloading} command.
  18.671 +Define the behavior of @{text "un_D\<^sub>0"} on values of the newly introduced
  18.672 +datatype using the \keyw{overloading} command.
  18.673  
  18.674  \item
  18.675  Derive the desired equation on @{text un_D} from the characteristic equations
  18.676 @@ -928,8 +1133,8 @@
  18.677  text {*
  18.678  Definitions of codatatypes have almost exactly the same syntax as for datatypes
  18.679  (Section~\ref{ssec:datatype-syntax}), with two exceptions: The command is called
  18.680 -@{command codatatype}; the \keyw{no\_discs\_sels} option is not available, because
  18.681 -destructors are a central notion for codatatypes.
  18.682 +@{command codatatype}; the \keyw{no\_discs\_sels} option is not available,
  18.683 +because destructors are a central notion for codatatypes.
  18.684  *}
  18.685  
  18.686  subsection {* Generated Theorems
  18.687 @@ -941,7 +1146,7 @@
  18.688  
  18.689  text {*
  18.690  This section describes how to specify corecursive functions using the
  18.691 -\keyw{primcorec} command.
  18.692 +@{command primcorec} command.
  18.693  
  18.694  %%% TODO: partial_function? E.g. for defining tail recursive function on lazy
  18.695  %%% lists (cf. terminal0 in TLList.thy)
  18.696 @@ -966,11 +1171,10 @@
  18.697  Primitive corecursive definitions have the following general syntax:
  18.698  
  18.699  @{rail "
  18.700 -  @@{command primcorec} @{syntax target}? @{syntax \"fixes\"} \\ @'where'
  18.701 +  @@{command_def primcorec} target? fixes \\ @'where'
  18.702      (@{syntax primcorec_formula} + '|')
  18.703    ;
  18.704 -  @{syntax_def primcorec_formula}: @{syntax thmdecl}? @{syntax prop}
  18.705 -    (@'of' (@{syntax term} * ))?
  18.706 +  @{syntax_def primcorec_formula}: thmdecl? prop (@'of' (term * ))?
  18.707  "}
  18.708  *}
  18.709  
  18.710 @@ -1009,19 +1213,18 @@
  18.711    \label{ssec:bnf-syntax} *}
  18.712  
  18.713  text {*
  18.714 -
  18.715  @{rail "
  18.716 -  @@{command bnf} @{syntax target}? (@{syntax name} ':')? @{syntax term} \\
  18.717 -    @{syntax term_list} @{syntax term} @{syntax term_list} @{syntax term}?
  18.718 +  @@{command_def bnf} target? (name ':')? term \\
  18.719 +    term_list term term_list term?
  18.720    ;
  18.721 -  @{syntax_def X_list}: '[' (@{syntax X} + ',') ']'
  18.722 +  X_list: '[' (X + ',') ']'
  18.723  "}
  18.724  
  18.725  options: no_discs_sels rep_compat
  18.726  *}
  18.727  
  18.728 -section {* Generating Free Constructor Theorems
  18.729 -  \label{sec:generating-free-constructor-theorems} *}
  18.730 +section {* Generating Destructors and Theorems for Free Constructors
  18.731 +  \label{sec:generating-destructors-and-theorems-for-free-constructors} *}
  18.732  
  18.733  text {*
  18.734  This section explains how to derive convenience theorems for free constructors,
  18.735 @@ -1031,7 +1234,7 @@
  18.736      a type not introduced by ...
  18.737  
  18.738    * also useful for compatibility with old package, e.g. add destructors to
  18.739 -    old @{command datatype}
  18.740 +    old \keyw{datatype}
  18.741  
  18.742    * @{command wrap_free_constructors}
  18.743      * \keyw{no\_discs\_sels}, \keyw{rep\_compat}
  18.744 @@ -1050,23 +1253,21 @@
  18.745  Free constructor wrapping has the following general syntax:
  18.746  
  18.747  @{rail "
  18.748 -  @@{command wrap_free_constructors} @{syntax target}? @{syntax dt_options} \\
  18.749 -    @{syntax term_list} @{syntax name} @{syntax fc_discs_sels}?
  18.750 +  @@{command_def wrap_free_constructors} target? @{syntax dt_options} \\
  18.751 +    term_list name @{syntax fc_discs_sels}?
  18.752    ;
  18.753 -  @{syntax_def fc_discs_sels}: @{syntax name_list} (@{syntax name_list_list} @{syntax name_term_list_list}? )?
  18.754 +  @{syntax_def fc_discs_sels}: name_list (name_list_list name_term_list_list? )?
  18.755    ;
  18.756 -  @{syntax_def name_term}: (@{syntax name} ':' @{syntax term})
  18.757 +  @{syntax_def name_term}: (name ':' term)
  18.758  "}
  18.759  
  18.760  options: no_discs_sels rep_compat
  18.761  
  18.762  X_list is as for BNF
  18.763  
  18.764 +Section~\ref{ssec:datatype-generated-theorems} lists the generated theorems.
  18.765  *}
  18.766  
  18.767 -subsection {* Generated Theorems
  18.768 -  \label{ssec:ctors-generated-theorems} *}
  18.769 -
  18.770  
  18.771  section {* Standard ML Interface
  18.772    \label{sec:standard-ml-interface} *}
  18.773 @@ -1114,7 +1315,7 @@
  18.774  *}
  18.775  
  18.776  text {*
  18.777 -* primrec\_new and primcorec are vaporware
  18.778 +* primcorec is unfinished
  18.779  
  18.780  * slow n-ary mutual (co)datatype, avoid as much as possible (e.g. using nesting)
  18.781  
  18.782 @@ -1128,12 +1329,13 @@
  18.783    based on overloading
  18.784  
  18.785  * no way to register "sum" and "prod" as (co)datatypes to enable N2M reduction for them
  18.786 -  (for datatype\_compat and prim(co)rec)
  18.787 +  (for @{command datatype_new_compat} and prim(co)rec)
  18.788  
  18.789  * no way to register same type as both data- and codatatype?
  18.790  
  18.791  * no recursion through unused arguments (unlike with the old package)
  18.792  
  18.793 +* in a locale, cannot use locally fixed types (because of limitation in typedef)?
  18.794  *}
  18.795  
  18.796  
    19.1 --- a/src/Doc/Datatypes/document/root.tex	Thu Sep 12 22:10:17 2013 +0200
    19.2 +++ b/src/Doc/Datatypes/document/root.tex	Fri Sep 13 09:31:45 2013 +0200
    19.3 @@ -13,11 +13,20 @@
    19.4  \usepackage{railsetup}
    19.5  \usepackage{framed}
    19.6  
    19.7 +\setcounter{secnumdepth}{3}
    19.8 +\setcounter{tocdepth}{3}
    19.9 +
   19.10  \newbox\boxA
   19.11  \setbox\boxA=\hbox{\ }
   19.12  \parindent=4\wd\boxA
   19.13  
   19.14 +\newcommand\blankline{\vskip-.5\baselineskip}
   19.15 +
   19.16 +\newenvironment{indentblock}{\list{}{}\item[]}{\endlist}
   19.17 +
   19.18  \newcommand{\keyw}[1]{\isacommand{#1}}
   19.19 +\newcommand{\synt}[1]{\textit{#1}}
   19.20 +\newcommand{\hthm}[1]{\textbf{\textit{#1}}}
   19.21  
   19.22  %\renewcommand{\isactrlsub}[1]{\/$\sb{\mathrm{#1}}$}
   19.23  \renewcommand{\isactrlsub}[1]{\/$\sb{#1}$}
    20.1 --- a/src/Doc/IsarRef/Spec.thy	Thu Sep 12 22:10:17 2013 +0200
    20.2 +++ b/src/Doc/IsarRef/Spec.thy	Fri Sep 13 09:31:45 2013 +0200
    20.3 @@ -251,7 +251,7 @@
    20.4    Here is an artificial example of bundling various configuration
    20.5    options: *}
    20.6  
    20.7 -bundle trace = [[simp_trace, blast_trace, linarith_trace, metis_trace, smt_trace]]
    20.8 +bundle trace = [[simp_trace, linarith_trace, metis_trace, smt_trace]]
    20.9  
   20.10  lemma "x = x"
   20.11    including trace by metis
    22.1 --- a/src/Doc/Sledgehammer/document/root.tex	Thu Sep 12 22:10:17 2013 +0200
    22.2 +++ b/src/Doc/Sledgehammer/document/root.tex	Fri Sep 13 09:31:45 2013 +0200
    22.3 @@ -1098,7 +1098,7 @@
    22.4  are potentially generated. Whether monomorphization takes place depends on the
    22.5  type encoding used. If the option is set to \textit{smart}, it is set to a value
    22.6  that was empirically found to be appropriate for the prover. For most provers,
    22.7 -this value is 200.
    22.8 +this value is 100.
    22.9  
   22.10  \nopagebreak
   22.11  {\small See also \textit{type\_enc} (\S\ref{problem-encoding}).}
    23.1 --- a/src/Doc/System/Interfaces.thy	Thu Sep 12 22:10:17 2013 +0200
    23.2 +++ b/src/Doc/System/Interfaces.thy	Fri Sep 13 09:31:45 2013 +0200
    23.3 @@ -32,10 +32,10 @@
    23.4    directories may be included via option @{verbatim "-d"} to augment
    23.5    that name space (see also \secref{sec:tool-build}).
    23.6  
    23.7 -  By default, the specified image is checked and built on demand, see
    23.8 -  also @{tool build_dialog}.  The @{verbatim "-s"} determines where to
    23.9 -  store the result session image (see also \secref{sec:tool-build}).
   23.10 -  The @{verbatim "-n"} option bypasses the session build dialog.
   23.11 +  By default, the specified image is checked and built on demand. The
   23.12 +  @{verbatim "-s"} option determines where to store the result session
   23.13 +  image (see also \secref{sec:tool-build}). The @{verbatim "-n"}
   23.14 +  option bypasses the session build dialog.
   23.15  
   23.16    The @{verbatim "-m"} option specifies additional print modes for the
   23.17    prover process.
    24.1 --- a/src/Doc/System/Scala.thy	Thu Sep 12 22:10:17 2013 +0200
    24.2 +++ b/src/Doc/System/Scala.thy	Fri Sep 13 09:31:45 2013 +0200
    24.3 @@ -61,10 +61,10 @@
    24.4  
    24.5    This allows to compile further Scala modules, depending on existing
    24.6    Isabelle/Scala functionality.  The resulting class or jar files can
    24.7 -  be added to the @{setting CLASSPATH} via the @{verbatim classpath}
    24.8 -  Bash function that is provided by the Isabelle process environment.
    24.9 -  Thus add-on components can register themselves in a modular manner,
   24.10 -  see also \secref{sec:components}.
   24.11 +  be added to the Java classpath the @{verbatim classpath} Bash
   24.12 +  function that is provided by the Isabelle process environment.  Thus
   24.13 +  add-on components can register themselves in a modular manner, see
   24.14 +  also \secref{sec:components}.
   24.15  
   24.16    Note that jEdit (\secref{sec:tool-jedit}) has its own mechanisms for
   24.17    adding plugin components, which needs special attention since
    25.1 --- a/src/Doc/System/Sessions.thy	Thu Sep 12 22:10:17 2013 +0200
    25.2 +++ b/src/Doc/System/Sessions.thy	Fri Sep 13 09:31:45 2013 +0200
    25.3 @@ -419,31 +419,4 @@
    25.4  \end{ttbox}
    25.5  *}
    25.6  
    25.7 -
    25.8 -section {* Build dialog *}
    25.9 -
   25.10 -text {* The @{tool_def build_dialog} provides a simple GUI wrapper to
   25.11 -  the tool Isabelle @{tool build} tool.  This enables user interfaces
   25.12 -  like Isabelle/jEdit \secref{sec:tool-jedit} to provide read-made
   25.13 -  logic image on startup.  Its command-line usage is:
   25.14 -\begin{ttbox}
   25.15 -Usage: isabelle build_dialog [OPTIONS] LOGIC
   25.16 -
   25.17 -  Options are:
   25.18 -    -L OPTION    default logic via system option
   25.19 -    -d DIR       include session directory
   25.20 -    -l NAME      logic session name
   25.21 -    -s           system build mode: produce output in ISABELLE_HOME
   25.22 -
   25.23 -  Build Isabelle logic session image via GUI dialog (default: \$ISABELLE_LOGIC).
   25.24 -\end{ttbox}
   25.25 -
   25.26 -  \medskip Option @{verbatim "-l"} specifies an explicit logic session
   25.27 -  name.  Option @{verbatim "-L"} specifies a system option name as
   25.28 -  fall-back to determine the logic session name.  If both are omitted
   25.29 -  or have empty value, @{setting ISABELLE_LOGIC} is used as default.
   25.30 -
   25.31 -  \medskip Options @{verbatim "-d"} and @{verbatim "-s"} have the same
   25.32 -  meaning as for the command-line @{tool build} tool itself.  *}
   25.33 -
   25.34  end
    26.1 --- a/src/HOL/BNF/BNF_Def.thy	Thu Sep 12 22:10:17 2013 +0200
    26.2 +++ b/src/HOL/BNF/BNF_Def.thy	Fri Sep 13 09:31:45 2013 +0200
    26.3 @@ -89,6 +89,9 @@
    26.4  lemma eq_OOI: "R = op = \<Longrightarrow> R = R OO R"
    26.5    by auto
    26.6  
    26.7 +lemma OO_Grp_alt: "(Grp A f)^--1 OO Grp A g = (\<lambda>x y. \<exists>z. z \<in> A \<and> f z = x \<and> g z = y)"
    26.8 +  unfolding Grp_def by auto
    26.9 +
   26.10  lemma Grp_UNIV_id: "f = id \<Longrightarrow> (Grp UNIV f)^--1 OO Grp UNIV f = Grp UNIV f"
   26.11  unfolding Grp_def by auto
   26.12  
   26.13 @@ -110,10 +113,6 @@
   26.14  lemma Collect_split_Grp_inD: "z \<in> Collect (split (Grp A f)) \<Longrightarrow> fst z \<in> A"
   26.15  unfolding Grp_def o_def by auto
   26.16  
   26.17 -lemma wpull_Grp:
   26.18 -"wpull (Collect (split (Grp A f))) A (f ` A) f id fst snd"
   26.19 -unfolding wpull_def Grp_def by auto
   26.20 -
   26.21  definition "pick_middlep P Q a c = (SOME b. P a b \<and> Q b c)"
   26.22  
   26.23  lemma pick_middlep:
    27.1 --- a/src/HOL/BNF/BNF_FP_Base.thy	Thu Sep 12 22:10:17 2013 +0200
    27.2 +++ b/src/HOL/BNF/BNF_FP_Base.thy	Fri Sep 13 09:31:45 2013 +0200
    27.3 @@ -11,8 +11,6 @@
    27.4  
    27.5  theory BNF_FP_Base
    27.6  imports BNF_Comp BNF_Ctr_Sugar
    27.7 -keywords
    27.8 -  "defaults"
    27.9  begin
   27.10  
   27.11  lemma mp_conj: "(P \<longrightarrow> Q) \<and> R \<Longrightarrow> P \<Longrightarrow> R \<and> Q"
    28.1 --- a/src/HOL/BNF/BNF_Util.thy	Thu Sep 12 22:10:17 2013 +0200
    28.2 +++ b/src/HOL/BNF/BNF_Util.thy	Fri Sep 13 09:31:45 2013 +0200
    28.3 @@ -47,16 +47,9 @@
    28.4  lemma bijI: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); \<And>y. \<exists>x. y = f x\<rbrakk> \<Longrightarrow> bij f"
    28.5  unfolding bij_def inj_on_def by auto blast
    28.6  
    28.7 -lemma pair_mem_Collect_split:
    28.8 -"(\<lambda>x y. (x, y) \<in> {(x, y). P x y}) = P"
    28.9 -by simp
   28.10 -
   28.11  lemma Collect_pair_mem_eq: "{(x, y). (x, y) \<in> R} = R"
   28.12  by simp
   28.13  
   28.14 -lemma Collect_fst_snd_mem_eq: "{p. (fst p, snd p) \<in> A} = A"
   28.15 -by simp
   28.16 -
   28.17  (* Operator: *)
   28.18  definition "Gr A f = {(a, f a) | a. a \<in> A}"
   28.19  
    29.1 --- a/src/HOL/BNF/Examples/Misc_Codatatype.thy	Thu Sep 12 22:10:17 2013 +0200
    29.2 +++ b/src/HOL/BNF/Examples/Misc_Codatatype.thy	Fri Sep 13 09:31:45 2013 +0200
    29.3 @@ -43,6 +43,8 @@
    29.4    ('a, 'b1, 'b2) F2 = unit + 'b1 * 'b2
    29.5  *)
    29.6  
    29.7 +codatatype 'a p = P "'a + 'a p"
    29.8 +
    29.9  codatatype 'a J1 = J11 'a "'a J1" | J12 'a "'a J2"
   29.10  and 'a J2 = J21 | J22 "'a J1" "'a J2"
   29.11  
   29.12 @@ -73,6 +75,7 @@
   29.13  
   29.14  codatatype ('b, 'c) less_killing = LK "'b \<Rightarrow> 'c"
   29.15  
   29.16 +codatatype 'b poly_unit = U "'b \<Rightarrow> 'b poly_unit"
   29.17  codatatype 'b cps = CPS1 'b | CPS2 "'b \<Rightarrow> 'b cps"
   29.18  
   29.19  codatatype ('b1, 'b2, 'b3, 'b4, 'b5, 'b6, 'b7, 'b8, 'b9) fun_rhs =
    30.1 --- a/src/HOL/BNF/Tools/bnf_def.ML	Thu Sep 12 22:10:17 2013 +0200
    30.2 +++ b/src/HOL/BNF/Tools/bnf_def.ML	Fri Sep 13 09:31:45 2013 +0200
    30.3 @@ -770,7 +770,7 @@
    30.4      val bnf_wit_As = map (apsnd (mk_bnf_t As')) bnf_wits;
    30.5  
    30.6      val pre_names_lthy = lthy;
    30.7 -    val (((((((((((((((((((((((((fs, gs), hs), x), y), (z, z')), zs), ys), As),
    30.8 +    val ((((((((((((((((((((((((fs, gs), hs), x), y), zs), ys), As),
    30.9        As_copy), Xs), B1s), B2s), f1s), f2s), e1s), e2s), p1s), p2s), bs), (Rs, Rs')), Rs_copy), Ss),
   30.10        transfer_domRs), transfer_ranRs), names_lthy) = pre_names_lthy
   30.11        |> mk_Frees "f" (map2 (curry op -->) As' Bs')
   30.12 @@ -778,7 +778,6 @@
   30.13        ||>> mk_Frees "h" (map2 (curry op -->) As' Ts)
   30.14        ||>> yield_singleton (mk_Frees "x") CA'
   30.15        ||>> yield_singleton (mk_Frees "y") CB'
   30.16 -      ||>> yield_singleton (apfst (op ~~) oo mk_Frees' "z") CRs'
   30.17        ||>> mk_Frees "z" As'
   30.18        ||>> mk_Frees "y" Bs'
   30.19        ||>> mk_Frees "A" (map HOLogic.mk_setT As')
   30.20 @@ -1093,7 +1092,8 @@
   30.21  
   30.22          val map_wppull = Lazy.lazy mk_map_wppull;
   30.23  
   30.24 -        val rel_OO_Grps = no_refl [#rel_OO_Grp axioms];
   30.25 +        val rel_OO_Grp = #rel_OO_Grp axioms;
   30.26 +        val rel_OO_Grps = no_refl [rel_OO_Grp];
   30.27  
   30.28          fun mk_rel_Grp () =
   30.29            let
   30.30 @@ -1182,23 +1182,7 @@
   30.31  
   30.32          val rel_OO = Lazy.lazy mk_rel_OO;
   30.33  
   30.34 -        fun mk_in_rel () =
   30.35 -          let
   30.36 -            val bnf_in = mk_in setRs (map (mk_bnf_t RTs) bnf_sets) CRs';
   30.37 -            val map1 = Term.list_comb (mk_bnf_map RTs As', map fst_const RTs);
   30.38 -            val map2 = Term.list_comb (mk_bnf_map RTs Bs', map snd_const RTs);
   30.39 -            val map_fst_eq = HOLogic.mk_eq (map1 $ z, x);
   30.40 -            val map_snd_eq = HOLogic.mk_eq (map2 $ z, y);
   30.41 -            val lhs = Term.list_comb (rel, Rs) $ x $ y;
   30.42 -            val rhs =
   30.43 -              HOLogic.mk_exists (fst z', snd z', HOLogic.mk_conj (HOLogic.mk_mem (z, bnf_in),
   30.44 -                HOLogic.mk_conj (map_fst_eq, map_snd_eq)));
   30.45 -            val goal =
   30.46 -              fold_rev Logic.all (x :: y :: Rs) (mk_Trueprop_eq (lhs, rhs));
   30.47 -          in
   30.48 -            Goal.prove_sorry lthy [] [] goal (mk_in_rel_tac (the_single rel_OO_Grps))
   30.49 -            |> Thm.close_derivation
   30.50 -          end;
   30.51 +        fun mk_in_rel () = trans OF [rel_OO_Grp, @{thm OO_Grp_alt}] RS @{thm predicate2_eqD};
   30.52  
   30.53          val in_rel = Lazy.lazy mk_in_rel;
   30.54  
    31.1 --- a/src/HOL/BNF/Tools/bnf_def_tactics.ML	Thu Sep 12 22:10:17 2013 +0200
    31.2 +++ b/src/HOL/BNF/Tools/bnf_def_tactics.ML	Fri Sep 13 09:31:45 2013 +0200
    31.3 @@ -21,7 +21,6 @@
    31.4    val mk_rel_eq_tac: int -> thm -> thm -> thm -> tactic
    31.5    val mk_rel_OO_tac: thm list -> thm -> thm -> thm -> thm -> thm list ->
    31.6      {prems: thm list, context: Proof.context} -> tactic
    31.7 -  val mk_in_rel_tac: thm -> {prems: 'a, context: Proof.context} -> tactic
    31.8    val mk_rel_conversep_tac: thm -> thm -> tactic
    31.9    val mk_rel_conversep_le_tac: thm list -> thm -> thm -> thm -> thm list ->
   31.10      {prems: thm list, context: Proof.context} -> tactic
   31.11 @@ -209,13 +208,6 @@
   31.12            rtac (map_comp0 RS sym), atac, atac]) [@{thm fst_fstOp}, @{thm snd_sndOp}])] 1
   31.13    end;
   31.14  
   31.15 -fun mk_in_rel_tac rel_OO_Gr {context = ctxt, prems = _} =
   31.16 -  EVERY' [rtac (rel_OO_Gr RS fun_cong RS fun_cong RS trans), rtac iffI,
   31.17 -    REPEAT_DETERM o eresolve_tac [@{thm GrpE}, @{thm relcomppE}, @{thm conversepE}],
   31.18 -    hyp_subst_tac ctxt, rtac exI, rtac conjI, atac, rtac conjI, rtac refl, rtac refl,
   31.19 -    REPEAT_DETERM o eresolve_tac [exE, conjE], rtac @{thm relcomppI}, rtac @{thm conversepI},
   31.20 -    etac @{thm GrpI}, atac, etac @{thm GrpI}, atac] 1;
   31.21 -
   31.22  fun mk_rel_mono_strong_tac in_rel set_map0s {context = ctxt, prems = _} =
   31.23    if null set_map0s then atac 1
   31.24    else
   31.25 @@ -230,16 +222,18 @@
   31.26    {context = ctxt, prems = _} =
   31.27    let
   31.28      val n = length set_maps;
   31.29 +    val in_tac = if n = 0 then rtac UNIV_I else
   31.30 +      rtac CollectI THEN' CONJ_WRAP' (fn thm =>
   31.31 +        etac (thm RS
   31.32 +          @{thm ord_eq_le_trans[OF _ subset_trans[OF image_mono convol_image_vimage2p]]}))
   31.33 +      set_maps;
   31.34    in
   31.35      REPEAT_DETERM_N n (HEADGOAL (rtac @{thm fun_relI})) THEN
   31.36      unfold_thms_tac ctxt @{thms fun_rel_iff_leq_vimage2p} THEN
   31.37      HEADGOAL (EVERY' [rtac @{thm order_trans}, rtac rel_mono, REPEAT_DETERM_N n o atac,
   31.38        rtac @{thm predicate2I}, dtac (in_rel RS iffD1),
   31.39        REPEAT_DETERM o eresolve_tac [exE, CollectE, conjE], hyp_subst_tac ctxt,
   31.40 -      rtac @{thm vimage2pI}, rtac (in_rel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
   31.41 -      CONJ_WRAP' (fn thm =>
   31.42 -        etac (thm RS @{thm ord_eq_le_trans[OF _ subset_trans[OF image_mono convol_image_vimage2p]]}))
   31.43 -      set_maps,
   31.44 +      rtac @{thm vimage2pI}, rtac (in_rel RS iffD2), rtac exI, rtac conjI, in_tac,
   31.45        rtac conjI,
   31.46        EVERY' (map (fn convol =>
   31.47          rtac (box_equals OF [map_cong0, map_comp RS sym, map_comp RS sym]) THEN'
    32.1 --- a/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML	Thu Sep 12 22:10:17 2013 +0200
    32.2 +++ b/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML	Fri Sep 13 09:31:45 2013 +0200
    32.3 @@ -44,8 +44,8 @@
    32.4    val build_rel: local_theory -> (typ * typ -> term) -> typ * typ -> term
    32.5    val dest_map: Proof.context -> string -> term -> term * term list
    32.6    val dest_ctr: Proof.context -> string -> term -> term * term list
    32.7 -  val mk_co_iters_prelims: BNF_FP_Util.fp_kind -> typ list -> typ list -> int list ->
    32.8 -    int list list -> term list list -> Proof.context ->
    32.9 +  val mk_co_iters_prelims: BNF_FP_Util.fp_kind -> typ list list list -> typ list -> typ list ->
   32.10 +    int list -> int list list -> term list list -> Proof.context ->
   32.11      (term list list
   32.12       * (typ list list * typ list list list list * term list list
   32.13          * term list list list list) list option
   32.14 @@ -53,9 +53,9 @@
   32.15          * ((term list list * term list list list) * (typ list * typ list list)) list) option)
   32.16      * Proof.context
   32.17  
   32.18 -  val mk_iter_fun_arg_types: typ list -> int list -> int list list -> term ->
   32.19 +  val mk_iter_fun_arg_types: typ list list list -> int list -> int list list -> term ->
   32.20      typ list list list list
   32.21 -  val mk_coiter_fun_arg_types: typ list -> int list -> int list list -> term ->
   32.22 +  val mk_coiter_fun_arg_types: typ list list list -> typ list -> int list -> term ->
   32.23      typ list list
   32.24      * (typ list list list list * typ list list list * typ list list list list * typ list)
   32.25    val define_iters: string list ->
   32.26 @@ -268,12 +268,12 @@
   32.27  
   32.28  val mk_fp_iter_fun_types = binder_fun_types o fastype_of;
   32.29  
   32.30 -fun unzip_recT Cs (T as Type (@{type_name prod}, Ts as [_, U])) =
   32.31 -    if member (op =) Cs U then Ts else [T]
   32.32 +fun unzip_recT (Type (@{type_name prod}, _)) T = [T]
   32.33 +  | unzip_recT _ (T as Type (@{type_name prod}, Ts)) = Ts
   32.34    | unzip_recT _ T = [T];
   32.35  
   32.36 -fun unzip_corecT Cs (T as Type (@{type_name sum}, Ts as [_, U])) =
   32.37 -    if member (op =) Cs U then Ts else [T]
   32.38 +fun unzip_corecT (Type (@{type_name sum}, _)) T = [T]
   32.39 +  | unzip_corecT _ (T as Type (@{type_name sum}, Ts)) = Ts
   32.40    | unzip_corecT _ T = [T];
   32.41  
   32.42  fun mk_map live Ts Us t =
   32.43 @@ -398,12 +398,12 @@
   32.44  
   32.45  fun mk_iter_fun_arg_types0 n ms = map2 dest_tupleT ms o dest_sumTN_balanced n o domain_type;
   32.46  
   32.47 -fun mk_iter_fun_arg_types Cs ns mss =
   32.48 +fun mk_iter_fun_arg_types ctr_Tsss ns mss =
   32.49    mk_fp_iter_fun_types
   32.50    #> map3 mk_iter_fun_arg_types0 ns mss
   32.51 -  #> map (map (map (unzip_recT Cs)));
   32.52 +  #> map2 (map2 (map2 unzip_recT)) ctr_Tsss;
   32.53  
   32.54 -fun mk_iters_args_types Cs ns mss ctor_iter_fun_Tss lthy =
   32.55 +fun mk_iters_args_types ctr_Tsss Cs ns mss ctor_iter_fun_Tss lthy =
   32.56    let
   32.57      val Css = map2 replicate ns Cs;
   32.58      val y_Tsss = map3 mk_iter_fun_arg_types0 ns mss (map un_fold_of ctor_iter_fun_Tss);
   32.59 @@ -418,8 +418,11 @@
   32.60      val yssss = map (map (map single)) ysss;
   32.61  
   32.62      val z_Tssss =
   32.63 -      map3 (fn n => fn ms => map2 (map (unzip_recT Cs) oo dest_tupleT) ms o
   32.64 -        dest_sumTN_balanced n o domain_type o co_rec_of) ns mss ctor_iter_fun_Tss;
   32.65 +      map4 (fn n => fn ms => fn ctr_Tss => fn ctor_iter_fun_Ts =>
   32.66 +          map3 (fn m => fn ctr_Ts => fn ctor_iter_fun_T =>
   32.67 +              map2 unzip_recT ctr_Ts (dest_tupleT m ctor_iter_fun_T))
   32.68 +            ms ctr_Tss (dest_sumTN_balanced n (domain_type (co_rec_of ctor_iter_fun_Ts))))
   32.69 +        ns mss ctr_Tsss ctor_iter_fun_Tss;
   32.70  
   32.71      val z_Tsss' = map (map flat_rec_arg_args) z_Tssss;
   32.72      val h_Tss = map2 (map2 (curry op --->)) z_Tsss' Css;
   32.73 @@ -434,16 +437,18 @@
   32.74      ([(g_Tss, y_Tssss, gss, yssss), (h_Tss, z_Tssss, hss, zssss)], lthy)
   32.75    end;
   32.76  
   32.77 -fun mk_coiter_fun_arg_types0 Cs ns mss fun_Ts =
   32.78 +fun mk_coiter_fun_arg_types0 ctr_Tsss Cs ns fun_Ts =
   32.79    let
   32.80 -    (*avoid "'a itself" arguments in coiterators and corecursors*)
   32.81 -    fun repair_arity [0] = [1]
   32.82 -      | repair_arity ms = ms;
   32.83 +    (*avoid "'a itself" arguments in coiterators*)
   32.84 +    fun repair_arity [[]] = [[@{typ unit}]]
   32.85 +      | repair_arity Tss = Tss;
   32.86  
   32.87 +    val ctr_Tsss' = map repair_arity ctr_Tsss;
   32.88      val f_sum_prod_Ts = map range_type fun_Ts;
   32.89      val f_prod_Tss = map2 dest_sumTN_balanced ns f_sum_prod_Ts;
   32.90 -    val f_Tsss = map2 (map2 dest_tupleT o repair_arity) mss f_prod_Tss;
   32.91 -    val f_Tssss = map2 (fn C => map (map (map (curry op --> C) o unzip_corecT Cs))) Cs f_Tsss;
   32.92 +    val f_Tsss = map2 (map2 (dest_tupleT o length)) ctr_Tsss' f_prod_Tss;
   32.93 +    val f_Tssss = map3 (fn C => map2 (map2 (map (curry op --> C) oo unzip_corecT)))
   32.94 +      Cs ctr_Tsss' f_Tsss;
   32.95      val q_Tssss = map (map (map (fn [_] => [] | [_, T] => [mk_pred1T (domain_type T)]))) f_Tssss;
   32.96    in
   32.97      (q_Tssss, f_Tsss, f_Tssss, f_sum_prod_Ts)
   32.98 @@ -451,18 +456,18 @@
   32.99  
  32.100  fun mk_coiter_p_pred_types Cs ns = map2 (fn n => replicate (Int.max (0, n - 1)) o mk_pred1T) ns Cs;
  32.101  
  32.102 -fun mk_coiter_fun_arg_types Cs ns mss dtor_coiter =
  32.103 +fun mk_coiter_fun_arg_types ctr_Tsss Cs ns dtor_coiter =
  32.104    (mk_coiter_p_pred_types Cs ns,
  32.105 -   mk_fp_iter_fun_types dtor_coiter |> mk_coiter_fun_arg_types0 Cs ns mss);
  32.106 +   mk_fp_iter_fun_types dtor_coiter |> mk_coiter_fun_arg_types0 ctr_Tsss Cs ns);
  32.107  
  32.108 -fun mk_coiters_args_types Cs ns mss dtor_coiter_fun_Tss lthy =
  32.109 +fun mk_coiters_args_types ctr_Tsss Cs ns mss dtor_coiter_fun_Tss lthy =
  32.110    let
  32.111      val p_Tss = mk_coiter_p_pred_types Cs ns;
  32.112  
  32.113      fun mk_types get_Ts =
  32.114        let
  32.115          val fun_Ts = map get_Ts dtor_coiter_fun_Tss;
  32.116 -        val (q_Tssss, f_Tsss, f_Tssss, f_sum_prod_Ts) = mk_coiter_fun_arg_types0 Cs ns mss fun_Ts;
  32.117 +        val (q_Tssss, f_Tsss, f_Tssss, f_sum_prod_Ts) = mk_coiter_fun_arg_types0 ctr_Tsss Cs ns fun_Ts;
  32.118          val pf_Tss = map3 flat_corec_preds_predsss_gettersss p_Tss q_Tssss f_Tssss;
  32.119        in
  32.120          (q_Tssss, f_Tsss, f_Tssss, (f_sum_prod_Ts, pf_Tss))
  32.121 @@ -509,7 +514,7 @@
  32.122      ((z, cs, cpss, [(unfold_args, unfold_types), (corec_args, corec_types)]), lthy)
  32.123    end;
  32.124  
  32.125 -fun mk_co_iters_prelims fp fpTs Cs ns mss xtor_co_iterss0 lthy =
  32.126 +fun mk_co_iters_prelims fp ctr_Tsss fpTs Cs ns mss xtor_co_iterss0 lthy =
  32.127    let
  32.128      val thy = Proof_Context.theory_of lthy;
  32.129  
  32.130 @@ -519,9 +524,9 @@
  32.131  
  32.132      val ((iters_args_types, coiters_args_types), lthy') =
  32.133        if fp = Least_FP then
  32.134 -        mk_iters_args_types Cs ns mss xtor_co_iter_fun_Tss lthy |>> (rpair NONE o SOME)
  32.135 +        mk_iters_args_types ctr_Tsss Cs ns mss xtor_co_iter_fun_Tss lthy |>> (rpair NONE o SOME)
  32.136        else
  32.137 -        mk_coiters_args_types Cs ns mss xtor_co_iter_fun_Tss lthy |>> (pair NONE o SOME)
  32.138 +        mk_coiters_args_types ctr_Tsss Cs ns mss xtor_co_iter_fun_Tss lthy |>> (pair NONE o SOME)
  32.139    in
  32.140      ((xtor_co_iterss, iters_args_types, coiters_args_types), lthy')
  32.141    end;
  32.142 @@ -542,9 +547,12 @@
  32.143    let
  32.144      val thy = Proof_Context.theory_of lthy0;
  32.145  
  32.146 +    val maybe_conceal_def_binding = Thm.def_binding
  32.147 +      #> Config.get lthy0 bnf_note_all = false ? Binding.conceal;
  32.148 +
  32.149      val ((csts, defs), (lthy', lthy)) = lthy0
  32.150        |> apfst split_list o fold_map (fn (b, spec) =>
  32.151 -        Specification.definition (SOME (b, NONE, NoSyn), ((Thm.def_binding b, []), spec))
  32.152 +        Specification.definition (SOME (b, NONE, NoSyn), ((maybe_conceal_def_binding b, []), spec))
  32.153          #>> apsnd snd) binding_specs
  32.154        ||> `Local_Theory.restore;
  32.155  
  32.156 @@ -1221,7 +1229,7 @@
  32.157      val mss = map (map length) ctr_Tsss;
  32.158  
  32.159      val ((xtor_co_iterss, iters_args_types, coiters_args_types), lthy') =
  32.160 -      mk_co_iters_prelims fp fpTs Cs ns mss xtor_co_iterss0 lthy;
  32.161 +      mk_co_iters_prelims fp ctr_Tsss fpTs Cs ns mss xtor_co_iterss0 lthy;
  32.162  
  32.163      fun define_ctrs_dtrs_for_type (((((((((((((((((((((((fp_bnf, fp_b), fpT), ctor), dtor),
  32.164              xtor_co_iters), ctor_dtor), dtor_ctor), ctor_inject), pre_map_def), pre_set_defs),
  32.165 @@ -1250,9 +1258,12 @@
  32.166            map3 (fn k => fn xs => fn tuple_x => fold_rev Term.lambda xs (ctor $
  32.167              mk_InN_balanced ctr_sum_prod_T n tuple_x k)) ks xss tuple_xs;
  32.168  
  32.169 +        val maybe_conceal_def_binding = Thm.def_binding
  32.170 +          #> Config.get no_defs_lthy bnf_note_all = false ? Binding.conceal;
  32.171 +
  32.172          val ((raw_ctrs, raw_ctr_defs), (lthy', lthy)) = no_defs_lthy
  32.173            |> apfst split_list o fold_map3 (fn b => fn mx => fn rhs =>
  32.174 -              Local_Theory.define ((b, mx), ((Thm.def_binding b, []), rhs)) #>> apsnd snd)
  32.175 +              Local_Theory.define ((b, mx), ((maybe_conceal_def_binding b, []), rhs)) #>> apsnd snd)
  32.176              ctr_bindings ctr_mixfixes ctr_rhss
  32.177            ||> `Local_Theory.restore;
  32.178  
  32.179 @@ -1538,7 +1549,7 @@
  32.180    (Parse.typ >> pair Binding.empty);
  32.181  
  32.182  val parse_defaults =
  32.183 -  @{keyword "("} |-- @{keyword "defaults"} |-- Scan.repeat parse_bound_term --| @{keyword ")"};
  32.184 +  @{keyword "("} |-- Parse.reserved "defaults" |-- Scan.repeat parse_bound_term --| @{keyword ")"};
  32.185  
  32.186  val parse_type_arg_constrained =
  32.187    Parse.type_ident -- Scan.option (@{keyword "::"} |-- Parse.!!! Parse.sort);
  32.188 @@ -1554,8 +1565,6 @@
  32.189  
  32.190  val no_map_rel = (Binding.empty, Binding.empty);
  32.191  
  32.192 -(* "map" and "rel" are purposedly not registered as keywords, because they are short and nice names
  32.193 -   that we don't want them to be highlighted everywhere. *)
  32.194  fun extract_map_rel ("map", b) = apfst (K b)
  32.195    | extract_map_rel ("rel", b) = apsnd (K b)
  32.196    | extract_map_rel (s, _) = error ("Unknown label " ^ quote s ^ " (expected \"map\" or \"rel\")");
    33.1 --- a/src/HOL/BNF/Tools/bnf_fp_def_sugar_tactics.ML	Thu Sep 12 22:10:17 2013 +0200
    33.2 +++ b/src/HOL/BNF/Tools/bnf_fp_def_sugar_tactics.ML	Fri Sep 13 09:31:45 2013 +0200
    33.3 @@ -152,7 +152,7 @@
    33.4       full_simp_tac
    33.5         (ss_only (@{thm prod.inject} :: no_refl discs @ rel_eqs @ more_simp_thms) ctxt) THEN'
    33.6       REPEAT o etac conjE THEN_MAYBE' REPEAT o hyp_subst_tac ctxt THEN' REPEAT o rtac conjI THEN'
    33.7 -     REPEAT o rtac refl);
    33.8 +     REPEAT o (rtac refl ORELSE' atac));
    33.9  
   33.10  fun mk_coinduct_distinct_ctrs_tac ctxt discs discs' =
   33.11    hyp_subst_tac ctxt THEN' REPEAT o etac conjE THEN'
    34.1 --- a/src/HOL/BNF/Tools/bnf_fp_n2m_sugar.ML	Thu Sep 12 22:10:17 2013 +0200
    34.2 +++ b/src/HOL/BNF/Tools/bnf_fp_n2m_sugar.ML	Fri Sep 13 09:31:45 2013 +0200
    34.3 @@ -127,7 +127,7 @@
    34.4        val nested_bnfs = nesty_bnfs lthy ctrXs_Tsss Xs;
    34.5  
    34.6        val ((xtor_co_iterss, iters_args_types, coiters_args_types), _) =
    34.7 -        mk_co_iters_prelims fp fpTs Cs ns mss xtor_co_iterss0 lthy;
    34.8 +        mk_co_iters_prelims fp ctr_Tsss fpTs Cs ns mss xtor_co_iterss0 lthy;
    34.9  
   34.10        fun mk_binding b suf = Binding.suffix_name ("_" ^ suf) b;
   34.11  
    35.1 --- a/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML	Thu Sep 12 22:10:17 2013 +0200
    35.2 +++ b/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML	Fri Sep 13 09:31:45 2013 +0200
    35.3 @@ -312,7 +312,8 @@
    35.4  
    35.5      val perm_Cs = map (body_type o fastype_of o co_rec_of o of_fp_sugar (#xtor_co_iterss o #fp_res))
    35.6        perm_fp_sugars;
    35.7 -    val perm_fun_arg_Tssss = mk_iter_fun_arg_types perm_Cs perm_ns perm_mss (co_rec_of ctor_iters1);
    35.8 +    val perm_fun_arg_Tssss =
    35.9 +      mk_iter_fun_arg_types perm_ctr_Tsss perm_ns perm_mss (co_rec_of ctor_iters1);
   35.10  
   35.11      fun unpermute0 perm0_xs = permute_like (op =) perm0_kks kks perm0_xs;
   35.12      fun unpermute perm_xs = permute_like (op =) perm_indices indices perm_xs;
   35.13 @@ -389,12 +390,11 @@
   35.14      val nn = length perm_fpTs;
   35.15      val kks = 0 upto nn - 1;
   35.16      val perm_ns = map length perm_ctr_Tsss;
   35.17 -    val perm_mss = map (map length) perm_ctr_Tsss;
   35.18  
   35.19      val perm_Cs = map (domain_type o body_fun_type o fastype_of o co_rec_of o
   35.20        of_fp_sugar (#xtor_co_iterss o #fp_res)) perm_fp_sugars;
   35.21      val (perm_p_Tss, (perm_q_Tssss, _, perm_f_Tssss, _)) =
   35.22 -      mk_coiter_fun_arg_types perm_Cs perm_ns perm_mss (co_rec_of dtor_coiters1);
   35.23 +      mk_coiter_fun_arg_types perm_ctr_Tsss perm_Cs perm_ns (co_rec_of dtor_coiters1);
   35.24  
   35.25      val (perm_p_hss, h) = indexedd perm_p_Tss 0;
   35.26      val (perm_q_hssss, h') = indexedddd perm_q_Tssss h;
   35.27 @@ -447,7 +447,8 @@
   35.28          val p_ios = map SOME p_is @ [NONE];
   35.29          val collapses = #collapses (nth ctr_sugars index);
   35.30          val corec_thms = co_rec_of (nth coiter_thmsss index);
   35.31 -        val disc_corecs = co_rec_of (nth disc_coitersss index);
   35.32 +        val disc_corecs = (case co_rec_of (nth disc_coitersss index) of [] => [TrueI]
   35.33 +          | thms => thms);
   35.34          val sel_corecss = co_rec_of (nth sel_coiterssss index);
   35.35        in
   35.36          map11 mk_ctr_spec ctrs discs selss p_ios q_isss f_isss f_Tsss collapses corec_thms
    36.1 --- a/src/HOL/BNF/Tools/bnf_fp_util.ML	Thu Sep 12 22:10:17 2013 +0200
    36.2 +++ b/src/HOL/BNF/Tools/bnf_fp_util.ML	Fri Sep 13 09:31:45 2013 +0200
    36.3 @@ -587,13 +587,15 @@
    36.4        in
    36.5          Binding.prefix_name rawN
    36.6          #> fold_rev (fn (s, mand) => Binding.qualify mand s) (qs @ [(n, true)])
    36.7 +        #> Binding.conceal
    36.8        end;
    36.9  
   36.10      val ((bnfs, (deadss, livess)), (unfold_set, lthy)) = apfst (apsnd split_list o split_list)
   36.11        (fold_map2 (fn b => bnf_of_typ Smart_Inline (raw_qualify b) fp_sort Xs) bs rhsXs
   36.12          (empty_unfolds, lthy));
   36.13  
   36.14 -    fun norm_qualify i = Binding.qualify true (Binding.name_of (nth bs (Int.max (0, i - 1))));
   36.15 +    fun norm_qualify i = Binding.qualify true (Binding.name_of (nth bs (Int.max (0, i - 1))))
   36.16 +      #> Binding.conceal;
   36.17  
   36.18      val Ass = map (map dest_TFree) livess;
   36.19      val resDs = fold (subtract (op =)) Ass resBs;
   36.20 @@ -606,7 +608,8 @@
   36.21  
   36.22      val Dss = map3 (append oo map o nth) livess kill_poss deadss;
   36.23  
   36.24 -    val pre_qualify = Binding.qualify false o Binding.name_of;
   36.25 +    fun pre_qualify b = Binding.qualify false (Binding.name_of b)
   36.26 +      #> Config.get lthy' bnf_note_all = false ? Binding.conceal;
   36.27  
   36.28      val ((pre_bnfs, deadss), lthy'') =
   36.29        fold_map3 (fn b => seal_bnf (pre_qualify b) unfold_set' (Binding.prefix_name preN b))
    37.1 --- a/src/HOL/BNF/Tools/bnf_gfp.ML	Thu Sep 12 22:10:17 2013 +0200
    37.2 +++ b/src/HOL/BNF/Tools/bnf_gfp.ML	Fri Sep 13 09:31:45 2013 +0200
    37.3 @@ -66,13 +66,17 @@
    37.4      val ks = 1 upto n;
    37.5      val m = live - n; (*passive, if 0 don't generate a new BNF*)
    37.6      val ls = 1 upto m;
    37.7 +
    37.8 +    val note_all = Config.get lthy bnf_note_all;
    37.9      val b_names = map Binding.name_of bs;
   37.10 -    val common_name = mk_common_name b_names;
   37.11 -    val b = Binding.name common_name;
   37.12 -    val internal_b = Binding.prefix true common_name b;
   37.13 -    fun qualify_bs internal = map2 (Binding.prefix internal) b_names bs;
   37.14 -    val internal_bs = qualify_bs true;
   37.15 -    val external_bs = qualify_bs false;
   37.16 +    val b_name = mk_common_name b_names;
   37.17 +    val b = Binding.name b_name;
   37.18 +    val mk_internal_b = Binding.name #> Binding.prefix true b_name #> Binding.conceal;
   37.19 +    fun mk_internal_bs name =
   37.20 +      map (fn b =>
   37.21 +        Binding.prefix true b_name (Binding.suffix_name ("_" ^ name) b) |> Binding.conceal) bs;
   37.22 +    val external_bs = map2 (Binding.prefix false) b_names bs
   37.23 +      |> note_all = false ? map Binding.conceal;
   37.24  
   37.25      (* TODO: check if m, n, etc., are sane *)
   37.26  
   37.27 @@ -297,7 +301,7 @@
   37.28  
   37.29      (* coalgebra *)
   37.30  
   37.31 -    val coalg_bind = Binding.suffix_name ("_" ^ coN ^ algN) internal_b;
   37.32 +    val coalg_bind = mk_internal_b (coN ^ algN) ;
   37.33      val coalg_name = Binding.name_of coalg_bind;
   37.34      val coalg_def_bind = (Thm.def_binding coalg_bind, []);
   37.35  
   37.36 @@ -373,7 +377,7 @@
   37.37  
   37.38      (* morphism *)
   37.39  
   37.40 -    val mor_bind = Binding.suffix_name ("_" ^ morN) internal_b;
   37.41 +    val mor_bind = mk_internal_b morN;
   37.42      val mor_name = Binding.name_of mor_bind;
   37.43      val mor_def_bind = (Thm.def_binding mor_bind, []);
   37.44  
   37.45 @@ -518,8 +522,7 @@
   37.46  
   37.47      val timer = time (timer "Morphism definition & thms");
   37.48  
   37.49 -    fun hset_rec_bind j = internal_b
   37.50 -      |> Binding.suffix_name ("_" ^ hset_recN ^ (if m = 1 then "" else string_of_int j)) ;
   37.51 +    fun hset_rec_bind j = mk_internal_b (hset_recN ^ (if m = 1 then "" else string_of_int j));
   37.52      val hset_rec_name = Binding.name_of o hset_rec_bind;
   37.53      val hset_rec_def_bind = rpair [] o Thm.def_binding o hset_rec_bind;
   37.54  
   37.55 @@ -573,8 +576,8 @@
   37.56      val hset_rec_0ss' = transpose hset_rec_0ss;
   37.57      val hset_rec_Sucss' = transpose hset_rec_Sucss;
   37.58  
   37.59 -    fun hset_bind i j = nth internal_bs (i - 1)
   37.60 -      |> Binding.suffix_name ("_" ^ hsetN ^ (if m = 1 then "" else string_of_int j));
   37.61 +    fun hset_binds j = mk_internal_bs (hsetN ^ (if m = 1 then "" else string_of_int j))
   37.62 +    fun hset_bind i j = nth (hset_binds j) (i - 1);
   37.63      val hset_name = Binding.name_of oo hset_bind;
   37.64      val hset_def_bind = rpair [] o Thm.def_binding oo hset_bind;
   37.65  
   37.66 @@ -741,7 +744,7 @@
   37.67  
   37.68      (* bisimulation *)
   37.69  
   37.70 -    val bis_bind = Binding.suffix_name ("_" ^ bisN) internal_b;
   37.71 +    val bis_bind = mk_internal_b bisN;
   37.72      val bis_name = Binding.name_of bis_bind;
   37.73      val bis_def_bind = (Thm.def_binding bis_bind, []);
   37.74  
   37.75 @@ -885,7 +888,8 @@
   37.76  
   37.77      (* largest self-bisimulation *)
   37.78  
   37.79 -    fun lsbis_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ lsbisN);
   37.80 +    val lsbis_binds = mk_internal_bs lsbisN;
   37.81 +    fun lsbis_bind i = nth lsbis_binds (i - 1);
   37.82      val lsbis_name = Binding.name_of o lsbis_bind;
   37.83      val lsbis_def_bind = rpair [] o Thm.def_binding o lsbis_bind;
   37.84  
   37.85 @@ -970,8 +974,7 @@
   37.86        then (lthy, sum_bd, sum_bdT, bd_card_order, bd_Cinfinite, bd_Card_order, set_bdss)
   37.87        else
   37.88          let
   37.89 -          val sbdT_bind =
   37.90 -            Binding.qualify false (Binding.name_of b) (Binding.suffix_name ("_" ^ sum_bdTN) b);
   37.91 +          val sbdT_bind = mk_internal_b sum_bdTN;
   37.92  
   37.93            val ((sbdT_name, (sbdT_glob_info, sbdT_loc_info)), lthy) =
   37.94              typedef (sbdT_bind, dead_params, NoSyn)
   37.95 @@ -980,7 +983,7 @@
   37.96            val sbdT = Type (sbdT_name, dead_params');
   37.97            val Abs_sbdT = Const (#Abs_name sbdT_glob_info, sum_bdT --> sbdT);
   37.98  
   37.99 -          val sbd_bind = Binding.suffix_name ("_" ^ sum_bdN) internal_b;
  37.100 +          val sbd_bind = mk_internal_b sum_bdN;
  37.101            val sbd_name = Binding.name_of sbd_bind;
  37.102            val sbd_def_bind = (Thm.def_binding sbd_bind, []);
  37.103  
  37.104 @@ -1076,7 +1079,8 @@
  37.105  
  37.106      (* tree coalgebra *)
  37.107  
  37.108 -    fun isNode_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ isNodeN);
  37.109 +    val isNode_binds = mk_internal_bs isNodeN;
  37.110 +    fun isNode_bind i = nth isNode_binds (i - 1);
  37.111      val isNode_name = Binding.name_of o isNode_bind;
  37.112      val isNode_def_bind = rpair [] o Thm.def_binding o isNode_bind;
  37.113  
  37.114 @@ -1135,7 +1139,8 @@
  37.115          Library.foldr1 HOLogic.mk_conj [empty, Field, prefCl, tree, undef]
  37.116        end;
  37.117  
  37.118 -    fun carT_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ carTN);
  37.119 +    val carT_binds = mk_internal_bs carTN;
  37.120 +    fun carT_bind i = nth carT_binds (i - 1);
  37.121      val carT_name = Binding.name_of o carT_bind;
  37.122      val carT_def_bind = rpair [] o Thm.def_binding o carT_bind;
  37.123  
  37.124 @@ -1167,7 +1172,8 @@
  37.125        (Const (nth carTs (i - 1),
  37.126           Library.foldr (op -->) (map fastype_of As, HOLogic.mk_setT treeT)), As);
  37.127  
  37.128 -    fun strT_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ strTN);
  37.129 +    val strT_binds = mk_internal_bs strTN;
  37.130 +    fun strT_bind i = nth strT_binds (i - 1);
  37.131      val strT_name = Binding.name_of o strT_bind;
  37.132      val strT_def_bind = rpair [] o Thm.def_binding o strT_bind;
  37.133  
  37.134 @@ -1228,7 +1234,7 @@
  37.135      val to_sbd_thmss = mk_to_sbd_thmss @{thm toCard};
  37.136      val from_to_sbd_thmss = mk_to_sbd_thmss @{thm fromCard_toCard};
  37.137  
  37.138 -    val Lev_bind = Binding.suffix_name ("_" ^ LevN) internal_b;
  37.139 +    val Lev_bind = mk_internal_b LevN;
  37.140      val Lev_name = Binding.name_of Lev_bind;
  37.141      val Lev_def_bind = rpair [] (Thm.def_binding Lev_bind);
  37.142  
  37.143 @@ -1282,7 +1288,7 @@
  37.144      val Lev_0s = flat (mk_rec_simps n @{thm nat_rec_0} [Lev_def]);
  37.145      val Lev_Sucs = flat (mk_rec_simps n @{thm nat_rec_Suc} [Lev_def]);
  37.146  
  37.147 -    val rv_bind = Binding.suffix_name ("_" ^ rvN) internal_b;
  37.148 +    val rv_bind = mk_internal_b rvN;
  37.149      val rv_name = Binding.name_of rv_bind;
  37.150      val rv_def_bind = rpair [] (Thm.def_binding rv_bind);
  37.151  
  37.152 @@ -1328,7 +1334,8 @@
  37.153      val rv_Nils = flat (mk_rec_simps n @{thm list_rec_Nil} [rv_def]);
  37.154      val rv_Conss = flat (mk_rec_simps n @{thm list_rec_Cons} [rv_def]);
  37.155  
  37.156 -    fun beh_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ behN);
  37.157 +    val beh_binds = mk_internal_bs behN;
  37.158 +    fun beh_bind i = nth beh_binds (i - 1);
  37.159      val beh_name = Binding.name_of o beh_bind;
  37.160      val beh_def_bind = rpair [] o Thm.def_binding o beh_bind;
  37.161  
  37.162 @@ -1636,7 +1643,7 @@
  37.163      val ((T_names, (T_glob_infos, T_loc_infos)), lthy) =
  37.164        lthy
  37.165        |> fold_map4 (fn b => fn mx => fn car_final => fn in_car_final =>
  37.166 -        typedef (b, params, mx) car_final NONE
  37.167 +        typedef (Binding.conceal b, params, mx) car_final NONE
  37.168            (EVERY' [rtac exI, rtac in_car_final] 1)) bs mixfixes car_finals in_car_final_thms
  37.169        |>> apsnd split_list o split_list;
  37.170  
  37.171 @@ -1692,7 +1699,7 @@
  37.172  
  37.173      fun dtor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtorN);
  37.174      val dtor_name = Binding.name_of o dtor_bind;
  37.175 -    val dtor_def_bind = rpair [] o Thm.def_binding o dtor_bind;
  37.176 +    val dtor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o dtor_bind;
  37.177  
  37.178      fun dtor_spec i rep str map_FT dtorT Jz Jz' =
  37.179        let
  37.180 @@ -1744,7 +1751,7 @@
  37.181  
  37.182      fun unfold_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtor_unfoldN);
  37.183      val unfold_name = Binding.name_of o unfold_bind;
  37.184 -    val unfold_def_bind = rpair [] o Thm.def_binding o unfold_bind;
  37.185 +    val unfold_def_bind = rpair [] o Binding.conceal o Thm.def_binding o unfold_bind;
  37.186  
  37.187      fun unfold_spec i T AT abs f z z' =
  37.188        let
  37.189 @@ -1865,7 +1872,7 @@
  37.190  
  37.191      fun ctor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctorN);
  37.192      val ctor_name = Binding.name_of o ctor_bind;
  37.193 -    val ctor_def_bind = rpair [] o Thm.def_binding o ctor_bind;
  37.194 +    val ctor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o ctor_bind;
  37.195  
  37.196      fun ctor_spec i ctorT =
  37.197        let
  37.198 @@ -1936,7 +1943,7 @@
  37.199  
  37.200      fun corec_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtor_corecN);
  37.201      val corec_name = Binding.name_of o corec_bind;
  37.202 -    val corec_def_bind = rpair [] o Thm.def_binding o corec_bind;
  37.203 +    val corec_def_bind = rpair [] o Binding.conceal o Thm.def_binding o corec_bind;
  37.204  
  37.205      val corec_strs =
  37.206        map3 (fn dtor => fn sum_s => fn mapx =>
  37.207 @@ -2007,7 +2014,7 @@
  37.208      val (dtor_corec_unique_thms, dtor_corec_unique_thm) =
  37.209        `split_conj_thm (split_conj_prems n
  37.210          (mor_UNIV_thm RS iffD2 RS corec_unique_mor_thm)
  37.211 -        |> Local_Defs.unfold lthy (@{thms o_sum_case o_id id_o o_assoc sum_case_o_inj(1)} @
  37.212 +        |> Local_Defs.unfold lthy (@{thms o_sum_case o_id id_o id_apply o_assoc sum_case_o_inj(1)} @
  37.213             map_id0s @ sym_map_comps) OF replicate n @{thm arg_cong2[of _ _ _ _ sum_case, OF refl]});
  37.214  
  37.215      val timer = time (timer "corec definitions & thms");
  37.216 @@ -2096,11 +2103,11 @@
  37.217  
  37.218      (*register new codatatypes as BNFs*)
  37.219      val (timer, Jbnfs, (folded_dtor_map_o_thms, folded_dtor_map_thms), folded_dtor_set_thmss',
  37.220 -      dtor_set_induct_thms, dtor_Jrel_thms, lthy) =
  37.221 +      dtor_set_induct_thms, dtor_Jrel_thms, Jbnf_notes, lthy) =
  37.222        if m = 0 then
  37.223          (timer, replicate n DEADID_bnf,
  37.224          map_split (`(mk_pointfree lthy)) (map2 mk_dtor_map_DEADID_thm dtor_inject_thms map_ids),
  37.225 -        replicate n [], [], map2 mk_dtor_Jrel_DEADID_thm dtor_inject_thms bnfs, lthy)
  37.226 +        replicate n [], [], map2 mk_dtor_Jrel_DEADID_thm dtor_inject_thms bnfs, [], lthy)
  37.227        else let
  37.228          val fTs = map2 (curry op -->) passiveAs passiveBs;
  37.229          val gTs = map2 (curry op -->) passiveBs passiveCs;
  37.230 @@ -2734,8 +2741,7 @@
  37.231              bs thmss)
  37.232        in
  37.233         (timer, Jbnfs, (folded_dtor_map_o_thms, folded_dtor_map_thms), folded_dtor_set_thmss',
  37.234 -         dtor_set_induct_thms, dtor_Jrel_thms,
  37.235 -         lthy |> Local_Theory.notes (Jbnf_common_notes @ Jbnf_notes) |> snd)
  37.236 +         dtor_set_induct_thms, dtor_Jrel_thms, Jbnf_common_notes @ Jbnf_notes, lthy)
  37.237        end;
  37.238  
  37.239        val dtor_unfold_o_map_thms = mk_xtor_un_fold_o_map_thms Greatest_FP false m
  37.240 @@ -2883,7 +2889,11 @@
  37.241          |> maps (fn (thmN, thmss) =>
  37.242            map2 (fn b => fn thms =>
  37.243              ((Binding.qualify true (Binding.name_of b) (Binding.name thmN), []), [(thms, [])]))
  37.244 -          bs thmss)
  37.245 +          bs thmss);
  37.246 +
  37.247 +    (*FIXME: once the package exports all the necessary high-level characteristic theorems,
  37.248 +       those should not only be concealed but rather not noted at all*)
  37.249 +    val maybe_conceal_notes = note_all = false ? map (apfst (apfst Binding.conceal));
  37.250    in
  37.251      timer;
  37.252      ({Ts = Ts, bnfs = Jbnfs, ctors = ctors, dtors = dtors,
  37.253 @@ -2896,24 +2906,18 @@
  37.254        xtor_co_iter_thmss = transpose [dtor_unfold_thms, dtor_corec_thms],
  37.255        xtor_co_iter_o_map_thmss = transpose [dtor_unfold_o_map_thms, dtor_corec_o_map_thms],
  37.256        rel_xtor_co_induct_thm = Jrel_coinduct_thm},
  37.257 -     lthy |> Local_Theory.notes (common_notes @ notes) |> snd)
  37.258 +     lthy |> Local_Theory.notes (maybe_conceal_notes (common_notes @ notes @ Jbnf_notes)) |> snd)
  37.259    end;
  37.260  
  37.261  val _ =
  37.262    Outer_Syntax.local_theory @{command_spec "codatatype"} "define BNF-based coinductive datatypes"
  37.263      (parse_co_datatype_cmd Greatest_FP construct_gfp);
  37.264  
  37.265 -local
  37.266 -
  37.267  val option_parser = Parse.group (fn () => "option") (Parse.reserved "sequential" >> K true);
  37.268  
  37.269 -in
  37.270 -
  37.271  val _ = Outer_Syntax.local_theory_to_proof @{command_spec "primcorec"}
  37.272    "define primitive corecursive functions"
  37.273    ((Scan.optional (@{keyword "("} |-- Parse.!!! option_parser --| @{keyword ")"}) false) --
  37.274      (Parse.fixes -- Parse_Spec.where_alt_specs) >> uncurry add_primcorec_cmd);
  37.275 - 
  37.276 -end
  37.277  
  37.278  end;
    38.1 --- a/src/HOL/BNF/Tools/bnf_lfp.ML	Thu Sep 12 22:10:17 2013 +0200
    38.2 +++ b/src/HOL/BNF/Tools/bnf_lfp.ML	Fri Sep 13 09:31:45 2013 +0200
    38.3 @@ -36,13 +36,17 @@
    38.4      val n = length bnfs; (*active*)
    38.5      val ks = 1 upto n;
    38.6      val m = live - n; (*passive, if 0 don't generate a new BNF*)
    38.7 +
    38.8 +    val note_all = Config.get lthy bnf_note_all;
    38.9      val b_names = map Binding.name_of bs;
   38.10 -    val common_name = mk_common_name b_names;
   38.11 -    val b = Binding.name common_name;
   38.12 -    val internal_b = Binding.prefix true common_name b;
   38.13 -    fun qualify_bs internal = map2 (Binding.prefix internal) b_names bs;
   38.14 -    val internal_bs = qualify_bs true;
   38.15 -    val external_bs = qualify_bs false;
   38.16 +    val b_name = mk_common_name b_names;
   38.17 +    val b = Binding.name b_name;
   38.18 +    val mk_internal_b = Binding.name #> Binding.prefix true b_name #> Binding.conceal;
   38.19 +    fun mk_internal_bs name =
   38.20 +      map (fn b =>
   38.21 +        Binding.prefix true b_name (Binding.suffix_name ("_" ^ name) b) |> Binding.conceal) bs;
   38.22 +    val external_bs = map2 (Binding.prefix false) b_names bs
   38.23 +      |> note_all = false ? map Binding.conceal;
   38.24  
   38.25      (* TODO: check if m, n, etc., are sane *)
   38.26  
   38.27 @@ -238,7 +242,7 @@
   38.28  
   38.29      (* algebra *)
   38.30  
   38.31 -    val alg_bind = Binding.suffix_name ("_" ^ algN) internal_b;
   38.32 +    val alg_bind = mk_internal_b algN;
   38.33      val alg_name = Binding.name_of alg_bind;
   38.34      val alg_def_bind = (Thm.def_binding alg_bind, []);
   38.35  
   38.36 @@ -325,7 +329,7 @@
   38.37  
   38.38      (* morphism *)
   38.39  
   38.40 -    val mor_bind = Binding.suffix_name ("_" ^ morN) internal_b;
   38.41 +    val mor_bind = mk_internal_b morN;
   38.42      val mor_name = Binding.name_of mor_bind;
   38.43      val mor_def_bind = (Thm.def_binding mor_bind, []);
   38.44  
   38.45 @@ -712,8 +716,9 @@
   38.46  
   38.47      val timer = time (timer "min_algs definition & thms");
   38.48  
   38.49 -    fun min_alg_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ min_algN);
   38.50 -    val min_alg_name = Binding.name_of o min_alg_bind;
   38.51 +    val min_alg_binds = mk_internal_bs min_algN;
   38.52 +    fun min_alg_bind i = nth min_alg_binds (i - 1);
   38.53 +    fun min_alg_name i = Binding.name_of (min_alg_bind i);
   38.54      val min_alg_def_bind = rpair [] o Thm.def_binding o min_alg_bind;
   38.55  
   38.56      fun min_alg_spec i =
   38.57 @@ -791,7 +796,7 @@
   38.58      val timer = time (timer "Minimal algebra definition & thms");
   38.59  
   38.60      val II_repT = HOLogic.mk_prodT (HOLogic.mk_tupleT II_BTs, HOLogic.mk_tupleT II_sTs);
   38.61 -    val IIT_bind = Binding.suffix_name ("_" ^ IITN) b;
   38.62 +    val IIT_bind = mk_internal_b IITN;
   38.63  
   38.64      val ((IIT_name, (IIT_glob_info, IIT_loc_info)), lthy) =
   38.65        typedef (IIT_bind, params, NoSyn)
   38.66 @@ -824,7 +829,8 @@
   38.67      val select_Bs = map (mk_nthN n (HOLogic.mk_fst (Rep_IIT $ iidx))) ks;
   38.68      val select_ss = map (mk_nthN n (HOLogic.mk_snd (Rep_IIT $ iidx))) ks;
   38.69  
   38.70 -    fun str_init_bind i = nth internal_bs (i - 1) |> Binding.suffix_name ("_" ^ str_initN);
   38.71 +    val str_init_binds = mk_internal_bs str_initN;
   38.72 +    fun str_init_bind i = nth str_init_binds (i - 1);
   38.73      val str_init_name = Binding.name_of o str_init_bind;
   38.74      val str_init_def_bind = rpair [] o Thm.def_binding o str_init_bind;
   38.75  
   38.76 @@ -953,7 +959,8 @@
   38.77  
   38.78      val ((T_names, (T_glob_infos, T_loc_infos)), lthy) =
   38.79        lthy
   38.80 -      |> fold_map3 (fn b => fn mx => fn car_init => typedef (b, params, mx) car_init NONE
   38.81 +      |> fold_map3 (fn b => fn mx => fn car_init =>
   38.82 +        typedef (Binding.conceal b, params, mx) car_init NONE
   38.83            (EVERY' [rtac ssubst, rtac @{thm ex_in_conv}, resolve_tac alg_not_empty_thms,
   38.84              rtac alg_init_thm] 1)) bs mixfixes car_inits
   38.85        |>> apsnd split_list o split_list;
   38.86 @@ -1016,7 +1023,7 @@
   38.87  
   38.88      fun ctor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctorN);
   38.89      val ctor_name = Binding.name_of o ctor_bind;
   38.90 -    val ctor_def_bind = rpair [] o Thm.def_binding o ctor_bind;
   38.91 +    val ctor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o ctor_bind;
   38.92  
   38.93      fun ctor_spec i abs str map_FT_init x x' =
   38.94        let
   38.95 @@ -1075,7 +1082,7 @@
   38.96  
   38.97      fun fold_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctor_foldN);
   38.98      val fold_name = Binding.name_of o fold_bind;
   38.99 -    val fold_def_bind = rpair [] o Thm.def_binding o fold_bind;
  38.100 +    val fold_def_bind = rpair [] o Binding.conceal o Thm.def_binding o fold_bind;
  38.101  
  38.102      fun fold_spec i T AT =
  38.103        let
  38.104 @@ -1165,7 +1172,7 @@
  38.105  
  38.106      fun dtor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtorN);
  38.107      val dtor_name = Binding.name_of o dtor_bind;
  38.108 -    val dtor_def_bind = rpair [] o Thm.def_binding o dtor_bind;
  38.109 +    val dtor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o dtor_bind;
  38.110  
  38.111      fun dtor_spec i FT T =
  38.112        let
  38.113 @@ -1238,7 +1245,7 @@
  38.114  
  38.115      fun rec_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctor_recN);
  38.116      val rec_name = Binding.name_of o rec_bind;
  38.117 -    val rec_def_bind = rpair [] o Thm.def_binding o rec_bind;
  38.118 +    val rec_def_bind = rpair [] o Binding.conceal o Thm.def_binding o rec_bind;
  38.119  
  38.120      val rec_strs =
  38.121        map3 (fn ctor => fn prod_s => fn mapx =>
  38.122 @@ -1405,11 +1412,11 @@
  38.123  
  38.124      (*register new datatypes as BNFs*)
  38.125      val (timer, Ibnfs, (folded_ctor_map_o_thms, folded_ctor_map_thms), folded_ctor_set_thmss',
  38.126 -        ctor_Irel_thms, lthy) =
  38.127 +        ctor_Irel_thms, Ibnf_notes, lthy) =
  38.128        if m = 0 then
  38.129          (timer, replicate n DEADID_bnf,
  38.130          map_split (`(mk_pointfree lthy)) (map2 mk_ctor_map_DEADID_thm ctor_inject_thms map_ids),
  38.131 -        replicate n [], map2 mk_ctor_Irel_DEADID_thm ctor_inject_thms bnfs, lthy)
  38.132 +        replicate n [], map2 mk_ctor_Irel_DEADID_thm ctor_inject_thms bnfs, [], lthy)
  38.133        else let
  38.134          val fTs = map2 (curry op -->) passiveAs passiveBs;
  38.135          val f1Ts = map2 (curry op -->) passiveAs passiveYs;
  38.136 @@ -1809,7 +1816,7 @@
  38.137              bs thmss)
  38.138        in
  38.139          (timer, Ibnfs, (folded_ctor_map_o_thms, folded_ctor_map_thms), folded_ctor_set_thmss',
  38.140 -          ctor_Irel_thms, lthy |> Local_Theory.notes (Ibnf_common_notes @ Ibnf_notes) |> snd)
  38.141 +          ctor_Irel_thms, Ibnf_common_notes @ Ibnf_notes, lthy)
  38.142        end;
  38.143  
  38.144        val ctor_fold_o_map_thms = mk_xtor_un_fold_o_map_thms Least_FP false m ctor_fold_unique_thm
  38.145 @@ -1858,7 +1865,11 @@
  38.146          |> maps (fn (thmN, thmss) =>
  38.147            map2 (fn b => fn thms =>
  38.148              ((Binding.qualify true (Binding.name_of b) (Binding.name thmN), []), [(thms, [])]))
  38.149 -          bs thmss)
  38.150 +          bs thmss);
  38.151 +
  38.152 +    (*FIXME: once the package exports all the necessary high-level characteristic theorems,
  38.153 +       those should not only be concealed but rather not noted at all*)
  38.154 +    val maybe_conceal_notes = note_all = false ? map (apfst (apfst Binding.conceal));
  38.155    in
  38.156      timer;
  38.157      ({Ts = Ts, bnfs = Ibnfs, ctors = ctors, dtors = dtors, xtor_co_iterss = transpose [folds, recs],
  38.158 @@ -1869,7 +1880,7 @@
  38.159        xtor_co_iter_thmss = transpose [ctor_fold_thms, ctor_rec_thms],
  38.160        xtor_co_iter_o_map_thmss = transpose [ctor_fold_o_map_thms, ctor_rec_o_map_thms],
  38.161        rel_xtor_co_induct_thm = Irel_induct_thm},
  38.162 -     lthy |> Local_Theory.notes (common_notes @ notes) |> snd)
  38.163 +     lthy |> Local_Theory.notes (maybe_conceal_notes (common_notes @ notes @ Ibnf_notes)) |> snd)
  38.164    end;
  38.165  
  38.166  val _ =
    39.1 --- a/src/HOL/BNF/Tools/bnf_tactics.ML	Thu Sep 12 22:10:17 2013 +0200
    39.2 +++ b/src/HOL/BNF/Tools/bnf_tactics.ML	Fri Sep 13 09:31:45 2013 +0200
    39.3 @@ -61,8 +61,7 @@
    39.4    |> pairself (dest_comb #> apsnd (dest_comb #> fst) #> HOLogic.mk_comp)
    39.5    |> mk_Trueprop_eq
    39.6    |> (fn goal => Goal.prove_sorry ctxt [] [] goal
    39.7 -     (fn {context=ctxt, prems = _} =>
    39.8 -       unfold_thms_tac ctxt [@{thm o_def}, mk_sym thm] THEN rtac refl 1))
    39.9 +    (K (rtac ext 1 THEN unfold_thms_tac ctxt [o_apply, mk_sym thm] THEN rtac refl 1)))
   39.10    |> Thm.close_derivation;
   39.11  
   39.12  
   39.13 @@ -102,7 +101,7 @@
   39.14    rtac (unfold_thms ctxt (IJrel_defs @ IJsrel_defs @
   39.15      @{thms Collect_pair_mem_eq mem_Collect_eq fst_conv snd_conv}) dtor_srel RS trans) 1 THEN
   39.16    unfold_thms_tac ctxt (srel_def ::
   39.17 -    @{thms Collect_fst_snd_mem_eq mem_Collect_eq pair_mem_Collect_split fst_conv snd_conv
   39.18 +    @{thms pair_collapse Collect_mem_eq mem_Collect_eq prod.cases fst_conv snd_conv
   39.19        split_conv}) THEN
   39.20    rtac refl 1;
   39.21  
    40.1 --- a/src/HOL/Library/Convex.thy	Thu Sep 12 22:10:17 2013 +0200
    40.2 +++ b/src/HOL/Library/Convex.thy	Fri Sep 13 09:31:45 2013 +0200
    40.3 @@ -46,6 +46,12 @@
    40.4  lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
    40.5    unfolding convex_def by auto
    40.6  
    40.7 +lemma convex_INT: "\<forall>i\<in>A. convex (B i) \<Longrightarrow> convex (\<Inter>i\<in>A. B i)"
    40.8 +  unfolding convex_def by auto
    40.9 +
   40.10 +lemma convex_Times: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<times> t)"
   40.11 +  unfolding convex_def by auto
   40.12 +
   40.13  lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
   40.14    unfolding convex_def
   40.15    by (auto simp: inner_add intro!: convex_bound_le)
    41.1 --- a/src/HOL/Library/Set_Algebras.thy	Thu Sep 12 22:10:17 2013 +0200
    41.2 +++ b/src/HOL/Library/Set_Algebras.thy	Fri Sep 13 09:31:45 2013 +0200
    41.3 @@ -90,6 +90,11 @@
    41.4  lemma set_plus_intro [intro]: "a : C ==> b : D ==> a + b : C + D"
    41.5    by (auto simp add: set_plus_def)
    41.6  
    41.7 +lemma set_plus_elim:
    41.8 +  assumes "x \<in> A + B"
    41.9 +  obtains a b where "x = a + b" and "a \<in> A" and "b \<in> B"
   41.10 +  using assms unfolding set_plus_def by fast
   41.11 +
   41.12  lemma set_plus_intro2 [intro]: "b : C ==> a + b : a +o C"
   41.13    by (auto simp add: elt_set_plus_def)
   41.14  
   41.15 @@ -201,6 +206,11 @@
   41.16  lemma set_times_intro [intro]: "a : C ==> b : D ==> a * b : C * D"
   41.17    by (auto simp add: set_times_def)
   41.18  
   41.19 +lemma set_times_elim:
   41.20 +  assumes "x \<in> A * B"
   41.21 +  obtains a b where "x = a * b" and "a \<in> A" and "b \<in> B"
   41.22 +  using assms unfolding set_times_def by fast
   41.23 +
   41.24  lemma set_times_intro2 [intro!]: "b : C ==> a * b : a *o C"
   41.25    by (auto simp add: elt_set_times_def)
   41.26  
   41.27 @@ -321,10 +331,20 @@
   41.28      - a : (- 1) *o C"
   41.29    by (auto simp add: elt_set_times_def)
   41.30  
   41.31 -lemma set_plus_image:
   41.32 -  fixes S T :: "'n::semigroup_add set" shows "S + T = (\<lambda>(x, y). x + y) ` (S \<times> T)"
   41.33 +lemma set_plus_image: "S + T = (\<lambda>(x, y). x + y) ` (S \<times> T)"
   41.34    unfolding set_plus_def by (fastforce simp: image_iff)
   41.35  
   41.36 +lemma set_times_image: "S * T = (\<lambda>(x, y). x * y) ` (S \<times> T)"
   41.37 +  unfolding set_times_def by (fastforce simp: image_iff)
   41.38 +
   41.39 +lemma finite_set_plus:
   41.40 +  assumes "finite s" and "finite t" shows "finite (s + t)"
   41.41 +  using assms unfolding set_plus_image by simp
   41.42 +
   41.43 +lemma finite_set_times:
   41.44 +  assumes "finite s" and "finite t" shows "finite (s * t)"
   41.45 +  using assms unfolding set_times_image by simp
   41.46 +
   41.47  lemma set_setsum_alt:
   41.48    assumes fin: "finite I"
   41.49    shows "setsum S I = {setsum s I |s. \<forall>i\<in>I. s i \<in> S i}"
    42.1 --- a/src/HOL/Limits.thy	Thu Sep 12 22:10:17 2013 +0200
    42.2 +++ b/src/HOL/Limits.thy	Fri Sep 13 09:31:45 2013 +0200
    42.3 @@ -185,17 +185,19 @@
    42.4  done
    42.5  
    42.6  text{*alternative formulation for boundedness*}
    42.7 -lemma Bseq_iff3: "Bseq X = (\<exists>k > 0. \<exists>N. \<forall>n. norm(X(n) + -X(N)) \<le> k)"
    42.8 -apply safe
    42.9 -apply (simp add: Bseq_def, safe)
   42.10 -apply (rule_tac x = "K + norm (X N)" in exI)
   42.11 -apply auto
   42.12 -apply (erule order_less_le_trans, simp)
   42.13 -apply (rule_tac x = N in exI, safe)
   42.14 -apply (drule_tac x = n in spec)
   42.15 -apply (rule order_trans [OF norm_triangle_ineq], simp)
   42.16 -apply (auto simp add: Bseq_iff2)
   42.17 -done
   42.18 +lemma Bseq_iff3:
   42.19 +  "Bseq X \<longleftrightarrow> (\<exists>k>0. \<exists>N. \<forall>n. norm (X n + - X N) \<le> k)" (is "?P \<longleftrightarrow> ?Q")
   42.20 +proof
   42.21 +  assume ?P
   42.22 +  then obtain K
   42.23 +    where *: "0 < K" and **: "\<And>n. norm (X n) \<le> K" by (auto simp add: Bseq_def)
   42.24 +  from * have "0 < K + norm (X 0)" by (rule order_less_le_trans) simp
   42.25 +  moreover from ** have "\<forall>n. norm (X n + - X 0) \<le> K + norm (X 0)"
   42.26 +    by (auto intro: order_trans norm_triangle_ineq)
   42.27 +  ultimately show ?Q by blast
   42.28 +next
   42.29 +  assume ?Q then show ?P by (auto simp add: Bseq_iff2)
   42.30 +qed
   42.31  
   42.32  lemma BseqI2: "(\<forall>n. k \<le> f n & f n \<le> (K::real)) ==> Bseq f"
   42.33  apply (simp add: Bseq_def)
    43.1 --- a/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML	Thu Sep 12 22:10:17 2013 +0200
    43.2 +++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML	Fri Sep 13 09:31:45 2013 +0200
    43.3 @@ -12,11 +12,11 @@
    43.4  
    43.5  fun extract_relevance_fudge args
    43.6        {local_const_multiplier, worse_irrel_freq, higher_order_irrel_weight,
    43.7 -       abs_rel_weight, abs_irrel_weight, skolem_irrel_weight,
    43.8 -       theory_const_rel_weight, theory_const_irrel_weight,
    43.9 -       chained_const_irrel_weight, intro_bonus, elim_bonus, simp_bonus,
   43.10 -       local_bonus, assum_bonus, chained_bonus, max_imperfect, max_imperfect_exp,
   43.11 -       threshold_divisor, ridiculous_threshold} =
   43.12 +       abs_rel_weight, abs_irrel_weight, theory_const_rel_weight,
   43.13 +       theory_const_irrel_weight, chained_const_irrel_weight, intro_bonus,
   43.14 +       elim_bonus, simp_bonus, local_bonus, assum_bonus, chained_bonus,
   43.15 +       max_imperfect, max_imperfect_exp, threshold_divisor,
   43.16 +       ridiculous_threshold} =
   43.17    {local_const_multiplier =
   43.18         get args "local_const_multiplier" local_const_multiplier,
   43.19     worse_irrel_freq = get args "worse_irrel_freq" worse_irrel_freq,
   43.20 @@ -24,7 +24,6 @@
   43.21         get args "higher_order_irrel_weight" higher_order_irrel_weight,
   43.22     abs_rel_weight = get args "abs_rel_weight" abs_rel_weight,
   43.23     abs_irrel_weight = get args "abs_irrel_weight" abs_irrel_weight,
   43.24 -   skolem_irrel_weight = get args "skolem_irrel_weight" skolem_irrel_weight,
   43.25     theory_const_rel_weight =
   43.26         get args "theory_const_rel_weight" theory_const_rel_weight,
   43.27     theory_const_irrel_weight =
    44.1 --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Thu Sep 12 22:10:17 2013 +0200
    44.2 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Fri Sep 13 09:31:45 2013 +0200
    44.3 @@ -291,7 +291,7 @@
    44.4    by (metis component_le_norm_cart order_trans)
    44.5  
    44.6  lemma norm_bound_component_lt_cart: "norm x < e ==> \<bar>x$i\<bar> < e"
    44.7 -  by (metis component_le_norm_cart basic_trans_rules(21))
    44.8 +  by (metis component_le_norm_cart le_less_trans)
    44.9  
   44.10  lemma norm_le_l1_cart: "norm x <= setsum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
   44.11    by (simp add: norm_vec_def setL2_le_setsum)
   44.12 @@ -322,7 +322,6 @@
   44.13    shows "setsum (\<lambda>x. c *s f x) S = c *s setsum f S"
   44.14    by (simp add: vec_eq_iff setsum_right_distrib)
   44.15  
   44.16 -(* TODO: use setsum_norm_allsubsets_bound *)
   44.17  lemma setsum_norm_allsubsets_bound_cart:
   44.18    fixes f:: "'a \<Rightarrow> real ^'n"
   44.19    assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
   44.20 @@ -500,7 +499,7 @@
   44.21    where "matrix f = (\<chi> i j. (f(axis j 1))$i)"
   44.22  
   44.23  lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::real ^ _))"
   44.24 -  by (simp add: linear_def matrix_vector_mult_def vec_eq_iff
   44.25 +  by (simp add: linear_iff matrix_vector_mult_def vec_eq_iff
   44.26        field_simps setsum_right_distrib setsum_addf)
   44.27  
   44.28  lemma matrix_works:
    45.1 --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Thu Sep 12 22:10:17 2013 +0200
    45.2 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Fri Sep 13 09:31:45 2013 +0200
    45.3 @@ -18,7 +18,7 @@
    45.4  (* ------------------------------------------------------------------------- *)
    45.5  
    45.6  lemma linear_scaleR: "linear (\<lambda>x. scaleR c x)"
    45.7 -  by (simp add: linear_def scaleR_add_right)
    45.8 +  by (simp add: linear_iff scaleR_add_right)
    45.9  
   45.10  lemma injective_scaleR: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>x::'a::real_vector. scaleR c x)"
   45.11    by (simp add: inj_on_def)
   45.12 @@ -303,13 +303,13 @@
   45.13  qed
   45.14  
   45.15  lemma fst_linear: "linear fst"
   45.16 -  unfolding linear_def by (simp add: algebra_simps)
   45.17 +  unfolding linear_iff by (simp add: algebra_simps)
   45.18  
   45.19  lemma snd_linear: "linear snd"
   45.20 -  unfolding linear_def by (simp add: algebra_simps)
   45.21 +  unfolding linear_iff by (simp add: algebra_simps)
   45.22  
   45.23  lemma fst_snd_linear: "linear (%(x,y). x + y)"
   45.24 -  unfolding linear_def by (simp add: algebra_simps)
   45.25 +  unfolding linear_iff by (simp add: algebra_simps)
   45.26  
   45.27  lemma scaleR_2:
   45.28    fixes x :: "'a::real_vector"
   45.29 @@ -8098,7 +8098,7 @@
   45.30        then obtain e where e: "e > 1" "(1 - e) *\<^sub>R f x + e *\<^sub>R f z \<in> S"
   45.31          using convex_rel_interior_iff[of S "f z"] z assms `S \<noteq> {}` by auto
   45.32        moreover have "(1 - e) *\<^sub>R f x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R x + e *\<^sub>R z)"
   45.33 -        using `linear f` by (simp add: linear_def)
   45.34 +        using `linear f` by (simp add: linear_iff)
   45.35        ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f -` S"
   45.36          using e by auto
   45.37      }
   45.38 @@ -8116,7 +8116,7 @@
   45.39        then obtain e where e: "e > 1" "(1 - e) *\<^sub>R y + e *\<^sub>R z \<in> f -` S"
   45.40          using convex_rel_interior_iff[of "f -` S" z] z conv by auto
   45.41        moreover have "(1 - e) *\<^sub>R x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R y + e *\<^sub>R z)"
   45.42 -        using `linear f` y by (simp add: linear_def)
   45.43 +        using `linear f` y by (simp add: linear_iff)
   45.44        ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R f z \<in> S \<inter> range f"
   45.45          using e by auto
   45.46      }
    46.1 --- a/src/HOL/Multivariate_Analysis/Derivative.thy	Thu Sep 12 22:10:17 2013 +0200
    46.2 +++ b/src/HOL/Multivariate_Analysis/Derivative.thy	Fri Sep 13 09:31:45 2013 +0200
    46.3 @@ -14,7 +14,7 @@
    46.4    assume "bounded_linear f"
    46.5    then interpret f: bounded_linear f .
    46.6    show "linear f"
    46.7 -    by (simp add: f.add f.scaleR linear_def)
    46.8 +    by (simp add: f.add f.scaleR linear_iff)
    46.9  qed
   46.10  
   46.11  lemma netlimit_at_vector: (* TODO: move *)
   46.12 @@ -1278,7 +1278,7 @@
   46.13        qed
   46.14      qed
   46.15      show "bounded_linear (g' x)"
   46.16 -      unfolding linear_linear linear_def
   46.17 +      unfolding linear_linear linear_iff
   46.18        apply(rule,rule,rule) defer
   46.19      proof(rule,rule)
   46.20        fix x' y z::"'m" and c::real
   46.21 @@ -1286,12 +1286,12 @@
   46.22        show "g' x (c *\<^sub>R x') = c *\<^sub>R g' x x'"
   46.23          apply(rule tendsto_unique[OF trivial_limit_sequentially])
   46.24          apply(rule lem3[rule_format])
   46.25 -        unfolding lin[unfolded bounded_linear_def bounded_linear_axioms_def,THEN conjunct2,THEN conjunct1,rule_format]
   46.26 +        unfolding lin[THEN bounded_linear_imp_linear, THEN linear_cmul]
   46.27          apply (intro tendsto_intros) by(rule lem3[rule_format])
   46.28        show "g' x (y + z) = g' x y + g' x z"
   46.29          apply(rule tendsto_unique[OF trivial_limit_sequentially])
   46.30          apply(rule lem3[rule_format])
   46.31 -        unfolding lin[unfolded bounded_linear_def additive_def,THEN conjunct1,rule_format]
   46.32 +        unfolding lin[THEN bounded_linear_imp_linear, THEN linear_add]
   46.33          apply(rule tendsto_add) by(rule lem3[rule_format])+
   46.34      qed
   46.35      show "\<forall>e>0. \<exists>d>0. \<forall>y\<in>s. norm (y - x) < d \<longrightarrow> norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
    47.1 --- a/src/HOL/Multivariate_Analysis/Determinants.thy	Thu Sep 12 22:10:17 2013 +0200
    47.2 +++ b/src/HOL/Multivariate_Analysis/Determinants.thy	Fri Sep 13 09:31:45 2013 +0200
    47.3 @@ -1080,7 +1080,7 @@
    47.4        unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
    47.5    note fc = this
    47.6    show ?thesis
    47.7 -    unfolding linear_def vector_eq[where 'a="real^'n"] scalar_mult_eq_scaleR
    47.8 +    unfolding linear_iff vector_eq[where 'a="real^'n"] scalar_mult_eq_scaleR
    47.9      by (simp add: inner_add fc field_simps)
   47.10  qed
   47.11  
    48.1 --- a/src/HOL/Multivariate_Analysis/Fashoda.thy	Thu Sep 12 22:10:17 2013 +0200
    48.2 +++ b/src/HOL/Multivariate_Analysis/Fashoda.thy	Fri Sep 13 09:31:45 2013 +0200
    48.3 @@ -1,7 +1,8 @@
    48.4 -(* Author:                     John Harrison
    48.5 -   Translation from HOL light: Robert Himmelmann, TU Muenchen *)
    48.6 +(*  Author:     John Harrison
    48.7 +    Author:     Robert Himmelmann, TU Muenchen (translation from HOL light)
    48.8 +*)
    48.9  
   48.10 -header {* Fashoda meet theorem. *}
   48.11 +header {* Fashoda meet theorem *}
   48.12  
   48.13  theory Fashoda
   48.14  imports Brouwer_Fixpoint Path_Connected Cartesian_Euclidean_Space
   48.15 @@ -15,131 +16,312 @@
   48.16  lemma axis_in_Basis: "a \<in> Basis \<Longrightarrow> axis i a \<in> Basis"
   48.17    by (auto simp add: Basis_vec_def axis_eq_axis)
   48.18  
   48.19 -subsection {*Fashoda meet theorem. *}
   48.20 +
   48.21 +subsection {* Fashoda meet theorem *}
   48.22  
   48.23 -lemma infnorm_2: "infnorm (x::real^2) = max (abs(x$1)) (abs(x$2))"
   48.24 -  unfolding infnorm_cart UNIV_2 apply(rule cSup_eq) by auto
   48.25 +lemma infnorm_2:
   48.26 +  fixes x :: "real^2"
   48.27 +  shows "infnorm x = max (abs (x$1)) (abs (x$2))"
   48.28 +  unfolding infnorm_cart UNIV_2 by (rule cSup_eq) auto
   48.29  
   48.30 -lemma infnorm_eq_1_2: "infnorm (x::real^2) = 1 \<longleftrightarrow>
   48.31 -        (abs(x$1) \<le> 1 \<and> abs(x$2) \<le> 1 \<and> (x$1 = -1 \<or> x$1 = 1 \<or> x$2 = -1 \<or> x$2 = 1))"
   48.32 +lemma infnorm_eq_1_2:
   48.33 +  fixes x :: "real^2"
   48.34 +  shows "infnorm x = 1 \<longleftrightarrow>
   48.35 +    abs (x$1) \<le> 1 \<and> abs (x$2) \<le> 1 \<and> (x$1 = -1 \<or> x$1 = 1 \<or> x$2 = -1 \<or> x$2 = 1)"
   48.36    unfolding infnorm_2 by auto
   48.37  
   48.38 -lemma infnorm_eq_1_imp: assumes "infnorm (x::real^2) = 1" shows "abs(x$1) \<le> 1" "abs(x$2) \<le> 1"
   48.39 +lemma infnorm_eq_1_imp:
   48.40 +  fixes x :: "real^2"
   48.41 +  assumes "infnorm x = 1"
   48.42 +  shows "abs (x$1) \<le> 1" and "abs (x$2) \<le> 1"
   48.43    using assms unfolding infnorm_eq_1_2 by auto
   48.44  
   48.45 -lemma fashoda_unit: fixes f g::"real \<Rightarrow> real^2"
   48.46 -  assumes "f ` {- 1..1} \<subseteq> {- 1..1}" "g ` {- 1..1} \<subseteq> {- 1..1}"
   48.47 -  "continuous_on {- 1..1} f"  "continuous_on {- 1..1} g"
   48.48 -  "f (- 1)$1 = - 1" "f 1$1 = 1" "g (- 1) $2 = -1" "g 1 $2 = 1"
   48.49 -  shows "\<exists>s\<in>{- 1..1}. \<exists>t\<in>{- 1..1}. f s = g t" proof(rule ccontr)
   48.50 -  case goal1 note as = this[unfolded bex_simps,rule_format]
   48.51 +lemma fashoda_unit:
   48.52 +  fixes f g :: "real \<Rightarrow> real^2"
   48.53 +  assumes "f ` {- 1..1} \<subseteq> {- 1..1}"
   48.54 +    and "g ` {- 1..1} \<subseteq> {- 1..1}"
   48.55 +    and "continuous_on {- 1..1} f"
   48.56 +    and "continuous_on {- 1..1} g"
   48.57 +    and "f (- 1)$1 = - 1"
   48.58 +    and "f 1$1 = 1" "g (- 1) $2 = -1"
   48.59 +    and "g 1 $2 = 1"
   48.60 +  shows "\<exists>s\<in>{- 1..1}. \<exists>t\<in>{- 1..1}. f s = g t"
   48.61 +proof (rule ccontr)
   48.62 +  assume "\<not> ?thesis"
   48.63 +  note as = this[unfolded bex_simps,rule_format]
   48.64    def sqprojection \<equiv> "\<lambda>z::real^2. (inverse (infnorm z)) *\<^sub>R z" 
   48.65 -  def negatex \<equiv> "\<lambda>x::real^2. (vector [-(x$1), x$2])::real^2" 
   48.66 -  have lem1:"\<forall>z::real^2. infnorm(negatex z) = infnorm z"
   48.67 +  def negatex \<equiv> "\<lambda>x::real^2. (vector [-(x$1), x$2])::real^2"
   48.68 +  have lem1: "\<forall>z::real^2. infnorm (negatex z) = infnorm z"
   48.69      unfolding negatex_def infnorm_2 vector_2 by auto
   48.70 -  have lem2:"\<forall>z. z\<noteq>0 \<longrightarrow> infnorm(sqprojection z) = 1" unfolding sqprojection_def
   48.71 -    unfolding infnorm_mul[unfolded scalar_mult_eq_scaleR] unfolding abs_inverse real_abs_infnorm
   48.72 -    apply(subst infnorm_eq_0[THEN sym]) by auto
   48.73 -  let ?F = "(\<lambda>w::real^2. (f \<circ> (\<lambda>x. x$1)) w - (g \<circ> (\<lambda>x. x$2)) w)"
   48.74 -  have *:"\<And>i. (\<lambda>x::real^2. x $ i) ` {- 1..1} = {- 1..1::real}"
   48.75 -    apply(rule set_eqI) unfolding image_iff Bex_def mem_interval_cart apply rule defer 
   48.76 -    apply(rule_tac x="vec x" in exI) by auto
   48.77 -  { fix x assume "x \<in> (\<lambda>w. (f \<circ> (\<lambda>x. x $ 1)) w - (g \<circ> (\<lambda>x. x $ 2)) w) ` {- 1..1::real^2}"
   48.78 +  have lem2: "\<forall>z. z \<noteq> 0 \<longrightarrow> infnorm (sqprojection z) = 1"
   48.79 +    unfolding sqprojection_def
   48.80 +    unfolding infnorm_mul[unfolded scalar_mult_eq_scaleR]
   48.81 +    unfolding abs_inverse real_abs_infnorm
   48.82 +    apply (subst infnorm_eq_0[THEN sym])
   48.83 +    apply auto
   48.84 +    done
   48.85 +  let ?F = "\<lambda>w::real^2. (f \<circ> (\<lambda>x. x$1)) w - (g \<circ> (\<lambda>x. x$2)) w"
   48.86 +  have *: "\<And>i. (\<lambda>x::real^2. x $ i) ` {- 1..1} = {- 1..1::real}"
   48.87 +    apply (rule set_eqI)
   48.88 +    unfolding image_iff Bex_def mem_interval_cart
   48.89 +    apply rule
   48.90 +    defer
   48.91 +    apply (rule_tac x="vec x" in exI)
   48.92 +    apply auto
   48.93 +    done
   48.94 +  {
   48.95 +    fix x
   48.96 +    assume "x \<in> (\<lambda>w. (f \<circ> (\<lambda>x. x $ 1)) w - (g \<circ> (\<lambda>x. x $ 2)) w) ` {- 1..1::real^2}"
   48.97      then guess w unfolding image_iff .. note w = this
   48.98 -    hence "x \<noteq> 0" using as[of "w$1" "w$2"] unfolding mem_interval_cart by auto} note x0=this
   48.99 -  have 21:"\<And>i::2. i\<noteq>1 \<Longrightarrow> i=2" using UNIV_2 by auto
  48.100 -  have 1:"{- 1<..<1::real^2} \<noteq> {}" unfolding interval_eq_empty_cart by auto
  48.101 -  have 2:"continuous_on {- 1..1} (negatex \<circ> sqprojection \<circ> ?F)"
  48.102 -    apply(intro continuous_on_intros continuous_on_component)
  48.103 -    unfolding * apply(rule assms)+
  48.104 -    apply(subst sqprojection_def)
  48.105 -    apply(intro continuous_on_intros)
  48.106 -    apply(simp add: infnorm_eq_0 x0)
  48.107 -    apply(rule linear_continuous_on)
  48.108 -  proof-
  48.109 -    show "bounded_linear negatex" apply(rule bounded_linearI') unfolding vec_eq_iff proof(rule_tac[!] allI) fix i::2 and x y::"real^2" and c::real
  48.110 -      show "negatex (x + y) $ i = (negatex x + negatex y) $ i" "negatex (c *\<^sub>R x) $ i = (c *\<^sub>R negatex x) $ i"
  48.111 -        apply-apply(case_tac[!] "i\<noteq>1") prefer 3 apply(drule_tac[1-2] 21) 
  48.112 -        unfolding negatex_def by(auto simp add:vector_2 ) qed
  48.113 +    then have "x \<noteq> 0"
  48.114 +      using as[of "w$1" "w$2"]
  48.115 +      unfolding mem_interval_cart
  48.116 +      by auto
  48.117 +  } note x0 = this
  48.118 +  have 21: "\<And>i::2. i \<noteq> 1 \<Longrightarrow> i = 2"
  48.119 +    using UNIV_2 by auto
  48.120 +  have 1: "{- 1<..<1::real^2} \<noteq> {}"
  48.121 +    unfolding interval_eq_empty_cart by auto
  48.122 +  have 2: "continuous_on {- 1..1} (negatex \<circ> sqprojection \<circ> ?F)"
  48.123 +    apply (intro continuous_on_intros continuous_on_component)
  48.124 +    unfolding *
  48.125 +    apply (rule assms)+
  48.126 +    apply (subst sqprojection_def)
  48.127 +    apply (intro continuous_on_intros)
  48.128 +    apply (simp add: infnorm_eq_0 x0)
  48.129 +    apply (rule linear_continuous_on)
  48.130 +  proof -
  48.131 +    show "bounded_linear negatex"
  48.132 +      apply (rule bounded_linearI')
  48.133 +      unfolding vec_eq_iff
  48.134 +    proof (rule_tac[!] allI)
  48.135 +      fix i :: 2
  48.136 +      fix x y :: "real^2"
  48.137 +      fix c :: real
  48.138 +      show "negatex (x + y) $ i =
  48.139 +        (negatex x + negatex y) $ i" "negatex (c *\<^sub>R x) $ i = (c *\<^sub>R negatex x) $ i"
  48.140 +        apply -
  48.141 +        apply (case_tac[!] "i\<noteq>1")
  48.142 +        prefer 3
  48.143 +        apply (drule_tac[1-2] 21) 
  48.144 +        unfolding negatex_def
  48.145 +        apply (auto simp add:vector_2)
  48.146 +        done
  48.147 +    qed
  48.148    qed
  48.149 -  have 3:"(negatex \<circ> sqprojection \<circ> ?F) ` {- 1..1} \<subseteq> {- 1..1}" unfolding subset_eq apply rule proof-
  48.150 -    case goal1 then guess y unfolding image_iff .. note y=this have "?F y \<noteq> 0" apply(rule x0) using y(1) by auto
  48.151 -    hence *:"infnorm (sqprojection (?F y)) = 1" unfolding y o_def apply- by(rule lem2[rule_format])
  48.152 -    have "infnorm x = 1" unfolding *[THEN sym] y o_def by(rule lem1[rule_format])
  48.153 -    thus "x\<in>{- 1..1}" unfolding mem_interval_cart infnorm_2 apply- apply rule
  48.154 -    proof-case goal1 thus ?case apply(cases "i=1") defer apply(drule 21) by auto qed qed
  48.155 -  guess x apply(rule brouwer_weak[of "{- 1..1::real^2}" "negatex \<circ> sqprojection \<circ> ?F"])
  48.156 -    apply(rule compact_interval convex_interval)+ unfolding interior_closed_interval
  48.157 -    apply(rule 1 2 3)+ . note x=this
  48.158 -  have "?F x \<noteq> 0" apply(rule x0) using x(1) by auto
  48.159 -  hence *:"infnorm (sqprojection (?F x)) = 1" unfolding o_def by(rule lem2[rule_format])
  48.160 -  have nx:"infnorm x = 1" apply(subst x(2)[THEN sym]) unfolding *[THEN sym] o_def by(rule lem1[rule_format])
  48.161 -  have "\<forall>x i. x \<noteq> 0 \<longrightarrow> (0 < (sqprojection x)$i \<longleftrightarrow> 0 < x$i)"    "\<forall>x i. x \<noteq> 0 \<longrightarrow> ((sqprojection x)$i < 0 \<longleftrightarrow> x$i < 0)"
  48.162 -    apply- apply(rule_tac[!] allI impI)+ proof- fix x::"real^2" and i::2 assume x:"x\<noteq>0"
  48.163 -    have "inverse (infnorm x) > 0" using x[unfolded infnorm_pos_lt[THEN sym]] by auto
  48.164 -    thus "(0 < sqprojection x $ i) = (0 < x $ i)"   "(sqprojection x $ i < 0) = (x $ i < 0)"
  48.165 +  have 3: "(negatex \<circ> sqprojection \<circ> ?F) ` {- 1..1} \<subseteq> {- 1..1}"
  48.166 +    unfolding subset_eq
  48.167 +    apply rule
  48.168 +  proof -
  48.169 +    case goal1
  48.170 +    then guess y unfolding image_iff .. note y=this
  48.171 +    have "?F y \<noteq> 0"
  48.172 +      apply (rule x0)
  48.173 +      using y(1)
  48.174 +      apply auto
  48.175 +      done
  48.176 +    then have *: "infnorm (sqprojection (?F y)) = 1"
  48.177 +      unfolding y o_def by - (rule lem2[rule_format])
  48.178 +    have "infnorm x = 1"
  48.179 +      unfolding *[THEN sym] y o_def by (rule lem1[rule_format])
  48.180 +    then show "x \<in> {- 1..1}"
  48.181 +      unfolding mem_interval_cart infnorm_2
  48.182 +      apply -
  48.183 +      apply rule
  48.184 +    proof -
  48.185 +      case goal1
  48.186 +      then show ?case
  48.187 +        apply (cases "i = 1")
  48.188 +        defer
  48.189 +        apply (drule 21)
  48.190 +        apply auto
  48.191 +        done
  48.192 +    qed
  48.193 +  qed
  48.194 +  guess x
  48.195 +    apply (rule brouwer_weak[of "{- 1..1::real^2}" "negatex \<circ> sqprojection \<circ> ?F"])
  48.196 +    apply (rule compact_interval convex_interval)+ unfolding interior_closed_interval
  48.197 +    apply (rule 1 2 3)+
  48.198 +    done
  48.199 +  note x=this
  48.200 +  have "?F x \<noteq> 0"
  48.201 +    apply (rule x0)
  48.202 +    using x(1)
  48.203 +    apply auto
  48.204 +    done
  48.205 +  then have *: "infnorm (sqprojection (?F x)) = 1"
  48.206 +    unfolding o_def by (rule lem2[rule_format])
  48.207 +  have nx: "infnorm x = 1"
  48.208 +    apply (subst x(2)[THEN sym])
  48.209 +    unfolding *[THEN sym] o_def
  48.210 +    apply (rule lem1[rule_format])
  48.211 +    done
  48.212 +  have "\<forall>x i. x \<noteq> 0 \<longrightarrow> (0 < (sqprojection x)$i \<longleftrightarrow> 0 < x$i)"
  48.213 +    and "\<forall>x i. x \<noteq> 0 \<longrightarrow> ((sqprojection x)$i < 0 \<longleftrightarrow> x$i < 0)"
  48.214 +    apply -
  48.215 +    apply (rule_tac[!] allI impI)+
  48.216 +  proof -
  48.217 +    fix x :: "real^2"
  48.218 +    fix i :: 2
  48.219 +    assume x: "x \<noteq> 0"
  48.220 +    have "inverse (infnorm x) > 0"
  48.221 +      using x[unfolded infnorm_pos_lt[THEN sym]] by auto
  48.222 +    then show "(0 < sqprojection x $ i) = (0 < x $ i)"
  48.223 +      and "(sqprojection x $ i < 0) = (x $ i < 0)"
  48.224        unfolding sqprojection_def vector_component_simps vector_scaleR_component real_scaleR_def
  48.225 -      unfolding zero_less_mult_iff mult_less_0_iff by(auto simp add:field_simps) qed
  48.226 +      unfolding zero_less_mult_iff mult_less_0_iff
  48.227 +      by (auto simp add: field_simps)
  48.228 +  qed
  48.229    note lem3 = this[rule_format]
  48.230 -  have x1:"x $ 1 \<in> {- 1..1::real}" "x $ 2 \<in> {- 1..1::real}" using x(1) unfolding mem_interval_cart by auto
  48.231 -  hence nz:"f (x $ 1) - g (x $ 2) \<noteq> 0" unfolding right_minus_eq apply-apply(rule as) by auto
  48.232 -  have "x $ 1 = -1 \<or> x $ 1 = 1 \<or> x $ 2 = -1 \<or> x $ 2 = 1" using nx unfolding infnorm_eq_1_2 by auto 
  48.233 -  thus False proof- fix P Q R S 
  48.234 -    presume "P \<or> Q \<or> R \<or> S" "P\<Longrightarrow>False" "Q\<Longrightarrow>False" "R\<Longrightarrow>False" "S\<Longrightarrow>False" thus False by auto
  48.235 -  next assume as:"x$1 = 1"
  48.236 -    hence *:"f (x $ 1) $ 1 = 1" using assms(6) by auto
  48.237 +  have x1: "x $ 1 \<in> {- 1..1::real}" "x $ 2 \<in> {- 1..1::real}"
  48.238 +    using x(1) unfolding mem_interval_cart by auto
  48.239 +  then have nz: "f (x $ 1) - g (x $ 2) \<noteq> 0"
  48.240 +    unfolding right_minus_eq
  48.241 +    apply -
  48.242 +    apply (rule as)
  48.243 +    apply auto
  48.244 +    done
  48.245 +  have "x $ 1 = -1 \<or> x $ 1 = 1 \<or> x $ 2 = -1 \<or> x $ 2 = 1"
  48.246 +    using nx unfolding infnorm_eq_1_2 by auto 
  48.247 +  then show False
  48.248 +  proof -
  48.249 +    fix P Q R S 
  48.250 +    presume "P \<or> Q \<or> R \<or> S"
  48.251 +      and "P \<Longrightarrow> False"
  48.252 +      and "Q \<Longrightarrow> False"
  48.253 +      and "R \<Longrightarrow> False"
  48.254 +      and "S \<Longrightarrow> False"
  48.255 +    then show False by auto
  48.256 +  next
  48.257 +    assume as: "x$1 = 1"
  48.258 +    then have *: "f (x $ 1) $ 1 = 1"
  48.259 +      using assms(6) by auto
  48.260      have "sqprojection (f (x$1) - g (x$2)) $ 1 < 0"
  48.261        using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=1]]
  48.262 -      unfolding as negatex_def vector_2 by auto moreover
  48.263 -    from x1 have "g (x $ 2) \<in> {- 1..1}" apply-apply(rule assms(2)[unfolded subset_eq,rule_format]) by auto
  48.264 -    ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart 
  48.265 -      apply(erule_tac x=1 in allE) by auto 
  48.266 -  next assume as:"x$1 = -1"
  48.267 -    hence *:"f (x $ 1) $ 1 = - 1" using assms(5) by auto
  48.268 +      unfolding as negatex_def vector_2
  48.269 +      by auto
  48.270 +    moreover
  48.271 +    from x1 have "g (x $ 2) \<in> {- 1..1}"
  48.272 +      apply -
  48.273 +      apply (rule assms(2)[unfolded subset_eq,rule_format])
  48.274 +      apply auto
  48.275 +      done
  48.276 +    ultimately show False
  48.277 +      unfolding lem3[OF nz] vector_component_simps * mem_interval_cart 
  48.278 +      apply (erule_tac x=1 in allE)
  48.279 +      apply auto
  48.280 +      done
  48.281 +  next
  48.282 +    assume as: "x$1 = -1"
  48.283 +    then have *: "f (x $ 1) $ 1 = - 1"
  48.284 +      using assms(5) by auto
  48.285      have "sqprojection (f (x$1) - g (x$2)) $ 1 > 0"
  48.286        using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=1]]
  48.287 -      unfolding as negatex_def vector_2 by auto moreover
  48.288 -    from x1 have "g (x $ 2) \<in> {- 1..1}" apply-apply(rule assms(2)[unfolded subset_eq,rule_format]) by auto
  48.289 -    ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart 
  48.290 -      apply(erule_tac x=1 in allE) by auto
  48.291 -  next assume as:"x$2 = 1"
  48.292 -    hence *:"g (x $ 2) $ 2 = 1" using assms(8) by auto
  48.293 +      unfolding as negatex_def vector_2
  48.294 +      by auto
  48.295 +    moreover
  48.296 +    from x1 have "g (x $ 2) \<in> {- 1..1}"
  48.297 +      apply -
  48.298 +      apply (rule assms(2)[unfolded subset_eq,rule_format])
  48.299 +      apply auto
  48.300 +      done
  48.301 +    ultimately show False
  48.302 +      unfolding lem3[OF nz] vector_component_simps * mem_interval_cart 
  48.303 +      apply (erule_tac x=1 in allE)
  48.304 +      apply auto
  48.305 +      done
  48.306 +  next
  48.307 +    assume as: "x$2 = 1"
  48.308 +    then have *: "g (x $ 2) $ 2 = 1"
  48.309 +      using assms(8) by auto
  48.310      have "sqprojection (f (x$1) - g (x$2)) $ 2 > 0"
  48.311        using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=2]]
  48.312 -      unfolding as negatex_def vector_2 by auto moreover
  48.313 -    from x1 have "f (x $ 1) \<in> {- 1..1}" apply-apply(rule assms(1)[unfolded subset_eq,rule_format]) by auto
  48.314 -    ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart 
  48.315 -     apply(erule_tac x=2 in allE) by auto
  48.316 - next assume as:"x$2 = -1"
  48.317 -    hence *:"g (x $ 2) $ 2 = - 1" using assms(7) by auto
  48.318 +      unfolding as negatex_def vector_2
  48.319 +      by auto
  48.320 +    moreover
  48.321 +    from x1 have "f (x $ 1) \<in> {- 1..1}"
  48.322 +      apply -
  48.323 +      apply (rule assms(1)[unfolded subset_eq,rule_format])
  48.324 +      apply auto
  48.325 +      done
  48.326 +    ultimately show False
  48.327 +      unfolding lem3[OF nz] vector_component_simps * mem_interval_cart
  48.328 +      apply (erule_tac x=2 in allE)
  48.329 +      apply auto
  48.330 +      done
  48.331 +  next
  48.332 +    assume as: "x$2 = -1"
  48.333 +    then have *: "g (x $ 2) $ 2 = - 1"
  48.334 +      using assms(7) by auto
  48.335      have "sqprojection (f (x$1) - g (x$2)) $ 2 < 0"
  48.336        using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=2]]
  48.337 -      unfolding as negatex_def vector_2 by auto moreover
  48.338 -    from x1 have "f (x $ 1) \<in> {- 1..1}" apply-apply(rule assms(1)[unfolded subset_eq,rule_format]) by auto
  48.339 -    ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart 
  48.340 -      apply(erule_tac x=2 in allE) by auto qed(auto) qed
  48.341 +      unfolding as negatex_def vector_2
  48.342 +      by auto
  48.343 +    moreover
  48.344 +    from x1 have "f (x $ 1) \<in> {- 1..1}"
  48.345 +      apply -
  48.346 +      apply (rule assms(1)[unfolded subset_eq,rule_format])
  48.347 +      apply auto
  48.348 +      done
  48.349 +    ultimately show False
  48.350 +      unfolding lem3[OF nz] vector_component_simps * mem_interval_cart
  48.351 +      apply (erule_tac x=2 in allE)
  48.352 +      apply auto
  48.353 +      done
  48.354 +  qed auto
  48.355 +qed
  48.356  
  48.357 -lemma fashoda_unit_path: fixes f ::"real \<Rightarrow> real^2" and g ::"real \<Rightarrow> real^2"
  48.358 -  assumes "path f" "path g" "path_image f \<subseteq> {- 1..1}" "path_image g \<subseteq> {- 1..1}"
  48.359 -  "(pathstart f)$1 = -1" "(pathfinish f)$1 = 1"  "(pathstart g)$2 = -1" "(pathfinish g)$2 = 1"
  48.360 -  obtains z where "z \<in> path_image f" "z \<in> path_image g" proof-
  48.361 +lemma fashoda_unit_path:
  48.362 +  fixes f g :: "real \<Rightarrow> real^2"
  48.363 +  assumes "path f"
  48.364 +    and "path g"
  48.365 +    and "path_image f \<subseteq> {- 1..1}"
  48.366 +    and "path_image g \<subseteq> {- 1..1}"
  48.367 +    and "(pathstart f)$1 = -1"
  48.368 +    and "(pathfinish f)$1 = 1"
  48.369 +    and "(pathstart g)$2 = -1"
  48.370 +    and "(pathfinish g)$2 = 1"
  48.371 +  obtains z where "z \<in> path_image f" and "z \<in> path_image g"
  48.372 +proof -
  48.373    note assms=assms[unfolded path_def pathstart_def pathfinish_def path_image_def]
  48.374    def iscale \<equiv> "\<lambda>z::real. inverse 2 *\<^sub>R (z + 1)"
  48.375 -  have isc:"iscale ` {- 1..1} \<subseteq> {0..1}" unfolding iscale_def by(auto)
  48.376 -  have "\<exists>s\<in>{- 1..1}. \<exists>t\<in>{- 1..1}. (f \<circ> iscale) s = (g \<circ> iscale) t" proof(rule fashoda_unit) 
  48.377 +  have isc: "iscale ` {- 1..1} \<subseteq> {0..1}"
  48.378 +    unfolding iscale_def by auto
  48.379 +  have "\<exists>s\<in>{- 1..1}. \<exists>t\<in>{- 1..1}. (f \<circ> iscale) s = (g \<circ> iscale) t"
  48.380 +  proof (rule fashoda_unit)
  48.381      show "(f \<circ> iscale) ` {- 1..1} \<subseteq> {- 1..1}" "(g \<circ> iscale) ` {- 1..1} \<subseteq> {- 1..1}"
  48.382        using isc and assms(3-4) unfolding image_compose by auto
  48.383 -    have *:"continuous_on {- 1..1} iscale" unfolding iscale_def by(rule continuous_on_intros)+
  48.384 +    have *: "continuous_on {- 1..1} iscale"
  48.385 +      unfolding iscale_def by (rule continuous_on_intros)+
  48.386      show "continuous_on {- 1..1} (f \<circ> iscale)" "continuous_on {- 1..1} (g \<circ> iscale)"
  48.387 -      apply-apply(rule_tac[!] continuous_on_compose[OF *]) apply(rule_tac[!] continuous_on_subset[OF _ isc])
  48.388 -      by(rule assms)+ have *:"(1 / 2) *\<^sub>R (1 + (1::real^1)) = 1" unfolding vec_eq_iff by auto
  48.389 -    show "(f \<circ> iscale) (- 1) $ 1 = - 1" "(f \<circ> iscale) 1 $ 1 = 1" "(g \<circ> iscale) (- 1) $ 2 = -1" "(g \<circ> iscale) 1 $ 2 = 1"
  48.390 -      unfolding o_def iscale_def using assms by(auto simp add:*) qed
  48.391 +      apply -
  48.392 +      apply (rule_tac[!] continuous_on_compose[OF *])
  48.393 +      apply (rule_tac[!] continuous_on_subset[OF _ isc])
  48.394 +      apply (rule assms)+
  48.395 +      done
  48.396 +    have *: "(1 / 2) *\<^sub>R (1 + (1::real^1)) = 1"
  48.397 +      unfolding vec_eq_iff by auto
  48.398 +    show "(f \<circ> iscale) (- 1) $ 1 = - 1"
  48.399 +      and "(f \<circ> iscale) 1 $ 1 = 1"
  48.400 +      and "(g \<circ> iscale) (- 1) $ 2 = -1"
  48.401 +      and "(g \<circ> iscale) 1 $ 2 = 1"
  48.402 +      unfolding o_def iscale_def
  48.403 +      using assms
  48.404 +      by (auto simp add: *)
  48.405 +  qed
  48.406    then guess s .. from this(2) guess t .. note st=this
  48.407 -  show thesis apply(rule_tac z="f (iscale s)" in that)
  48.408 -    using st `s\<in>{- 1..1}` unfolding o_def path_image_def image_iff apply-
  48.409 -    apply(rule_tac x="iscale s" in bexI) prefer 3 apply(rule_tac x="iscale t" in bexI)
  48.410 -    using isc[unfolded subset_eq, rule_format] by auto qed
  48.411 +  show thesis
  48.412 +    apply (rule_tac z="f (iscale s)" in that)
  48.413 +    using st `s\<in>{- 1..1}`
  48.414 +    unfolding o_def path_image_def image_iff
  48.415 +    apply -
  48.416 +    apply (rule_tac x="iscale s" in bexI)
  48.417 +    prefer 3
  48.418 +    apply (rule_tac x="iscale t" in bexI)
  48.419 +    using isc[unfolded subset_eq, rule_format]
  48.420 +    apply auto
  48.421 +    done
  48.422 +qed
  48.423  
  48.424  lemma fashoda: fixes b::"real^2"
  48.425    assumes "path f" "path g" "path_image f \<subseteq> {a..b}" "path_image g \<subseteq> {a..b}"
    49.1 --- a/src/HOL/Multivariate_Analysis/Integration.thy	Thu Sep 12 22:10:17 2013 +0200
    49.2 +++ b/src/HOL/Multivariate_Analysis/Integration.thy	Fri Sep 13 09:31:45 2013 +0200
    49.3 @@ -136,18 +136,21 @@
    49.4      "f 0 = 0"
    49.5      "f (- a) = - f a"
    49.6      "f (s *\<^sub>R v) = s *\<^sub>R (f v)"
    49.7 -  apply (rule_tac[!] additive.add additive.minus additive.diff additive.zero bounded_linear.scaleR)
    49.8 -  using assms unfolding bounded_linear_def additive_def
    49.9 -  apply auto
   49.10 -  done
   49.11 +proof -
   49.12 +  interpret f: bounded_linear f by fact
   49.13 +  show "f (a + b) = f a + f b" by (rule f.add)
   49.14 +  show "f (a - b) = f a - f b" by (rule f.diff)
   49.15 +  show "f 0 = 0" by (rule f.zero)
   49.16 +  show "f (- a) = - f a" by (rule f.minus)
   49.17 +  show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scaleR)
   49.18 +qed
   49.19  
   49.20  lemma bounded_linearI:
   49.21    assumes "\<And>x y. f (x + y) = f x + f y"
   49.22      and "\<And>r x. f (r *\<^sub>R x) = r *\<^sub>R f x"
   49.23      and "\<And>x. norm (f x) \<le> norm x * K"
   49.24    shows "bounded_linear f"
   49.25 -  unfolding bounded_linear_def additive_def bounded_linear_axioms_def
   49.26 -  using assms by auto
   49.27 +  using assms by (rule bounded_linear_intro) (* FIXME: duplicate *)
   49.28  
   49.29  lemma bounded_linear_component [intro]: "bounded_linear (\<lambda>x::'a::euclidean_space. x \<bullet> k)"
   49.30    by (rule bounded_linear_inner_left)
   49.31 @@ -3324,12 +3327,13 @@
   49.32    have *: "\<And>(a::'a) b c. content ({a..b} \<inter> {x. x\<bullet>k \<le> c}) = 0 \<longleftrightarrow>
   49.33      interior({a..b} \<inter> {x. x\<bullet>k \<le> c}) = {}"
   49.34      unfolding  interval_split[OF k] content_eq_0_interior by auto
   49.35 -  guess u1 v1 using d(4)[OF assms(2)] apply-by(erule exE)+ note uv1=this
   49.36 -  guess u2 v2 using d(4)[OF assms(3)] apply-by(erule exE)+ note uv2=this
   49.37 +  guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
   49.38 +  guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
   49.39    have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
   49.40      by auto
   49.41    show ?thesis
   49.42 -    unfolding uv1 uv2 * apply(rule **[OF d(5)[OF assms(2-4)]])
   49.43 +    unfolding uv1 uv2 *
   49.44 +    apply (rule **[OF d(5)[OF assms(2-4)]])
   49.45      defer
   49.46      apply (subst assms(5)[unfolded uv1 uv2])
   49.47      unfolding uv1 uv2
   49.48 @@ -3686,7 +3690,7 @@
   49.49          unfolding lem3[OF p(3)]
   49.50          apply (subst setsum_reindex_nonzero[OF p(3)])
   49.51          defer
   49.52 -        apply(subst setsum_reindex_nonzero[OF p(3)])
   49.53 +        apply (subst setsum_reindex_nonzero[OF p(3)])
   49.54          defer
   49.55          unfolding lem4[symmetric]
   49.56          apply (rule refl)
   49.57 @@ -3903,7 +3907,7 @@
   49.58            unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
   49.59            using p
   49.60            using assms
   49.61 -          by (auto simp add:algebra_simps)
   49.62 +          by (auto simp add: algebra_simps)
   49.63        qed
   49.64      qed
   49.65    qed
   49.66 @@ -3927,7 +3931,7 @@
   49.67        opp (f ({a..b} \<inter> {x. x\<bullet>k \<le> c})) (f ({a..b} \<inter> {x. x\<bullet>k \<ge> c}))"
   49.68    using assms unfolding operative_def by auto
   49.69  
   49.70 -lemma operative_trivial: "operative opp f \<Longrightarrow> content({a..b}) = 0 \<Longrightarrow> f({a..b}) = neutral opp"
   49.71 +lemma operative_trivial: "operative opp f \<Longrightarrow> content {a..b} = 0 \<Longrightarrow> f {a..b} = neutral opp"
   49.72    unfolding operative_def by auto
   49.73  
   49.74  lemma property_empty_interval: "\<forall>a b. content {a..b} = 0 \<longrightarrow> P {a..b} \<Longrightarrow> P {}"
   49.75 @@ -4122,11 +4126,8 @@
   49.76    apply rule
   49.77    done
   49.78  
   49.79 -lemma neutral_monoid: "neutral ((op +)::('a::comm_monoid_add) \<Rightarrow> 'a \<Rightarrow> 'a) = 0"
   49.80 -  by (rule neutral_add) (* FIXME: duplicate *)
   49.81 -
   49.82  lemma monoidal_monoid[intro]: "monoidal ((op +)::('a::comm_monoid_add) \<Rightarrow> 'a \<Rightarrow> 'a)"
   49.83 -  unfolding monoidal_def neutral_monoid
   49.84 +  unfolding monoidal_def neutral_add
   49.85    by (auto simp add: algebra_simps)
   49.86  
   49.87  lemma operative_integral:
   49.88 @@ -4854,12 +4855,12 @@
   49.89  proof -
   49.90    have *: "setsum f s = setsum f (support op + f s)"
   49.91      apply (rule setsum_mono_zero_right)
   49.92 -    unfolding support_def neutral_monoid
   49.93 +    unfolding support_def neutral_add
   49.94      using assms
   49.95      apply auto
   49.96      done
   49.97    then show ?thesis unfolding * iterate_def fold'_def setsum.eq_fold
   49.98 -    unfolding neutral_monoid by (simp add: comp_def)
   49.99 +    unfolding neutral_add by (simp add: comp_def)
  49.100  qed
  49.101  
  49.102  lemma additive_content_division:
  49.103 @@ -5180,7 +5181,7 @@
  49.104    by auto
  49.105  
  49.106  lemma has_integral_component_lbound:
  49.107 -  fixes f :: "'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  49.108 +  fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
  49.109    assumes "(f has_integral i) {a..b}"
  49.110      and "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k"
  49.111      and "k \<in> Basis"
  49.112 @@ -5398,7 +5399,6 @@
  49.113    apply (rule iterate_nonzero_image_lemma)
  49.114    apply (rule assms monoidal_monoid)+
  49.115    unfolding assms
  49.116 -  using neutral_add
  49.117    unfolding neutral_add
  49.118    using assms
  49.119    apply auto
  49.120 @@ -6354,54 +6354,121 @@
  49.121    using operative_division[OF monoidal_and assms] division_of_finite[OF assms(2)]
  49.122    by auto
  49.123  
  49.124 -lemma operative_approximable: assumes "0 \<le> e" fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.125 -  shows "operative op \<and> (\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i)" unfolding operative_def neutral_and
  49.126 +lemma operative_approximable:
  49.127 +  fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.128 +  assumes "0 \<le> e"
  49.129 +  shows "operative op \<and> (\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i)"
  49.130 +  unfolding operative_def neutral_and
  49.131  proof safe
  49.132 -  fix a b::"'b"
  49.133 -  { assume "content {a..b} = 0"
  49.134 -    thus "\<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}"
  49.135 -      apply(rule_tac x=f in exI) using assms by(auto intro!:integrable_on_null) }
  49.136 -  { fix c g and k :: 'b
  49.137 -    assume as:"\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e" "g integrable_on {a..b}" and k:"k\<in>Basis"
  49.138 +  fix a b :: 'b
  49.139 +  {
  49.140 +    assume "content {a..b} = 0"
  49.141 +    then show "\<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}"
  49.142 +      apply (rule_tac x=f in exI)
  49.143 +      using assms
  49.144 +      apply (auto intro!:integrable_on_null)
  49.145 +      done
  49.146 +  }
  49.147 +  {
  49.148 +    fix c g
  49.149 +    fix k :: 'b
  49.150 +    assume as: "\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e" "g integrable_on {a..b}"
  49.151 +    assume k: "k \<in> Basis"
  49.152      show "\<exists>g. (\<forall>x\<in>{a..b} \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}"
  49.153        "\<exists>g. (\<forall>x\<in>{a..b} \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k}"
  49.154 -      apply(rule_tac[!] x=g in exI) using as(1) integrable_split[OF as(2) k] by auto }
  49.155 -  fix c k g1 g2 assume as:"\<forall>x\<in>{a..b} \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g1 x) \<le> e" "g1 integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}"
  49.156 -                          "\<forall>x\<in>{a..b} \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g2 x) \<le> e" "g2 integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k}"
  49.157 -  assume k:"k\<in>Basis"
  49.158 +      apply (rule_tac[!] x=g in exI)
  49.159 +      using as(1) integrable_split[OF as(2) k]
  49.160 +      apply auto
  49.161 +      done
  49.162 +  }
  49.163 +  fix c k g1 g2
  49.164 +  assume as: "\<forall>x\<in>{a..b} \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g1 x) \<le> e" "g1 integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}"
  49.165 +    "\<forall>x\<in>{a..b} \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g2 x) \<le> e" "g2 integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k}"
  49.166 +  assume k: "k \<in> Basis"
  49.167    let ?g = "\<lambda>x. if x\<bullet>k = c then f x else if x\<bullet>k \<le> c then g1 x else g2 x"
  49.168 -  show "\<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}" apply(rule_tac x="?g" in exI)
  49.169 -  proof safe case goal1 thus ?case apply- apply(cases "x\<bullet>k=c", case_tac "x\<bullet>k < c") using as assms by auto
  49.170 -  next case goal2 presume "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}" "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<ge> c}"
  49.171 -    then guess h1 h2 unfolding integrable_on_def by auto from has_integral_split[OF this k]
  49.172 -    show ?case unfolding integrable_on_def by auto
  49.173 -  next show "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}" "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<ge> c}"
  49.174 -      apply(rule_tac[!] integrable_spike[OF negligible_standard_hyperplane[of k c]]) using k as(2,4) by auto qed qed
  49.175 -
  49.176 -lemma approximable_on_division: fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.177 -  assumes "0 \<le> e" "d division_of {a..b}" "\<forall>i\<in>d. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  49.178 +  show "\<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}"
  49.179 +    apply (rule_tac x="?g" in exI)
  49.180 +  proof safe
  49.181 +    case goal1
  49.182 +    then show ?case
  49.183 +      apply -
  49.184 +      apply (cases "x\<bullet>k=c")
  49.185 +      apply (case_tac "x\<bullet>k < c")
  49.186 +      using as assms
  49.187 +      apply auto
  49.188 +      done
  49.189 +  next
  49.190 +    case goal2
  49.191 +    presume "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}"
  49.192 +      and "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<ge> c}"
  49.193 +    then guess h1 h2 unfolding integrable_on_def by auto
  49.194 +    from has_integral_split[OF this k] show ?case
  49.195 +      unfolding integrable_on_def by auto
  49.196 +  next
  49.197 +    show "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}" "?g integrable_on {a..b} \<inter> {x. x \<bullet> k \<ge> c}"
  49.198 +      apply(rule_tac[!] integrable_spike[OF negligible_standard_hyperplane[of k c]])
  49.199 +      using k as(2,4)
  49.200 +      apply auto
  49.201 +      done
  49.202 +  qed
  49.203 +qed
  49.204 +
  49.205 +lemma approximable_on_division:
  49.206 +  fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.207 +  assumes "0 \<le> e"
  49.208 +    and "d division_of {a..b}"
  49.209 +    and "\<forall>i\<in>d. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  49.210    obtains g where "\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e" "g integrable_on {a..b}"
  49.211 -proof- note * = operative_division[OF monoidal_and operative_approximable[OF assms(1)] assms(2)]
  49.212 -  note this[unfolded iterate_and[OF division_of_finite[OF assms(2)]]] from assms(3)[unfolded this[of f]]
  49.213 -  guess g .. thus thesis apply-apply(rule that[of g]) by auto qed
  49.214 -
  49.215 -lemma integrable_continuous: fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.216 -  assumes "continuous_on {a..b} f" shows "f integrable_on {a..b}"
  49.217 -proof(rule integrable_uniform_limit,safe) fix e::real assume e:"0 < e"
  49.218 +proof -
  49.219 +  note * = operative_division[OF monoidal_and operative_approximable[OF assms(1)] assms(2)]
  49.220 +  note this[unfolded iterate_and[OF division_of_finite[OF assms(2)]]]
  49.221 +  from assms(3)[unfolded this[of f]] guess g ..
  49.222 +  then show thesis
  49.223 +    apply -
  49.224 +    apply (rule that[of g])
  49.225 +    apply auto
  49.226 +    done
  49.227 +qed
  49.228 +
  49.229 +lemma integrable_continuous:
  49.230 +  fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.231 +  assumes "continuous_on {a..b} f"
  49.232 +  shows "f integrable_on {a..b}"
  49.233 +proof (rule integrable_uniform_limit, safe)
  49.234 +  fix e :: real
  49.235 +  assume e: "e > 0"
  49.236    from compact_uniformly_continuous[OF assms compact_interval,unfolded uniformly_continuous_on_def,rule_format,OF e] guess d ..
  49.237    note d=conjunctD2[OF this,rule_format]
  49.238    from fine_division_exists[OF gauge_ball[OF d(1)], of a b] guess p . note p=this
  49.239    note p' = tagged_division_ofD[OF p(1)]
  49.240 -  have *:"\<forall>i\<in>snd ` p. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  49.241 -  proof(safe,unfold snd_conv) fix x l assume as:"(x,l) \<in> p"
  49.242 -    from p'(4)[OF this] guess a b apply-by(erule exE)+ note l=this
  49.243 -    show "\<exists>g. (\<forall>x\<in>l. norm (f x - g x) \<le> e) \<and> g integrable_on l" apply(rule_tac x="\<lambda>y. f x" in exI)
  49.244 -    proof safe show "(\<lambda>y. f x) integrable_on l" unfolding integrable_on_def l by(rule,rule has_integral_const)
  49.245 -      fix y assume y:"y\<in>l" note fineD[OF p(2) as,unfolded subset_eq,rule_format,OF this]
  49.246 +  have *: "\<forall>i\<in>snd ` p. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
  49.247 +  proof (safe, unfold snd_conv)
  49.248 +    fix x l
  49.249 +    assume as: "(x, l) \<in> p"
  49.250 +    from p'(4)[OF this] guess a b by (elim exE) note l=this
  49.251 +    show "\<exists>g. (\<forall>x\<in>l. norm (f x - g x) \<le> e) \<and> g integrable_on l"
  49.252 +      apply (rule_tac x="\<lambda>y. f x" in exI)
  49.253 +    proof safe
  49.254 +      show "(\<lambda>y. f x) integrable_on l"
  49.255 +        unfolding integrable_on_def l
  49.256 +        apply rule
  49.257 +        apply (rule has_integral_const)
  49.258 +        done
  49.259 +      fix y
  49.260 +      assume y: "y \<in> l"
  49.261 +      note fineD[OF p(2) as,unfolded subset_eq,rule_format,OF this]
  49.262        note d(2)[OF _ _ this[unfolded mem_ball]]
  49.263 -      thus "norm (f y - f x) \<le> e" using y p'(2-3)[OF as] unfolding dist_norm l norm_minus_commute by fastforce qed qed
  49.264 -  from e have "0 \<le> e" by auto from approximable_on_division[OF this division_of_tagged_division[OF p(1)] *] guess g .
  49.265 -  thus "\<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}" by auto qed
  49.266 +      then show "norm (f y - f x) \<le> e"
  49.267 +        using y p'(2-3)[OF as] unfolding dist_norm l norm_minus_commute by fastforce
  49.268 +    qed
  49.269 +  qed
  49.270 +  from e have "e \<ge> 0"
  49.271 +    by auto
  49.272 +  from approximable_on_division[OF this division_of_tagged_division[OF p(1)] *] guess g .
  49.273 +  then show "\<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}"
  49.274 +    by auto
  49.275 +qed
  49.276 +
  49.277  
  49.278  subsection {* Specialization of additivity to one dimension. *}
  49.279  
  49.280 @@ -6410,374 +6477,978 @@
  49.281    and real_inner_1_right: "inner x 1 = x"
  49.282    by simp_all
  49.283  
  49.284 -lemma operative_1_lt: assumes "monoidal opp"
  49.285 +lemma operative_1_lt:
  49.286 +  assumes "monoidal opp"
  49.287    shows "operative opp f \<longleftrightarrow> ((\<forall>a b. b \<le> a \<longrightarrow> f {a..b::real} = neutral opp) \<and>
  49.288 -                (\<forall>a b c. a < c \<and> c < b \<longrightarrow> opp (f{a..c})(f{c..b}) = f {a..b}))"
  49.289 -  apply (simp add: operative_def content_eq_0 less_one)
  49.290 -proof safe fix a b c::"real" assume as:"\<forall>a b c. f {a..b} = opp (f ({a..b} \<inter> {x. x \<le> c}))
  49.291 -    (f ({a..b} \<inter> {x. c \<le> x}))" "a < c" "c < b"
  49.292 -    from this(2-) have "{a..b} \<inter> {x. x \<le> c} = {a..c}" "{a..b} \<inter> {x. x \<ge> c} = {c..b}" by auto
  49.293 -    thus "opp (f {a..c}) (f {c..b}) = f {a..b}" unfolding as(1)[rule_format,of a b "c"] by auto
  49.294 -next fix a b c::real
  49.295 -  assume as:"\<forall>a b. b \<le> a \<longrightarrow> f {a..b} = neutral opp" "\<forall>a b c. a < c \<and> c < b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.296 +    (\<forall>a b c. a < c \<and> c < b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}))"
  49.297 +  apply (simp add: operative_def content_eq_0)
  49.298 +proof safe
  49.299 +  fix a b c :: real
  49.300 +  assume as:
  49.301 +    "\<forall>a b c. f {a..b} = opp (f ({a..b} \<inter> {x. x \<le> c})) (f ({a..b} \<inter> {x. c \<le> x}))"
  49.302 +    "a < c"
  49.303 +    "c < b"
  49.304 +    from this(2-) have "{a..b} \<inter> {x. x \<le> c} = {a..c}" "{a..b} \<inter> {x. x \<ge> c} = {c..b}"
  49.305 +      by auto
  49.306 +    then show "opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.307 +      unfolding as(1)[rule_format,of a b "c"] by auto
  49.308 +next
  49.309 +  fix a b c :: real
  49.310 +  assume as: "\<forall>a b. b \<le> a \<longrightarrow> f {a..b} = neutral opp"
  49.311 +    "\<forall>a b c. a < c \<and> c < b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.312    show "f {a..b} = opp (f ({a..b} \<inter> {x. x \<le> c})) (f ({a..b} \<inter> {x. c \<le> x}))"
  49.313 -  proof(cases "c \<in> {a .. b}")
  49.314 -    case False hence "c<a \<or> c>b" by auto
  49.315 -    thus ?thesis apply-apply(erule disjE)
  49.316 -    proof- assume "c<a" hence *:"{a..b} \<inter> {x. x \<le> c} = {1..0}"  "{a..b} \<inter> {x. c \<le> x} = {a..b}" by auto
  49.317 -      show ?thesis unfolding * apply(subst as(1)[rule_format,of 0 1]) using assms by auto
  49.318 -    next   assume "b<c" hence *:"{a..b} \<inter> {x. x \<le> c} = {a..b}"  "{a..b} \<inter> {x. c \<le> x} = {1..0}" by auto
  49.319 -      show ?thesis unfolding * apply(subst as(1)[rule_format,of 0 1]) using assms by auto
  49.320 +  proof (cases "c \<in> {a..b}")
  49.321 +    case False
  49.322 +    then have "c < a \<or> c > b" by auto
  49.323 +    then show ?thesis
  49.324 +    proof
  49.325 +      assume "c < a"
  49.326 +      then have *: "{a..b} \<inter> {x. x \<le> c} = {1..0}" "{a..b} \<inter> {x. c \<le> x} = {a..b}"
  49.327 +        by auto
  49.328 +      show ?thesis
  49.329 +        unfolding *
  49.330 +        apply (subst as(1)[rule_format,of 0 1])
  49.331 +        using assms
  49.332 +        apply auto
  49.333 +        done
  49.334 +    next
  49.335 +      assume "b < c"
  49.336 +      then have *: "{a..b} \<inter> {x. x \<le> c} = {a..b}" "{a..b} \<inter> {x. c \<le> x} = {1..0}"
  49.337 +        by auto
  49.338 +      show ?thesis
  49.339 +        unfolding *
  49.340 +        apply (subst as(1)[rule_format,of 0 1])
  49.341 +        using assms
  49.342 +        apply auto
  49.343 +        done
  49.344      qed
  49.345 -  next case True hence *:"min (b) c = c" "max a c = c" by auto
  49.346 -    have **: "(1::real) \<in> Basis" by simp
  49.347 -    have ***:"\<And>P Q. (\<Sum>i\<in>Basis. (if i = 1 then P i else Q i) *\<^sub>R i) = (P 1::real)"
  49.348 +  next
  49.349 +    case True
  49.350 +    then have *: "min (b) c = c" "max a c = c"
  49.351 +      by auto
  49.352 +    have **: "(1::real) \<in> Basis"
  49.353 +      by simp
  49.354 +    have ***: "\<And>P Q. (\<Sum>i\<in>Basis. (if i = 1 then P i else Q i) *\<^sub>R i) = (P 1::real)"
  49.355        by simp
  49.356      show ?thesis
  49.357        unfolding interval_split[OF **, unfolded real_inner_1_right] unfolding *** *
  49.358 -    proof(cases "c = a \<or> c = b")
  49.359 -      case False thus "f {a..b} = opp (f {a..c}) (f {c..b})"
  49.360 -        apply-apply(subst as(2)[rule_format]) using True by auto
  49.361 -    next case True thus "f {a..b} = opp (f {a..c}) (f {c..b})" apply-
  49.362 -      proof(erule disjE) assume *:"c=a"
  49.363 -        hence "f {a..c} = neutral opp" apply-apply(rule as(1)[rule_format]) by auto
  49.364 -        thus ?thesis using assms unfolding * by auto
  49.365 -      next assume *:"c=b" hence "f {c..b} = neutral opp" apply-apply(rule as(1)[rule_format]) by auto
  49.366 -        thus ?thesis using assms unfolding * by auto qed qed qed qed
  49.367 -
  49.368 -lemma operative_1_le: assumes "monoidal opp"
  49.369 +    proof (cases "c = a \<or> c = b")
  49.370 +      case False
  49.371 +      then show "f {a..b} = opp (f {a..c}) (f {c..b})"
  49.372 +        apply -
  49.373 +        apply (subst as(2)[rule_format])
  49.374 +        using True
  49.375 +        apply auto
  49.376 +        done
  49.377 +    next
  49.378 +      case True
  49.379 +      then show "f {a..b} = opp (f {a..c}) (f {c..b})"
  49.380 +      proof
  49.381 +        assume *: "c = a"
  49.382 +        then have "f {a..c} = neutral opp"
  49.383 +          apply -
  49.384 +          apply (rule as(1)[rule_format])
  49.385 +          apply auto
  49.386 +          done
  49.387 +        then show ?thesis
  49.388 +          using assms unfolding * by auto
  49.389 +      next
  49.390 +        assume *: "c = b"
  49.391 +        then have "f {c..b} = neutral opp"
  49.392 +          apply -
  49.393 +          apply (rule as(1)[rule_format])
  49.394 +          apply auto
  49.395 +          done
  49.396 +        then show ?thesis
  49.397 +          using assms unfolding * by auto
  49.398 +      qed
  49.399 +    qed
  49.400 +  qed
  49.401 +qed
  49.402 +
  49.403 +lemma operative_1_le:
  49.404 +  assumes "monoidal opp"
  49.405    shows "operative opp f \<longleftrightarrow> ((\<forall>a b. b \<le> a \<longrightarrow> f {a..b::real} = neutral opp) \<and>
  49.406 -                (\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> opp (f{a..c})(f{c..b}) = f {a..b}))"
  49.407 -unfolding operative_1_lt[OF assms]
  49.408 -proof safe fix a b c::"real" assume as:"\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}" "a < c" "c < b"
  49.409 -  show "opp (f {a..c}) (f {c..b}) = f {a..b}" apply(rule as(1)[rule_format]) using as(2-) by auto
  49.410 -next fix a b c ::"real" assume "\<forall>a b. b \<le> a \<longrightarrow> f {a..b} = neutral opp"
  49.411 -    "\<forall>a b c. a < c \<and> c < b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}" "a \<le> c" "c \<le> b"
  49.412 +    (\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}))"
  49.413 +  unfolding operative_1_lt[OF assms]
  49.414 +proof safe
  49.415 +  fix a b c :: real
  49.416 +  assume as:
  49.417 +    "\<forall>a b c. a \<le> c \<and> c \<le> b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.418 +    "a < c"
  49.419 +    "c < b"
  49.420 +  show "opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.421 +    apply (rule as(1)[rule_format])
  49.422 +    using as(2-)
  49.423 +    apply auto
  49.424 +    done
  49.425 +next
  49.426 +  fix a b c :: real
  49.427 +  assume "\<forall>a b. b \<le> a \<longrightarrow> f {a..b} = neutral opp"
  49.428 +    and "\<forall>a b c. a < c \<and> c < b \<longrightarrow> opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.429 +    and "a \<le> c"
  49.430 +    and "c \<le> b"
  49.431    note as = this[rule_format]
  49.432    show "opp (f {a..c}) (f {c..b}) = f {a..b}"
  49.433 -  proof(cases "c = a \<or> c = b")
  49.434 -    case False thus ?thesis apply-apply(subst as(2)) using as(3-) by(auto)
  49.435 -    next case True thus ?thesis apply-
  49.436 -      proof(erule disjE) assume *:"c=a" hence "f {a..c} = neutral opp" apply-apply(rule as(1)[rule_format]) by auto
  49.437 -        thus ?thesis using assms unfolding * by auto
  49.438 -      next               assume *:"c=b" hence "f {c..b} = neutral opp" apply-apply(rule as(1)[rule_format]) by auto
  49.439 -        thus ?thesis using assms unfolding * by auto qed qed qed
  49.440 +  proof (cases "c = a \<or> c = b")
  49.441 +    case False
  49.442 +    then show ?thesis
  49.443 +      apply -
  49.444 +      apply (subst as(2))
  49.445 +      using as(3-)
  49.446 +      apply auto
  49.447 +      done
  49.448 +  next
  49.449 +    case True
  49.450 +    then show ?thesis
  49.451 +    proof
  49.452 +      assume *: "c = a"
  49.453 +      then have "f {a..c} = neutral opp"
  49.454 +        apply -
  49.455 +        apply (rule as(1)[rule_format])
  49.456 +        apply auto
  49.457 +        done
  49.458 +      then show ?thesis
  49.459 +        using assms unfolding * by auto
  49.460 +    next
  49.461 +      assume *: "c = b"
  49.462 +      then have "f {c..b} = neutral opp"
  49.463 +        apply -
  49.464 +        apply (rule as(1)[rule_format])
  49.465 +        apply auto
  49.466 +        done
  49.467 +      then show ?thesis
  49.468 +        using assms unfolding * by auto
  49.469 +    qed
  49.470 +  qed
  49.471 +qed
  49.472 +
  49.473  
  49.474  subsection {* Special case of additivity we need for the FCT. *}
  49.475  
  49.476 -lemma interval_bound_sing[simp]: "interval_upperbound {a} = a"  "interval_lowerbound {a} = a"
  49.477 -  unfolding interval_upperbound_def interval_lowerbound_def by (auto simp: euclidean_representation)
  49.478 -
  49.479 -lemma additive_tagged_division_1: fixes f::"real \<Rightarrow> 'a::real_normed_vector"
  49.480 -  assumes "a \<le> b" "p tagged_division_of {a..b}"
  49.481 +lemma interval_bound_sing[simp]:
  49.482 +  "interval_upperbound {a} = a"
  49.483 +  "interval_lowerbound {a} = a"
  49.484 +  unfolding interval_upperbound_def interval_lowerbound_def
  49.485 +  by (auto simp: euclidean_representation)
  49.486 +
  49.487 +lemma additive_tagged_division_1:
  49.488 +  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
  49.489 +  assumes "a \<le> b"
  49.490 +    and "p tagged_division_of {a..b}"
  49.491    shows "setsum (\<lambda>(x,k). f(interval_upperbound k) - f(interval_lowerbound k)) p = f b - f a"
  49.492 -proof- let ?f = "(\<lambda>k::(real) set. if k = {} then 0 else f(interval_upperbound k) - f(interval_lowerbound k))"
  49.493 -  have ***:"\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i" using assms by auto
  49.494 -  have *:"operative op + ?f" unfolding operative_1_lt[OF monoidal_monoid] interval_eq_empty by auto
  49.495 -  have **:"{a..b} \<noteq> {}" using assms(1) by auto note operative_tagged_division[OF monoidal_monoid * assms(2)]
  49.496 +proof -
  49.497 +  let ?f = "(\<lambda>k::(real) set. if k = {} then 0 else f(interval_upperbound k) - f(interval_lowerbound k))"
  49.498 +  have ***: "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i"
  49.499 +    using assms by auto
  49.500 +  have *: "operative op + ?f"
  49.501 +    unfolding operative_1_lt[OF monoidal_monoid] interval_eq_empty by auto
  49.502 +  have **: "{a..b} \<noteq> {}"
  49.503 +    using assms(1) by auto note operative_tagged_division[OF monoidal_monoid * assms(2)]
  49.504    note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],symmetric]
  49.505 -  show ?thesis unfolding * apply(subst setsum_iterate[symmetric]) defer
  49.506 -    apply(rule setsum_cong2) unfolding split_paired_all split_conv using assms(2) by auto qed
  49.507 +  show ?thesis
  49.508 +    unfolding *
  49.509 +    apply (subst setsum_iterate[symmetric])
  49.510 +    defer
  49.511 +    apply (rule setsum_cong2)
  49.512 +    unfolding split_paired_all split_conv
  49.513 +    using assms(2)
  49.514 +    apply auto
  49.515 +    done
  49.516 +qed
  49.517 +
  49.518  
  49.519  subsection {* A useful lemma allowing us to factor out the content size. *}
  49.520  
  49.521  lemma has_integral_factor_content:
  49.522 -  "(f has_integral i) {a..b} \<longleftrightarrow> (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b} \<and> d fine p
  49.523 -    \<longrightarrow> norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content {a..b}))"
  49.524 -proof(cases "content {a..b} = 0")
  49.525 -  case True show ?thesis unfolding has_integral_null_eq[OF True] apply safe
  49.526 -    apply(rule,rule,rule gauge_trivial,safe) unfolding setsum_content_null[OF True] True defer
  49.527 -    apply(erule_tac x=1 in allE,safe) defer apply(rule fine_division_exists[of _ a b],assumption)
  49.528 -    apply(erule_tac x=p in allE) unfolding setsum_content_null[OF True] by auto
  49.529 -next case False note F = this[unfolded content_lt_nz[symmetric]]
  49.530 -  let ?P = "\<lambda>e opp. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow> opp (norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i)) e)"
  49.531 -  show ?thesis apply(subst has_integral)
  49.532 -  proof safe fix e::real assume e:"e>0"
  49.533 -    { assume "\<forall>e>0. ?P e op <" thus "?P (e * content {a..b}) op \<le>" apply(erule_tac x="e * content {a..b}" in allE)
  49.534 -        apply(erule impE) defer apply(erule exE,rule_tac x=d in exI)
  49.535 -        using F e by(auto simp add:field_simps intro:mult_pos_pos) }
  49.536 -    {  assume "\<forall>e>0. ?P (e * content {a..b}) op \<le>" thus "?P e op <" apply(erule_tac x="e / 2 / content {a..b}" in allE)
  49.537 -        apply(erule impE) defer apply(erule exE,rule_tac x=d in exI)
  49.538 -        using F e by(auto simp add:field_simps intro:mult_pos_pos) } qed qed
  49.539 +  "(f has_integral i) {a..b} \<longleftrightarrow>
  49.540 +    (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow>
  49.541 +      norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content {a..b}))"
  49.542 +proof (cases "content {a..b} = 0")
  49.543 +  case True
  49.544 +  show ?thesis
  49.545 +    unfolding has_integral_null_eq[OF True]
  49.546 +    apply safe
  49.547 +    apply (rule, rule, rule gauge_trivial, safe)
  49.548 +    unfolding setsum_content_null[OF True] True
  49.549 +    defer
  49.550 +    apply (erule_tac x=1 in allE)
  49.551 +    apply safe
  49.552 +    defer
  49.553 +    apply (rule fine_division_exists[of _ a b])
  49.554 +    apply assumption
  49.555 +    apply (erule_tac x=p in allE)
  49.556 +    unfolding setsum_content_null[OF True]
  49.557 +    apply auto
  49.558 +    done
  49.559 +next
  49.560 +  case False
  49.561 +  note F = this[unfolded content_lt_nz[symmetric]]
  49.562 +  let ?P = "\<lambda>e opp. \<exists>d. gauge d \<and>
  49.563 +    (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow> opp (norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i)) e)"
  49.564 +  show ?thesis
  49.565 +    apply (subst has_integral)
  49.566 +  proof safe
  49.567 +    fix e :: real
  49.568 +    assume e: "e > 0"
  49.569 +    {
  49.570 +      assume "\<forall>e>0. ?P e op <"
  49.571 +      then show "?P (e * content {a..b}) op \<le>"
  49.572 +        apply (erule_tac x="e * content {a..b}" in allE)
  49.573 +        apply (erule impE)
  49.574 +        defer
  49.575 +        apply (erule exE,rule_tac x=d in exI)
  49.576 +        using F e
  49.577 +        apply (auto simp add:field_simps intro:mult_pos_pos)
  49.578 +        done
  49.579 +    }
  49.580 +    {
  49.581 +      assume "\<forall>e>0. ?P (e * content {a..b}) op \<le>"
  49.582 +      then show "?P e op <"
  49.583 +        apply (erule_tac x="e / 2 / content {a..b}" in allE)
  49.584 +        apply (erule impE)
  49.585 +        defer
  49.586 +        apply (erule exE,rule_tac x=d in exI)
  49.587 +        using F e
  49.588 +        apply (auto simp add: field_simps intro: mult_pos_pos)
  49.589 +        done
  49.590 +    }
  49.591 +  qed
  49.592 +qed
  49.593 +
  49.594  
  49.595  subsection {* Fundamental theorem of calculus. *}
  49.596  
  49.597 -lemma interval_bounds_real: assumes "a\<le>(b::real)"
  49.598 -  shows "interval_upperbound {a..b} = b" "interval_lowerbound {a..b} = a"
  49.599 -  apply(rule_tac[!] interval_bounds) using assms by auto
  49.600 -
  49.601 -lemma fundamental_theorem_of_calculus: fixes f::"real \<Rightarrow> 'a::banach"
  49.602 -  assumes "a \<le> b"  "\<forall>x\<in>{a..b}. (f has_vector_derivative f' x) (at x within {a..b})"
  49.603 -  shows "(f' has_integral (f b - f a)) ({a..b})"
  49.604 -unfolding has_integral_factor_content
  49.605 -proof safe fix e::real assume e:"e>0"
  49.606 +lemma interval_bounds_real:
  49.607 +  fixes q b :: real
  49.608 +  assumes "a \<le> b"
  49.609 +  shows "interval_upperbound {a..b} = b"
  49.610 +    and "interval_lowerbound {a..b} = a"
  49.611 +  apply (rule_tac[!] interval_bounds)
  49.612 +  using assms
  49.613 +  apply auto
  49.614 +  done
  49.615 +
  49.616 +lemma fundamental_theorem_of_calculus:
  49.617 +  fixes f :: "real \<Rightarrow> 'a::banach"
  49.618 +  assumes "a \<le> b"
  49.619 +    and "\<forall>x\<in>{a..b}. (f has_vector_derivative f' x) (at x within {a..b})"
  49.620 +  shows "(f' has_integral (f b - f a)) {a..b}"
  49.621 +  unfolding has_integral_factor_content
  49.622 +proof safe
  49.623 +  fix e :: real
  49.624 +  assume e: "e > 0"
  49.625    note assm = assms(2)[unfolded has_vector_derivative_def has_derivative_within_alt]
  49.626 -  have *:"\<And>P Q. \<forall>x\<in>{a..b}. P x \<and> (\<forall>e>0. \<exists>d>0. Q x e d) \<Longrightarrow> \<forall>x. \<exists>(d::real)>0. x\<in>{a..b} \<longrightarrow> Q x e d" using e by blast
  49.627 -  note this[OF assm,unfolded gauge_existence_lemma] from choice[OF this,unfolded Ball_def[symmetric]]
  49.628 -  guess d .. note d=conjunctD2[OF this[rule_format],rule_format]
  49.629 +  have *: "\<And>P Q. \<forall>x\<in>{a..b}. P x \<and> (\<forall>e>0. \<exists>d>0. Q x e d) \<Longrightarrow> \<forall>x. \<exists>(d::real)>0. x\<in>{a..b} \<longrightarrow> Q x e d"
  49.630 +    using e by blast
  49.631 +  note this[OF assm,unfolded gauge_existence_lemma]
  49.632 +  from choice[OF this,unfolded Ball_def[symmetric]] guess d ..
  49.633 +  note d=conjunctD2[OF this[rule_format],rule_format]
  49.634    show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow>
  49.635 -                 norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b})"
  49.636 -    apply(rule_tac x="\<lambda>x. ball x (d x)" in exI,safe)
  49.637 -    apply(rule gauge_ball_dependent,rule,rule d(1))
  49.638 -  proof- fix p assume as:"p tagged_division_of {a..b}" "(\<lambda>x. ball x (d x)) fine p"
  49.639 +    norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b})"
  49.640 +    apply (rule_tac x="\<lambda>x. ball x (d x)" in exI)
  49.641 +    apply safe
  49.642 +    apply (rule gauge_ball_dependent)
  49.643 +    apply rule
  49.644 +    apply (rule d(1))
  49.645 +  proof -
  49.646 +    fix p
  49.647 +    assume as: "p tagged_division_of {a..b}" "(\<lambda>x. ball x (d x)) fine p"
  49.648      show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b}"
  49.649        unfolding content_real[OF assms(1)] additive_tagged_division_1[OF assms(1) as(1),of f,symmetric]
  49.650        unfolding additive_tagged_division_1[OF assms(1) as(1),of "\<lambda>x. x",symmetric]
  49.651 -      unfolding setsum_right_distrib defer unfolding setsum_subtractf[symmetric]
  49.652 -    proof(rule setsum_norm_le,safe) fix x k assume "(x,k)\<in>p"
  49.653 -      note xk = tagged_division_ofD(2-4)[OF as(1) this] from this(3) guess u v apply-by(erule exE)+ note k=this
  49.654 -      have *:"u \<le> v" using xk unfolding k by auto
  49.655 -      have ball:"\<forall>xa\<in>k. xa \<in> ball x (d x)" using as(2)[unfolded fine_def,rule_format,OF `(x,k)\<in>p`,
  49.656 -        unfolded split_conv subset_eq] .
  49.657 +      unfolding setsum_right_distrib
  49.658 +      defer
  49.659 +      unfolding setsum_subtractf[symmetric]
  49.660 +    proof (rule setsum_norm_le,safe)
  49.661 +      fix x k
  49.662 +      assume "(x, k) \<in> p"
  49.663 +      note xk = tagged_division_ofD(2-4)[OF as(1) this]
  49.664 +      from this(3) guess u v by (elim exE) note k=this
  49.665 +      have *: "u \<le> v"
  49.666 +        using xk unfolding k by auto
  49.667 +      have ball: "\<forall>xa\<in>k. xa \<in> ball x (d x)"
  49.668 +        using as(2)[unfolded fine_def,rule_format,OF `(x,k)\<in>p`,unfolded split_conv subset_eq] .
  49.669        have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) \<le>
  49.670          norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)"
  49.671 -        apply(rule order_trans[OF _ norm_triangle_ineq4]) apply(rule eq_refl) apply(rule arg_cong[where f=norm])
  49.672 -        unfolding scaleR_diff_left by(auto simp add:algebra_simps)
  49.673 -      also have "... \<le> e * norm (u - x) + e * norm (v - x)"
  49.674 -        apply(rule add_mono) apply(rule d(2)[of "x" "u",unfolded o_def]) prefer 4
  49.675 -        apply(rule d(2)[of "x" "v",unfolded o_def])
  49.676 +        apply (rule order_trans[OF _ norm_triangle_ineq4])
  49.677 +        apply (rule eq_refl)
  49.678 +        apply (rule arg_cong[where f=norm])
  49.679 +        unfolding scaleR_diff_left
  49.680 +        apply (auto simp add:algebra_simps)
  49.681 +        done
  49.682 +      also have "\<dots> \<le> e * norm (u - x) + e * norm (v - x)"
  49.683 +        apply (rule add_mono)
  49.684 +        apply (rule d(2)[of "x" "u",unfolded o_def])
  49.685 +        prefer 4
  49.686 +        apply (rule d(2)[of "x" "v",unfolded o_def])
  49.687          using ball[rule_format,of u] ball[rule_format,of v]
  49.688 -        using xk(1-2) unfolding k subset_eq by(auto simp add:dist_real_def)
  49.689 -      also have "... \<le> e * (interval_upperbound k - interval_lowerbound k)"
  49.690 -        unfolding k interval_bounds_real[OF *] using xk(1) unfolding k by(auto simp add:dist_real_def field_simps)
  49.691 +        using xk(1-2)
  49.692 +        unfolding k subset_eq
  49.693 +        apply (auto simp add:dist_real_def)
  49.694 +        done
  49.695 +      also have "\<dots> \<le> e * (interval_upperbound k - interval_lowerbound k)"
  49.696 +        unfolding k interval_bounds_real[OF *]
  49.697 +        using xk(1)
  49.698 +        unfolding k
  49.699 +        by (auto simp add: dist_real_def field_simps)
  49.700        finally show "norm (content k *\<^sub>R f' x - (f (interval_upperbound k) - f (interval_lowerbound k))) \<le>
  49.701 -        e * (interval_upperbound k - interval_lowerbound k)" unfolding k interval_bounds_real[OF *] content_real[OF *] .
  49.702 -    qed qed qed
  49.703 +        e * (interval_upperbound k - interval_lowerbound k)"
  49.704 +        unfolding k interval_bounds_real[OF *] content_real[OF *] .
  49.705 +    qed
  49.706 +  qed
  49.707 +qed
  49.708 +
  49.709  
  49.710  subsection {* Attempt a systematic general set of "offset" results for components. *}
  49.711  
  49.712  lemma gauge_modify:
  49.713    assumes "(\<forall>s. open s \<longrightarrow> open {x. f(x) \<in> s})" "gauge d"
  49.714    shows "gauge (\<lambda>x. {y. f y \<in> d (f x)})"
  49.715 -  using assms unfolding gauge_def apply safe defer apply(erule_tac x="f x" in allE)
  49.716 -  apply(erule_tac x="d (f x)" in allE) by auto
  49.717 +  using assms
  49.718 +  unfolding gauge_def
  49.719 +  apply safe
  49.720 +  defer
  49.721 +  apply (erule_tac x="f x" in allE)
  49.722 +  apply (erule_tac x="d (f x)" in allE)
  49.723 +  apply auto
  49.724 +  done
  49.725 +
  49.726  
  49.727  subsection {* Only need trivial subintervals if the interval itself is trivial. *}
  49.728  
  49.729 -lemma division_of_nontrivial: fixes s::"('a::ordered_euclidean_space) set set"
  49.730 -  assumes "s division_of {a..b}" "content({a..b}) \<noteq> 0"
  49.731 -  shows "{k. k \<in> s \<and> content k \<noteq> 0} division_of {a..b}" using assms(1) apply-
  49.732 -proof(induct "card s" arbitrary:s rule:nat_less_induct)
  49.733 -  fix s::"'a set set" assume assm:"s division_of {a..b}"
  49.734 -    "\<forall>m<card s. \<forall>x. m = card x \<longrightarrow> x division_of {a..b} \<longrightarrow> {k \<in> x. content k \<noteq> 0} division_of {a..b}"
  49.735 -  note s = division_ofD[OF assm(1)] let ?thesis = "{k \<in> s. content k \<noteq> 0} division_of {a..b}"
  49.736 -  { presume *:"{k \<in> s. content k \<noteq> 0} \<noteq> s \<Longrightarrow> ?thesis"
  49.737 -    show ?thesis apply cases defer apply(rule *,assumption) using assm(1) by auto }
  49.738 -  assume noteq:"{k \<in> s. content k \<noteq> 0} \<noteq> s"
  49.739 -  then obtain k where k:"k\<in>s" "content k = 0" by auto
  49.740 -  from s(4)[OF k(1)] guess c d apply-by(erule exE)+ note k=k this
  49.741 -  from k have "card s > 0" unfolding card_gt_0_iff using assm(1) by auto
  49.742 -  hence card:"card (s - {k}) < card s" using assm(1) k(1) apply(subst card_Diff_singleton_if) by auto
  49.743 -  have *:"closed (\<Union>(s - {k}))" apply(rule closed_Union) defer apply rule apply(drule DiffD1,drule s(4))
  49.744 -    apply safe apply(rule closed_interval) using assm(1) by auto
  49.745 -  have "k \<subseteq> \<Union>(s - {k})" apply safe apply(rule *[unfolded closed_limpt,rule_format]) unfolding islimpt_approachable
  49.746 -  proof safe fix x and e::real assume as:"x\<in>k" "e>0"
  49.747 +lemma division_of_nontrivial:
  49.748 +  fixes s :: "'a::ordered_euclidean_space set set"
  49.749 +  assumes "s division_of {a..b}"
  49.750 +    and "content {a..b} \<noteq> 0"
  49.751 +  shows "{k. k \<in> s \<and> content k \<noteq> 0} division_of {a..b}"
  49.752 +  using assms(1)
  49.753 +  apply -
  49.754 +proof (induct "card s" arbitrary: s rule: nat_less_induct)
  49.755 +  fix s::"'a set set"
  49.756 +  assume assm: "s division_of {a..b}"
  49.757 +    "\<forall>m<card s. \<forall>x. m = card x \<longrightarrow>
  49.758 +      x division_of {a..b} \<longrightarrow> {k \<in> x. content k \<noteq> 0} division_of {a..b}"
  49.759 +  note s = division_ofD[OF assm(1)]
  49.760 +  let ?thesis = "{k \<in> s. content k \<noteq> 0} division_of {a..b}"
  49.761 +  {
  49.762 +    presume *: "{k \<in> s. content k \<noteq> 0} \<noteq> s \<Longrightarrow> ?thesis"
  49.763 +    show ?thesis
  49.764 +      apply cases
  49.765 +      defer
  49.766 +      apply (rule *)
  49.767 +      apply assumption
  49.768 +      using assm(1)
  49.769 +      apply auto
  49.770 +      done
  49.771 +  }
  49.772 +  assume noteq: "{k \<in> s. content k \<noteq> 0} \<noteq> s"
  49.773 +  then obtain k where k: "k \<in> s" "content k = 0"
  49.774 +    by auto
  49.775 +  from s(4)[OF k(1)] guess c d by (elim exE) note k=k this
  49.776 +  from k have "card s > 0"
  49.777 +    unfolding card_gt_0_iff using assm(1) by auto
  49.778 +  then have card: "card (s - {k}) < card s"
  49.779 +    using assm(1) k(1)
  49.780 +    apply (subst card_Diff_singleton_if)
  49.781 +    apply auto
  49.782 +    done
  49.783 +  have *: "closed (\<Union>(s - {k}))"
  49.784 +    apply (rule closed_Union)
  49.785 +    defer
  49.786 +    apply rule
  49.787 +    apply (drule DiffD1,drule s(4))
  49.788 +    apply safe
  49.789 +    apply (rule closed_interval)
  49.790 +    using assm(1)
  49.791 +    apply auto
  49.792 +    done
  49.793 +  have "k \<subseteq> \<Union>(s - {k})"
  49.794 +    apply safe
  49.795 +    apply (rule *[unfolded closed_limpt,rule_format])
  49.796 +    unfolding islimpt_approachable
  49.797 +  proof safe
  49.798 +    fix x
  49.799 +    fix e :: real
  49.800 +    assume as: "x \<in> k" "e > 0"
  49.801      from k(2)[unfolded k content_eq_0] guess i ..
  49.802 -    hence i:"c\<bullet>i = d\<bullet>i" "i\<in>Basis" using s(3)[OF k(1),unfolded k] unfolding interval_ne_empty by auto
  49.803 -    hence xi:"x\<bullet>i = d\<bullet>i" using as unfolding k mem_interval by (metis antisym)
  49.804 -    def y \<equiv> "(\<Sum>j\<in>Basis. (if j = i then if c\<bullet>i \<le> (a\<bullet>i + b\<bullet>i) / 2 then c\<bullet>i +
  49.805 -      min e (b\<bullet>i - c\<bullet>i) / 2 else c\<bullet>i - min e (c\<bullet>i - a\<bullet>i) / 2 else x\<bullet>j) *\<^sub>R j)::'a"
  49.806 -    show "\<exists>x'\<in>\<Union>(s - {k}). x' \<noteq> x \<and> dist x' x < e" apply(rule_tac x=y in bexI)
  49.807 -    proof have "d \<in> {c..d}" using s(3)[OF k(1)] unfolding k interval_eq_empty mem_interval by(fastforce simp add: not_less)
  49.808 -      hence "d \<in> {a..b}" using s(2)[OF k(1)] unfolding k by auto note di = this[unfolded mem_interval,THEN bspec[where x=i]]
  49.809 -      hence xyi:"y\<bullet>i \<noteq> x\<bullet>i"
  49.810 -        unfolding y_def i xi using as(2) assms(2)[unfolded content_eq_0] i(2)
  49.811 +    then have i:"c\<bullet>i = d\<bullet>i" "i\<in>Basis"
  49.812 +      using s(3)[OF k(1),unfolded k] unfolding interval_ne_empty by auto
  49.813 +    then have xi: "x\<bullet>i = d\<bullet>i"
  49.814 +      using as unfolding k mem_interval by (metis antisym)
  49.815 +    def y \<equiv> "\<Sum>j\<in>Basis. (if j = i then if c\<bullet>i \<le> (a\<bullet>i + b\<bullet>i) / 2 then c\<bullet>i +
  49.816 +      min e (b\<bullet>i - c\<bullet>i) / 2 else c\<bullet>i - min e (c\<bullet>i - a\<bullet>i) / 2 else x\<bullet>j) *\<^sub>R j"
  49.817 +    show "\<exists>x'\<in>\<Union>(s - {k}). x' \<noteq> x \<and> dist x' x < e"
  49.818 +      apply (rule_tac x=y in bexI)
  49.819 +    proof
  49.820 +      have "d \<in> {c..d}"
  49.821 +        using s(3)[OF k(1)]
  49.822 +        unfolding k interval_eq_empty mem_interval
  49.823 +        by (fastforce simp add: not_less)
  49.824 +      then have "d \<in> {a..b}"
  49.825 +        using s(2)[OF k(1)]
  49.826 +        unfolding k
  49.827 +        by auto
  49.828 +      note di = this[unfolded mem_interval,THEN bspec[where x=i]]
  49.829 +      then have xyi: "y\<bullet>i \<noteq> x\<bullet>i"
  49.830 +        unfolding y_def i xi
  49.831 +        using as(2) assms(2)[unfolded content_eq_0] i(2)
  49.832          by (auto elim!: ballE[of _ _ i])
  49.833 -      thus "y \<noteq> x" unfolding euclidean_eq_iff[where 'a='a] using i by auto
  49.834 -      have *:"Basis = insert i (Basis - {i})" using i by auto
  49.835 -      have "norm (y - x) < e + setsum (\<lambda>i. 0) Basis" apply(rule le_less_trans[OF norm_le_l1])
  49.836 -        apply(subst *,subst setsum_insert) prefer 3 apply(rule add_less_le_mono)
  49.837 -      proof-
  49.838 +      then show "y \<noteq> x"
  49.839 +        unfolding euclidean_eq_iff[where 'a='a] using i by auto
  49.840 +      have *: "Basis = insert i (Basis - {i})"
  49.841 +        using i by auto
  49.842 +      have "norm (y - x) < e + setsum (\<lambda>i. 0) Basis"
  49.843 +        apply (rule le_less_trans[OF norm_le_l1])
  49.844 +        apply (subst *)
  49.845 +        apply (subst setsum_insert)
  49.846 +        prefer 3
  49.847 +        apply (rule add_less_le_mono)
  49.848 +      proof -
  49.849          show "\<bar>(y - x) \<bullet> i\<bar> < e"
  49.850            using di as(2) y_def i xi by (auto simp: inner_simps)
  49.851          show "(\<Sum>i\<in>Basis - {i}. \<bar>(y - x) \<bullet> i\<bar>) \<le> (\<Sum>i\<in>Basis. 0)"
  49.852            unfolding y_def by (auto simp: inner_simps)
  49.853 -      qed auto thus "dist y x < e" unfolding dist_norm by auto
  49.854 -      have "y\<notin>k" unfolding k mem_interval apply rule apply(erule_tac x=i in ballE) using xyi k i xi by auto
  49.855 -      moreover have "y \<in> \<Union>s"
  49.856 -        using set_rev_mp[OF as(1) s(2)[OF k(1)]] as(2) di i unfolding s mem_interval y_def
  49.857 +      qed auto
  49.858 +      then show "dist y x < e"
  49.859 +        unfolding dist_norm by auto
  49.860 +      have "y \<notin> k"
  49.861 +        unfolding k mem_interval
  49.862 +        apply rule
  49.863 +        apply (erule_tac x=i in ballE)
  49.864 +        using xyi k i xi
  49.865 +        apply auto
  49.866 +        done
  49.867 +      moreover
  49.868 +      have "y \<in> \<Union>s"
  49.869 +        using set_rev_mp[OF as(1) s(2)[OF k(1)]] as(2) di i
  49.870 +        unfolding s mem_interval y_def
  49.871          by (auto simp: field_simps elim!: ballE[of _ _ i])
  49.872 -      ultimately show "y \<in> \<Union>(s - {k})" by auto
  49.873 -    qed qed hence "\<Union>(s - {k}) = {a..b}" unfolding s(6)[symmetric] by auto
  49.874 -  hence  "{ka \<in> s - {k}. content ka \<noteq> 0} division_of {a..b}" apply-apply(rule assm(2)[rule_format,OF card refl])
  49.875 -    apply(rule division_ofI) defer apply(rule_tac[1-4] s) using assm(1) by auto
  49.876 -  moreover have "{ka \<in> s - {k}. content ka \<noteq> 0} = {k \<in> s. content k \<noteq> 0}" using k by auto ultimately show ?thesis by auto qed
  49.877 +      ultimately
  49.878 +      show "y \<in> \<Union>(s - {k})" by auto
  49.879 +    qed
  49.880 +  qed
  49.881 +  then have "\<Union>(s - {k}) = {a..b}"
  49.882 +    unfolding s(6)[symmetric] by auto
  49.883 +  then have  "{ka \<in> s - {k}. content ka \<noteq> 0} division_of {a..b}"
  49.884 +    apply -
  49.885 +    apply (rule assm(2)[rule_format,OF card refl])
  49.886 +    apply (rule division_ofI)
  49.887 +    defer
  49.888 +    apply (rule_tac[1-4] s)
  49.889 +    using assm(1)
  49.890 +    apply auto
  49.891 +    done
  49.892 +  moreover
  49.893 +  have "{ka \<in> s - {k}. content ka \<noteq> 0} = {k \<in> s. content k \<noteq> 0}"
  49.894 +    using k by auto
  49.895 +  ultimately show ?thesis by auto
  49.896 +qed
  49.897 +
  49.898  
  49.899  subsection {* Integrability on subintervals. *}
  49.900  
  49.901 -lemma operative_integrable: fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach" shows
  49.902 -  "operative op \<and> (\<lambda>i. f integrable_on i)"
  49.903 -  unfolding operative_def neutral_and apply safe apply(subst integrable_on_def)
  49.904 -  unfolding has_integral_null_eq apply(rule,rule refl) apply(rule,assumption,assumption)+
  49.905 -  unfolding integrable_on_def by(auto intro!: has_integral_split)
  49.906 -
  49.907 -lemma integrable_subinterval: fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.908 -  assumes "f integrable_on {a..b}" "{c..d} \<subseteq> {a..b}" shows "f integrable_on {c..d}"
  49.909 -  apply(cases "{c..d} = {}") defer apply(rule partial_division_extend_1[OF assms(2)],assumption)
  49.910 -  using operative_division_and[OF operative_integrable,symmetric,of _ _ _ f] assms(1) by auto
  49.911 +lemma operative_integrable:
  49.912 +  fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.913 +  shows "operative op \<and> (\<lambda>i. f integrable_on i)"
  49.914 +  unfolding operative_def neutral_and
  49.915 +  apply safe
  49.916 +  apply (subst integrable_on_def)
  49.917 +  unfolding has_integral_null_eq
  49.918 +  apply (rule, rule refl)
  49.919 +  apply (rule, assumption, assumption)+
  49.920 +  unfolding integrable_on_def
  49.921 +  by (auto intro!: has_integral_split)
  49.922 +
  49.923 +lemma integrable_subinterval:
  49.924 +  fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
  49.925 +  assumes "f integrable_on {a..b}"
  49.926 +    and "{c..d} \<subseteq> {a..b}"
  49.927 +  shows "f integrable_on {c..d}"
  49.928 +  apply (cases "{c..d} = {}")
  49.929 +  defer
  49.930 +  apply (rule partial_division_extend_1[OF assms(2)],assumption)
  49.931 +  using operative_division_and[OF operative_integrable,symmetric,of _ _ _ f] assms(1)
  49.932 +  apply auto
  49.933 +  done
  49.934 +
  49.935  
  49.936  subsection {* Combining adjacent intervals in 1 dimension. *}
  49.937  
  49.938 -lemma has_integral_combine: assumes "(a::real) \<le> c" "c \<le> b"
  49.939 -  "(f has_integral i) {a..c}" "(f has_integral (j::'a::banach)) {c..b}"
  49.940 +lemma has_integral_combine:
  49.941 +  fixes a b c :: real
  49.942 +  assumes "a \<le> c"
  49.943 +    and "c \<le> b"
  49.944 +    and "(f has_integral i) {a..c}"
  49.945 +    and "(f has_integral (j::'a::banach)) {c..b}"
  49.946    shows "(f has_integral (i + j)) {a..b}"
  49.947 -proof- note operative_integral[of f, unfolded operative_1_le[OF monoidal_lifted[OF monoidal_monoid]]]
  49.948 -  note conjunctD2[OF this,rule_format] note * = this(2)[OF conjI[OF assms(1-2)],unfolded if_P[OF assms(3)]]
  49.949 -  hence "f integrable_on {a..b}" apply- apply(rule ccontr) apply(subst(asm) if_P) defer
  49.950 -    apply(subst(asm) if_P) using assms(3-) by auto
  49.951 -  with * show ?thesis apply-apply(subst(asm) if_P) defer apply(subst(asm) if_P) defer apply(subst(asm) if_P)
  49.952 -    unfolding lifted.simps using assms(3-) by(auto simp add: integrable_on_def integral_unique) qed
  49.953 -
  49.954 -lemma integral_combine: fixes f::"real \<Rightarrow> 'a::banach"
  49.955 -  assumes "a \<le> c" "c \<le> b" "f integrable_on ({a..b})"
  49.956 -  shows "integral {a..c} f + integral {c..b} f = integral({a..b}) f"
  49.957 -  apply(rule integral_unique[symmetric]) apply(rule has_integral_combine[OF assms(1-2)])
  49.958 -  apply(rule_tac[!] integrable_integral integrable_subinterval[OF assms(3)])+ using assms(1-2) by auto
  49.959 -
  49.960 -lemma integrable_combine: fixes f::"real \<Rightarrow> 'a::banach"
  49.961 -  assumes "a \<le> c" "c \<le> b" "f integrable_on {a..c}" "f integrable_on {c..b}"
  49.962 -  shows "f integrable_on {a..b}" using assms unfolding integrable_on_def by(fastforce intro!:has_integral_combine)
  49.963 +proof -
  49.964 +  note operative_integral[of f, unfolded operative_1_le[OF monoidal_lifted[OF monoidal_monoid]]]
  49.965 +  note conjunctD2[OF this,rule_format]
  49.966 +  note * = this(2)[OF conjI[OF assms(1-2)],unfolded if_P[OF assms(3)]]
  49.967 +  then have "f integrable_on {a..b}"
  49.968 +    apply -
  49.969 +    apply (rule ccontr)
  49.970 +    apply (subst(asm) if_P)
  49.971 +    defer
  49.972 +    apply (subst(asm) if_P)
  49.973 +    using assms(3-)
  49.974 +    apply auto
  49.975 +    done
  49.976 +  with *
  49.977 +  show ?thesis
  49.978 +    apply -
  49.979 +    apply (subst(asm) if_P)
  49.980 +    defer
  49.981 +    apply (subst(asm) if_P)
  49.982 +    defer
  49.983 +    apply (subst(asm) if_P)
  49.984 +    unfolding lifted.simps
  49.985 +    using assms(3-)
  49.986 +    apply (auto simp add: integrable_on_def integral_unique)
  49.987 +    done
  49.988 +qed
  49.989 +
  49.990 +lemma integral_combine:
  49.991 +  fixes f :: "real \<Rightarrow> 'a::banach"
  49.992 +  assumes "a \<le> c"
  49.993 +    and "c \<le> b"
  49.994 +    and "f integrable_on {a..b}"
  49.995 +  shows "integral {a..c} f + integral {c..b} f = integral {a..b} f"
  49.996 +  apply (rule integral_unique[symmetric])
  49.997 +  apply (rule has_integral_combine[OF assms(1-2)])
  49.998 +  apply (rule_tac[!] integrable_integral integrable_subinterval[OF assms(3)])+
  49.999 +  using assms(1-2)
 49.1000 +  apply auto
 49.1001 +  done
 49.1002 +
 49.1003 +lemma integrable_combine:
 49.1004 +  fixes f :: "real \<Rightarrow> 'a::banach"
 49.1005 +  assumes "a \<le> c"
 49.1006 +    and "c \<le> b"
 49.1007 +    and "f integrable_on {a..c}"
 49.1008 +    and "f integrable_on {c..b}"
 49.1009 +  shows "f integrable_on {a..b}"
 49.1010 +  using assms
 49.1011 +  unfolding integrable_on_def
 49.1012 +  by (fastforce intro!:has_integral_combine)
 49.1013 +
 49.1014  
 49.1015  subsection {* Reduce integrability to "local" integrability. *}
 49.1016  
 49.1017 -lemma integrable_on_little_subintervals: fixes f::"'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
 49.1018 -  assumes "\<forall>x\<in>{a..b}. \<exists>d>0. \<forall>u v. x \<in> {u..v} \<and> {u..v} \<subseteq> ball x d \<and> {u..v} \<subseteq> {a..b} \<longrightarrow> f integrable_on {u..v}"
 49.1019 +lemma integrable_on_little_subintervals:
 49.1020 +  fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
 49.1021 +  assumes "\<forall>x\<in>{a..b}. \<exists>d>0. \<forall>u v. x \<in> {u..v} \<and> {u..v} \<subseteq> ball x d \<and> {u..v} \<subseteq> {a..b} \<longrightarrow>
 49.1022 +    f integrable_on {u..v}"
 49.1023    shows "f integrable_on {a..b}"
 49.1024 -proof- have "\<forall>x. \<exists>d. x\<in>{a..b} \<longrightarrow> d>0 \<and> (\<forall>u v. x \<in> {u..v} \<and> {u..v} \<subseteq> ball x d \<and> {u..v} \<subseteq> {a..b} \<longrightarrow> f integrable_on {u..v})"
 49.1025 -    using assms by auto note this[unfolded gauge_existence_lemma] from choice[OF this] guess d .. note d=this[rule_format]
 49.1026 -  guess p apply(rule fine_division_exists[OF gauge_ball_dependent,of d a b]) using d by auto note p=this(1-2)
 49.1027 -  note division_of_tagged_division[OF this(1)] note * = operative_division_and[OF operative_integrable,OF this,symmetric,of f]
 49.1028 -  show ?thesis unfolding * apply safe unfolding snd_conv
 49.1029 -  proof- fix x k assume "(x,k) \<in> p" note tagged_division_ofD(2-4)[OF p(1) this] fineD[OF p(2) this]
 49.1030 -    thus "f integrable_on k" apply safe apply(rule d[THEN conjunct2,rule_format,of x]) by auto qed qed
 49.1031 +proof -
 49.1032 +  have "\<forall>x. \<exists>d. x\<in>{a..b} \<longrightarrow> d>0 \<and> (\<forall>u v. x \<in> {u..v} \<and> {u..v} \<subseteq> ball x d \<and> {u..v} \<subseteq> {a..b} \<longrightarrow>
 49.1033 +    f integrable_on {u..v})"
 49.1034 +    using assms by auto
 49.1035 +  note this[unfolded gauge_existence_lemma]
 49.1036 +  from choice[OF this] guess d .. note d=this[rule_format]
 49.1037 +  guess p
 49.1038 +    apply (rule fine_division_exists[OF gauge_ball_dependent,of d a b])
 49.1039 +    using d
 49.1040 +    by auto
 49.1041 +  note p=this(1-2)
 49.1042 +  note division_of_tagged_division[OF this(1)]
 49.1043 +  note * = operative_division_and[OF operative_integrable,OF this,symmetric,of f]
 49.1044 +  show ?thesis
 49.1045 +    unfolding *
 49.1046 +    apply safe
 49.1047 +    unfolding snd_conv
 49.1048 +  proof -
 49.1049 +    fix x k
 49.1050 +    assume "(x, k) \<in> p"
 49.1051 +    note tagged_division_ofD(2-4)[OF p(1) this] fineD[OF p(2) this]
 49.1052 +    then show "f integrable_on k"
 49.1053 +      apply safe
 49.1054 +      apply (rule d[THEN conjunct2,rule_format,of x])
 49.1055 +      apply auto
 49.1056 +      done
 49.1057 +  qed
 49.1058 +qed
 49.1059 +
 49.1060  
 49.1061  subsection {* Second FCT or existence of antiderivative. *}
 49.1062  
 49.1063 -lemma integrable_const[intro]:"(\<lambda>x. c) integrable_on {a..b}"
 49.1064 -  unfolding integrable_on_def by(rule,rule has_integral_const)
 49.1065 -
 49.1066 -lemma integral_has_vector_derivative: fixes f::"real \<Rightarrow> 'a::banach"
 49.1067 -  assumes "continuous_on {a..b} f" "x \<in> {a..b}"
 49.1068 +lemma integrable_const[intro]: "(\<lambda>x. c) integrable_on {a..b}"
 49.1069 +  unfolding integrable_on_def
 49.1070 +  apply rule
 49.1071 +  apply (rule has_integral_const)
 49.1072 +  done
 49.1073 +
 49.1074 +lemma integral_has_vector_derivative:
 49.1075 +  fixes f :: "real \<Rightarrow> 'a::banach"
 49.1076 +  assumes "continuous_on {a..b} f"
 49.1077 +    and "x \<in> {a..b}"
 49.1078    shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f(x)) (at x within {a..b})"
 49.1079    unfolding has_vector_derivative_def has_derivative_within_alt
 49.1080 -apply safe apply(rule bounded_linear_scaleR_left)
 49.1081 -proof- fix e::real assume e:"e>0"
 49.1082 +  apply safe
 49.1083 +  apply (rule bounded_linear_scaleR_left)
 49.1084 +proof -
 49.1085 +  fix e :: real
 49.1086 +  assume e: "e > 0"
 49.1087    note compact_uniformly_continuous[OF assms(1) compact_interval,unfolded uniformly_continuous_on_def]
 49.1088 -  from this[rule_format,OF e] guess d apply-by(erule conjE exE)+ note d=this[rule_format]
 49.1089 +  from this[rule_format,OF e] guess d by (elim conjE exE) note d=this[rule_format]
 49.1090    let ?I = "\<lambda>a b. integral {a..b} f"
 49.1091 -  show "\<exists>d>0. \<forall>y\<in>{a..b}. norm (y - x) < d \<longrightarrow> norm (?I a y - ?I a x - (y - x) *\<^sub>R f x) \<le> e * norm (y - x)"
 49.1092 -  proof(rule,rule,rule d,safe) case goal1 show ?case proof(cases "y < x")
 49.1093 -      case False have "f integrable_on {a..y}" apply(rule integrable_subinterval,rule integrable_continuous)
 49.1094 -        apply(rule assms)  unfolding not_less using assms(2) goal1 by auto
 49.1095 -      hence *:"?I a y - ?I a x = ?I x y" unfolding algebra_simps apply(subst eq_commute) apply(rule integral_combine)
 49.1096 -        using False unfolding not_less using assms(2) goal1 by auto
 49.1097 -      have **:"norm (y - x) = content {x..y}" apply(subst content_real) using False unfolding not_less by auto
 49.1098 -      show ?thesis unfolding ** apply(rule has_integral_bound[where f="(\<lambda>u. f u - f x)"]) unfolding * unfolding o_def
 49.1099 -        defer apply(rule has_integral_sub) apply(rule integrable_integral)
 49.1100 -        apply(rule integrable_subinterval,rule integrable_continuous) apply(rule assms)+
 49.1101 -      proof- show "{x..y} \<subseteq> {a..b}" using goal1 assms(2) by auto
 49.1102 -        have *:"y - x = norm(y - x)" using False by auto
 49.1103 -        show "((\<lambda>xa. f x) has_integral (y - x) *\<^sub>R f x) {x.. y}" apply(subst *) unfolding ** by auto
 49.1104 -        show "\<forall>xa\<in>{x..y}. norm (f xa - f x) \<le> e" apply safe apply(rule less_imp_le)
 49.1105 -          apply(rule d(2)[unfolded dist_norm]) using assms(2) using goal1 by auto
 49.1106 -      qed(insert e,auto)
 49.1107 -    next case True have "f integrable_on {a..x}" apply(rule integrable_subinterval,rule integrable_continuous)
 49.1108 -        apply(rule assms)+  unfolding not_less using assms(2) goal1 by auto
 49.1109 -      hence *:"?I a x - ?I a y = ?I y x" unfolding algebra_simps apply(subst eq_commute) apply(rule integral_combine)
 49.1110 -        using True using assms(2) goal1 by auto
 49.1111 -      have **:"norm (y - x) = content {y..x}" apply(subst content_real) using True unfolding not_less by auto
 49.1112 -      have ***:"\<And>fy fx c::'a. fx - fy - (y - x) *\<^sub>R c = -(fy - fx - (x - y) *\<^sub>R c)" unfolding scaleR_left.diff by auto
 49.1113 -      show ?thesis apply(subst ***) unfolding norm_minus_cancel **
 49.1114 -        apply(rule has_integral_bound[where f="(\<lambda>u. f u - f x)"]) unfolding * unfolding o_def
 49.1115 -        defer apply(rule has_integral_sub) apply(subst minus_minus[symmetric]) unfolding minus_minus
 49.1116 -        apply(rule integrable_integral) apply(rule integrable_subinterval,rule integrable_continuous) apply(rule assms)+
 49.1117 -      proof- show "{y..x} \<subseteq> {a..b}" using goal1 assms(2) by auto
 49.1118 -        have *:"x - y = norm(y - x)" using True by auto
 49.1119 -        show "((\<lambda>xa. f x) has_integral (x - y) *\<^sub>R f x) {y..x}" apply(subst *) unfolding ** by auto
 49.1120 -        show "\<forall>xa\<in>{y..x}. norm (f xa - f x) \<le> e" apply safe apply(rule less_imp_le)
 49.1121 -          apply(rule d(2)[unfolded dist_norm]) using assms(2) using goal1 by auto
 49.1122 -      qed(insert e,auto) qed qed qed
 49.1123 -
 49.1124 -lemma antiderivative_continuous: assumes "continuous_on {a..b::real} f"
 49.1125 -  obtains g where "\<forall>x\<in> {a..b}. (g has_vector_derivative (f(x)::_::banach)) (at x within {a..b})"
 49.1126 -  apply(rule that,rule) using integral_has_vector_derivative[OF assms] by auto
 49.1127 +  show "\<exists>d>0. \<forall>y\<in>{a..b}. norm (y - x) < d \<longrightarrow>
 49.1128 +    norm (?I a y - ?I a x - (y - x) *\<^sub>R f x) \<le> e * norm (y - x)"
 49.1129 +  proof (rule, rule, rule d, safe)
 49.1130 +    case goal1
 49.1131 +    show ?case
 49.1132 +    proof (cases "y < x")
 49.1133 +      case False
 49.1134 +      have "f integrable_on {a..y}"
 49.1135 +        apply (rule integrable_subinterval,rule integrable_continuous)
 49.1136 +        apply (rule assms)
 49.1137 +        unfolding not_less
 49.1138 +        using assms(2) goal1
 49.1139 +        apply auto
 49.1140 +        done
 49.1141 +      then have *: "?I a y - ?I a x = ?I x y"
 49.1142 +        unfolding algebra_simps
 49.1143 +        apply (subst eq_commute)
 49.1144 +        apply (rule integral_combine)
 49.1145 +        using False
 49.1146 +        unfolding not_less
 49.1147 +        using assms(2) goal1
 49.1148 +        apply auto
 49.1149 +        done
 49.1150 +      have **: "norm (y - x) = content {x..y}"
 49.1151 +        apply (subst content_real)
 49.1152 +        using False
 49.1153 +        unfolding not_less
 49.1154 +        apply auto
 49.1155 +        done
 49.1156 +      show ?thesis
 49.1157 +        unfolding **
 49.1158 +        apply (rule has_integral_bound[where f="(\<lambda>u. f u - f x)"])
 49.1159 +        unfolding *
 49.1160 +        unfolding o_def
 49.1161 +        defer
 49.1162 +        apply (rule has_integral_sub)
 49.1163 +        apply (rule integrable_integral)
 49.1164 +        apply (rule integrable_subinterval)
 49.1165 +        apply (rule integrable_continuous)
 49.1166 +        apply (rule assms)+
 49.1167 +      proof -
 49.1168 +        show "{x..y} \<subseteq> {a..b}"
 49.1169 +          using goal1 assms(2) by auto
 49.1170 +        have *: "y - x = norm (y - x)"
 49.1171 +          using False by auto
 49.1172 +        show "((\<lambda>xa. f x) has_integral (y - x) *\<^sub>R f x) {x.. y}"
 49.1173 +          apply (subst *)
 49.1174 +          unfolding **
 49.1175 +          apply auto
 49.1176 +          done
 49.1177 +        show "\<forall>xa\<in>{x..y}. norm (f xa - f x) \<le> e"
 49.1178 +          apply safe
 49.1179 +          apply (rule less_imp_le)
 49.1180 +          apply (rule d(2)[unfolded dist_norm])
 49.1181 +          using assms(2)
 49.1182 +          using goal1
 49.1183 +          apply auto
 49.1184 +          done
 49.1185 +      qed (insert e, auto)
 49.1186 +    next
 49.1187 +      case True
 49.1188 +      have "f integrable_on {a..x}"
 49.1189 +        apply (rule integrable_subinterval,rule integrable_continuous)
 49.1190 +        apply (rule assms)+
 49.1191 +        unfolding not_less
 49.1192 +        using assms(2) goal1
 49.1193 +        apply auto
 49.1194 +        done
 49.1195 +      then have *: "?I a x - ?I a y = ?I y x"
 49.1196 +        unfolding algebra_simps
 49.1197 +        apply (subst eq_commute)
 49.1198 +        apply (rule integral_combine)
 49.1199 +        using True using assms(2) goal1
 49.1200 +        apply auto
 49.1201 +        done
 49.1202 +      have **: "norm (y - x) = content {y..x}"
 49.1203 +        apply (subst content_real)
 49.1204 +        using True
 49.1205 +        unfolding not_less
 49.1206 +        apply auto
 49.1207 +        done
 49.1208 +      have ***: "\<And>fy fx c::'a. fx - fy - (y - x) *\<^sub>R c = -(fy - fx - (x - y) *\<^sub>R c)"
 49.1209 +        unfolding scaleR_left.diff by auto
 49.1210 +      show ?thesis
 49.1211 +        apply (subst ***)
 49.1212 +        unfolding norm_minus_cancel **
 49.1213 +        apply (rule has_integral_bound[where f="(\<lambda>u. f u - f x)"])
 49.1214 +        unfolding *
 49.1215 +        unfolding o_def
 49.1216 +        defer
 49.1217 +        apply (rule has_integral_sub)
 49.1218 +        apply (subst minus_minus[symmetric])
 49.1219 +        unfolding minus_minus
 49.1220 +        apply (rule integrable_integral)
 49.1221 +        apply (rule integrable_subinterval,rule integrable_continuous)
 49.1222 +        apply (rule assms)+
 49.1223 +      proof -
 49.1224 +        show "{y..x} \<subseteq> {a..b}"
 49.1225 +          using goal1 assms(2) by auto
 49.1226 +        have *: "x - y = norm (y - x)"
 49.1227 +          using True by auto
 49.1228 +        show "((\<lambda>xa. f x) has_integral (x - y) *\<^sub>R f x) {y..x}"
 49.1229 +          apply (subst *)
 49.1230 +          unfolding **
 49.1231 +          apply auto
 49.1232 +          done
 49.1233 +        show "\<forall>xa\<in>{y..x}. norm (f xa - f x) \<le> e"
 49.1234 +          apply safe
 49.1235 +          apply (rule less_imp_le)
 49.1236 +          apply (rule d(2)[unfolded dist_norm])
 49.1237 +          using assms(2)
 49.1238 +          using goal1
 49.1239 +          apply auto
 49.1240 +          done
 49.1241 +      qed (insert e, auto)
 49.1242 +    qed
 49.1243 +  qed
 49.1244 +qed
 49.1245 +
 49.1246 +lemma antiderivative_continuous:
 49.1247 +  fixes q b :: real
 49.1248 +  assumes "continuous_on {a..b} f"
 49.1249 +  obtains g where "\<forall>x\<in> {a..b}. (g has_vector_derivative (f x::_::banach)) (at x within {a..b})"
 49.1250 +  apply (rule that)
 49.1251 +  apply rule
 49.1252 +  using integral_has_vector_derivative[OF assms]
 49.1253 +  apply auto
 49.1254 +  done
 49.1255 +
 49.1256  
 49.1257  subsection {* Combined fundamental theorem of calculus. *}
 49.1258  
 49.1259 -lemma antiderivative_integral_continuous: fixes f::"real \<Rightarrow> 'a::banach" assumes "continuous_on {a..b} f"
 49.1260 +lemma antiderivative_integral_continuous:
 49.1261 +  fixes f :: "real \<Rightarrow> 'a::banach"
 49.1262 +  assumes "continuous_on {a..b} f"
 49.1263    obtains g where "\<forall>u\<in>{a..b}. \<forall>v \<in> {a..b}. u \<le> v \<longrightarrow> (f has_integral (g v - g u)) {u..v}"
 49.1264 -proof- from antiderivative_continuous[OF assms] guess g . note g=this
 49.1265 -  show ?thesis apply(rule that[of g])
 49.1266 -  proof safe case goal1 have "\<forall>x\<in>{u..v}. (g has_vector_derivative f x) (at x within {u..v})"
 49.1267 -      apply(rule,rule has_vector_derivative_within_subset) apply(rule g[rule_format]) using goal1(1-2) by auto
 49.1268 -    thus ?case using fundamental_theorem_of_calculus[OF goal1(3),of "g" "f"] by auto qed qed
 49.1269 +proof -
 49.1270 +  from antiderivative_continuous[OF assms] guess g . note g=this
 49.1271 +  show ?thesis
 49.1272 +    apply (rule that[of g])
 49.1273 +  proof safe
 49.1274 +    case goal1
 49.1275 +    have "\<forall>x\<in>{u..v}. (g has_vector_derivative f x) (at x within {u..v})"
 49.1276 +      apply rule
 49.1277 +      apply (rule has_vector_derivative_within_subset)
 49.1278 +      apply (rule g[rule_format])
 49.1279 +      using goal1(1-2)
 49.1280 +      apply auto
 49.1281 +      done
 49.1282 +    then show ?case
 49.1283 +      using fundamental_theorem_of_calculus[OF goal1(3),of "g" "f"] by auto
 49.1284 +  qed
 49.1285 +qed
 49.1286 +
 49.1287  
 49.1288  subsection {* General "twiddling" for interval-to-interval function image. *}
 49.1289  
 49.1290  lemma has_integral_twiddle:
 49.1291 -  assumes "0 < r" "\<forall>x. h(g x) = x" "\<forall>x. g(h x) = x" "\<forall>x. continuous (at x) g"
 49.1292 -  "\<forall>u v. \<exists>w z. g ` {u..v} = {w..z}"
 49.1293 -  "\<forall>u v. \<exists>w z. h ` {u..v} = {w..z}"
 49.1294 -  "\<forall>u v. content(g ` {u..v}) = r * content {u..v}"
 49.1295 -  "(f has_integral i) {a..b}"
 49.1296 +  assumes "0 < r"
 49.1297 +    and "\<forall>x. h(g x) = x"
 49.1298 +    and "\<forall>x. g(h x) = x"
 49.1299 +    and "\<forall>x. continuous (at x) g"
 49.1300 +    and "\<forall>u v. \<exists>w z. g ` {u..v} = {w..z}"
 49.1301 +    and "\<forall>u v. \<exists>w z. h ` {u..v} = {w..z}"
 49.1302 +    and "\<forall>u v. content(g ` {u..v}) = r * content {u..v}"
 49.1303 +    and "(f has_integral i) {a..b}"
 49.1304    shows "((\<lambda>x. f(g x)) has_integral (1 / r) *\<^sub>R i) (h ` {a..b})"
 49.1305 -proof- { presume *:"{a..b} \<noteq> {} \<Longrightarrow> ?thesis"
 49.1306 -    show ?thesis apply cases defer apply(rule *,assumption)
 49.1307 -    proof- case goal1 thus ?thesis unfolding goal1 assms(8)[unfolded goal1 has_integral_empty_eq] by auto qed }
 49.1308 -  assume "{a..b} \<noteq> {}" from assms(6)[rule_format,of a b] guess w z apply-by(erule exE)+ note wz=this
 49.1309 -  have inj:"inj g" "inj h" unfolding inj_on_def apply safe apply(rule_tac[!] ccontr)
 49.1310 -    using assms(2) apply(erule_tac x=x in allE) using assms(2) apply(erule_tac x=y in allE) defer
 49.1311 -    using assms(3) apply(erule_tac x=x in allE) using assms(3) apply(erule_tac x=y in allE) by auto
 49.1312 -  show ?thesis unfolding has_integral_def has_integral_compact_interval_def apply(subst if_P) apply(rule,rule,rule wz)
 49.1313 -  proof safe fix e::real assume e:"e>0" hence "e * r > 0" using assms(1) by(rule mult_pos_pos)
 49.1314 -    from assms(8)[unfolded has_integral,rule_format,OF this] guess d apply-by(erule exE conjE)+ note d=this[rule_format]
 49.1315 -    def d' \<equiv> "\<lambda>x. {y. g y \<in> d (g x)}" have d':"\<And>x. d' x = {y. g y \<in> (d (g x))}" unfolding d'_def ..
 49.1316 +proof -
 49.1317 +  {
 49.1318 +    presume *: "{a..b} \<noteq> {} \<Longrightarrow> ?thesis"
 49.1319 +    show ?thesis
 49.1320 +      apply cases
 49.1321 +      defer
 49.1322 +      apply (rule *)
 49.1323 +      apply assumption
 49.1324 +    proof -
 49.1325 +      case goal1
 49.1326 +      then show ?thesis
 49.1327 +        unfolding goal1 assms(8)[unfolded goal1 has_integral_empty_eq] by auto qed
 49.1328 +  }
 49.1329 +  assume "{a..b} \<noteq> {}"
 49.1330 +  from assms(6)[rule_format,of a b] guess w z by (elim exE) note wz=this
 49.1331 +  have inj: "inj g" "inj h"
 49.1332 +    unfolding inj_on_def
 49.1333 +    apply safe
 49.1334 +    apply(rule_tac[!] ccontr)
 49.1335 +    using assms(2)
 49.1336 +    apply(erule_tac x=x in allE)
 49.1337 +    using assms(2)
 49.1338 +    apply(erule_tac x=y in allE)
 49.1339 +    defer
 49.1340 +    using assms(3)
 49.1341 +    apply (erule_tac x=x in allE)
 49.1342 +    using assms(3)
 49.1343 +    apply(erule_tac x=y in allE)
 49.1344 +    apply auto
 49.1345 +    done
 49.1346 +  show ?thesis
 49.1347 +    unfolding has_integral_def has_integral_compact_interval_def
 49.1348 +    apply (subst if_P)
 49.1349 +    apply rule
 49.1350 +    apply rule
 49.1351 +    apply (rule wz)
 49.1352 +  proof safe
 49.1353 +    fix e :: real
 49.1354 +    assume e: "e > 0"
 49.1355 +    then have "e * r > 0"
 49.1356 +      using assms(1) by (rule mult_pos_pos)
 49.1357 +    from assms(8)[unfolded has_integral,rule_format,OF this] guess d by (elim exE conjE) note d=this[rule_format]
 49.1358 +    def d' \<equiv> "\<lambda>x. {y. g y \<in> d (g x)}"
 49.1359 +    have d': "\<And>x. d' x = {y. g y \<in> (d (g x))}"
 49.1360 +      unfolding d'_def ..
 49.1361      show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of h ` {a..b} \<and> d fine p \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e)"
 49.1362 -    proof(rule_tac x=d' in exI,safe) show "gauge d'" using d(1) unfolding gauge_def d' using continuous_open_preimage_univ[OF assms(4)] by auto
 49.1363 -      fix p assume as:"p tagged_division_of h ` {a..b}" "d' fine p" note p = tagged_division_ofD[OF as(1)]
 49.1364 -      have "(\<lambda>(x, k). (g x, g ` k)) ` p tagged_division_of {a..b} \<and> d fine (\<lambda>(x, k). (g x, g ` k)) ` p" unfolding tagged_division_of
 49.1365 -      proof safe show "finite ((\<lambda>(x, k). (g x, g ` k)) ` p)" using as by auto
 49.1366 -        show "d fine (\<lambda>(x, k). (g x, g ` k)) ` p" using as(2) unfolding fine_def d' by auto
 49.1367 -        fix x k assume xk[intro]:"(x,k) \<in> p" show "g x \<in> g ` k" using p(2)[OF xk] by auto
 49.1368 -        show "\<exists>u v. g ` k = {u..v}" using p(4)[OF xk] using assms(5-6) by auto
 49.1369 -        { fix y assume "y \<in> k" thus "g y \<in> {a..b}" "g y \<in> {a..b}" using p(3)[OF xk,unfolded subset_eq,rule_format,of "h (g y)"]
 49.1370 -            using assms(2)[rule_format,of y] unfolding inj_image_mem_iff[OF inj(2)] by auto }
 49.1371 -        fix x' k' assume xk':"(x',k') \<in> p" fix z assume "z \<in> interior (g ` k)" "z \<in> interior (g ` k')"
 49.1372 -        hence *:"interior (g ` k) \<inter> interior (g ` k') \<noteq> {}" by auto
 49.1373 -        have same:"(x, k) = (x', k')" apply-apply(rule ccontr,drule p(5)[OF xk xk'])
 49.1374 -        proof- assume as:"interior k \<inter> interior k' = {}" from nonempty_witness[OF *] guess z .
 49.1375 -          hence "z \<in> g ` (interior k \<inter> interior k')" using interior_image_subset[OF assms(4) inj(1)]
 49.1376 -            unfolding image_Int[OF inj(1)] by auto thus False using as by blast
 49.1377 -        qed thus "g x = g x'" by auto
 49.1378 -        { fix z assume "z \<in> k"  thus  "g z \<in> g ` k'" using same by auto }
 49.1379 -        { fix z assume "z \<in> k'" thus  "g z \<in> g ` k"  using same by auto }
 49.1380 -      next fix x assume "x \<in> {a..b}" hence "h x \<in>  \<Union>{k. \<exists>x. (x, k) \<in> p}" using p(6) by auto
 49.1381 -        then guess X unfolding Union_iff .. note X=this from this(1) guess y unfolding mem_Collect_eq ..
 49.1382 -        thus "x \<in> \<Union>{k. \<exists>x. (x, k) \<in> (\<lambda>(x, k). (g x, g ` k)) ` p}" apply-
 49.1383 -          apply(rule_tac X="g ` X" in UnionI) defer apply(rule_tac x="h x" in image_eqI)
 49.1384 -          using X(2) assms(3)[rule_format,of x] by auto
 49.1385 -      qed note ** = d(2)[OF this] have *:"inj_on (\<lambda>(x, k). (g x, g ` k)) p" using inj(1) unfolding inj_on_def by fastforce
 49.1386 -       have "(\<Sum>(x, k)\<in>(\<lambda>(x, k). (g x, g ` k)) ` p. content k *\<^sub>R f x) - i = r *\<^sub>R (\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - i" (is "?l = _") unfolding algebra_simps add_left_cancel
 49.1387 -        unfolding setsum_reindex[OF *] apply(subst scaleR_right.setsum) defer apply(rule setsum_cong2) unfolding o_def split_paired_all split_conv
 49.1388 -        apply(drule p(4)) apply safe unfolding assms(7)[rule_format] using p by auto
 49.1389 -      also have "... = r *\<^sub>R ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i)" (is "_ = ?r") unfolding scaleR_diff_right scaleR_scaleR
 49.1390 -        using assms(1) by auto finally have *:"?l = ?r" .
 49.1391 -      show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e" using ** unfolding * unfolding norm_scaleR
 49.1392 -        using assms(1) by(auto simp add:field_simps) qed qed qed
 49.1393 +    proof (rule_tac x=d' in exI, safe)
 49.1394 +      show "gauge d'"
 49.1395 +        using d(1)
 49.1396 +        unfolding gauge_def d'
 49.1397 +        using continuous_open_preimage_univ[OF assms(4)]
 49.1398 +        by auto
 49.1399 +      fix p
 49.1400 +      assume as: "p tagged_division_of h ` {a..b}" "d' fine p"
 49.1401 +      note p = tagged_division_ofD[OF as(1)]
 49.1402 +      have "(\<lambda>(x, k). (g x, g ` k)) ` p tagged_division_of {a..b} \<and> d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
 49.1403 +        unfolding tagged_division_of
 49.1404 +      proof safe
 49.1405 +        show "finite ((\<lambda>(x, k). (g x, g ` k)) ` p)"
 49.1406 +          using as by auto
 49.1407 +        show "d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
 49.1408 +          using as(2) unfolding fine_def d' by auto
 49.1409 +        fix x k
 49.1410 +        assume xk[intro]: "(x, k) \<in> p"
 49.1411 +        show "g x \<in> g ` k"
 49.1412 +          using p(2)[OF xk] by auto
 49.1413 +        show "\<exists>u v. g ` k = {u..v}"
 49.1414 +          using p(4)[OF xk] using assms(5-6) by auto
 49.1415 +        {
 49.1416 +          fix y
 49.1417 +          assume "y \<in> k"
 49.1418 +          then show "g y \<in> {a..b}" "g y \<in> {a..b}"
 49.1419 +            using p(3)[OF xk,unfolded subset_eq,rule_format,of "h (g y)"]
 49.1420 +            using assms(2)[rule_format,of y]
 49.1421 +            unfolding inj_image_mem_iff[OF inj(2)]
 49.1422 +            by auto
 49.1423 +        }
 49.1424 +        fix x' k'
 49.1425 +        assume xk': "(x', k') \<in> p"
 49.1426 +        fix z
 49.1427 +        assume "z \<in> interior (g ` k)" and "z \<in> interior (g ` k')"
 49.1428 +        then have *: "interior (g ` k) \<inter> interior (g ` k') \<noteq> {}"
 49.1429 +          by auto
 49.1430 +        have same: "(x, k) = (x', k')"
 49.1431 +          apply -
 49.1432 +          apply (rule ccontr,drule p(5)[OF xk xk'])
 49.1433 +        proof -
 49.1434 +          assume as: "interior k \<inter> interior k' = {}"
 49.1435 +          from nonempty_witness[OF *] guess z .
 49.1436 +          then have "z \<in> g ` (interior k \<inter> interior k')"
 49.1437 +            using interior_image_subset[OF assms(4) inj(1)]
 49.1438 +            unfolding image_Int[OF inj(1)]
 49.1439 +            by auto
 49.1440 +          then show False
 49.1441 +            using as by blast
 49.1442 +        qed
 49.1443 +        then show "g x = g x'"
 49.1444 +          by auto
 49.1445 +        {
 49.1446 +          fix z
 49.1447 +          assume "z \<in> k"
 49.1448 +          then show "g z \<in> g ` k'"
 49.1449 +            using same by auto
 49.1450 +        }
 49.1451 +        {
 49.1452 +          fix z
 49.1453 +          assume "z \<in> k'"
 49.1454 +          then show "g z \<in> g ` k"
 49.1455 +            using same by auto
 49.1456 +        }
 49.1457 +      next
 49.1458 +        fix x
 49.1459 +        assume "x \<in> {a..b}"
 49.1460 +        then have "h x \<in>  \<Union>{k. \<exists>x. (x, k) \<in> p}"
 49.1461 +          using p(6) by auto
 49.1462 +        then guess X unfolding Union_iff .. note X=this
 49.1463 +        from this(1) guess y unfolding mem_Collect_eq ..
 49.1464 +        then show "x \<in> \<Union>{k. \<exists>x. (x, k) \<in> (\<lambda>(x, k). (g x, g ` k)) ` p}"
 49.1465 +          apply -
 49.1466 +          apply (rule_tac X="g ` X" in UnionI)
 49.1467 +          defer
 49.1468 +          apply (rule_tac x="h x" in image_eqI)
 49.1469 +          using X(2) assms(3)[rule_format,of x]
 49.1470 +          apply auto
 49.1471 +          done
 49.1472 +      qed
 49.1473 +        note ** = d(2)[OF this]
 49.1474 +        have *: "inj_on (\<lambda>(x, k). (g x, g ` k)) p"
 49.1475 +          using inj(1) unfolding inj_on_def by fastforce
 49.1476 +        have "(\<Sum>(x, k)\<in>(\<lambda>(x, k). (g x, g ` k)) ` p. content k *\<^sub>R f x) - i = r *\<^sub>R (\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - i" (is "?l = _")
 49.1477 +          unfolding algebra_simps add_left_cancel
 49.1478 +          unfolding setsum_reindex[OF *]
 49.1479 +          apply (subst scaleR_right.setsum)
 49.1480 +          defer
 49.1481 +          apply (rule setsum_cong2)
 49.1482 +          unfolding o_def split_paired_all split_conv
 49.1483 +          apply (drule p(4))
 49.1484 +          apply safe
 49.1485 +          unfolding assms(7)[rule_format]
 49.1486 +          using p
 49.1487 +          apply auto
 49.1488 +          done
 49.1489 +      also have "\<dots> = r *\<^sub>R ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i)" (is "_ = ?r")
 49.1490 +        unfolding scaleR_diff_right scaleR_scaleR
 49.1491 +        using assms(1)
 49.1492 +        by auto
 49.1493 +      finally have *: "?l = ?r" .
 49.1494 +      show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e"
 49.1495 +        using **
 49.1496 +        unfolding *
 49.1497 +        unfolding norm_scaleR
 49.1498 +        using assms(1)
 49.1499 +        by (auto simp add:field_simps)
 49.1500 +    qed
 49.1501 +  qed
 49.1502 +qed
 49.1503 +
 49.1504  
 49.1505  subsection {* Special case of a basic affine transformation. *}
 49.1506  
 49.1507 -lemma interval_image_affinity_interval: shows "\<exists>u v. (\<lambda>x. m *\<^sub>R (x::'a::ordered_euclidean_space) + c) ` {a..b} = {u..v}"
 49.1508 -  unfolding image_affinity_interval by auto
 49.1509 -
 49.1510 -lemma setprod_cong2: assumes "\<And>x. x \<in> A \<Longrightarrow> f x = g x" shows "setprod f A = setprod g A"
 49.1511 -  apply(rule setprod_cong) using assms by auto
 49.1512 +lemma interval_image_affinity_interval:
 49.1513 +  "\<exists>u v. (\<lambda>x. m *\<^sub>R (x::'a::ordered_euclidean_space) + c) ` {a..b} = {u..v}"
 49.1514 +  unfolding image_affinity_interval
 49.1515 +  by auto
 49.1516 +
 49.1517 +lemma setprod_cong2:
 49.1518 +  assumes "\<And>x. x \<in> A \<Longrightarrow> f x = g x"
 49.1519 +  shows "setprod f A = setprod g A"
 49.1520 +  apply (rule setprod_cong)
 49.1521 +  using assms
 49.1522 +  apply auto
 49.1523 +  done
 49.1524  
 49.1525  lemma content_image_affinity_interval:
 49.1526 - "content((\<lambda>x::'a::ordered_euclidean_space. m *\<^sub>R x + c) ` {a..b}) = (abs m) ^ DIM('a) * content {a..b}" (is "?l = ?r")
 49.1527 -proof- { presume *:"{a..b}\<noteq>{} \<Longrightarrow> ?thesis" show ?thesis apply(cases,rule *,assumption)
 49.1528 -      unfolding not_not using content_empty by auto }
 49.1529 -  assume as: "{a..b}\<noteq>{}"
 49.1530 +  "content((\<lambda>x::'a::ordered_euclidean_space. m *\<^sub>R x + c) ` {a..b}) =
 49.1531 +    abs m ^ DIM('a) * content {a..b}" (is "?l = ?r")
 49.1532 +proof -
 49.1533 +  {
 49.1534 +    presume *: "{a..b} \<noteq> {} \<Longrightarrow> ?thesis"
 49.1535 +    show ?thesis
 49.1536 +      apply cases
 49.1537 +      apply (rule *)
 49.1538 +      apply assumption
 49.1539 +      unfolding not_not
 49.1540 +      using content_empty
 49.1541 +      apply auto
 49.1542 +      done
 49.1543 +  }
 49.1544 +  assume as: "{a..b} \<noteq> {}"
 49.1545    show ?thesis
 49.1546    proof (cases "m \<ge> 0")
 49.1547      case True
 49.1548 @@ -6791,7 +7462,7 @@
 49.1549        by (simp add: inner_simps field_simps)
 49.1550      ultimately show ?thesis
 49.1551        by (simp add: image_affinity_interval True content_closed_interval'
 49.1552 -                    setprod_timesf setprod_constant inner_diff_left)
 49.1553 +        setprod_timesf setprod_constant inner_diff_left)
 49.1554    next
 49.1555      case False
 49.1556      with as have "{m *\<^sub>R b + c..m *\<^sub>R a + c} \<noteq> {}"
 49.1557 @@ -6804,20 +7475,43 @@
 49.1558        by (simp add: inner_simps field_simps)
 49.1559      ultimately show ?thesis using False
 49.1560        by (simp add: image_affinity_interval content_closed_interval'
 49.1561 -                    setprod_timesf[symmetric] setprod_constant[symmetric] inner_diff_left)
 49.1562 +        setprod_timesf[symmetric] setprod_constant[symmetric] inner_diff_left)
 49.1563    qed
 49.1564  qed
 49.1565  
 49.1566 -lemma has_integral_affinity: fixes a::"'a::ordered_euclidean_space" assumes "(f has_integral i) {a..b}" "m \<noteq> 0"
 49.1567 +lemma has_integral_affinity:
 49.1568 +  fixes a :: "'a::ordered_euclidean_space"
 49.1569 +  assumes "(f has_integral i) {a..b}"
 49.1570 +    and "m \<noteq> 0"
 49.1571    shows "((\<lambda>x. f(m *\<^sub>R x + c)) has_integral ((1 / (abs(m) ^ DIM('a))) *\<^sub>R i)) ((\<lambda>x. (1 / m) *\<^sub>R x + -((1 / m) *\<^sub>R c)) ` {a..b})"
 49.1572 -  apply(rule has_integral_twiddle,safe) apply(rule zero_less_power) unfolding euclidean_eq_iff[where 'a='a]
 49.1573 +  apply (rule has_integral_twiddle)
 49.1574 +  apply safe
 49.1575 +  apply (rule zero_less_power)
 49.1576 +  unfolding euclidean_eq_iff[where 'a='a]
 49.1577    unfolding scaleR_right_distrib inner_simps scaleR_scaleR
 49.1578 -  defer apply(insert assms(2), simp add:field_simps) apply(insert assms(2), simp add:field_simps)
 49.1579 -  apply(rule continuous_intros)+ apply(rule interval_image_affinity_interval)+ apply(rule content_image_affinity_interval) using assms by auto
 49.1580 -
 49.1581 -lemma integrable_affinity: assumes "f integrable_on {a..b}" "m \<noteq> 0"
 49.1582 +  defer
 49.1583 +  apply (insert assms(2))
 49.1584 +  apply (simp add: field_simps)
 49.1585 +  apply (insert assms(2))
 49.1586 +  apply (simp add: field_simps)
 49.1587 +  apply (rule continuous_intros)+
 49.1588 +  apply (rule interval_image_affinity_interval)+
 49.1589 +  apply (rule content_image_affinity_interval)
 49.1590 +  using assms
 49.1591 +  apply auto
 49.1592 +  done
 49.1593 +
 49.1594 +lemma integrable_affinity:
 49.1595 +  assumes "f integrable_on {a..b}"
 49.1596 +    and "m \<noteq> 0"
 49.1597    shows "(\<lambda>x. f(m *\<^sub>R x + c)) integrable_on ((\<lambda>x. (1 / m) *\<^sub>R x + -((1/m) *\<^sub>R c)) ` {a..b})"
 49.1598 -  using assms unfolding integrable_on_def apply safe apply(drule has_integral_affinity) by auto
 49.1599 +  using assms
 49.1600 +  unfolding integrable_on_def
 49.1601 +  apply safe
 49.1602 +  apply (drule has_integral_affinity)
 49.1603 +  apply auto
 49.1604 +  done
 49.1605 +
 49.1606  
 49.1607  subsection {* Special case of stretching coordinate axes separately. *}
 49.1608  
 49.1609 @@ -6856,310 +7550,744 @@
 49.1610  qed simp
 49.1611  
 49.1612  lemma interval_image_stretch_interval:
 49.1613 -    "\<exists>u v. (\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k) ` {a..b::'a::ordered_euclidean_space} = {u..v::'a}"
 49.1614 +  "\<exists>u v. (\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k) ` {a..b::'a::ordered_euclidean_space} = {u..v::'a}"
 49.1615    unfolding image_stretch_interval by auto
 49.1616  
 49.1617  lemma content_image_stretch_interval:
 49.1618 -  "content((\<lambda>x::'a::ordered_euclidean_space. (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)::'a) ` {a..b}) = abs(setprod m Basis) * content({a..b})"
 49.1619 -proof(cases "{a..b} = {}") case True thus ?thesis
 49.1620 +  "content ((\<lambda>x::'a::ordered_euclidean_space. (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)::'a) ` {a..b}) =
 49.1621 +    abs (setprod m Basis) * content {a..b}"
 49.1622 +proof (cases "{a..b} = {}")
 49.1623 +  case True
 49.1624 +  then show ?thesis
 49.1625      unfolding content_def image_is_empty image_stretch_interval if_P[OF True] by auto
 49.1626 -next case False hence "(\<lambda>x. (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)::'a) ` {a..b} \<noteq> {}" by auto
 49.1627 -  thus ?thesis using False unfolding content_def image_stretch_interval apply- unfolding interval_bounds' if_not_P
 49.1628 -    unfolding abs_setprod setprod_timesf[symmetric] apply(rule setprod_cong2) unfolding lessThan_iff
 49.1629 -  proof (simp only: inner_setsum_left_Basis)
 49.1630 -    fix i :: 'a assume i:"i\<in>Basis" have "(m i < 0 \<or> m i > 0) \<or> m i = 0" by auto
 49.1631 -    thus "max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) - min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) =
 49.1632 -        \<bar>m i\<bar> * (b \<bullet> i - a \<bullet> i)"
 49.1633 -      apply-apply(erule disjE)+ unfolding min_def max_def using False[unfolded interval_ne_empty,rule_format,of i] i
 49.1634 -      by(auto simp add:field_simps not_le mult_le_cancel_left_neg mult_le_cancel_left_pos) qed qed
 49.1635 -
 49.1636 -lemma has_integral_stretch: fixes f::"'a::ordered_euclidean_space => 'b::real_normed_vector"
 49.1637 -  assumes "(f has_integral i) {a..b}" "\<forall>k\<in>Basis. ~(m k = 0)"
 49.1638 +next
 49.1639 +  case False
 49.1640 +  then have "(\<lambda>x. (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) ` {a..b} \<noteq> {}"
 49.1641 +    by auto
 49.1642 +  then show ?thesis
 49.1643 +    using False
 49.1644 +    unfolding content_def image_stretch_interval
 49.1645 +    apply -
 49.1646 +    unfolding interval_bounds' if_not_P
 49.1647 +    unfolding abs_setprod setprod_timesf[symmetric]
 49.1648 +    apply (rule setprod_cong2)
 49.1649 +    unfolding lessThan_iff
 49.1650 +    apply (simp only: inner_setsum_left_Basis)
 49.1651 +  proof -
 49.1652 +    fix i :: 'a
 49.1653 +    assume i: "i \<in> Basis"
 49.1654 +    have "(m i < 0 \<or> m i > 0) \<or> m i = 0"
 49.1655 +      by auto
 49.1656 +    then show "max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) - min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) =
 49.1657 +      \<bar>m i\<bar> * (b \<bullet> i - a \<bullet> i)"
 49.1658 +      apply -
 49.1659 +      apply (erule disjE)+
 49.1660 +      unfolding min_def max_def
 49.1661 +      using False[unfolded interval_ne_empty,rule_format,of i] i
 49.1662 +      apply (auto simp add:field_simps not_le mult_le_cancel_left_neg mult_le_cancel_left_pos)
 49.1663 +      done
 49.1664 +  qed
 49.1665 +qed
 49.1666 +
 49.1667 +lemma has_integral_stretch:
 49.1668 +  fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::real_normed_vector"
 49.1669 +  assumes "(f has_integral i) {a..b}"
 49.1670 +    and "\<forall>k\<in>Basis. m k \<noteq> 0"
 49.1671    shows "((\<lambda>x. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) has_integral
 49.1672 -             ((1/(abs(setprod m Basis))) *\<^sub>R i)) ((\<lambda>x. (\<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k)) ` {a..b})"
 49.1673 -  apply(rule has_integral_twiddle[where f=f]) unfolding zero_less_abs_iff content_image_stretch_interval
 49.1674 -  unfolding image_stretch_interval empty_as_interval euclidean_eq_iff[where 'a='a] using assms
 49.1675 -proof- show "\<forall>y::'a. continuous (at y) (\<lambda>x. (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k))"
 49.1676 -   apply(rule,rule linear_continuous_at) unfolding linear_linear
 49.1677 -   unfolding linear_def inner_simps euclidean_eq_iff[where 'a='a] by(auto simp add:field_simps)
 49.1678 +    ((1/(abs(setprod m Basis))) *\<^sub>R i)) ((\<lambda>x. (\<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k)) ` {a..b})"
 49.1679 +  apply (rule has_integral_twiddle[where f=f])
 49.1680 +  unfolding zero_less_abs_iff content_image_stretch_interval
 49.1681 +  unfolding image_stretch_interval empty_as_interval euclidean_eq_iff[where 'a='a]
 49.1682 +  using assms
 49.1683 +proof -
 49.1684 +  show "\<forall>y::'a. continuous (at y) (\<lambda>x. (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k))"
 49.1685 +    apply rule
 49.1686 +    apply (rule linear_continuous_at)
 49.1687 +    unfolding linear_linear
 49.1688 +    unfolding linear_iff inner_simps euclidean_eq_iff[where 'a='a]
 49.1689 +    apply (auto simp add: field_simps)
 49.1690 +    done
 49.1691  qed auto
 49.1692  
 49.1693 -lemma integrable_stretch:  fixes f::"'a::ordered_euclidean_space => 'b::real_normed_vector"
 49.1694 -  assumes "f integrable_on {a..b}" "\<forall>k\<in>Basis. ~(m k = 0)"
 49.1695 -  shows "(\<lambda>x::'a. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) integrable_on ((\<lambda>x. \<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k) ` {a..b})"
 49.1696 -  using assms unfolding integrable_on_def apply-apply(erule exE)
 49.1697 -  apply(drule has_integral_stretch,assumption) by auto
 49.1698 +lemma integrable_stretch:
 49.1699 +  fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::real_normed_vector"
 49.1700 +  assumes "f integrable_on {a..b}"
 49.1701 +    and "\<forall>k\<in>Basis. m k \<noteq> 0"
 49.1702 +  shows "(\<lambda>x::'a. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) integrable_on
 49.1703 +    ((\<lambda>x. \<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k) ` {a..b})"
 49.1704 +  using assms
 49.1705 +  unfolding integrable_on_def
 49.1706 +  apply -
 49.1707 +  apply (erule exE)
 49.1708 +  apply (drule has_integral_stretch)
 49.1709 +  apply assumption
 49.1710 +  apply auto
 49.1711 +  done
 49.1712 +
 49.1713  
 49.1714  subsection {* even more special cases. *}
 49.1715  
 49.1716 -lemma uminus_interval_vector[simp]:"uminus ` {a..b} = {-b .. -a::'a::ordered_euclidean_space}"
 49.1717 -  apply(rule set_eqI,rule) defer unfolding image_iff
 49.1718 -  apply(rule_tac x="-x" in bexI) by(auto simp add:minus_le_iff le_minus_iff eucl_le[where 'a='a])
 49.1719 -
 49.1720 -lemma has_integral_reflect_lemma[intro]: assumes "(f has_integral i) {a..b}"
 49.1721 -  shows "((\<lambda>x. f(-x)) has_integral i) {-b .. -a}"
 49.1722 -  using has_integral_affinity[OF assms, of "-1" 0] by auto
 49.1723 -
 49.1724 -lemma has_integral_reflect[simp]: "((\<lambda>x. f(-x)) has_integral i) {-b..-a} \<longleftrightarrow> (f has_integral i) ({a..b})"
 49.1725 -  apply rule apply(drule_tac[!] has_integral_reflect_lemma) by auto
 49.1726 +lemma uminus_interval_vector[simp]:
 49.1727 +  fixes a b :: "'a::ordered_euclidean_space"
 49.1728 +  shows "uminus ` {a..b} = {-b..-a}"
 49.1729 +  apply (rule set_eqI)
 49.1730 +  apply rule
 49.1731 +  defer
 49.1732 +  unfolding image_iff
 49.1733 +  apply (rule_tac x="-x" in bexI)
 49.1734 +  apply (auto simp add:minus_le_iff le_minus_iff eucl_le[where 'a='a])
 49.1735 +  done
 49.1736 +
 49.1737 +lemma has_integral_reflect_lemma[intro]:
 49.1738 +  assumes "(f has_integral i) {a..b}"
 49.1739 +  shows "((\<lambda>x. f(-x)) has_integral i) {-b..-a}"
 49.1740 +  using has_integral_affinity[OF assms, of "-1" 0]
 49.1741 +  by auto
 49.1742 +
 49.1743 +lemma has_integral_reflect[simp]:
 49.1744 +  "((\<lambda>x. f (-x)) has_integral i) {-b..-a} \<longleftrightarrow> (f has_integral i) {a..b}"
 49.1745 +  apply rule
 49.1746 +  apply (drule_tac[!] has_integral_reflect_lemma)
 49.1747 +  apply auto
 49.1748 +  done
 49.1749  
 49.1750  lemma integrable_reflect[simp]: "(\<lambda>x. f(-x)) integrable_on {-b..-a} \<longleftrightarrow> f integrable_on {a..b}"
 49.1751    unfolding integrable_on_def by auto
 49.1752  
 49.1753 -lemma integral_reflect[simp]: "integral {-b..-a} (\<lambda>x. f(-x)) = integral ({a..b}) f"
 49.1754 +lemma integral_reflect[simp]: "integral {-b..-a} (\<lambda>x. f (-x)) = integral {a..b} f"
 49.1755    unfolding integral_def by auto
 49.1756  
 49.1757 +
 49.1758  subsection {* Stronger form of FCT; quite a tedious proof. *}
 49.1759  
 49.1760 -lemma bgauge_existence_lemma: "(\<forall>x\<in>s. \<exists>d::real. 0 < d \<and> q d x) \<longleftrightarrow> (\<forall>x. \<exists>d>0. x\<in>s \<longrightarrow> q d x)" by(meson zero_less_one)
 49.1761 -
 49.1762 -lemma additive_tagged_division_1': fixes f::"real \<Rightarrow> 'a::real_normed_vector"
 49.1763 -  assumes "a \<le> b" "p tagged_division_of {a..b}"
 49.1764 +lemma bgauge_existence_lemma: "(\<forall>x\<in>s. \<exists>d::real. 0 < d \<and> q d x) \<longleftrightarrow> (\<forall>x. \<exists>d>0. x\<in>s \<longrightarrow> q d x)"
 49.1765 +  by (meson zero_less_one)
 49.1766 +
 49.1767 +lemma additive_tagged_division_1':
 49.1768 +  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
 49.1769 +  assumes "a \<le> b"
 49.1770 +    and "p tagged_division_of {a..b}"
 49.1771    shows "setsum (\<lambda>(x,k). f (interval_upperbound k) - f(interval_lowerbound k)) p = f b - f a"
 49.1772 -  using additive_tagged_division_1[OF _ assms(2), of f] using assms(1) by auto
 49.1773 -
 49.1774 -lemma split_minus[simp]:"(\<lambda>(x, k). f x k) x - (\<lambda>(x, k). g x k) x = (\<lambda>(x, k). f x k - g x k) x"
 49.1775 -  unfolding split_def by(rule refl)
 49.1776 +  using additive_tagged_division_1[OF _ assms(2), of f]
 49.1777 +  using assms(1)
 49.1778 +  by auto
 49.1779 +
 49.1780 +lemma split_minus[simp]: "(\<lambda>(x, k). f x k) x - (\<lambda>(x, k). g x k) x = (\<lambda>(x, k). f x k - g x k) x"
 49.1781 +  by (simp add: split_def)
 49.1782  
 49.1783  lemma norm_triangle_le_sub: "norm x + norm y \<le> e \<Longrightarrow> norm (x - y) \<le> e"
 49.1784 -  apply(subst(asm)(2) norm_minus_cancel[symmetric])
 49.1785 -  apply(drule norm_triangle_le) by(auto simp add:algebra_simps)
 49.1786 -
 49.1787 -lemma fundamental_theorem_of_calculus_interior: fixes f::"real => 'a::real_normed_vector"
 49.1788 -  assumes"a \<le> b" "continuous_on {a..b} f" "\<forall>x\<in>{a<..<b}. (f has_vector_derivative f'(x)) (at x)"
 49.1789 +  apply (subst(asm)(2) norm_minus_cancel[symmetric])
 49.1790 +  apply (drule norm_triangle_le)
 49.1791 +  apply (auto simp add: algebra_simps)
 49.1792 +  done
 49.1793 +
 49.1794 +lemma fundamental_theorem_of_calculus_interior:
 49.1795 +  fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
 49.1796 +  assumes "a \<le> b"
 49.1797 +    and "continuous_on {a..b} f"
 49.1798 +    and "\<forall>x\<in>{a<..<b}. (f has_vector_derivative f'(x)) (at x)"
 49.1799    shows "(f' has_integral (f b - f a)) {a..b}"
 49.1800 -proof- { presume *:"a < b \<Longrightarrow> ?thesis"
 49.1801 -    show ?thesis proof(cases,rule *,assumption)
 49.1802 -      assume "\<not> a < b" hence "a = b" using assms(1) by auto
 49.1803 -      hence *:"{a .. b} = {b}" "f b - f a = 0" by(auto simp add:  order_antisym)
 49.1804 -      show ?thesis unfolding *(2) apply(rule has_integral_null) unfolding content_eq_0 using * `a=b`
 49.1805 +proof -
 49.1806 +  {
 49.1807 +    presume *: "a < b \<Longrightarrow> ?thesis"
 49.1808 +    show ?thesis
 49.1809 +    proof (cases "a < b")
 49.1810 +      case True
 49.1811 +      then show ?thesis by (rule *)
 49.1812 +    next
 49.1813 +      case False
 49.1814 +      then have "a = b"
 49.1815 +        using assms(1) by auto
 49.1816 +      then have *: "{a .. b} = {b}" "f b - f a = 0"
 49.1817 +        by (auto simp add:  order_antisym)
 49.1818 +      show ?thesis
 49.1819 +        unfolding *(2)
 49.1820 +        apply (rule has_integral_null)
 49.1821 +        unfolding content_eq_0
 49.1822 +        using * `a = b`
 49.1823          by (auto simp: ex_in_conv)
 49.1824 -    qed } assume ab:"a < b"
 49.1825 +    qed
 49.1826 +  }
 49.1827 +  assume ab: "a < b"
 49.1828    let ?P = "\<lambda>e. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow>
 49.1829 -                   norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b})"
 49.1830 -  { presume "\<And>e. e>0 \<Longrightarrow> ?P e" thus ?thesis unfolding has_integral_factor_content by auto }
 49.1831 -  fix e::real assume e:"e>0"
 49.1832 +    norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b})"
 49.1833 +  { presume "\<And>e. e > 0 \<Longrightarrow> ?P e" then show ?thesis unfolding has_integral_factor_content by auto }
 49.1834 +  fix e :: real
 49.1835 +  assume e: "e > 0"
 49.1836    note assms(3)[unfolded has_vector_derivative_def has_derivative_at_alt ball_conj_distrib]
 49.1837 -  note conjunctD2[OF this] note bounded=this(1) and this(2)
 49.1838 -  from this(2) have "\<forall>x\<in>{a<..<b}. \<exists>d>0. \<forall>y. norm (y - x) < d \<longrightarrow> norm (f y - f x - (y - x) *\<^sub>R f' x) \<le> e/2 * norm (y - x)"
 49.1839 -    apply-apply safe apply(erule_tac x=x in ballE,erule_tac x="e/2" in allE) using e by auto note this[unfolded bgauge_existence_lemma]
 49.1840 -  from choice[OF this] guess d .. note conjunctD2[OF this[rule_format]] note d = this[rule_format]
 49.1841 -  have "bounded (f ` {a..b})" apply(rule compact_imp_bounded compact_continuous_image)+ using compact_interval assms by auto
 49.1842 +  note conjunctD2[OF this]
 49.1843 +  note bounded=this(1) and this(2)
 49.1844 +  from this(2) have "\<forall>x\<in>{a<..<b}. \<exists>d>0. \<forall>y. norm (y - x) < d \<longrightarrow>
 49.1845 +    norm (f y - f x - (y - x) *\<^sub>R f' x) \<le> e/2 * norm (y - x)"
 49.1846 +    apply -
 49.1847 +    apply safe
 49.1848 +    apply (erule_tac x=x in ballE)
 49.1849 +    apply (erule_tac x="e/2" in allE)
 49.1850 +    using e
 49.1851 +    apply auto
 49.1852 +    done
 49.1853 +  note this[unfolded bgauge_existence_lemma]
 49.1854 +  from choice[OF this] guess d ..
 49.1855 +  note conjunctD2[OF this[rule_format]]
 49.1856 +  note d = this[rule_format]
 49.1857 +  have "bounded (f ` {a..b})"
 49.1858 +    apply (rule compact_imp_bounded compact_continuous_image)+
 49.1859 +    using compact_interval assms
 49.1860 +    apply auto
 49.1861 +    done
 49.1862    from this[unfolded bounded_pos] guess B .. note B = this[rule_format]
 49.1863  
 49.1864 -  have "\<exists>da. 0 < da \<and> (\<forall>c. a \<le> c \<and> {a..c} \<subseteq> {a..b} \<and> {a..c} \<subseteq> ball a da
 49.1865 -    \<longrightarrow> norm(content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> (e * (b - a)) / 4)"
 49.1866 -  proof- have "a\<in>{a..b}" using ab by auto
 49.1867 +  have "\<exists>da. 0 < da \<and> (\<forall>c. a \<le> c \<and> {a..c} \<subseteq> {a..b} \<and> {a..c} \<subseteq> ball a da \<longrightarrow>
 49.1868 +    norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> (e * (b - a)) / 4)"
 49.1869 +  proof -
 49.1870 +    have "a \<in> {a..b}"
 49.1871 +      using ab by auto
 49.1872      note assms(2)[unfolded continuous_on_eq_continuous_within,rule_format,OF this]
 49.1873 -    note * = this[unfolded continuous_within Lim_within,rule_format] have "(e * (b - a)) / 8 > 0" using e ab by(auto simp add:field_simps)
 49.1874 +    note * = this[unfolded continuous_within Lim_within,rule_format]
 49.1875 +    have "(e * (b - a)) / 8 > 0"
 49.1876 +      using e ab by (auto simp add: field_simps)
 49.1877      from *[OF this] guess k .. note k = conjunctD2[OF this,rule_format]
 49.1878      have "\<exists>l. 0 < l \<and> norm(l *\<^sub>R f' a) \<le> (e * (b - a)) / 8"
 49.1879 -    proof(cases "f' a = 0") case True
 49.1880 -      thus ?thesis apply(rule_tac x=1 in exI) using ab e by(auto intro!:mult_nonneg_nonneg)
 49.1881 -    next case False thus ?thesis
 49.1882 -        apply(rule_tac x="(e * (b - a)) / 8 / norm (f' a)" in exI) using ab e by(auto simp add:field_simps)
 49.1883 -    qed then guess l .. note l = conjunctD2[OF this]
 49.1884 -    show ?thesis apply(rule_tac x="min k l" in exI) apply safe unfolding min_less_iff_conj apply(rule,(rule l k)+)
 49.1885 -    proof- fix c assume as:"a \<le> c" "{a..c} \<subseteq> {a..b}" "{a..c} \<subseteq> ball a (min k l)"
 49.1886 +    proof (cases "f' a = 0")
 49.1887 +      case True
 49.1888 +      then show ?thesis
 49.1889 +        apply (rule_tac x=1 in exI)
 49.1890 +        using ab e
 49.1891 +        apply (auto intro!:mult_nonneg_nonneg)
 49.1892 +        done
 49.1893 +    next
 49.1894 +      case False
 49.1895 +      then show ?thesis
 49.1896 +        apply (rule_tac x="(e * (b - a)) / 8 / norm (f' a)" in exI)
 49.1897 +        using ab e
 49.1898 +        apply (auto simp add: field_simps)
 49.1899 +        done
 49.1900 +    qed
 49.1901 +    then guess l .. note l = conjunctD2[OF this]
 49.1902 +    show ?thesis
 49.1903 +      apply (rule_tac x="min k l" in exI)
 49.1904 +      apply safe
 49.1905 +      unfolding min_less_iff_conj
 49.1906 +      apply rule
 49.1907 +      apply (rule l k)+
 49.1908 +    proof -
 49.1909 +      fix c
 49.1910 +      assume as: "a \<le> c" "{a..c} \<subseteq> {a..b}" "{a..c} \<subseteq> ball a (min k l)"
 49.1911        note as' = this[unfolded subset_eq Ball_def mem_ball dist_real_def mem_interval]
 49.1912 -      have "norm ((c - a) *\<^sub>R f' a - (f c - f a)) \<le> norm ((c - a) *\<^sub>R f' a) + norm (f c - f a)" by(rule norm_triangle_ineq4)
 49.1913 -      also have "... \<le> e * (b - a) / 8 + e * (b - a) / 8"
 49.1914 -      proof(rule add_mono) case goal1 have "\<bar>c - a\<bar> \<le> \<bar>l\<bar>" using as' by auto
 49.1915 -        thus ?case apply-apply(rule order_trans[OF _ l(2)]) unfolding norm_scaleR apply(rule mult_right_mono) by auto
 49.1916 -      next case goal2 show ?case apply(rule less_imp_le) apply(cases "a = c") defer
 49.1917 -          apply(rule k(2)[unfolded dist_norm]) using as' e ab by(auto simp add:field_simps)
 49.1918 -      qed finally show "norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> e * (b - a) / 4"
 49.1919 +      have "norm ((c - a) *\<^sub>R f' a - (f c - f a)) \<le> norm ((c - a) *\<^sub>R f' a) + norm (f c - f a)"
 49.1920 +        by (rule norm_triangle_ineq4)
 49.1921 +      also have "\<dots> \<le> e * (b - a) / 8 + e * (b - a) / 8"
 49.1922 +      proof (rule add_mono)
 49.1923 +        case goal1
 49.1924 +        have "\<bar>c - a\<bar> \<le> \<bar>l\<bar>"
 49.1925 +          using as' by auto
 49.1926 +        then show ?case
 49.1927 +          apply -
 49.1928 +          apply (rule order_trans[OF _ l(2)])
 49.1929 +          unfolding norm_scaleR
 49.1930 +          apply (rule mult_right_mono)
 49.1931 +          apply auto
 49.1932 +          done
 49.1933 +      next
 49.1934 +        case goal2
 49.1935 +        show ?case
 49.1936 +          apply (rule less_imp_le)
 49.1937 +          apply (cases "a = c")
 49.1938 +          defer
 49.1939 +          apply (rule k(2)[unfolded dist_norm])
 49.1940 +          using as' e ab
 49.1941 +          apply (auto simp add: field_simps)
 49.1942 +          done
 49.1943 +      qed
 49.1944 +      finally show "norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> e * (b - a) / 4"
 49.1945          unfolding content_real[OF as(1)] by auto
 49.1946 -    qed qed then guess da .. note da=conjunctD2[OF this,rule_format]
 49.1947 +    qed
 49.1948 +  qed
 49.1949 +  then guess da .. note da=conjunctD2[OF this,rule_format]
 49.1950  
 49.1951    have "\<exists>db>0. \<forall>c\<le>b. {c..b} \<subseteq> {a..b} \<and> {c..b} \<subseteq> ball b db \<longrightarrow>
 49.1952 -    norm(content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> (e * (b - a)) / 4"
 49.1953 -  proof- have "b\<in>{a..b}" using ab by auto
 49.1954 +    norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> (e * (b - a)) / 4"
 49.1955 +  proof -
 49.1956 +    have "b \<in> {a..b}"
 49.1957 +      using ab by auto
 49.1958      note assms(2)[unfolded continuous_on_eq_continuous_within,rule_format,OF this]
 49.1959      note * = this[unfolded continuous_within Lim_within,rule_format] have "(e * (b - a)) / 8 > 0"
 49.1960 -      using e ab by(auto simp add:field_simps)
 49.1961 +      using e ab by (auto simp add: field_simps)
 49.1962      from *[OF this] guess k .. note k = conjunctD2[OF this,rule_format]
 49.1963 -    have "\<exists>l. 0 < l \<and> norm(l *\<^sub>R f' b) \<le> (e * (b - a)) / 8"
 49.1964 -    proof(cases "f' b = 0") case True
 49.1965 -      thus ?thesis apply(rule_tac x=1 in exI) using ab e by(auto intro!:mult_nonneg_nonneg)
 49.1966 -    next case False thus ?thesis
 49.1967 -        apply(rule_tac x="(e * (b - a)) / 8 / norm (f' b)" in exI)
 49.1968 -        using ab e by(auto simp add:field_simps)
 49.1969 -    qed then guess l .. note l = conjunctD2[OF this]
 49.1970 -    show ?thesis apply(rule_tac x="min k l" in exI) apply safe unfolding min_less_iff_conj apply(rule,(rule l k)+)
 49.1971 -    proof- fix c assume as:"c \<le> b" "{c..b} \<subseteq> {a..b}" "{c..b} \<subseteq> ball b (min k l)"
 49.1972 +    have "\<exists>l. 0 < l \<and> norm (l *\<^sub>R f' b) \<le> (e * (b - a)) / 8"
 49.1973 +    proof (cases "f' b = 0")
 49.1974 +      case True
 49.1975 +      then show ?thesis
 49.1976 +        apply (rule_tac x=1 in exI)
 49.1977 +        using ab e
 49.1978 +        apply (auto intro!: mult_nonneg_nonneg)
 49.1979 +        done
 49.1980 +    next
 49.1981 +      case False
 49.1982 +      then show ?thesis
 49.1983 +        apply (rule_tac x="(e * (b - a)) / 8 / norm (f' b)" in exI)
 49.1984 +        using ab e
 49.1985 +        apply (auto simp add: field_simps)
 49.1986 +        done
 49.1987 +    qed
 49.1988 +    then guess l .. note l = conjunctD2[OF this]
 49.1989 +    show ?thesis
 49.1990 +      apply (rule_tac x="min k l" in exI)
 49.1991 +      apply safe
 49.1992 +      unfolding min_less_iff_conj
 49.1993 +      apply rule
 49.1994 +      apply (rule l k)+
 49.1995 +    proof -
 49.1996 +      fix c
 49.1997 +      assume as: "c \<le> b" "{c..b} \<subseteq> {a..b}" "{c..b} \<subseteq> ball b (min k l)"
 49.1998        note as' = this[unfolded subset_eq Ball_def mem_ball dist_real_def mem_interval]
 49.1999 -      have "norm ((b - c) *\<^sub>R f' b - (f b - f c)) \<le> norm ((b - c) *\<^sub>R f' b) + norm (f b - f c)" by(rule norm_triangle_ineq4)
 49.2000 -      also have "... \<le> e * (b - a) / 8 + e * (b - a) / 8"
 49.2001 -      proof(rule add_mono) case goal1 have "\<bar>c - b\<bar> \<le> \<bar>l\<bar>" using as' by auto
 49.2002 -        thus ?case apply-apply(rule order_trans[OF _ l(2)]) unfolding norm_scaleR apply(rule mult_right_mono) by auto
 49.2003 -      next case goal2 show ?case apply(rule less_imp_le) apply(cases "b = c") defer apply(subst norm_minus_commute)
 49.2004 -          apply(rule k(2)[unfolded dist_norm]) using as' e ab by(auto simp add:field_simps)
 49.2005 -      qed finally show "norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> e * (b - a) / 4"
 49.2006 +      have "norm ((b - c) *\<^sub>R f' b - (f b - f c)) \<le> norm ((b - c) *\<^sub>R f' b) + norm (f b - f c)"
 49.2007 +        by (rule norm_triangle_ineq4)
 49.2008 +      also have "\<dots> \<le> e * (b - a) / 8 + e * (b - a) / 8"
 49.2009 +      proof (rule add_mono)
 49.2010 +        case goal1
 49.2011 +        have "\<bar>c - b\<bar> \<le> \<bar>l\<bar>"
 49.2012 +          using as' by auto
 49.2013 +        then show ?case
 49.2014 +          apply -
 49.2015 +          apply (rule order_trans[OF _ l(2)])
 49.2016 +          unfolding norm_scaleR
 49.2017 +          apply (rule mult_right_mono)
 49.2018 +          apply auto
 49.2019 +          done
 49.2020 +      next
 49.2021 +        case goal2
 49.2022 +        show ?case
 49.2023 +          apply (rule less_imp_le)
 49.2024 +          apply (cases "b = c")
 49.2025 +          defer
 49.2026 +          apply (subst norm_minus_commute)
 49.2027 +          apply (rule k(2)[unfolded dist_norm])
 49.2028 +          using as' e ab
 49.2029 +          apply (auto simp add: field_simps)
 49.2030 +          done
 49.2031 +      qed
 49.2032 +      finally show "norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> e * (b - a) / 4"
 49.2033          unfolding content_real[OF as(1)] by auto
 49.2034 -    qed qed then guess db .. note db=conjunctD2[OF this,rule_format]
 49.2035 +    qed
 49.2036 +  qed
 49.2037 +  then guess db .. note db=conjunctD2[OF this,rule_format]
 49.2038  
 49.2039    let ?d = "(\<lambda>x. ball x (if x=a then da else if x=b then db else d x))"
 49.2040 -  show "?P e" apply(rule_tac x="?d" in exI)
 49.2041 -  proof safe case goal1 show ?case apply(rule gauge_ball_dependent) using ab db(1) da(1) d(1) by auto
 49.2042 -  next case goal2 note as=this let ?A = "{t. fst t \<in> {a, b}}" note p = tagged_division_ofD[OF goal2(1)]
 49.2043 -    have pA:"p = (p \<inter> ?A) \<union> (p - ?A)" "finite (p \<inter> ?A)" "finite (p - ?A)" "(p \<inter> ?A) \<inter> (p - ?A) = {}"  using goal2 by auto
 49.2044 +  show "?P e"
 49.2045 +    apply (rule_tac x="?d" in exI)
 49.2046 +  proof safe
 49.2047 +    case goal1
 49.2048 +    show ?case
 49.2049 +      apply (rule gauge_ball_dependent)
 49.2050 +      using ab db(1) da(1) d(1)
 49.2051 +      apply auto
 49.2052 +      done
 49.2053 +  next
 49.2054 +    case goal2
 49.2055 +    note as=this
 49.2056 +    let ?A = "{t. fst t \<in> {a, b}}"
 49.2057 +    note p = tagged_division_ofD[OF goal2(1)]
 49.2058 +    have pA: "p = (p \<inter> ?A) \<union> (p - ?A)" "finite (p \<inter> ?A)" "finite (p - ?A)" "(p \<inter> ?A) \<inter> (p - ?A) = {}"
 49.2059 +      using goal2 by auto
 49.2060      note * = additive_tagged_division_1'[OF assms(1) goal2(1), symmetric]
 49.2061 -    have **:"\<And>n1 s1 n2 s2::real. n2 \<le> s2 / 2 \<Longrightarrow> n1 - s1 \<le> s2 / 2 \<Longrightarrow> n1 + n2 \<le> s1 + s2" by arith
 49.2062 -    show ?case unfolding content_real[OF assms(1)] and *[of "\<lambda>x. x"] *[of f] setsum_subtractf[symmetric] split_minus
 49.2063 -      unfolding setsum_right_distrib apply(subst(2) pA,subst pA) unfolding setsum_Un_disjoint[OF pA(2-)]
 49.2064 -    proof(rule norm_triangle_le,rule **)
 49.2065 -      case goal1 show ?case apply(rule order_trans,rule setsum_norm_le) defer apply(subst setsum_divide_distrib)
 49.2066 -      proof(rule order_refl,safe,unfold not_le o_def split_conv fst_conv,rule ccontr) fix x k assume as:"(x,k) \<in> p"
 49.2067 -          "e * (interval_upperbound k -  interval_lowerbound k) / 2
 49.2068 -          < norm (content k *\<^sub>R f' x - (f (interval_upperbound k) - f (interval_lowerbound k)))"
 49.2069 -        from p(4)[OF this(1)] guess u v apply-by(erule exE)+ note k=this
 49.2070 -        hence "u \<le> v" and uv:"{u,v}\<subseteq>{u..v}" using p(2)[OF as(1)] by auto
 49.2071 +    have **: "\<And>n1 s1 n2 s2::real. n2 \<le> s2 / 2 \<Longrightarrow> n1 - s1 \<le> s2 / 2 \<Longrightarrow> n1 + n2 \<le> s1 + s2"
 49.2072 +      by arith
 49.2073 +    show ?case
 49.2074 +      unfolding content_real[OF assms(1)] and *[of "\<lambda>x. x"] *[of f] setsum_subtractf[symmetric] split_minus
 49.2075 +      unfolding setsum_right_distrib
 49.2076 +      apply (subst(2) pA)
 49.2077 +      apply (subst pA)
 49.2078 +      unfolding setsum_Un_disjoint[OF pA(2-)]
 49.2079 +    proof (rule norm_triangle_le, rule **)
 49.2080 +      case goal1
 49.2081 +      show ?case
 49.2082 +        apply (rule order_trans)
 49.2083 +        apply (rule setsum_norm_le)
 49.2084 +        defer
 49.2085 +        apply (subst setsum_divide_distrib)
 49.2086 +        apply (rule order_refl)
 49.2087 +        apply safe
 49.2088 +        apply (unfold not_le o_def split_conv fst_conv)
 49.2089 +      proof (rule ccontr)
 49.2090 +        fix x k
 49.2091 +        assume as: "(x, k) \<in> p"
 49.2092 +          "e * (interval_upperbound k -  interval_lowerbound k) / 2 <
 49.2093 +            norm (content k *\<^sub>R f' x - (f (interval_upperbound k) - f (interval_lowerbound k)))"
 49.2094 +        from p(4)[OF this(1)] guess u v by (elim exE) note k=this
 49.2095 +        then have "u \<le> v" and uv: "{u, v} \<subseteq> {u..v}"
 49.2096 +          using p(2)[OF as(1)] by auto
 49.2097          note result = as(2)[unfolded k interval_bounds_real[OF this(1)] content_real[OF this(1)]]
 49.2098  
 49.2099 -        assume as':"x \<noteq> a" "x \<noteq> b" hence "x \<in> {a<..<b}" using p(2-3)[OF as(1)] by auto
 49.2100 +        assume as': "x \<noteq> a" "x \<noteq> b"
 49.2101 +        then have "x \<in> {a<..<b}"
 49.2102 +          using p(2-3)[OF as(1)] by auto
 49.2103          note  * = d(2)[OF this]
 49.2104          have "norm ((v - u) *\<^sub>R f' (x) - (f (v) - f (u))) =
 49.2105            norm ((f (u) - f (x) - (u - x) *\<^sub>R f' (x)) - (f (v) - f (x) - (v - x) *\<^sub>R f' (x)))"
 49.2106 -          apply(rule arg_cong[of _ _ norm]) unfolding scaleR_left.diff by auto
 49.2107 -        also have "... \<le> e / 2 * norm (u - x) + e / 2 * norm (v - x)" apply(rule norm_triangle_le_sub)
 49.2108 -          apply(rule add_mono) apply(rule_tac[!] *) using fineD[OF goal2(2) as(1)] as' unfolding k subset_eq
 49.2109 -          apply- apply(erule_tac x=u in ballE,erule_tac[3] x=v in ballE) using uv by(auto simp:dist_real_def)
 49.2110 -        also have "... \<le> e / 2 * norm (v - u)" using p(2)[OF as(1)] unfolding k by(auto simp add:field_simps)
 49.2111 +          apply (rule arg_cong[of _ _ norm])
 49.2112 +          unfolding scaleR_left.diff
 49.2113 +          apply auto
 49.2114 +          done
 49.2115 +        also have "\<dots> \<le> e / 2 * norm (u - x) + e / 2 * norm (v - x)"
 49.2116 +          apply (rule norm_triangle_le_sub)
 49.2117 +          apply (rule add_mono)
 49.2118 +          apply (rule_tac[!] *)
 49.2119 +          using fineD[OF goal2(2) as(1)] as'
 49.2120 +          unfolding k subset_eq
 49.2121 +          apply -
 49.2122 +          apply (erule_tac x=u in ballE)
 49.2123 +          apply (erule_tac[3] x=v in ballE)
 49.2124 +          using uv
 49.2125 +          apply (auto simp:dist_real_def)
 49.2126 +          done
 49.2127 +        also have "\<dots> \<le> e / 2 * norm (v - u)"
 49.2128 +          using p(2)[OF as(1)]
 49.2129 +          unfolding k
 49.2130 +          by (auto simp add: field_simps)
 49.2131          finally have "e * (v - u) / 2 < e * (v - u) / 2"
 49.2132 -          apply- apply(rule less_le_trans[OF result]) using uv by auto thus False by auto qed
 49.2133 -
 49.2134 -    next have *:"\<And>x s1 s2::real. 0 \<le> s1 \<Longrightarrow> x \<le> (s1 + s2) / 2 \<Longrightarrow> x - s1 \<le> s2 / 2" by auto
 49.2135 -      case goal2 show ?case apply(rule *) apply(rule setsum_nonneg) apply(rule,unfold split_paired_all split_conv)
 49.2136 -        defer unfolding setsum_Un_disjoint[OF pA(2-),symmetric] pA(1)[symmetric] unfolding setsum_right_distrib[symmetric]
 49.2137 -        apply(subst additive_tagged_division_1[OF _ as(1)]) apply(rule assms)
 49.2138 -      proof- fix x k assume "(x,k) \<in> p \<inter> {t. fst t \<in> {a, b}}" note xk=IntD1[OF this]
 49.2139 -        from p(4)[OF this] guess u v apply-by(erule exE)+ note uv=this
 49.2140 -        with p(2)[OF xk] have "{u..v} \<noteq> {}" by auto
 49.2141 -        thus "0 \<le> e * ((interval_upperbound k) - (interval_lowerbound k))"
 49.2142 -          unfolding uv using e by(auto simp add:field_simps)
 49.2143 -      next have *:"\<And>s f t e. setsum f s = setsum f t \<Longrightarrow> norm(setsum f t) \<le> e \<Longrightarrow> norm(setsum f s) \<le> e" by auto
 49.2144 +          apply -
 49.2145 +          apply (rule less_le_trans[OF result])
 49.2146 +          using uv
 49.2147 +          apply auto
 49.2148 +          done
 49.2149 +        then show False by auto
 49.2150 +      qed
 49.2151 +    next
 49.2152 +      have *: "\<And>x s1 s2::real. 0 \<le> s1 \<Longrightarrow> x \<le> (s1 + s2) / 2 \<Longrightarrow> x - s1 \<le> s2 / 2"
 49.2153 +        by auto
 49.2154 +      case goal2
 49.2155 +      show ?case
 49.2156 +        apply (rule *)
 49.2157 +        apply (rule setsum_nonneg)
 49.2158 +        apply rule
 49.2159 +        apply (unfold split_paired_all split_conv)
 49.2160 +        defer
 49.2161 +        unfolding setsum_Un_disjoint[OF pA(2-),symmetric] pA(1)[symmetric]
 49.2162 +        unfolding setsum_right_distrib[symmetric]
 49.2163 +        apply (subst additive_tagged_division_1[OF _ as(1)])
 49.2164 +        apply (rule assms)
 49.2165 +      proof -
 49.2166 +        fix x k
 49.2167 +        assume "(x, k) \<in> p \<inter> {t. fst t \<in> {a, b}}"
 49.2168 +        note xk=IntD1[OF this]
 49.2169 +        from p(4)[OF this] guess u v by (elim exE) note uv=this
 49.2170 +        with p(2)[OF xk] have "{u..v} \<noteq> {}"
 49.2171 +          by auto
 49.2172 +        then show "0 \<le> e * ((interval_upperbound k) - (interval_lowerbound k))"
 49.2173 +          unfolding uv using e by (auto simp add: field_simps)
 49.2174 +      next
 49.2175 +        have *: "\<And>s f t e. setsum f s = setsum f t \<Longrightarrow> norm (setsum f t) \<le> e \<Longrightarrow> norm (setsum f s) \<le> e"
 49.2176 +          by auto
 49.2177          show "norm (\<Sum>(x, k)\<in>p \<inter> ?A. content k *\<^sub>R f' x -
 49.2178            (f ((interval_upperbound k)) - f ((interval_lowerbound k)))) \<le> e * (b - a) / 2"
 49.2179 -          apply(rule *[where t="p \<inter> {t. fst t \<in> {a, b} \<and> content(snd t) \<noteq> 0}"])
 49.2180 -          apply(rule setsum_mono_zero_right[OF pA(2)]) defer apply(rule) unfolding split_paired_all split_conv o_def
 49.2181 -        proof- fix x k assume "(x,k) \<in> p \<inter> {t. fst t \<in> {a, b}} - p \<inter> {t. fst t \<in> {a, b} \<and> content (snd t) \<noteq> 0}"
 49.2182 -          hence xk:"(x,k)\<in>p" "content k = 0" by auto from p(4)[OF xk(1)] guess u v apply-by(erule exE)+ note uv=this
 49.2183 -          have "k\<noteq>{}" using p(2)[OF xk(1)] by auto hence *:"u = v" using xk
 49.2184 -            unfolding uv content_eq_0 interval_eq_empty by auto
 49.2185 -          thus "content k *\<^sub>R (f' (x)) - (f ((interval_upperbound k)) - f ((interval_lowerbound k))) = 0" using xk unfolding uv by auto
 49.2186 -        next have *:"p \<inter> {t. fst t \<in> {a, b} \<and> content(snd t) \<noteq> 0} =
 49.2187 -            {t. t\<in>p \<and> fst t = a \<and> content(snd t) \<noteq> 0} \<union> {t. t\<in>p \<and> fst t = b \<and> content(snd t) \<noteq> 0}" by blast
 49.2188 -          have **:"\<And>s f. \<And>e::real. (\<forall>x y. x \<in> s \<and> y \<in> s \<longrightarrow> x = y) \<Longrightarrow> (\<forall>x. x \<in> s \<longrightarrow> norm(f x) \<le> e)
 49.2189 -            \<Longrightarrow> e>0 \<Longrightarrow> norm(setsum f s) \<le> e"
 49.2190 -          proof(case_tac "s={}") case goal2 then obtain x where "x\<in>s" by auto hence *:"s = {x}" using goal2(1) by auto
 49.2191 -            thus ?case using `x\<in>s` goal2(2) by auto
 49.2192 +          apply (rule *[where t="p \<inter> {t. fst t \<in> {a, b} \<and> content(snd t) \<noteq> 0}"])
 49.2193 +          apply (rule setsum_mono_zero_right[OF pA(2)])
 49.2194 +          defer
 49.2195 +          apply rule
 49.2196 +          unfolding split_paired_all split_conv o_def
 49.2197 +        proof -
 49.2198 +          fix x k
 49.2199 +          assume "(x, k) \<in> p \<inter> {t. fst t \<in> {a, b}} - p \<inter> {t. fst t \<in> {a, b} \<and> content (snd t) \<noteq> 0}"
 49.2200 +          then have xk: "(x, k) \<in> p" "content k = 0"
 49.2201 +            by auto
 49.2202 +          from p(4)[OF xk(1)] guess u v by (elim exE) note uv=this
 49.2203 +          have "k \<noteq> {}"
 49.2204 +            using p(2)[OF xk(1)] by auto
 49.2205 +          then have *: "u = v"
 49.2206 +            using xk
 49.2207 +            unfolding uv content_eq_0 interval_eq_empty
 49.2208 +            by auto
 49.2209 +          then show "content k *\<^sub>R (f' (x)) - (f ((interval_upperbound k)) - f ((interval_lowerbound k))) = 0"
 49.2210 +            using xk unfolding uv by auto
 49.2211 +        next
 49.2212 +          have *: "p \<inter> {t. fst t \<in> {a, b} \<and> content(snd t) \<noteq> 0} =
 49.2213 +            {t. t\<in>p \<and> fst t = a \<and> content(snd t) \<noteq> 0} \<union> {t. t\<in>p \<and> fst t = b \<and> content(snd t) \<noteq> 0}"
 49.2214 +            by blast
 49.2215 +          have **: "\<And>s f. \<And>e::real. (\<forall>x y. x \<in> s \<and> y \<in> s \<longrightarrow> x = y) \<Longrightarrow>
 49.2216 +            (\<forall>x. x \<in> s \<longrightarrow> norm (f x) \<le> e) \<Longrightarrow> e > 0 \<Longrightarrow> norm (setsum f s) \<le> e"
 49.2217 +          proof (case_tac "s = {}")
 49.2218 +            case goal2
 49.2219 +            then obtain x where "x \<in> s"
 49.2220 +              by auto
 49.2221 +            then have *: "s = {x}"
 49.2222 +              using goal2(1) by auto
 49.2223 +            then show ?case
 49.2224 +              using `x \<in> s` goal2(2) by auto
 49.2225            qed auto
 49.2226 -          case goal2 show ?case apply(subst *, subst setsum_Un_disjoint) prefer 4
 49.2227 -            apply(rule order_trans[of _ "e * (b - a)/4 + e * (b - a)/4"])
 49.2228 -            apply(rule norm_triangle_le,rule add_mono) apply(rule_tac[1-2] **)
 49.2229 -          proof- let ?B = "\<lambda>x. {t \<in> p. fst t = x \<and> content (snd t) \<noteq> 0}"
 49.2230 -            have pa:"\<And>k. (a, k) \<in> p \<Longrightarrow> \<exists>v. k = {a .. v} \<and> a \<le> v"
 49.2231 -            proof- case goal1 guess u v using p(4)[OF goal1] apply-by(erule exE)+ note uv=this
 49.2232 -              have *:"u \<le> v" using p(2)[OF goal1] unfolding uv by auto
 49.2233 -              have u:"u = a" proof(rule ccontr)  have "u \<in> {u..v}" using p(2-3)[OF goal1(1)] unfolding uv by auto
 49.2234 -                have "u \<ge> a" using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto moreover assume "u\<noteq>a" ultimately
 49.2235 -                have "u > a" by auto
 49.2236 -                thus False using p(2)[OF goal1(1)] unfolding uv by(auto simp add:)
 49.2237 -              qed thus ?case apply(rule_tac x=v in exI) unfolding uv using * by auto
 49.2238 +          case goal2
 49.2239 +          show ?case
 49.2240 +            apply (subst *)
 49.2241 +            apply (subst setsum_Un_disjoint)
 49.2242 +            prefer 4
 49.2243 +            apply (rule order_trans[of _ "e * (b - a)/4 + e * (b - a)/4"])
 49.2244 +            apply (rule norm_triangle_le,rule add_mono)
 49.2245 +            apply (rule_tac[1-2] **)
 49.2246 +          proof -
 49.2247 +            let ?B = "\<lambda>x. {t \<in> p. fst t = x \<and> content (snd t) \<noteq> 0}"
 49.2248 +            have pa: "\<And>k. (a, k) \<in> p \<Longrightarrow> \<exists>v. k = {a .. v} \<and> a \<le> v"
 49.2249 +            proof -
 49.2250 +              case goal1
 49.2251 +              guess u v using p(4)[OF goal1] by (elim exE) note uv=this
 49.2252 +              have *: "u \<le> v"
 49.2253 +                using p(2)[OF goal1] unfolding uv by auto
 49.2254 +              have u: "u = a"
 49.2255 +              proof (rule ccontr)
 49.2256 +                have "u \<in> {u..v}"
 49.2257 +                  using p(2-3)[OF goal1(1)] unfolding uv by auto
 49.2258 +                have "u \<ge> a"
 49.2259 +                  using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto
 49.2260 +                moreover assume "u \<noteq> a"
 49.2261 +                ultimately have "u > a" by auto
 49.2262 +                then show False
 49.2263 +                  using p(2)[OF goal1(1)] unfolding uv by (auto simp add:)
 49.2264 +              qed
 49.2265 +              then show ?case
 49.2266 +                apply (rule_tac x=v in exI)
 49.2267 +                unfolding uv
 49.2268 +                using *
 49.2269 +                apply auto
 49.2270 +                done
 49.2271              qed
 49.2272 -            have pb:"\<And>k. (b, k) \<in> p \<Longrightarrow> \<exists>v. k = {v .. b} \<and> b \<ge> v"
 49.2273 -            proof- case goal1 guess u v using p(4)[OF goal1] apply-by(erule exE)+ note uv=this
 49.2274 -              have *:"u \<le> v" using p(2)[OF goal1] unfolding uv by auto
 49.2275 -              have u:"v =  b" proof(rule ccontr)  have "u \<in> {u..v}" using p(2-3)[OF goal1(1)] unfolding uv by auto
 49.2276 -                have "v \<le>  b" using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto moreover assume "v\<noteq> b" ultimately
 49.2277 -                have "v <  b" by auto
 49.2278 -                thus False using p(2)[OF goal1(1)] unfolding uv by(auto simp add:)
 49.2279 -              qed thus ?case apply(rule_tac x=u in exI) unfolding uv using * by auto
 49.2280 +            have pb: "\<And>k. (b, k) \<in> p \<Longrightarrow> \<exists>v. k = {v .. b} \<and> b \<ge> v"
 49.2281 +            proof -
 49.2282 +              case goal1
 49.2283 +              guess u v using p(4)[OF goal1] by (elim exE) note uv=this
 49.2284 +              have *: "u \<le> v"
 49.2285 +                using p(2)[OF goal1] unfolding uv by auto
 49.2286 +              have u: "v =  b"
 49.2287 +              proof (rule ccontr)
 49.2288 +                have "u \<in> {u..v}"
 49.2289 +                  using p(2-3)[OF goal1(1)] unfolding uv by auto
 49.2290 +                have "v \<le> b"
 49.2291 +                  using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto
 49.2292 +                moreover assume "v \<noteq> b"
 49.2293 +                ultimately have "v < b" by auto
 49.2294 +                then show False
 49.2295 +                  using p(2)[OF goal1(1)] unfolding uv by (auto simp add:)
 49.2296 +              qed
 49.2297 +              then show ?case
 49.2298 +                apply (rule_tac x=u in exI)
 49.2299 +                unfolding uv
 49.2300 +                using *
 49.2301 +                apply auto
 49.2302 +                done
 49.2303              qed
 49.2304 -
 49.2305 -            show "\<forall>x y. x \<in> ?B a \<and> y \<in> ?B a \<longrightarrow> x = y" apply(rule,rule,rule,unfold split_paired_all)
 49.2306 -              unfolding mem_Collect_eq fst_conv snd_conv apply safe
 49.2307 -            proof- fix x k k' assume k:"( a, k) \<in> p" "( a, k') \<in> p" "content k \<noteq> 0" "content k' \<noteq> 0"
 49.2308 +            show "\<forall>x y. x \<in> ?B a \<and> y \<in> ?B a \<longrightarrow> x = y"
 49.2309 +              apply (rule,rule,rule,unfold split_paired_all)
 49.2310 +              unfolding mem_Collect_eq fst_conv snd_conv
 49.2311 +              apply safe
 49.2312 +            proof -
 49.2313 +              fix x k k'
 49.2314 +              assume k: "(a, k) \<in> p" "(a, k') \<in> p" "content k \<noteq> 0" "content k' \<noteq> 0"
 49.2315                guess v using pa[OF k(1)] .. note v = conjunctD2[OF this]
 49.2316 -              guess v' using pa[OF k(2)] .. note v' = conjunctD2[OF this] let ?v = " (min (v) (v'))"
 49.2317 -              have "{ a <..< ?v} \<subseteq> k \<inter> k'" unfolding v v' by(auto simp add:) note interior_mono[OF this,unfolded interior_inter]
 49.2318 -              moreover have " ((a + ?v)/2) \<in> { a <..< ?v}" using k(3-)
 49.2319 -                unfolding v v' content_eq_0 not_le by(auto simp add:not_le)
 49.2320 -              ultimately have " ((a + ?v)/2) \<in> interior k \<inter> interior k'" unfolding interior_open[OF open_interval] by auto
 49.2321 -              hence *:"k = k'" apply- apply(rule ccontr) using p(5)[OF k(1-2)] by auto
 49.2322 -              { assume "x\<in>k" thus "x\<in>k'" unfolding * . } { assume "x\<in>k'" thus "x\<in>k" unfolding * . }
 49.2323 +              guess v' using pa[OF k(2)] .. note v' = conjunctD2[OF this] let ?v = "min v v'"
 49.2324 +              have "{a <..< ?v} \<subseteq> k \<inter> k'"
 49.2325 +                unfolding v v' by (auto simp add:)
 49.2326 +              note interior_mono[OF this,unfolded interior_inter]
 49.2327 +              moreover have "(a + ?v)/2 \<in> { a <..< ?v}"
 49.2328 +                using k(3-)
 49.2329 +                unfolding v v' content_eq_0 not_le
 49.2330 +                by (auto simp add: not_le)
 49.2331 +              ultimately have "(a + ?v)/2 \<in> interior k \<inter> interior k'"
 49.2332 +                unfolding interior_open[OF open_interval] by auto
 49.2333 +              then have *: "k = k'"
 49.2334 +                apply -
 49.2335 +                apply (rule ccontr)
 49.2336 +                using p(5)[OF k(1-2)]
 49.2337 +                apply auto
 49.2338 +                done
 49.2339 +              { assume "x \<in> k" then show "x \<in> k'" unfolding * . }
 49.2340 +              { assume "x \<in> k'" then show "x\<in>k" unfolding * . }
 49.2341              qed
 49.2342 -            show "\<forall>x y. x \<in> ?B b \<and> y \<in> ?B b \<longrightarrow> x = y" apply(rule,rule,rule,unfold split_paired_all)
 49.2343 -              unfolding mem_Collect_eq fst_conv snd_conv apply safe
 49.2344 -            proof- fix x k k' assume k:"( b, k) \<in> p" "( b, k') \<in> p" "content k \<noteq> 0" "content k' \<noteq> 0"
 49.2345 +            show "\<forall>x y. x \<in> ?B b \<and> y \<in> ?B b \<longrightarrow> x = y"
 49.2346 +              apply rule
 49.2347 +              apply rule
 49.2348 +              apply rule
 49.2349 +              apply (unfold split_paired_all)
 49.2350 +              unfolding mem_Collect_eq fst_conv snd_conv
 49.2351 +              apply safe
 49.2352 +            proof -
 49.2353 +              fix x k k'
 49.2354 +              assume k: "(b, k) \<in> p" "(b, k') \<in> p" "content k \<noteq> 0" "content k' \<noteq> 0"
 49.2355                guess v using pb[OF k(1)] .. note v = conjunctD2[OF this]
 49.2356 -              guess v' using pb[OF k(2)] .. note v' = conjunctD2[OF this] let ?v = " (max (v) (v'))"
 49.2357 -              have "{?v <..<  b} \<subseteq> k \<inter> k'" unfolding v v' by(auto simp add:) note interior_mono[OF this,unfolded interior_inter]
 49.2358 -              moreover have " ((b + ?v)/2) \<in> {?v <..<  b}" using k(3-) unfolding v v' content_eq_0 not_le by auto
 49.2359 -              ultimately have " ((b + ?v)/2) \<in> interior k \<inter> interior k'" unfolding interior_open[OF open_interval] by auto
 49.2360 -              hence *:"k = k'" apply- apply(rule ccontr) using p(5)[OF k(1-2)] by auto
 49.2361 -              { assume "x\<in>k" thus "x\<in>k'" unfolding * . } { assume "x\<in>k'" thus "x\<in>k" unfolding * . }
 49.2362 +              guess v' using pb[OF k(2)] .. note v' = conjunctD2[OF this]
 49.2363 +              let ?v = "max v v'"
 49.2364 +              have "{?v <..< b} \<subseteq> k \<inter> k'"
 49.2365 +                unfolding v v' by auto
 49.2366 +                note interior_mono[OF this,unfolded interior_inter]
 49.2367 +              moreover have " ((b + ?v)/2) \<in> {?v <..<  b}"
 49.2368 +                using k(3-) unfolding v v' content_eq_0 not_le by auto
 49.2369 +              ultimately have " ((b + ?v)/2) \<in> interior k \<inter> interior k'"
 49.2370 +                unfolding interior_open[OF open_interval] by auto
 49.2371 +              then have *: "k = k'"
 49.2372 +                apply -
 49.2373 +                apply (rule ccontr)
 49.2374 +                using p(5)[OF k(1-2)]
 49.2375 +                apply auto
 49.2376 +                done
 49.2377 +              { assume "x \<in> k" then show "x \<in> k'" unfolding * . }
 49.2378 +              { assume "x \<in> k'" then show "x\<in>k" unfolding * . }
 49.2379              qed
 49.2380  
 49.2381              let ?a = a and ?b = b (* a is something else while proofing the next theorem. *)
 49.2382 -            show "\<forall>x. x \<in> ?B a \<longrightarrow> norm ((\<lambda>(x, k). content k *\<^sub>R f' (x) - (f ((interval_upperbound k)) -
 49.2383 -              f ((interval_lowerbound k)))) x) \<le> e * (b - a) / 4" apply(rule,rule) unfolding mem_Collect_eq
 49.2384 +            show "\<forall>x. x \<in> ?B a \<longrightarrow> norm ((\<lambda>(x, k). content k *\<^sub>R f' x - (f (interval_upperbound k) -
 49.2385 +              f (interval_lowerbound k))) x) \<le> e * (b - a) / 4"
 49.2386 +              apply rule
 49.2387 +              apply rule
 49.2388 +              unfolding mem_Collect_eq
 49.2389                unfolding split_paired_all fst_conv snd_conv
 49.2390 -            proof safe case goal1 guess v using pa[OF goal1(1)] .. note v = conjunctD2[OF this]
 49.2391 -              have " ?a\<in>{ ?a..v}" using v(2) by auto hence "v \<le> ?b" using p(3)[OF goal1(1)] unfolding subset_eq v by auto
 49.2392 -              moreover have "{?a..v} \<subseteq> ball ?a da" using fineD[OF as(2) goal1(1)]
 49.2393 -                apply-apply(subst(asm) if_P,rule refl) unfolding subset_eq apply safe apply(erule_tac x=" x" in ballE)
 49.2394 -                by(auto simp add:subset_eq dist_real_def v) ultimately
 49.2395 -              show ?case unfolding v interval_bounds_real[OF v(2)] apply- apply(rule da(2)[of "v"])
 49.2396 -                using goal1 fineD[OF as(2) goal1(1)] unfolding v content_eq_0 by auto
 49.2397 +            proof safe
 49.2398 +              case goal1
 49.2399 +              guess v using pa[OF goal1(1)] .. note v = conjunctD2[OF this]
 49.2400 +              have "?a \<in> {?a..v}"
 49.2401 +                using v(2) by auto
 49.2402 +              then have "v \<le> ?b"
 49.2403 +                using p(3)[OF goal1(1)] unfolding subset_eq v by auto
 49.2404 +              moreover have "{?a..v} \<subseteq> ball ?a da"
 49.2405 +                using fineD[OF as(2) goal1(1)]
 49.2406 +                apply -
 49.2407 +                apply (subst(asm) if_P)
 49.2408 +                apply (rule refl)
 49.2409 +                unfolding subset_eq
 49.2410 +                apply safe
 49.2411 +                apply (erule_tac x=" x" in ballE)
 49.2412 +                apply (auto simp add:subset_eq dist_real_def v)
 49.2413 +                done
 49.2414 +              ultimately show ?case
 49.2415 +                unfolding v interval_bounds_real[OF v(2)]
 49.2416 +                apply -
 49.2417 +                apply(rule da(2)[of "v"])
 49.2418 +                using goal1 fineD[OF as(2) goal1(1)]
 49.2419 +                unfolding v content_eq_0
 49.2420 +                apply auto
 49.2421 +                done
 49.2422              qed
 49.2423 -            show "\<forall>x. x \<in> ?B b \<longrightarrow> norm ((\<lambda>(x, k). content k *\<^sub>R f' (x) -
 49.2424 -              (f ((interval_upperbound k)) - f ((interval_lowerbound k)))) x) \<le> e * (b - a) / 4"
 49.2425 -              apply(rule,rule) unfolding mem_Collect_eq unfolding split_paired_all fst_conv snd_conv
 49.2426 -            proof safe case goal1 guess v using pb[OF goal1(1)] .. note v = conjunctD2[OF this]
 49.2427 -              have " ?b\<in>{v.. ?b}" using v(2) by auto hence "v \<ge> ?a" using p(3)[OF goal1(1)]
 49.2428 +            show "\<forall>x. x \<in> ?B b \<longrightarrow> norm ((\<lambda>(x, k). content k *\<^sub>R f' x -
 49.2429 +              (f (interval_upperbound k) - f (interval_lowerbound k))) x) \<le> e * (b - a) / 4"
 49.2430 +              apply rule
 49.2431 +              apply rule
 49.2432 +              unfolding mem_Collect_eq
 49.2433 +              unfolding split_paired_all fst_conv snd_conv
 49.2434 +            proof safe
 49.2435 +              case goal1 guess v using pb[OF goal1(1)] .. note v = conjunctD2[OF this]
 49.2436 +              have "?b \<in> {v.. ?b}"
 49.2437 +                using v(2) by auto
 49.2438 +              then have "v \<ge> ?a" using p(3)[OF goal1(1)]
 49.2439                  unfolding subset_eq v by auto
 49.2440 -              moreover have "{v..?b} \<subseteq> ball ?b db" using fineD[OF as(2) goal1(1)]
 49.2441 -                apply-apply(subst(asm) if_P,rule refl) unfolding subset_eq apply safe
 49.2442 -                apply(erule_tac x=" x" in ballE) using ab
 49.2443 -                by(auto simp add:subset_eq v dist_real_def) ultimately
 49.2444 -              show ?case unfolding v unfolding interval_bounds_real[OF v(2)] apply- apply(rule db(2)[of "v"])
 49.2445 -                using goal1 fineD[OF as(2) goal1(1)] unfolding v content_eq_0 by auto
 49.2446 +              moreover have "{v..?b} \<subseteq> ball ?b db"
 49.2447 +                using fineD[OF as(2) goal1(1)]
 49.2448 +                apply -
 49.2449 +                apply (subst(asm) if_P, rule refl)
 49.2450 +                unfolding subset_eq
 49.2451 +                apply safe
 49.2452 +                apply (erule_tac x=" x" in ballE)
 49.2453 +                using ab
 49.2454 +                apply (auto simp add:subset_eq v dist_real_def)
 49.2455 +                done
 49.2456 +              ultimately show ?case
 49.2457 +                unfolding v
 49.2458 +                unfolding interval_bounds_real[OF v(2)]
 49.2459 +                apply -
 49.2460 +                apply(rule db(2)[of "v"])
 49.2461 +                using goal1 fineD[OF as(2) goal1(1)]
 49.2462 +                unfolding v content_eq_0
 49.2463 +                apply auto
 49.2464 +                done
 49.2465              qed
 49.2466 -          qed(insert p(1) ab e, auto simp add:field_simps) qed auto qed qed qed qed
 49.2467 +          qed (insert p(1) ab e, auto simp add: field_simps)
 49.2468 +        qed auto
 49.2469 +      qed
 49.2470 +    qed
 49.2471 +  qed
 49.2472 +qed
 49.2473 +
 49.2474  
 49.2475  subsection {* Stronger form with finite number of exceptional points. *}
 49.2476  
 49.2477 -lemma fundamental_theorem_of_calculus_interior_strong: fixes f::"real \<Rightarrow> 'a::banach"
 49.2478 -  assumes"finite s" "a \<le> b" "continuous_on {a..b} f"
 49.2479 -  "\<forall>x\<in>{a<..<b} - s. (f has_vector_derivative f'(x)) (at x)"
 49.2480 -  shows "(f' has_integral (f b - f a)) {a..b}" using assms apply-
 49.2481 -proof(induct "card s" arbitrary:s a b)
 49.2482 -  case 0 show ?case apply(rule fundamental_theorem_of_calculus_interior) using 0 by auto
 49.2483 -next case (Suc n) from this(2) guess c s' apply-apply(subst(asm) eq_commute) unfolding card_Suc_eq
 49.2484 -    apply(subst(asm)(2) eq_commute) by(erule exE conjE)+ note cs = this[rule_format]
 49.2485 -  show ?case proof(cases "c\<in>{a<..<b}")
 49.2486 -    case False thus ?thesis apply- apply(rule Suc(1)[OF cs(3) _ Suc(4,5)]) apply safe defer
 49.2487 -      apply(rule Suc(6)[rule_format]) using Suc(3) unfolding cs by auto
 49.2488 -  next have *:"f b - f a = (f c - f a) + (f b - f c)" by auto
 49.2489 -    case True hence "a \<le> c" "c \<le> b" by auto
 49.2490 -    thus ?thesis apply(subst *) apply(rule has_integral_combine) apply assumption+
 49.2491 -      apply(rule_tac[!] Suc(1)[OF cs(3)]) using Suc(3) unfolding cs
 49.2492 -    proof- show "continuous_on {a..c} f" "continuous_on {c..b} f"
 49.2493 -        apply(rule_tac[!] continuous_on_subset[OF Suc(5)]) using True by auto
 49.2494 +lemma fundamental_theorem_of_calculus_interior_strong:
 49.2495 +  fixes f :: "real \<Rightarrow> 'a::banach"
 49.2496 +  assumes "finite s"
 49.2497 +    and "a \<le> b"
 49.2498 +    and "continuous_on {a..b} f"
 49.2499 +    and "\<forall>x\<in>{a<..<b} - s. (f has_vector_derivative f'(x)) (at x)"
 49.2500 +  shows "(f' has_integral (f b - f a)) {a..b}"
 49.2501 +  using assms
 49.2502 +proof (induct "card s" arbitrary: s a b)
 49.2503 +  case 0
 49.2504 +  show ?case
 49.2505 +    apply (rule fundamental_theorem_of_calculus_interior)
 49.2506 +    using 0
 49.2507 +    apply auto
 49.2508 +    done
 49.2509 +next
 49.2510 +  case (Suc n)
 49.2511 +  from this(2) guess c s'
 49.2512 +    apply -
 49.2513 +    apply (subst(asm) eq_commute)
 49.2514 +    unfolding card_Suc_eq
 49.2515 +    apply (subst(asm)(2) eq_commute)
 49.2516 +    apply (elim exE conjE)
 49.2517 +    done
 49.2518 +  note cs = this[rule_format]
 49.2519 +  show ?case
 49.2520 +  proof (cases "c \<in> {a<..<b}")
 49.2521 +    case False
 49.2522 +    then show ?thesis
 49.2523 +      apply -
 49.2524 +      apply (rule Suc(1)[OF cs(3) _ Suc(4,5)])
 49.2525 +      apply safe
 49.2526 +      defer
 49.2527 +      apply (rule Suc(6)[rule_format])
 49.2528 +      using Suc(3)
 49.2529 +      unfolding cs
 49.2530 +      apply auto
 49.2531 +      done
 49.2532 +  next
 49.2533 +    have *: "f b - f a = (f c - f a) + (f b - f c)"
 49.2534 +      by auto
 49.2535 +    case True
 49.2536 +    then have "a \<le> c" "c \<le> b"
 49.2537 +      by auto
 49.2538 +    then show ?thesis
 49.2539 +      apply (subst *)
 49.2540 +      apply (rule has_integral_combine)
 49.2541 +      apply assumption+
 49.2542 +      apply (rule_tac[!] Suc(1)[OF cs(3)])
 49.2543 +      using Suc(3)
 49.2544 +      unfolding cs
 49.2545 +    proof -
 49.2546 +      show "continuous_on {a..c} f" "continuous_on {c..b} f"
 49.2547 +        apply (rule_tac[!] continuous_on_subset[OF Suc(5)])
 49.2548 +        using True
 49.2549 +        apply auto
 49.2550 +        done
 49.2551        let ?P = "\<lambda>i j. \<forall>x\<in>{i<..<j} - s'. (f has_vector_derivative f' x) (at x)"
 49.2552 -      show "?P a c" "?P c b" apply safe apply(rule_tac[!] Suc(6)[rule_format]) using True unfolding cs by auto
 49.2553 -    qed auto qed qed
 49.2554 -
 49.2555 -lemma fundamental_theorem_of_calculus_strong: fixes f::"real \<Rightarrow> 'a::banach"
 49.2556 -  assumes "finite s" "a \<le> b" "continuous_on {a..b} f"
 49.2557 -  "\<forall>x\<in>{a..b} - s. (f has_vector_derivative f'(x)) (at x)"
 49.2558 +      show "?P a c" "?P c b"
 49.2559 +        apply safe
 49.2560 +        apply (rule_tac[!] Suc(6)[rule_format])
 49.2561 +        using True
 49.2562 +        unfolding cs
 49.2563 +        apply auto
 49.2564 +        done
 49.2565 +    qed auto
 49.2566 +  qed
 49.2567 +qed
 49.2568 +
 49.2569 +lemma fundamental_theorem_of_calculus_strong:
 49.2570 +  fixes f :: "real \<Rightarrow> 'a::banach"
 49.2571 +  assumes "finite s"
 49.2572 +    and "a \<le> b"
 49.2573 +    and "continuous_on {a..b} f"
 49.2574 +    and "\<forall>x\<in>{a..b} - s. (f has_vector_derivative f'(x)) (at x)"
 49.2575    shows "(f' has_integral (f(b) - f(a))) {a..b}"
 49.2576 -  apply(rule fundamental_theorem_of_calculus_interior_strong[OF assms(1-3), of f'])
 49.2577 -  using assms(4) by auto
 49.2578 -
 49.2579 -lemma indefinite_integral_continuous_left: fixes f::"real \<Rightarrow> 'a::banach"
 49.2580 +  apply (rule fundamental_theorem_of_calculus_interior_strong[OF assms(1-3), of f'])
 49.2581 +  using assms(4)
 49.2582 +  apply auto
 49.2583 +  done
 49.2584 +
 49.2585 +lemma indefinite_integral_continuous_left:
 49.2586 +  fixes f::"real \<Rightarrow> 'a::banach"
 49.2587    assumes "f integrable_on {a..b}" "a < c" "c \<le> b" "0 < e"
 49.2588    obtains d where "0 < d" "\<forall>t. c - d < t \<and> t \<le> c \<longrightarrow> norm(integral {a..c} f - integral {a..t} f) < e"
 49.2589  proof- have "\<exists>w>0. \<forall>t. c - w < t \<and> t < c \<longrightarrow> norm(f c) * norm(c - t) < e / 3"
 49.2590 @@ -7377,7 +8505,7 @@
 49.2591      thus ?thesis using integrable_integral unfolding g_def by auto }
 49.2592  
 49.2593    note iterate_eq_neutral[OF mon,unfolded neutral_lifted[OF monoidal_monoid]]
 49.2594 -  note * = this[unfolded neutral_monoid]
 49.2595 +  note * = this[unfolded neutral_add]
 49.2596    have iterate:"iterate (lifted op +) (p - {{c..d}})
 49.2597        (\<lambda>i. if g integrable_on i then Some (integral i g) else None) = Some 0"
 49.2598    proof(rule *,rule) case goal1 hence "x\<in>p" by auto note div = division_ofD(2-5)[OF p(1) this]
 49.2599 @@ -8286,7 +9414,7 @@
 49.2600    next case goal2 thus ?case apply(rule integrable_sub) using assms(1) by auto
 49.2601    next case goal3 thus ?case using *[of x "Suc k" "Suc (Suc k)"] by auto
 49.2602    next case goal4 thus ?case apply-apply(rule tendsto_diff)
 49.2603 -      using seq_offset[OF assms(3)[rule_format],of x 1] by auto
 49.2604 +      using LIMSEQ_ignore_initial_segment[OF assms(3)[rule_format],of x 1] by auto
 49.2605    next case goal5 thus ?case using assms(4) unfolding bounded_iff
 49.2606        apply safe apply(rule_tac x="a + norm (integral s (\<lambda>x. f 0 x))" in exI)
 49.2607        apply safe apply(erule_tac x="integral s (\<lambda>x. f (Suc k) x)" in ballE) unfolding sub
 49.2608 @@ -8294,7 +9422,7 @@
 49.2609    note conjunctD2[OF this] note tendsto_add[OF this(2) tendsto_const[of "integral s (f 0)"]]
 49.2610      integrable_add[OF this(1) assms(1)[rule_format,of 0]]
 49.2611    thus ?thesis unfolding sub apply-apply rule defer apply(subst(asm) integral_sub)
 49.2612 -    using assms(1) apply auto apply(rule seq_offset_rev[where k=1]) by auto qed
 49.2613 +    using assms(1) apply auto by(rule LIMSEQ_imp_Suc) qed
 49.2614  
 49.2615  lemma monotone_convergence_decreasing: fixes f::"nat \<Rightarrow> 'n::ordered_euclidean_space \<Rightarrow> real"
 49.2616    assumes "\<forall>k. (f k) integrable_on s"  "\<forall>k. \<forall>x\<in>s. (f (Suc k) x) \<le> (f k x)"
 49.2617 @@ -9087,7 +10215,8 @@
 49.2618          apply (rule_tac x=N in exI)
 49.2619        proof safe
 49.2620          case goal1
 49.2621 -        have *:"\<And>y ix. y < i + r \<longrightarrow> i \<le> ix \<longrightarrow> ix \<le> y \<longrightarrow> abs(ix - i) < r" by arith
 49.2622 +        have *: "\<And>y ix. y < i + r \<longrightarrow> i \<le> ix \<longrightarrow> ix \<le> y \<longrightarrow> abs(ix - i) < r"
 49.2623 +          by arith
 49.2624          show ?case
 49.2625            unfolding real_norm_def
 49.2626              apply (rule *[rule_format,OF y(2)])
    50.1 --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy	Thu Sep 12 22:10:17 2013 +0200
    50.2 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy	Fri Sep 13 09:31:45 2013 +0200
    50.3 @@ -248,35 +248,36 @@
    50.4  
    50.5  subsection {* Linear functions. *}
    50.6  
    50.7 -definition linear :: "('a::real_vector \<Rightarrow> 'b::real_vector) \<Rightarrow> bool"
    50.8 -  where "linear f \<longleftrightarrow> (\<forall>x y. f(x + y) = f x + f y) \<and> (\<forall>c x. f(c *\<^sub>R x) = c *\<^sub>R f x)"
    50.9 -
   50.10 -lemma linearI:
   50.11 -  assumes "\<And>x y. f (x + y) = f x + f y"
   50.12 -    and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
   50.13 -  shows "linear f"
   50.14 -  using assms unfolding linear_def by auto
   50.15 +lemma linear_iff:
   50.16 +  "linear f \<longleftrightarrow> (\<forall>x y. f(x + y) = f x + f y) \<and> (\<forall>c x. f(c *\<^sub>R x) = c *\<^sub>R f x)"
   50.17 +  (is "linear f \<longleftrightarrow> ?rhs")
   50.18 +proof
   50.19 +  assume "linear f" then interpret f: linear f .
   50.20 +  show "?rhs" by (simp add: f.add f.scaleR)
   50.21 +next
   50.22 +  assume "?rhs" then show "linear f" by unfold_locales simp_all
   50.23 +qed
   50.24  
   50.25  lemma linear_compose_cmul: "linear f \<Longrightarrow> linear (\<lambda>x. c *\<^sub>R f x)"
   50.26 -  by (simp add: linear_def algebra_simps)
   50.27 +  by (simp add: linear_iff algebra_simps)
   50.28  
   50.29  lemma linear_compose_neg: "linear f \<Longrightarrow> linear (\<lambda>x. - f x)"
   50.30 -  by (simp add: linear_def)
   50.31 +  by (simp add: linear_iff)
   50.32  
   50.33  lemma linear_compose_add: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x + g x)"
   50.34 -  by (simp add: linear_def algebra_simps)
   50.35 +  by (simp add: linear_iff algebra_simps)
   50.36  
   50.37  lemma linear_compose_sub: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x - g x)"
   50.38 -  by (simp add: linear_def algebra_simps)
   50.39 +  by (simp add: linear_iff algebra_simps)
   50.40  
   50.41  lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
   50.42 -  by (simp add: linear_def)
   50.43 +  by (simp add: linear_iff)
   50.44  
   50.45  lemma linear_id: "linear id"
   50.46 -  by (simp add: linear_def id_def)
   50.47 +  by (simp add: linear_iff id_def)
   50.48  
   50.49  lemma linear_zero: "linear (\<lambda>x. 0)"
   50.50 -  by (simp add: linear_def)
   50.51 +  by (simp add: linear_iff)
   50.52  
   50.53  lemma linear_compose_setsum:
   50.54    assumes fS: "finite S"
   50.55 @@ -288,20 +289,20 @@
   50.56    done
   50.57  
   50.58  lemma linear_0: "linear f \<Longrightarrow> f 0 = 0"
   50.59 -  unfolding linear_def
   50.60 +  unfolding linear_iff
   50.61    apply clarsimp
   50.62    apply (erule allE[where x="0::'a"])
   50.63    apply simp
   50.64    done
   50.65  
   50.66  lemma linear_cmul: "linear f \<Longrightarrow> f (c *\<^sub>R x) = c *\<^sub>R f x"
   50.67 -  by (simp add: linear_def)
   50.68 +  by (simp add: linear_iff)
   50.69  
   50.70  lemma linear_neg: "linear f \<Longrightarrow> f (- x) = - f x"
   50.71    using linear_cmul [where c="-1"] by simp
   50.72  
   50.73  lemma linear_add: "linear f \<Longrightarrow> f(x + y) = f x + f y"
   50.74 -  by (metis linear_def)
   50.75 +  by (metis linear_iff)
   50.76  
   50.77  lemma linear_sub: "linear f \<Longrightarrow> f(x - y) = f x - f y"
   50.78    by (simp add: diff_minus linear_add linear_neg)
   50.79 @@ -354,16 +355,16 @@
   50.80  definition "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
   50.81  
   50.82  lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
   50.83 -  by (simp add: bilinear_def linear_def)
   50.84 +  by (simp add: bilinear_def linear_iff)
   50.85  
   50.86  lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
   50.87 -  by (simp add: bilinear_def linear_def)
   50.88 +  by (simp add: bilinear_def linear_iff)
   50.89  
   50.90  lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
   50.91 -  by (simp add: bilinear_def linear_def)
   50.92 +  by (simp add: bilinear_def linear_iff)
   50.93  
   50.94  lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
   50.95 -  by (simp add: bilinear_def linear_def)
   50.96 +  by (simp add: bilinear_def linear_iff)
   50.97  
   50.98  lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
   50.99    by (simp only: scaleR_minus1_left [symmetric] bilinear_lmul)
  50.100 @@ -475,7 +476,7 @@
  50.101    fixes f:: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  50.102    assumes lf: "linear f"
  50.103    shows "linear (adjoint f)"
  50.104 -  by (simp add: lf linear_def euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
  50.105 +  by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
  50.106      adjoint_clauses[OF lf] inner_simps)
  50.107  
  50.108  lemma adjoint_adjoint:
  50.109 @@ -560,6 +561,9 @@
  50.110  lemma subset_hull: "S t \<Longrightarrow> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
  50.111    unfolding hull_def by blast
  50.112  
  50.113 +lemma hull_UNIV: "S hull UNIV = UNIV"
  50.114 +  unfolding hull_def by auto
  50.115 +
  50.116  lemma hull_unique: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> S t' \<Longrightarrow> t \<subseteq> t') \<Longrightarrow> (S hull s = t)"
  50.117    unfolding hull_def by auto
  50.118  
  50.119 @@ -744,7 +748,7 @@
  50.120      and sS: "subspace S"
  50.121    shows "subspace (f ` S)"
  50.122    using lf sS linear_0[OF lf]
  50.123 -  unfolding linear_def subspace_def
  50.124 +  unfolding linear_iff subspace_def
  50.125    apply (auto simp add: image_iff)
  50.126    apply (rule_tac x="x + y" in bexI)
  50.127    apply auto
  50.128 @@ -753,10 +757,10 @@
  50.129    done
  50.130  
  50.131  lemma subspace_linear_vimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace (f -` S)"
  50.132 -  by (auto simp add: subspace_def linear_def linear_0[of f])
  50.133 +  by (auto simp add: subspace_def linear_iff linear_0[of f])
  50.134  
  50.135  lemma subspace_linear_preimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace {x. f x \<in> S}"
  50.136 -  by (auto simp add: subspace_def linear_def linear_0[of f])
  50.137 +  by (auto simp add: subspace_def linear_iff linear_0[of f])
  50.138  
  50.139  lemma subspace_trivial: "subspace {0}"
  50.140    by (simp add: subspace_def)
  50.141 @@ -984,7 +988,7 @@
  50.142      by safe (force intro: span_clauses)+
  50.143  next
  50.144    have "linear (\<lambda>(a, b). a + b)"
  50.145 -    by (simp add: linear_def scaleR_add_right)
  50.146 +    by (simp add: linear_iff scaleR_add_right)
  50.147    moreover have "subspace (span A \<times> span B)"
  50.148      by (intro subspace_Times subspace_span)
  50.149    ultimately show "subspace ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
  50.150 @@ -1521,7 +1525,7 @@
  50.151    by (metis Basis_le_norm order_trans)
  50.152  
  50.153  lemma norm_bound_Basis_lt: "b \<in> Basis \<Longrightarrow> norm x < e \<Longrightarrow> \<bar>x \<bullet> b\<bar> < e"
  50.154 -  by (metis Basis_le_norm basic_trans_rules(21))
  50.155 +  by (metis Basis_le_norm le_less_trans)
  50.156  
  50.157  lemma norm_le_l1: "norm x \<le> (\<Sum>b\<in>Basis. \<bar>x \<bullet> b\<bar>)"
  50.158    apply (subst euclidean_representation[of x, symmetric])
  50.159 @@ -1639,11 +1643,11 @@
  50.160    proof
  50.161      fix x y
  50.162      show "f (x + y) = f x + f y"
  50.163 -      using `linear f` unfolding linear_def by simp
  50.164 +      using `linear f` unfolding linear_iff by simp
  50.165    next
  50.166      fix r x
  50.167      show "f (scaleR r x) = scaleR r (f x)"
  50.168 -      using `linear f` unfolding linear_def by simp
  50.169 +      using `linear f` unfolding linear_iff by simp
  50.170    next
  50.171      have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  50.172        using `linear f` by (rule linear_bounded)
  50.173 @@ -1653,7 +1657,7 @@
  50.174  next
  50.175    assume "bounded_linear f"
  50.176    then interpret f: bounded_linear f .
  50.177 -  show "linear f" by (simp add: f.add f.scaleR linear_def)
  50.178 +  show "linear f" by (simp add: f.add f.scaleR linear_iff)
  50.179  qed
  50.180  
  50.181  lemma bounded_linearI':
  50.182 @@ -1725,20 +1729,20 @@
  50.183    proof
  50.184      fix x y z
  50.185      show "h (x + y) z = h x z + h y z"
  50.186 -      using `bilinear h` unfolding bilinear_def linear_def by simp
  50.187 +      using `bilinear h` unfolding bilinear_def linear_iff by simp
  50.188    next
  50.189      fix x y z
  50.190      show "h x (y + z) = h x y + h x z"
  50.191 -      using `bilinear h` unfolding bilinear_def linear_def by simp
  50.192 +      using `bilinear h` unfolding bilinear_def linear_iff by simp
  50.193    next
  50.194      fix r x y
  50.195      show "h (scaleR r x) y = scaleR r (h x y)"
  50.196 -      using `bilinear h` unfolding bilinear_def linear_def
  50.197 +      using `bilinear h` unfolding bilinear_def linear_iff
  50.198        by simp
  50.199    next
  50.200      fix r x y
  50.201      show "h x (scaleR r y) = scaleR r (h x y)"
  50.202 -      using `bilinear h` unfolding bilinear_def linear_def
  50.203 +      using `bilinear h` unfolding bilinear_def linear_iff
  50.204        by simp
  50.205    next
  50.206      have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  50.207 @@ -2444,7 +2448,7 @@
  50.208       (\<forall>x\<in> span C. \<forall>c. g (c*\<^sub>R x) = c *\<^sub>R g x) \<and>
  50.209       (\<forall>x\<in> C. g x = f x)" by blast
  50.210    from g show ?thesis
  50.211 -    unfolding linear_def
  50.212 +    unfolding linear_iff
  50.213      using C
  50.214      apply clarsimp
  50.215      apply blast
  50.216 @@ -2613,7 +2617,7 @@
  50.217  proof -
  50.218    let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  50.219    from bf bg have sp: "subspace ?P"
  50.220 -    unfolding bilinear_def linear_def subspace_def bf bg
  50.221 +    unfolding bilinear_def linear_iff subspace_def bf bg
  50.222      by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
  50.223        intro: bilinear_ladd[OF bf])
  50.224  
  50.225 @@ -2623,7 +2627,7 @@
  50.226      apply (rule span_induct')
  50.227      apply (simp add: fg)
  50.228      apply (auto simp add: subspace_def)
  50.229 -    using bf bg unfolding bilinear_def linear_def
  50.230 +    using bf bg unfolding bilinear_def linear_iff
  50.231      apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def
  50.232        intro: bilinear_ladd[OF bf])
  50.233      done
    51.1 --- a/src/HOL/Multivariate_Analysis/Path_Connected.thy	Thu Sep 12 22:10:17 2013 +0200
    51.2 +++ b/src/HOL/Multivariate_Analysis/Path_Connected.thy	Fri Sep 13 09:31:45 2013 +0200
    51.3 @@ -587,7 +587,7 @@
    51.4  qed
    51.5  
    51.6  lemma open_path_component:
    51.7 -  fixes s :: "'a::real_normed_vector set" (*TODO: generalize to metric_space*)
    51.8 +  fixes s :: "'a::real_normed_vector set"
    51.9    assumes "open s"
   51.10    shows "open {y. path_component s x y}"
   51.11    unfolding open_contains_ball
   51.12 @@ -620,7 +620,7 @@
   51.13  qed
   51.14  
   51.15  lemma open_non_path_component:
   51.16 -  fixes s :: "'a::real_normed_vector set" (*TODO: generalize to metric_space*)
   51.17 +  fixes s :: "'a::real_normed_vector set"
   51.18    assumes "open s"
   51.19    shows "open(s - {y. path_component s x y})"
   51.20    unfolding open_contains_ball
   51.21 @@ -648,7 +648,7 @@
   51.22  qed
   51.23  
   51.24  lemma connected_open_path_connected:
   51.25 -  fixes s :: "'a::real_normed_vector set" (*TODO: generalize to metric_space*)
   51.26 +  fixes s :: "'a::real_normed_vector set"
   51.27    assumes "open s" "connected s"
   51.28    shows "path_connected s"
   51.29    unfolding path_connected_component_set
    52.1 --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Thu Sep 12 22:10:17 2013 +0200
    52.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Fri Sep 13 09:31:45 2013 +0200
    52.3 @@ -978,9 +978,6 @@
    52.4      unfolding th0 th1 by simp
    52.5  qed
    52.6  
    52.7 -lemma connected_empty[simp, intro]: "connected {}"  (* FIXME duplicate? *)
    52.8 -  by simp
    52.9 -
   52.10  
   52.11  subsection{* Limit points *}
   52.12  
   52.13 @@ -2125,32 +2122,20 @@
   52.14  
   52.15  text{* Some other lemmas about sequences. *}
   52.16  
   52.17 -lemma sequentially_offset:
   52.18 +lemma sequentially_offset: (* TODO: move to Topological_Spaces.thy *)
   52.19    assumes "eventually (\<lambda>i. P i) sequentially"
   52.20    shows "eventually (\<lambda>i. P (i + k)) sequentially"
   52.21 -  using assms unfolding eventually_sequentially by (metis trans_le_add1)
   52.22 -
   52.23 -lemma seq_offset:
   52.24 -  assumes "(f ---> l) sequentially"
   52.25 -  shows "((\<lambda>i. f (i + k)) ---> l) sequentially"
   52.26 -  using assms by (rule LIMSEQ_ignore_initial_segment) (* FIXME: redundant *)
   52.27 -
   52.28 -lemma seq_offset_neg:
   52.29 +  using assms by (rule eventually_sequentially_seg [THEN iffD2])
   52.30 +
   52.31 +lemma seq_offset_neg: (* TODO: move to Topological_Spaces.thy *)
   52.32    "(f ---> l) sequentially \<Longrightarrow> ((\<lambda>i. f(i - k)) ---> l) sequentially"
   52.33 -  apply (rule topological_tendstoI)
   52.34 -  apply (drule (2) topological_tendstoD)
   52.35 -  apply (simp only: eventually_sequentially)
   52.36 -  apply (subgoal_tac "\<And>N k (n::nat). N + k <= n \<Longrightarrow> N <= n - k")
   52.37 -  apply metis
   52.38 +  apply (erule filterlim_compose)
   52.39 +  apply (simp add: filterlim_def le_sequentially eventually_filtermap eventually_sequentially)
   52.40    apply arith
   52.41    done
   52.42  
   52.43 -lemma seq_offset_rev:
   52.44 -  "((\<lambda>i. f(i + k)) ---> l) sequentially \<Longrightarrow> (f ---> l) sequentially"
   52.45 -  by (rule LIMSEQ_offset) (* FIXME: redundant *)
   52.46 -
   52.47  lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
   52.48 -  using LIMSEQ_inverse_real_of_nat by (rule LIMSEQ_imp_Suc)
   52.49 +  using LIMSEQ_inverse_real_of_nat by (rule LIMSEQ_imp_Suc) (* TODO: move to Limits.thy *)
   52.50  
   52.51  subsection {* More properties of closed balls *}
   52.52  
    53.1 --- a/src/HOL/NthRoot.thy	Thu Sep 12 22:10:17 2013 +0200
    53.2 +++ b/src/HOL/NthRoot.thy	Fri Sep 13 09:31:45 2013 +0200
    53.3 @@ -410,17 +410,17 @@
    53.4  lemma real_sqrt_eq_iff [simp]: "(sqrt x = sqrt y) = (x = y)"
    53.5  unfolding sqrt_def by (rule real_root_eq_iff [OF pos2])
    53.6  
    53.7 -lemmas real_sqrt_gt_0_iff [simp] = real_sqrt_less_iff [where x=0, simplified]
    53.8 -lemmas real_sqrt_lt_0_iff [simp] = real_sqrt_less_iff [where y=0, simplified]
    53.9 -lemmas real_sqrt_ge_0_iff [simp] = real_sqrt_le_iff [where x=0, simplified]
   53.10 -lemmas real_sqrt_le_0_iff [simp] = real_sqrt_le_iff [where y=0, simplified]
   53.11 -lemmas real_sqrt_eq_0_iff [simp] = real_sqrt_eq_iff [where y=0, simplified]
   53.12 +lemmas real_sqrt_gt_0_iff [simp] = real_sqrt_less_iff [where x=0, unfolded real_sqrt_zero]
   53.13 +lemmas real_sqrt_lt_0_iff [simp] = real_sqrt_less_iff [where y=0, unfolded real_sqrt_zero]
   53.14 +lemmas real_sqrt_ge_0_iff [simp] = real_sqrt_le_iff [where x=0, unfolded real_sqrt_zero]
   53.15 +lemmas real_sqrt_le_0_iff [simp] = real_sqrt_le_iff [where y=0, unfolded real_sqrt_zero]
   53.16 +lemmas real_sqrt_eq_0_iff [simp] = real_sqrt_eq_iff [where y=0, unfolded real_sqrt_zero]
   53.17  
   53.18 -lemmas real_sqrt_gt_1_iff [simp] = real_sqrt_less_iff [where x=1, simplified]
   53.19 -lemmas real_sqrt_lt_1_iff [simp] = real_sqrt_less_iff [where y=1, simplified]
   53.20 -lemmas real_sqrt_ge_1_iff [simp] = real_sqrt_le_iff [where x=1, simplified]
   53.21 -lemmas real_sqrt_le_1_iff [simp] = real_sqrt_le_iff [where y=1, simplified]
   53.22 -lemmas real_sqrt_eq_1_iff [simp] = real_sqrt_eq_iff [where y=1, simplified]
   53.23 +lemmas real_sqrt_gt_1_iff [simp] = real_sqrt_less_iff [where x=1, unfolded real_sqrt_one]
   53.24 +lemmas real_sqrt_lt_1_iff [simp] = real_sqrt_less_iff [where y=1, unfolded real_sqrt_one]
   53.25 +lemmas real_sqrt_ge_1_iff [simp] = real_sqrt_le_iff [where x=1, unfolded real_sqrt_one]
   53.26 +lemmas real_sqrt_le_1_iff [simp] = real_sqrt_le_iff [where y=1, unfolded real_sqrt_one]
   53.27 +lemmas real_sqrt_eq_1_iff [simp] = real_sqrt_eq_iff [where y=1, unfolded real_sqrt_one]
   53.28  
   53.29  lemma isCont_real_sqrt: "isCont sqrt x"
   53.30  unfolding sqrt_def by (rule isCont_real_root)
    54.1 --- a/src/HOL/Number_Theory/Primes.thy	Thu Sep 12 22:10:17 2013 +0200
    54.2 +++ b/src/HOL/Number_Theory/Primes.thy	Fri Sep 13 09:31:45 2013 +0200
    54.3 @@ -167,18 +167,24 @@
    54.4    by (metis div_mult_self1_is_id div_mult_self2_is_id
    54.5        int_div_less_self int_one_le_iff_zero_less zero_less_mult_pos less_le)
    54.6  
    54.7 -lemma prime_dvd_power_nat [rule_format]: "prime (p::nat) -->
    54.8 -    n > 0 --> (p dvd x^n --> p dvd x)"
    54.9 -  by (induct n rule: nat_induct) auto
   54.10 +lemma prime_dvd_power_nat: "prime (p::nat) \<Longrightarrow> p dvd x^n \<Longrightarrow> p dvd x"
   54.11 +  by (induct n) auto
   54.12  
   54.13 -lemma prime_dvd_power_int [rule_format]: "prime (p::int) -->
   54.14 -    n > 0 --> (p dvd x^n --> p dvd x)"
   54.15 -  apply (induct n rule: nat_induct)
   54.16 -  apply auto
   54.17 +lemma prime_dvd_power_int: "prime (p::int) \<Longrightarrow> p dvd x^n \<Longrightarrow> p dvd x"
   54.18 +  apply (induct n)
   54.19    apply (frule prime_ge_0_int)
   54.20    apply auto
   54.21    done
   54.22  
   54.23 +lemma prime_dvd_power_nat_iff: "prime (p::nat) \<Longrightarrow> n > 0 \<Longrightarrow>
   54.24 +    p dvd x^n \<longleftrightarrow> p dvd x"
   54.25 +  by (cases n) (auto elim: prime_dvd_power_nat)
   54.26 +
   54.27 +lemma prime_dvd_power_int_iff: "prime (p::int) \<Longrightarrow> n > 0 \<Longrightarrow>
   54.28 +    p dvd x^n \<longleftrightarrow> p dvd x"
   54.29 +  by (cases n) (auto elim: prime_dvd_power_int)
   54.30 +
   54.31 +
   54.32  subsubsection {* Make prime naively executable *}
   54.33  
   54.34  lemma zero_not_prime_nat [simp]: "~prime (0::nat)"
    55.1 --- a/src/HOL/Real_Vector_Spaces.thy	Thu Sep 12 22:10:17 2013 +0200
    55.2 +++ b/src/HOL/Real_Vector_Spaces.thy	Fri Sep 13 09:31:45 2013 +0200
    55.3 @@ -934,8 +934,16 @@
    55.4  
    55.5  subsection {* Bounded Linear and Bilinear Operators *}
    55.6  
    55.7 -locale bounded_linear = additive f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
    55.8 +locale linear = additive f for f :: "'a::real_vector \<Rightarrow> 'b::real_vector" +
    55.9    assumes scaleR: "f (scaleR r x) = scaleR r (f x)"
   55.10 +
   55.11 +lemma linearI:
   55.12 +  assumes "\<And>x y. f (x + y) = f x + f y"
   55.13 +  assumes "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
   55.14 +  shows "linear f"
   55.15 +  by default (rule assms)+
   55.16 +
   55.17 +locale bounded_linear = linear f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
   55.18    assumes bounded: "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
   55.19  begin
   55.20  
   55.21 @@ -1547,4 +1555,3 @@
   55.22  qed
   55.23  
   55.24  end
   55.25 -
    56.1 --- a/src/HOL/Series.thy	Thu Sep 12 22:10:17 2013 +0200
    56.2 +++ b/src/HOL/Series.thy	Fri Sep 13 09:31:45 2013 +0200
    56.3 @@ -446,7 +446,7 @@
    56.4  lemma sumr_pos_lt_pair:
    56.5    fixes f :: "nat \<Rightarrow> real"
    56.6    shows "\<lbrakk>summable f;
    56.7 -        \<forall>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
    56.8 +        \<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
    56.9        \<Longrightarrow> setsum f {0..<k} < suminf f"
   56.10  unfolding One_nat_def
   56.11  apply (subst suminf_split_initial_segment [where k="k"])
    57.1 --- a/src/HOL/TPTP/atp_theory_export.ML	Thu Sep 12 22:10:17 2013 +0200
    57.2 +++ b/src/HOL/TPTP/atp_theory_export.ML	Fri Sep 13 09:31:45 2013 +0200
    57.3 @@ -71,7 +71,7 @@
    57.4        tracing ("Ran ATP: " ^
    57.5                 (case outcome of
    57.6                    NONE => "Success"
    57.7 -                | SOME failure => string_of_failure failure))
    57.8 +                | SOME failure => string_of_atp_failure failure))
    57.9    in outcome end
   57.10  
   57.11  fun is_problem_line_reprovable ctxt format prelude axioms deps
    58.1 --- a/src/HOL/Tools/ATP/atp_problem.ML	Thu Sep 12 22:10:17 2013 +0200
    58.2 +++ b/src/HOL/Tools/ATP/atp_problem.ML	Fri Sep 13 09:31:45 2013 +0200
    58.3 @@ -7,21 +7,23 @@
    58.4  
    58.5  signature ATP_PROBLEM =
    58.6  sig
    58.7 -  datatype ('a, 'b) ho_term =
    58.8 -    ATerm of ('a * 'b list) * ('a, 'b) ho_term list |
    58.9 -    AAbs of (('a * 'b) * ('a, 'b) ho_term) * ('a, 'b) ho_term list
   58.10 -  datatype quantifier = AForall | AExists
   58.11 -  datatype connective = ANot | AAnd | AOr | AImplies | AIff
   58.12 -  datatype ('a, 'b, 'c, 'd) formula =
   58.13 -    ATyQuant of quantifier * ('b * 'd list) list * ('a, 'b, 'c, 'd) formula |
   58.14 -    AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c, 'd) formula |
   58.15 -    AConn of connective * ('a, 'b, 'c, 'd) formula list |
   58.16 +  datatype ('a, 'b) atp_term =
   58.17 +    ATerm of ('a * 'b list) * ('a, 'b) atp_term list |
   58.18 +    AAbs of (('a * 'b) * ('a, 'b) atp_term) * ('a, 'b) atp_term list
   58.19 +  datatype atp_quantifier = AForall | AExists
   58.20 +  datatype atp_connective = ANot | AAnd | AOr | AImplies | AIff
   58.21 +  datatype ('a, 'b, 'c, 'd) atp_formula =
   58.22 +    ATyQuant of atp_quantifier * ('b * 'd list) list
   58.23 +        * ('a, 'b, 'c, 'd) atp_formula |
   58.24 +    AQuant of atp_quantifier * ('a * 'b option) list
   58.25 +        * ('a, 'b, 'c, 'd) atp_formula |
   58.26 +    AConn of atp_connective * ('a, 'b, 'c, 'd) atp_formula list |
   58.27      AAtom of 'c
   58.28  
   58.29 -  datatype 'a ho_type =
   58.30 -    AType of 'a * 'a ho_type list |
   58.31 -    AFun of 'a ho_type * 'a ho_type |
   58.32 -    APi of 'a list * 'a ho_type
   58.33 +  datatype 'a atp_type =
   58.34 +    AType of 'a * 'a atp_type list |
   58.35 +    AFun of 'a atp_type * 'a atp_type |
   58.36 +    APi of 'a list * 'a atp_type
   58.37  
   58.38    type term_order =
   58.39      {is_lpo : bool,
   58.40 @@ -41,22 +43,22 @@
   58.41      THF of polymorphism * thf_choice * thf_defs |
   58.42      DFG of polymorphism
   58.43  
   58.44 -  datatype formula_role =
   58.45 +  datatype atp_formula_role =
   58.46      Axiom | Definition | Lemma | Hypothesis | Conjecture | Negated_Conjecture |
   58.47      Plain | Unknown
   58.48  
   58.49 -  datatype 'a problem_line =
   58.50 +  datatype 'a atp_problem_line =
   58.51      Class_Decl of string * 'a * 'a list |
   58.52      Type_Decl of string * 'a * int |
   58.53 -    Sym_Decl of string * 'a * 'a ho_type |
   58.54 -    Datatype_Decl of string * ('a * 'a list) list * 'a ho_type
   58.55 -                     * ('a, 'a ho_type) ho_term list * bool |
   58.56 -    Class_Memb of string * ('a * 'a list) list * 'a ho_type * 'a |
   58.57 -    Formula of (string * string) * formula_role
   58.58 -               * ('a, 'a ho_type, ('a, 'a ho_type) ho_term, 'a) formula
   58.59 -               * (string, string ho_type) ho_term option
   58.60 -               * (string, string ho_type) ho_term list
   58.61 -  type 'a problem = (string * 'a problem_line list) list
   58.62 +    Sym_Decl of string * 'a * 'a atp_type |
   58.63 +    Datatype_Decl of string * ('a * 'a list) list * 'a atp_type
   58.64 +                     * ('a, 'a atp_type) atp_term list * bool |
   58.65 +    Class_Memb of string * ('a * 'a list) list * 'a atp_type * 'a |
   58.66 +    Formula of (string * string) * atp_formula_role
   58.67 +               * ('a, 'a atp_type, ('a, 'a atp_type) atp_term, 'a) atp_formula
   58.68 +               * (string, string atp_type) atp_term option
   58.69 +               * (string, string atp_type) atp_term list
   58.70 +  type 'a atp_problem = (string * 'a atp_problem_line list) list
   58.71  
   58.72    val tptp_cnf : string
   58.73    val tptp_fof : string
   58.74 @@ -89,9 +91,9 @@
   58.75    val tptp_true : string
   58.76    val tptp_empty_list : string
   58.77    val isabelle_info_prefix : string
   58.78 -  val isabelle_info : string -> int -> (string, 'a) ho_term list
   58.79 -  val extract_isabelle_status : (string, 'a) ho_term list -> string option
   58.80 -  val extract_isabelle_rank : (string, 'a) ho_term list -> int
   58.81 +  val isabelle_info : string -> int -> (string, 'a) atp_term list
   58.82 +  val extract_isabelle_status : (string, 'a) atp_term list -> string option
   58.83 +  val extract_isabelle_rank : (string, 'a) atp_term list -> int
   58.84    val inductionN : string
   58.85    val introN : string
   58.86    val inductiveN : string
   58.87 @@ -107,37 +109,37 @@
   58.88    val is_built_in_tptp_symbol : string -> bool
   58.89    val is_tptp_variable : string -> bool
   58.90    val is_tptp_user_symbol : string -> bool
   58.91 -  val bool_atype : (string * string) ho_type
   58.92 -  val individual_atype : (string * string) ho_type
   58.93 -  val mk_anot : ('a, 'b, 'c, 'd) formula -> ('a, 'b, 'c, 'd) formula
   58.94 +  val bool_atype : (string * string) atp_type
   58.95 +  val individual_atype : (string * string) atp_type
   58.96 +  val mk_anot : ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'c, 'd) atp_formula
   58.97    val mk_aconn :
   58.98 -    connective -> ('a, 'b, 'c, 'd) formula -> ('a, 'b, 'c, 'd) formula
   58.99 -    -> ('a, 'b, 'c, 'd) formula
  58.100 +    atp_connective -> ('a, 'b, 'c, 'd) atp_formula
  58.101 +    -> ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'c, 'd) atp_formula
  58.102    val aconn_fold :
  58.103 -    bool option -> (bool option -> 'a -> 'b -> 'b) -> connective * 'a list
  58.104 +    bool option -> (bool option -> 'a -> 'b -> 'b) -> atp_connective * 'a list
  58.105      -> 'b -> 'b
  58.106    val aconn_map :
  58.107 -    bool option -> (bool option -> 'a -> ('b, 'c, 'd, 'e) formula)
  58.108 -    -> connective * 'a list -> ('b, 'c, 'd, 'e) formula
  58.109 +    bool option -> (bool option -> 'a -> ('b, 'c, 'd, 'e) atp_formula)
  58.110 +    -> atp_connective * 'a list -> ('b, 'c, 'd, 'e) atp_formula
  58.111    val formula_fold :
  58.112 -    bool option -> (bool option -> 'c -> 'e -> 'e) -> ('a, 'b, 'c, 'd) formula
  58.113 -    -> 'e -> 'e
  58.114 +    bool option -> (bool option -> 'c -> 'e -> 'e)
  58.115 +    -> ('a, 'b, 'c, 'd) atp_formula -> 'e -> 'e
  58.116    val formula_map :
  58.117 -    ('c -> 'e) -> ('a, 'b, 'c, 'd) formula -> ('a, 'b, 'e, 'd) formula
  58.118 -  val strip_atype : 'a ho_type -> 'a list * ('a ho_type list * 'a ho_type)
  58.119 +    ('c -> 'e) -> ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'e, 'd) atp_formula
  58.120 +  val strip_atype : 'a atp_type -> 'a list * ('a atp_type list * 'a atp_type)
  58.121    val is_format_higher_order : atp_format -> bool
  58.122 -  val tptp_string_of_line : atp_format -> string problem_line -> string
  58.123 +  val tptp_string_of_line : atp_format -> string atp_problem_line -> string
  58.124    val lines_of_atp_problem :
  58.125 -    atp_format -> term_order -> (unit -> (string * int) list) -> string problem
  58.126 -    -> string list
  58.127 +    atp_format -> term_order -> (unit -> (string * int) list)
  58.128 +    -> string atp_problem -> string list
  58.129    val ensure_cnf_problem :
  58.130 -    (string * string) problem -> (string * string) problem
  58.131 +    (string * string) atp_problem -> (string * string) atp_problem
  58.132    val filter_cnf_ueq_problem :
  58.133 -    (string * string) problem -> (string * string) problem
  58.134 -  val declared_in_atp_problem : 'a problem -> ('a list * 'a list) * 'a list
  58.135 +    (string * string) atp_problem -> (string * string) atp_problem
  58.136 +  val declared_in_atp_problem : 'a atp_problem -> ('a list * 'a list) * 'a list
  58.137    val nice_atp_problem :
  58.138 -    bool -> atp_format -> ('a * (string * string) problem_line list) list
  58.139 -    -> ('a * string problem_line list) list
  58.140 +    bool -> atp_format -> ('a * (string * string) atp_problem_line list) list
  58.141 +    -> ('a * string atp_problem_line list) list
  58.142         * (string Symtab.table * string Symtab.table) option
  58.143  end;
  58.144  
  58.145 @@ -151,21 +153,23 @@
  58.146  
  58.147  (** ATP problem **)
  58.148  
  58.149 -datatype ('a, 'b) ho_term =
  58.150 -  ATerm of ('a * 'b list) * ('a, 'b) ho_term list |
  58.151 -  AAbs of (('a * 'b) * ('a, 'b) ho_term) * ('a, 'b) ho_term list
  58.152 -datatype quantifier = AForall | AExists
  58.153 -datatype connective = ANot | AAnd | AOr | AImplies | AIff
  58.154 -datatype ('a, 'b, 'c, 'd) formula =
  58.155 -  ATyQuant of quantifier * ('b * 'd list) list * ('a, 'b, 'c, 'd) formula |
  58.156 -  AQuant of quantifier * ('a * 'b option) list * ('a, 'b, 'c, 'd) formula |
  58.157 -  AConn of connective * ('a, 'b, 'c, 'd) formula list |
  58.158 +datatype ('a, 'b) atp_term =
  58.159 +  ATerm of ('a * 'b list) * ('a, 'b) atp_term list |
  58.160 +  AAbs of (('a * 'b) * ('a, 'b) atp_term) * ('a, 'b) atp_term list
  58.161 +datatype atp_quantifier = AForall | AExists
  58.162 +datatype atp_connective = ANot | AAnd | AOr | AImplies | AIff
  58.163 +datatype ('a, 'b, 'c, 'd) atp_formula =
  58.164 +  ATyQuant of atp_quantifier * ('b * 'd list) list
  58.165 +      * ('a, 'b, 'c, 'd) atp_formula |
  58.166 +  AQuant of atp_quantifier * ('a * 'b option) list
  58.167 +      * ('a, 'b, 'c, 'd) atp_formula |
  58.168 +  AConn of atp_connective * ('a, 'b, 'c, 'd) atp_formula list |
  58.169    AAtom of 'c
  58.170  
  58.171 -datatype 'a ho_type =
  58.172 -  AType of 'a * 'a ho_type list |
  58.173 -  AFun of 'a ho_type * 'a ho_type |
  58.174 -  APi of 'a list * 'a ho_type
  58.175 +datatype 'a atp_type =
  58.176 +  AType of 'a * 'a atp_type list |
  58.177 +  AFun of 'a atp_type * 'a atp_type |
  58.178 +  APi of 'a list * 'a atp_type
  58.179  
  58.180  type term_order =
  58.181    {is_lpo : bool,
  58.182 @@ -185,22 +189,22 @@
  58.183    THF of polymorphism * thf_choice * thf_defs |
  58.184    DFG of polymorphism
  58.185  
  58.186 -datatype formula_role =
  58.187 +datatype atp_formula_role =
  58.188    Axiom | Definition | Lemma | Hypothesis | Conjecture | Negated_Conjecture |
  58.189    Plain | Unknown
  58.190  
  58.191 -datatype 'a problem_line =
  58.192 +datatype 'a atp_problem_line =
  58.193    Class_Decl of string * 'a * 'a list |
  58.194    Type_Decl of string * 'a * int |
  58.195 -  Sym_Decl of string * 'a * 'a ho_type |
  58.196 -  Datatype_Decl of string * ('a * 'a list) list * 'a ho_type
  58.197 -                   * ('a, 'a ho_type) ho_term list * bool |
  58.198 -  Class_Memb of string * ('a * 'a list) list * 'a ho_type * 'a |
  58.199 -  Formula of (string * string) * formula_role
  58.200 -             * ('a, 'a ho_type, ('a, 'a ho_type) ho_term, 'a) formula
  58.201 -             * (string, string ho_type) ho_term option
  58.202 -             * (string, string ho_type) ho_term list
  58.203 -type 'a problem = (string * 'a problem_line list) list
  58.204 +  Sym_Decl of string * 'a * 'a atp_type |
  58.205 +  Datatype_Decl of string * ('a * 'a list) list * 'a atp_type
  58.206 +                   * ('a, 'a atp_type) atp_term list * bool |
  58.207 +  Class_Memb of string * ('a * 'a list) list * 'a atp_type * 'a |
  58.208 +  Formula of (string * string) * atp_formula_role
  58.209 +             * ('a, 'a atp_type, ('a, 'a atp_type) atp_term, 'a) atp_formula
  58.210 +             * (string, string atp_type) atp_term option
  58.211 +             * (string, string atp_type) atp_term list
  58.212 +type 'a atp_problem = (string * 'a atp_problem_line list) list
  58.213  
  58.214  (* official TPTP syntax *)
  58.215  val tptp_cnf = "cnf"
    59.1 --- a/src/HOL/Tools/ATP/atp_problem_generate.ML	Thu Sep 12 22:10:17 2013 +0200
    59.2 +++ b/src/HOL/Tools/ATP/atp_problem_generate.ML	Fri Sep 13 09:31:45 2013 +0200
    59.3 @@ -8,12 +8,12 @@
    59.4  
    59.5  signature ATP_PROBLEM_GENERATE =
    59.6  sig
    59.7 -  type ('a, 'b) ho_term = ('a, 'b) ATP_Problem.ho_term
    59.8 -  type connective = ATP_Problem.connective
    59.9 -  type ('a, 'b, 'c, 'd) formula = ('a, 'b, 'c, 'd) ATP_Problem.formula
   59.10 +  type ('a, 'b) atp_term = ('a, 'b) ATP_Problem.atp_term
   59.11 +  type atp_connective = ATP_Problem.atp_connective
   59.12 +  type ('a, 'b, 'c, 'd) atp_formula = ('a, 'b, 'c, 'd) ATP_Problem.atp_formula
   59.13    type atp_format = ATP_Problem.atp_format
   59.14 -  type formula_role = ATP_Problem.formula_role
   59.15 -  type 'a problem = 'a ATP_Problem.problem
   59.16 +  type atp_formula_role = ATP_Problem.atp_formula_role
   59.17 +  type 'a atp_problem = 'a ATP_Problem.atp_problem
   59.18  
   59.19    datatype mode = Metis | Sledgehammer | Sledgehammer_Completish | Exporter
   59.20  
   59.21 @@ -100,8 +100,9 @@
   59.22    val adjust_type_enc : atp_format -> type_enc -> type_enc
   59.23    val is_lambda_free : term -> bool
   59.24    val mk_aconns :
   59.25 -    connective -> ('a, 'b, 'c, 'd) formula list -> ('a, 'b, 'c, 'd) formula
   59.26 -  val unmangled_const : string -> string * (string, 'b) ho_term list
   59.27 +    atp_connective -> ('a, 'b, 'c, 'd) atp_formula list
   59.28 +    -> ('a, 'b, 'c, 'd) atp_formula
   59.29 +  val unmangled_const : string -> string * (string, 'b) atp_term list
   59.30    val unmangled_const_name : string -> string list
   59.31    val helper_table : ((string * bool) * (status * thm) list) list
   59.32    val trans_lams_of_string :
   59.33 @@ -109,13 +110,13 @@
   59.34    val string_of_status : status -> string
   59.35    val factsN : string
   59.36    val prepare_atp_problem :
   59.37 -    Proof.context -> atp_format -> formula_role -> type_enc -> mode -> string
   59.38 -    -> bool -> bool -> bool -> term list -> term
   59.39 +    Proof.context -> atp_format -> atp_formula_role -> type_enc -> mode
   59.40 +    -> string -> bool -> bool -> bool -> term list -> term
   59.41      -> ((string * stature) * term) list
   59.42 -    -> string problem * string Symtab.table * (string * stature) list vector
   59.43 +    -> string atp_problem * string Symtab.table * (string * stature) list vector
   59.44         * (string * term) list * int Symtab.table
   59.45 -  val atp_problem_selection_weights : string problem -> (string * real) list
   59.46 -  val atp_problem_term_order_info : string problem -> (string * int) list
   59.47 +  val atp_problem_selection_weights : string atp_problem -> (string * real) list
   59.48 +  val atp_problem_term_order_info : string atp_problem -> (string * int) list
   59.49  end;
   59.50  
   59.51  structure ATP_Problem_Generate : ATP_PROBLEM_GENERATE =
   59.52 @@ -826,8 +827,8 @@
   59.53  type ifact =
   59.54    {name : string,
   59.55     stature : stature,
   59.56 -   role : formula_role,
   59.57 -   iformula : (string * string, typ, iterm, string * string) formula,
   59.58 +   role : atp_formula_role,
   59.59 +   iformula : (string * string, typ, iterm, string * string) atp_formula,
   59.60     atomic_types : typ list}
   59.61  
   59.62  fun update_iformula f ({name, stature, role, iformula, atomic_types} : ifact) =
   59.63 @@ -916,9 +917,9 @@
   59.64      | term (TVar z) = AType (tvar_name z, [])
   59.65    in term end
   59.66  
   59.67 -fun ho_term_of_ho_type (AType (name, tys)) =
   59.68 -    ATerm ((name, []), map ho_term_of_ho_type tys)
   59.69 -  | ho_term_of_ho_type _ = raise Fail "unexpected type"
   59.70 +fun atp_term_of_ho_type (AType (name, tys)) =
   59.71 +    ATerm ((name, []), map atp_term_of_ho_type tys)
   59.72 +  | atp_term_of_ho_type _ = raise Fail "unexpected type"
   59.73  
   59.74  fun ho_type_of_type_arg type_enc T =
   59.75    if T = dummyT then NONE else SOME (raw_ho_type_of_typ type_enc T)
   59.76 @@ -983,7 +984,7 @@
   59.77    if is_type_enc_native type_enc then
   59.78      (map (native_ho_type_of_typ type_enc false 0) T_args, [])
   59.79    else
   59.80 -    ([], map_filter (Option.map ho_term_of_ho_type
   59.81 +    ([], map_filter (Option.map atp_term_of_ho_type
   59.82                       o ho_type_of_type_arg type_enc) T_args)
   59.83  
   59.84  fun class_atom type_enc (cl, T) =
   59.85 @@ -2071,10 +2072,10 @@
   59.86  fun tag_with_type ctxt mono type_enc pos T tm =
   59.87    IConst (type_tag, T --> T, [T])
   59.88    |> mangle_type_args_in_iterm type_enc
   59.89 -  |> ho_term_of_iterm ctxt mono type_enc pos
   59.90 +  |> atp_term_of_iterm ctxt mono type_enc pos
   59.91    |> (fn ATerm ((s, tys), tms) => ATerm ((s, tys), tms @ [tm])
   59.92         | _ => raise Fail "unexpected lambda-abstraction")
   59.93 -and ho_term_of_iterm ctxt mono type_enc pos =
   59.94 +and atp_term_of_iterm ctxt mono type_enc pos =
   59.95    let
   59.96      fun term site u =
   59.97        let
   59.98 @@ -2112,7 +2113,7 @@
   59.99    let
  59.100      val thy = Proof_Context.theory_of ctxt
  59.101      val level = level_of_type_enc type_enc
  59.102 -    val do_term = ho_term_of_iterm ctxt mono type_enc
  59.103 +    val do_term = atp_term_of_iterm ctxt mono type_enc
  59.104      fun do_out_of_bound_type pos phi universal (name, T) =
  59.105        if should_guard_type ctxt mono type_enc
  59.106               (fn () => should_guard_var thy level pos phi universal name) T then
  59.107 @@ -2599,7 +2600,7 @@
  59.108          val base_ary = min_ary_of sym_tab0 base_s
  59.109          fun do_const name = IConst (name, T, T_args)
  59.110          val filter_ty_args = filter_type_args_in_iterm thy ctrss type_enc
  59.111 -        val ho_term_of = ho_term_of_iterm ctxt mono type_enc (SOME true)
  59.112 +        val atp_term_of = atp_term_of_iterm ctxt mono type_enc (SOME true)
  59.113          val name1 as (s1, _) =
  59.114            base_name |> ary - 1 > base_ary ? aliased_uncurried (ary - 1)
  59.115          val name2 as (s2, _) = base_name |> aliased_uncurried ary
  59.116 @@ -2619,7 +2620,7 @@
  59.117          val eq =
  59.118            eq_formula type_enc (atomic_types_of T)
  59.119                       (map (apsnd do_bound_type) bounds) false
  59.120 -                     (ho_term_of tm1) (ho_term_of tm2)
  59.121 +                     (atp_term_of tm1) (atp_term_of tm2)
  59.122        in
  59.123          ([tm1, tm2],
  59.124           [Formula ((uncurried_alias_eq_prefix ^ s2, ""), role,
    60.1 --- a/src/HOL/Tools/ATP/atp_proof.ML	Thu Sep 12 22:10:17 2013 +0200
    60.2 +++ b/src/HOL/Tools/ATP/atp_proof.ML	Fri Sep 13 09:31:45 2013 +0200
    60.3 @@ -8,14 +8,14 @@
    60.4  
    60.5  signature ATP_PROOF =
    60.6  sig
    60.7 -  type ('a, 'b) ho_term = ('a, 'b) ATP_Problem.ho_term
    60.8 -  type formula_role = ATP_Problem.formula_role
    60.9 -  type ('a, 'b, 'c, 'd) formula = ('a, 'b, 'c, 'd) ATP_Problem.formula
   60.10 -  type 'a problem = 'a ATP_Problem.problem
   60.11 +  type ('a, 'b) atp_term = ('a, 'b) ATP_Problem.atp_term
   60.12 +  type atp_formula_role = ATP_Problem.atp_formula_role
   60.13 +  type ('a, 'b, 'c, 'd) atp_formula = ('a, 'b, 'c, 'd) ATP_Problem.atp_formula
   60.14 +  type 'a atp_problem = 'a ATP_Problem.atp_problem
   60.15  
   60.16    exception UNRECOGNIZED_ATP_PROOF of unit
   60.17  
   60.18 -  datatype failure =
   60.19 +  datatype atp_failure =
   60.20      Unprovable |
   60.21      GaveUp |
   60.22      ProofMissing |
   60.23 @@ -34,32 +34,36 @@
   60.24      InternalError |
   60.25      UnknownError of string
   60.26  
   60.27 -  type step_name = string * string list
   60.28 -  type 'a step = step_name * formula_role * 'a * string * step_name list
   60.29 +  type atp_step_name = string * string list
   60.30 +  type ('a, 'b) atp_step =
   60.31 +    atp_step_name * atp_formula_role * 'a * 'b * atp_step_name list
   60.32  
   60.33 -  type 'a proof = ('a, 'a, ('a, 'a) ho_term, 'a) formula step list
   60.34 +  type 'a atp_proof =
   60.35 +    (('a, 'a, ('a, 'a) atp_term, 'a) atp_formula, string) atp_step list
   60.36  
   60.37    val short_output : bool -> string -> string
   60.38 -  val string_of_failure : failure -> string
   60.39 +  val string_of_atp_failure : atp_failure -> string
   60.40    val extract_important_message : string -> string
   60.41 -  val extract_known_failure :
   60.42 -    (failure * string) list -> string -> failure option
   60.43 +  val extract_known_atp_failure :
   60.44 +    (atp_failure * string) list -> string -> atp_failure option
   60.45    val extract_tstplike_proof_and_outcome :
   60.46 -    bool -> (string * string) list -> (failure * string) list -> string
   60.47 -    -> string * failure option
   60.48 -  val is_same_atp_step : step_name -> step_name -> bool
   60.49 +    bool -> (string * string) list -> (atp_failure * string) list -> string
   60.50 +    -> string * atp_failure option
   60.51 +  val is_same_atp_step : atp_step_name -> atp_step_name -> bool
   60.52    val scan_general_id : string list -> string * string list
   60.53    val agsyhol_coreN : string
   60.54    val satallax_coreN : string
   60.55    val z3_tptp_coreN : string
   60.56    val parse_formula :
   60.57      string list
   60.58 -    -> (string, 'a, (string, 'a) ho_term, string) formula * string list
   60.59 -  val atp_proof_of_tstplike_proof : string problem -> string -> string proof
   60.60 -  val clean_up_atp_proof_dependencies : string proof -> string proof
   60.61 +    -> (string, 'a, (string, 'a) atp_term, string) atp_formula * string list
   60.62 +  val atp_proof_of_tstplike_proof :
   60.63 +    string atp_problem -> string -> string atp_proof
   60.64 +  val clean_up_atp_proof_dependencies : string atp_proof -> string atp_proof
   60.65    val map_term_names_in_atp_proof :
   60.66 -    (string -> string) -> string proof -> string proof
   60.67 -  val nasty_atp_proof : string Symtab.table -> string proof -> string proof
   60.68 +    (string -> string) -> string atp_proof -> string atp_proof
   60.69 +  val nasty_atp_proof :
   60.70 +    string Symtab.table -> string atp_proof -> string atp_proof
   60.71  end;
   60.72  
   60.73  structure ATP_Proof : ATP_PROOF =
   60.74 @@ -70,7 +74,7 @@
   60.75  
   60.76  exception UNRECOGNIZED_ATP_PROOF of unit
   60.77  
   60.78 -datatype failure =
   60.79 +datatype atp_failure =
   60.80    Unprovable |
   60.81    GaveUp |
   60.82    ProofMissing |
   60.83 @@ -103,37 +107,37 @@
   60.84    | involving ss =
   60.85      " involving " ^ space_implode " " (Try.serial_commas "and" (map quote ss))
   60.86  
   60.87 -fun string_of_failure Unprovable = "The generated problem is unprovable."
   60.88 -  | string_of_failure GaveUp = "The prover gave up."
   60.89 -  | string_of_failure ProofMissing =
   60.90 +fun string_of_atp_failure Unprovable = "The generated problem is unprovable."
   60.91 +  | string_of_atp_failure GaveUp = "The prover gave up."
   60.92 +  | string_of_atp_failure ProofMissing =
   60.93      "The prover claims the conjecture is a theorem but did not provide a proof."
   60.94 -  | string_of_failure ProofIncomplete =
   60.95 +  | string_of_atp_failure ProofIncomplete =
   60.96      "The prover claims the conjecture is a theorem but provided an incomplete \
   60.97      \(or unparsable) proof."
   60.98 -  | string_of_failure (UnsoundProof (false, ss)) =
   60.99 +  | string_of_atp_failure (UnsoundProof (false, ss)) =
  60.100      "The prover derived \"False\" using" ^ involving ss ^
  60.101      ". Specify a sound type encoding or omit the \"type_enc\" option."
  60.102 -  | string_of_failure (UnsoundProof (true, ss)) =
  60.103 +  | string_of_atp_failure (UnsoundProof (true, ss)) =
  60.104      "The prover derived \"False\" using" ^ involving ss ^
  60.105      ". This could be due to inconsistent axioms (including \"sorry\"s) or to \
  60.106      \a bug in Sledgehammer. If the problem persists, please contact the \
  60.107      \Isabelle developers."
  60.108 -  | string_of_failure CantConnect = "Cannot connect to remote server."
  60.109 -  | string_of_failure TimedOut = "Timed out."
  60.110 -  | string_of_failure Inappropriate =
  60.111 +  | string_of_atp_failure CantConnect = "Cannot connect to remote server."
  60.112 +  | string_of_atp_failure TimedOut = "Timed out."
  60.113 +  | string_of_atp_failure Inappropriate =
  60.114      "The generated problem lies outside the prover's scope."
  60.115 -  | string_of_failure OutOfResources = "The prover ran out of resources."
  60.116 -  | string_of_failure NoPerl = "Perl" ^ missing_message_tail
  60.117 -  | string_of_failure NoLibwwwPerl =
  60.118 +  | string_of_atp_failure OutOfResources = "The prover ran out of resources."
  60.119 +  | string_of_atp_failure NoPerl = "Perl" ^ missing_message_tail
  60.120 +  | string_of_atp_failure NoLibwwwPerl =
  60.121      "The Perl module \"libwww-perl\"" ^ missing_message_tail
  60.122 -  | string_of_failure MalformedInput =
  60.123 +  | string_of_atp_failure MalformedInput =
  60.124      "The generated problem is malformed. Please report this to the Isabelle \
  60.125      \developers."
  60.126 -  | string_of_failure MalformedOutput = "The prover output is malformed."
  60.127 -  | string_of_failure Interrupted = "The prover was interrupted."
  60.128 -  | string_of_failure Crashed = "The prover crashed."
  60.129 -  | string_of_failure InternalError = "An internal prover error occurred."
  60.130 -  | string_of_failure (UnknownError s) =
  60.131 +  | string_of_atp_failure MalformedOutput = "The prover output is malformed."
  60.132 +  | string_of_atp_failure Interrupted = "The prover was interrupted."
  60.133 +  | string_of_atp_failure Crashed = "The prover crashed."
  60.134 +  | string_of_atp_failure InternalError = "An internal prover error occurred."
  60.135 +  | string_of_atp_failure (UnknownError s) =
  60.136      "A prover error occurred" ^
  60.137      (if s = "" then ". (Pass the \"verbose\" option for details.)"
  60.138       else ":\n" ^ s)
  60.139 @@ -163,7 +167,7 @@
  60.140      extract_delimited (begin_delim, end_delim) output
  60.141    | _ => ""
  60.142  
  60.143 -fun extract_known_failure known_failures output =
  60.144 +fun extract_known_atp_failure known_failures output =
  60.145    known_failures
  60.146    |> find_first (fn (_, pattern) => String.isSubstring pattern output)
  60.147    |> Option.map fst
  60.148 @@ -171,14 +175,14 @@
  60.149  fun extract_tstplike_proof_and_outcome verbose proof_delims known_failures
  60.150                                         output =
  60.151    case (extract_tstplike_proof proof_delims output,
  60.152 -        extract_known_failure known_failures output) of
  60.153 +        extract_known_atp_failure known_failures output) of
  60.154      (_, SOME ProofIncomplete) => ("", NONE)
  60.155    | ("", SOME ProofMissing) => ("", NONE)
  60.156    | ("", NONE) => ("", SOME (UnknownError (short_output verbose output)))
  60.157    | res as ("", _) => res
  60.158    | (tstplike_proof, _) => (tstplike_proof, NONE)
  60.159  
  60.160 -type step_name = string * string list
  60.161 +type atp_step_name = string * string list
  60.162  
  60.163  fun is_same_atp_step (s1, _) (s2, _) = s1 = s2
  60.164  
  60.165 @@ -193,9 +197,11 @@
  60.166      | _ => raise Fail "not Vampire"
  60.167    end
  60.168  
  60.169 -type 'a step = step_name * formula_role * 'a * string * step_name list
  60.170 +type ('a, 'b) atp_step =
  60.171 +  atp_step_name * atp_formula_role * 'a * 'b * atp_step_name list
  60.172  
  60.173 -type 'a proof = ('a, 'a, ('a, 'a) ho_term, 'a) formula step list
  60.174 +type 'a atp_proof =
  60.175 +  (('a, 'a, ('a, 'a) atp_term, 'a) atp_formula, string) atp_step list
  60.176  
  60.177  (**** PARSING OF TSTP FORMAT ****)
  60.178  
  60.179 @@ -205,8 +211,6 @@
  60.180    || Scan.repeat ($$ "$") -- Scan.many1 Symbol.is_letdig
  60.181       >> (fn (ss1, ss2) => implode ss1 ^ implode ss2)
  60.182  
  60.183 -val scan_nat = Scan.repeat1 (Scan.one Symbol.is_ascii_digit) >> implode
  60.184 -
  60.185  val skip_term =
  60.186    let
  60.187      fun skip _ accum [] = (accum, [])
    61.1 --- a/src/HOL/Tools/ATP/atp_proof_reconstruct.ML	Thu Sep 12 22:10:17 2013 +0200
    61.2 +++ b/src/HOL/Tools/ATP/atp_proof_reconstruct.ML	Fri Sep 13 09:31:45 2013 +0200
    61.3 @@ -8,8 +8,8 @@
    61.4  
    61.5  signature ATP_PROOF_RECONSTRUCT =
    61.6  sig
    61.7 -  type ('a, 'b) ho_term = ('a, 'b) ATP_Problem.ho_term
    61.8 -  type ('a, 'b, 'c, 'd) formula = ('a, 'b, 'c, 'd) ATP_Problem.formula
    61.9 +  type ('a, 'b) atp_term = ('a, 'b) ATP_Problem.atp_term
   61.10 +  type ('a, 'b, 'c, 'd) atp_formula = ('a, 'b, 'c, 'd) ATP_Problem.atp_formula
   61.11  
   61.12    val metisN : string
   61.13    val full_typesN : string
   61.14 @@ -28,10 +28,10 @@
   61.15    val unalias_type_enc : string -> string list
   61.16    val term_of_atp :
   61.17      Proof.context -> bool -> int Symtab.table -> typ option ->
   61.18 -    (string, string) ho_term -> term
   61.19 +    (string, string) atp_term -> term
   61.20    val prop_of_atp :
   61.21      Proof.context -> bool -> int Symtab.table ->
   61.22 -    (string, string, (string, string) ho_term, string) formula -> term
   61.23 +    (string, string, (string, string) atp_term, string) atp_formula -> term
   61.24  end;
   61.25  
   61.26  structure ATP_Proof_Reconstruct : ATP_PROOF_RECONSTRUCT =
   61.27 @@ -90,9 +90,9 @@
   61.28      TFree (ww, the_default HOLogic.typeS (Variable.def_sort ctxt (ww, ~1)))
   61.29    end
   61.30  
   61.31 -exception HO_TERM of (string, string) ho_term list
   61.32 -exception FORMULA of
   61.33 -    (string, string, (string, string) ho_term, string) formula list
   61.34 +exception ATP_TERM of (string, string) atp_term list
   61.35 +exception ATP_FORMULA of
   61.36 +    (string, string, (string, string) atp_term, string) atp_formula list
   61.37  exception SAME of unit
   61.38  
   61.39  (* Type variables are given the basic sort "HOL.type". Some will later be
   61.40 @@ -103,7 +103,7 @@
   61.41        SOME b => Type (invert_const b, Ts)
   61.42      | NONE =>
   61.43        if not (null us) then
   61.44 -        raise HO_TERM [u]  (* only "tconst"s have type arguments *)
   61.45 +        raise ATP_TERM [u]  (* only "tconst"s have type arguments *)
   61.46        else case unprefix_and_unascii tfree_prefix a of
   61.47          SOME b => make_tfree ctxt b
   61.48        | NONE =>
   61.49 @@ -120,7 +120,7 @@
   61.50  fun type_constraint_of_term ctxt (u as ATerm ((a, _), us)) =
   61.51    case (unprefix_and_unascii class_prefix a, map (typ_of_atp ctxt) us) of
   61.52      (SOME b, [T]) => (b, T)
   61.53 -  | _ => raise HO_TERM [u]
   61.54 +  | _ => raise ATP_TERM [u]
   61.55  
   61.56  (* Accumulate type constraints in a formula: negative type literals. *)
   61.57  fun add_var (key, z)  = Vartab.map_default (key, []) (cons z)
   61.58 @@ -178,7 +178,8 @@
   61.59        case u of
   61.60          ATerm ((s, _), us) =>
   61.61          if s = ""
   61.62 -          then error "Isar proof reconstruction failed because the ATP proof contained unparsable material."
   61.63 +          then error "Isar proof reconstruction failed because the ATP proof \
   61.64 +                     \contains unparsable material."
   61.65          else if String.isPrefix native_type_prefix s then
   61.66            @{const True} (* ignore TPTP type information *)
   61.67          else if s = tptp_equal then
   61.68 @@ -199,7 +200,7 @@
   61.69                case mangled_us @ us of
   61.70                  [typ_u, term_u] =>
   61.71                  do_term extra_ts (SOME (typ_of_atp ctxt typ_u)) term_u
   61.72 -              | _ => raise HO_TERM us
   61.73 +              | _ => raise ATP_TERM us
   61.74              else if s' = predicator_name then
   61.75                do_term [] (SOME @{typ bool}) (hd us)
   61.76              else if s' = app_op_name then
   61.77 @@ -335,7 +336,7 @@
   61.78               | AIff => s_iff
   61.79               | ANot => raise Fail "impossible connective")
   61.80        | AAtom tm => term_of_atom ctxt textual sym_tab pos tm
   61.81 -      | _ => raise FORMULA [phi]
   61.82 +      | _ => raise ATP_FORMULA [phi]
   61.83    in repair_tvar_sorts (do_formula true phi Vartab.empty) end
   61.84  
   61.85  end;
    62.1 --- a/src/HOL/Tools/ATP/atp_systems.ML	Thu Sep 12 22:10:17 2013 +0200
    62.2 +++ b/src/HOL/Tools/ATP/atp_systems.ML	Fri Sep 13 09:31:45 2013 +0200
    62.3 @@ -9,8 +9,8 @@
    62.4  sig
    62.5    type term_order = ATP_Problem.term_order
    62.6    type atp_format = ATP_Problem.atp_format
    62.7 -  type formula_role = ATP_Problem.formula_role
    62.8 -  type failure = ATP_Proof.failure
    62.9 +  type atp_formula_role = ATP_Problem.atp_formula_role
   62.10 +  type atp_failure = ATP_Proof.atp_failure
   62.11  
   62.12    type slice_spec = (int * string) * atp_format * string * string * bool
   62.13    type atp_config =
   62.14 @@ -20,8 +20,8 @@
   62.15         -> term_order * (unit -> (string * int) list)
   62.16            * (unit -> (string * real) list) -> string,
   62.17       proof_delims : (string * string) list,
   62.18 -     known_failures : (failure * string) list,
   62.19 -     prem_role : formula_role,
   62.20 +     known_failures : (atp_failure * string) list,
   62.21 +     prem_role : atp_formula_role,
   62.22       best_slices : Proof.context -> (real * (slice_spec * string)) list,
   62.23       best_max_mono_iters : int,
   62.24       best_max_new_mono_instances : int}
   62.25 @@ -69,7 +69,7 @@
   62.26    val remote_prefix : string
   62.27    val remote_atp :
   62.28      string -> string -> string list -> (string * string) list
   62.29 -    -> (failure * string) list -> formula_role
   62.30 +    -> (atp_failure * string) list -> atp_formula_role
   62.31      -> (Proof.context -> slice_spec * string) -> string * (unit -> atp_config)
   62.32    val add_atp : string * (unit -> atp_config) -> theory -> theory
   62.33    val get_atp : theory -> string -> (unit -> atp_config)
   62.34 @@ -91,7 +91,7 @@
   62.35  (* ATP configuration *)
   62.36  
   62.37  val default_max_mono_iters = 3 (* FUDGE *)
   62.38 -val default_max_new_mono_instances = 200 (* FUDGE *)
   62.39 +val default_max_new_mono_instances = 100 (* FUDGE *)
   62.40  
   62.41  type slice_spec = (int * string) * atp_format * string * string * bool
   62.42  
   62.43 @@ -102,8 +102,8 @@
   62.44       -> term_order * (unit -> (string * int) list)
   62.45          * (unit -> (string * real) list) -> string,
   62.46     proof_delims : (string * string) list,
   62.47 -   known_failures : (failure * string) list,
   62.48 -   prem_role : formula_role,
   62.49 +   known_failures : (atp_failure * string) list,
   62.50 +   prem_role : atp_formula_role,
   62.51     best_slices : Proof.context -> (real * (slice_spec * string)) list,
   62.52     best_max_mono_iters : int,
   62.53     best_max_new_mono_instances : int}
   62.54 @@ -225,7 +225,7 @@
   62.55       (* FUDGE *)
   62.56       K [(1.0, (((60, ""), agsyhol_thf0, "mono_native_higher", keep_lamsN, false), ""))],
   62.57     best_max_mono_iters = default_max_mono_iters - 1 (* FUDGE *),
   62.58 -   best_max_new_mono_instances = default_max_new_mono_instances div 2 (* FUDGE *)}
   62.59 +   best_max_new_mono_instances = default_max_new_mono_instances}
   62.60  
   62.61  val agsyhol = (agsyholN, fn () => agsyhol_config)
   62.62  
   62.63 @@ -480,7 +480,7 @@
   62.64       (* FUDGE *)
   62.65       K [(1.0, (((40, ""), leo2_thf0, "mono_native_higher", keep_lamsN, false), ""))],
   62.66     best_max_mono_iters = default_max_mono_iters - 1 (* FUDGE *),
   62.67 -   best_max_new_mono_instances = default_max_new_mono_instances div 2 (* FUDGE *)}
   62.68 +   best_max_new_mono_instances = default_max_new_mono_instances}
   62.69  
   62.70  val leo2 = (leo2N, fn () => leo2_config)
   62.71  
   62.72 @@ -502,7 +502,7 @@
   62.73       (* FUDGE *)
   62.74       K [(1.0, (((60, ""), satallax_thf0, "mono_native_higher", keep_lamsN, false), ""))],
   62.75     best_max_mono_iters = default_max_mono_iters - 1 (* FUDGE *),
   62.76 -   best_max_new_mono_instances = default_max_new_mono_instances div 2 (* FUDGE *)}
   62.77 +   best_max_new_mono_instances = default_max_new_mono_instances}
   62.78  
   62.79  val satallax = (satallaxN, fn () => satallax_config)
   62.80  
   62.81 @@ -609,7 +609,7 @@
   62.82       |> (if Config.get ctxt force_sos then hd #> apfst (K 1.0) #> single
   62.83           else I),
   62.84     best_max_mono_iters = default_max_mono_iters,
   62.85 -   best_max_new_mono_instances = default_max_new_mono_instances}
   62.86 +   best_max_new_mono_instances = 2 * default_max_new_mono_instances (* FUDGE *)}
   62.87  
   62.88  val vampire = (vampireN, fn () => vampire_config)
   62.89  
   62.90 @@ -633,7 +633,7 @@
   62.91          (0.125, (((62, mashN), z3_tff0, "mono_native", combsN, false), "")),
   62.92          (0.125, (((31, meshN), z3_tff0, "mono_native", combsN, false), ""))],
   62.93     best_max_mono_iters = default_max_mono_iters,
   62.94 -   best_max_new_mono_instances = default_max_new_mono_instances}
   62.95 +   best_max_new_mono_instances = 2 * default_max_new_mono_instances (* FUDGE *)}
   62.96  
   62.97  val z3_tptp = (z3_tptpN, fn () => z3_tptp_config)
   62.98  
   62.99 @@ -675,8 +675,8 @@
  62.100              "\"$ISABELLE_ATP/scripts/remote_atp\" -w 2>&1" of
  62.101            (output, 0) => split_lines output
  62.102          | (output, _) =>
  62.103 -          (warning (case extract_known_failure known_perl_failures output of
  62.104 -                      SOME failure => string_of_failure failure
  62.105 +          (warning (case extract_known_atp_failure known_perl_failures output of
  62.106 +                      SOME failure => string_of_atp_failure failure
  62.107                      | NONE => trim_line output ^ "."); [])) ()
  62.108    handle TimeLimit.TimeOut => []
  62.109  
    63.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    63.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/ExpandFeatures.py	Fri Sep 13 09:31:45 2013 +0200
    63.3 @@ -0,0 +1,162 @@
    63.4 +'''
    63.5 +Created on Aug 21, 2013
    63.6 +
    63.7 +@author: daniel
    63.8 +'''
    63.9 +
   63.10 +from math import log
   63.11 +from gensim import corpora, models, similarities
   63.12 +
   63.13 +class ExpandFeatures(object):
   63.14 +
   63.15 +    def __init__(self,dicts):
   63.16 +        self.dicts = dicts
   63.17 +        self.featureMap = {}
   63.18 +        self.alpha = 0.1
   63.19 +        self.featureCounts = {}
   63.20 +        self.counter = 0        
   63.21 +        self.corpus = []
   63.22 +        self.LSIModel = models.lsimodel.LsiModel(self.corpus,num_topics=500)
   63.23 +
   63.24 +    def initialize(self,dicts):
   63.25 +        self.dicts = dicts
   63.26 +        IS = open(dicts.accFile,'r')
   63.27 +        for line in IS:
   63.28 +            line = line.split(':')
   63.29 +            name = line[0]
   63.30 +            #print 'name',name
   63.31 +            nameId = dicts.nameIdDict[name]    
   63.32 +            features = dicts.featureDict[nameId]
   63.33 +            dependencies = dicts.dependenciesDict[nameId]   
   63.34 +            x = [self.dicts.idNameDict[d] for d in dependencies]
   63.35 +            #print x  
   63.36 +            self.update(features, dependencies)
   63.37 +            self.corpus.append([(x,1) for x in features.keys()])
   63.38 +        IS.close()
   63.39 +        print 'x'
   63.40 +        #self.LSIModel = models.lsimodel.LsiModel(self.corpus,num_topics=500)
   63.41 +        print self.LSIModel
   63.42 +        print 'y'
   63.43 +        
   63.44 +    def update(self,features,dependencies):
   63.45 +        self.counter += 1
   63.46 +        self.corpus.append([(x,1) for x in features.keys()])
   63.47 +        self.LSIModel.add_documents([[(x,1) for x in features.keys()]])
   63.48 +        """
   63.49 +        for f in features.iterkeys():
   63.50 +            try:
   63.51 +                self.featureCounts[f] += 1
   63.52 +            except:
   63.53 +                self.featureCounts[f] = 1
   63.54 +            if self.featureCounts[f] > 100:
   63.55 +                continue
   63.56 +            try:
   63.57 +                self.featureMap[f] = self.featureMap[f].intersection(features.keys())
   63.58 +            except:
   63.59 +                self.featureMap[f] = set(features.keys())
   63.60 +            #print 'fOld',len(fMap),self.featureCounts[f],len(dependencies)
   63.61 +
   63.62 +            for d in dependencies[1:]:
   63.63 +                #print 'dep',self.dicts.idNameDict[d]
   63.64 +                dFeatures = self.dicts.featureDict[d]
   63.65 +                for df in dFeatures.iterkeys():
   63.66 +                    if self.featureCounts.has_key(df):
   63.67 +                        if self.featureCounts[df] > 20:
   63.68 +                            continue
   63.69 +                    else:
   63.70 +                        print df
   63.71 +                    try:
   63.72 +                        fMap[df] += self.alpha * (1.0 - fMap[df])
   63.73 +                    except:
   63.74 +                        fMap[df] = self.alpha
   63.75 +            """
   63.76 +            #print 'fNew',len(fMap)
   63.77 +            
   63.78 +    def expand(self,features):
   63.79 +        #print self.corpus[:50]        
   63.80 +        #print corpus
   63.81 +        #tfidfmodel = models.TfidfModel(self.corpus, normalize=True)        
   63.82 +        #print features.keys()        
   63.83 +        #tfidfcorpus = [tfidfmodel[x] for x in self.corpus]
   63.84 +        #newFeatures = LSI[[(x,1) for x in features.keys()]]
   63.85 +        newFeatures = self.LSIModel[[(x,1) for x in features.keys()]]
   63.86 +        print features
   63.87 +        print newFeatures
   63.88 +        #print newFeatures
   63.89 +        
   63.90 +        """
   63.91 +        newFeatures = dict(features)
   63.92 +        for f in features.keys():
   63.93 +            try:
   63.94 +                fC = self.featureCounts[f]
   63.95 +            except:
   63.96 +                fC = 0.5
   63.97 +            newFeatures[f] = log(float(8+self.counter) / fC)
   63.98 +        #nrOfFeatures = float(len(features))
   63.99 +        addedCount = 0
  63.100 +        alpha = 0.2
  63.101 +        #"""
  63.102 +        
  63.103 +        """
  63.104 +        consideredFeatures = []
  63.105 +        while len(newFeatures) < 30:
  63.106 +            #alpha = alpha * 0.5
  63.107 +            minF = None
  63.108 +            minFrequence = 1000000
  63.109 +            for f in newFeatures.iterkeys():
  63.110 +                if f in consideredFeatures:
  63.111 +                    continue
  63.112 +                try:
  63.113 +                    if self.featureCounts[f] < minFrequence:
  63.114 +                        minF = f
  63.115 +                except:
  63.116 +                    pass
  63.117 +            if minF == None:
  63.118 +                break
  63.119 +            # Expand minimal feature
  63.120 +            consideredFeatures.append(minF)
  63.121 +            for expF in self.featureMap[minF]:
  63.122 +                if not newFeatures.has_key(expF):
  63.123 +                    fC = self.featureCounts[minF]
  63.124 +                    newFeatures[expF] = alpha*log(float(8+self.counter) / fC)
  63.125 +        #print features, newFeatures
  63.126 +        #"""
  63.127 +        """
  63.128 +        for f in features.iterkeys():
  63.129 +            try:
  63.130 +                self.featureCounts[f] += 1
  63.131 +            except:
  63.132 +                self.featureCounts[f] = 0            
  63.133 +            if self.featureCounts[f] > 10:
  63.134 +                continue            
  63.135 +            addedCount += 1
  63.136 +            try:
  63.137 +                fmap = self.featureMap[f]
  63.138 +            except:
  63.139 +                self.featureMap[f] = {}
  63.140 +                fmap = {}
  63.141 +            for nf,nv in fmap.iteritems():
  63.142 +                try:
  63.143 +                    newFeatures[nf] += nv
  63.144 +                except:
  63.145 +                    newFeatures[nf] = nv
  63.146 +        if addedCount > 0: 
  63.147 +            for f,w in newFeatures.iteritems():
  63.148 +                newFeatures[f] = float(w)/addedCount
  63.149 +        #"""                    
  63.150 +        """
  63.151 +        deleteF = []
  63.152 +        for f,w in newFeatures.iteritems():
  63.153 +            if w < 0.1:
  63.154 +                deleteF.append(f)
  63.155 +        for f in deleteF:
  63.156 +            del newFeatures[f]
  63.157 +        """
  63.158 +        #print 'fold',len(features)
  63.159 +        #print 'fnew',len(newFeatures)
  63.160 +        return dict(newFeatures)
  63.161 +
  63.162 +if __name__ == "__main__":
  63.163 +    pass
  63.164 +    
  63.165 +        
  63.166 \ No newline at end of file
    64.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    64.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/KNN.py	Fri Sep 13 09:31:45 2013 +0200
    64.3 @@ -0,0 +1,99 @@
    64.4 +'''
    64.5 +Created on Aug 21, 2013
    64.6 +
    64.7 +@author: daniel
    64.8 +'''
    64.9 +
   64.10 +from cPickle import dump,load
   64.11 +from numpy import array
   64.12 +from math import sqrt,log
   64.13 +
   64.14 +def cosine(f1,f2):
   64.15 +    f1Norm = 0.0
   64.16 +    for f in f1.keys():
   64.17 +        f1Norm += f1[f] * f1[f]
   64.18 +    #assert f1Norm = sum(map(lambda x,y: x*y,f1.itervalues(),f1.itervalues()))
   64.19 +    f1Norm = sqrt(f1Norm) 
   64.20 +    
   64.21 +    f2Norm = 0.0
   64.22 +    for f in f2.keys():
   64.23 +        f2Norm += f2[f] * f2[f]
   64.24 +    f2Norm = sqrt(f2Norm)         
   64.25 +   
   64.26 +    dotProduct = 0.0
   64.27 +    featureIntersection = set(f1.keys()) & set(f2.keys())
   64.28 +    for f in featureIntersection:
   64.29 +            dotProduct += f1[f] * f2[f]
   64.30 +    cosine = dotProduct / (f1Norm * f2Norm)        
   64.31 +    return 1.0 - cosine
   64.32 +
   64.33 +def euclidean(f1,f2):
   64.34 +    diffSum = 0.0        
   64.35 +    featureUnion = set(f1.keys()) | set(f2.keys())
   64.36 +    for f in featureUnion:
   64.37 +        try:
   64.38 +            f1Val = f1[f]
   64.39 +        except:
   64.40 +            f1Val = 0.0
   64.41 +        try:
   64.42 +            f2Val = f2[f]
   64.43 +        except:
   64.44 +            f2Val = 0.0
   64.45 +        diff = f1Val - f2Val
   64.46 +        diffSum += diff * diff
   64.47 +        #if f in f1.keys():
   64.48 +        #    diffSum += log(2+self.pointCount/self.featureCounts[f]) * diff * diff
   64.49 +        #else:
   64.50 +        #    diffSum += diff * diff            
   64.51 +    #print diffSum,f1,f2
   64.52 +    return diffSum
   64.53 +
   64.54 +class KNN(object):
   64.55 +    '''
   64.56 +    A basic KNN ranker.
   64.57 +    '''
   64.58 +
   64.59 +    def __init__(self,dicts,metric=cosine):
   64.60 +        '''
   64.61 +        Constructor
   64.62 +        '''
   64.63 +        self.points = dicts.featureDict
   64.64 +        self.metric = metric
   64.65 +
   64.66 +    def initializeModel(self,_trainData,_dicts):  
   64.67 +        """
   64.68 +        Build basic model from training data.
   64.69 +        """
   64.70 +        pass
   64.71 +    
   64.72 +    def update(self,dataPoint,features,dependencies):
   64.73 +        assert self.points[dataPoint] == features
   64.74 +        
   64.75 +    def overwrite(self,problemId,newDependencies,dicts):
   64.76 +        # Taken care of by dicts
   64.77 +        pass
   64.78 +    
   64.79 +    def delete(self,dataPoint,features,dependencies):
   64.80 +        # Taken care of by dicts
   64.81 +        pass      
   64.82 +    
   64.83 +    def predict(self,features,accessibles,dicts):
   64.84 +        predictions = map(lambda x: self.metric(features,self.points[x]),accessibles)
   64.85 +        predictions = array(predictions)
   64.86 +        perm = predictions.argsort()
   64.87 +        return array(accessibles)[perm],predictions[perm]
   64.88 +    
   64.89 +    def save(self,fileName):
   64.90 +        OStream = open(fileName, 'wb')
   64.91 +        dump((self.points,self.metric),OStream)
   64.92 +        OStream.close()
   64.93 +
   64.94 +    def load(self,fileName):
   64.95 +        OStream = open(fileName, 'rb')
   64.96 +        self.points,self.metric = load(OStream)
   64.97 +        OStream.close()
   64.98 +
   64.99 +if __name__ == '__main__':
  64.100 +    pass    
  64.101 +        
  64.102 +        
  64.103 \ No newline at end of file
    65.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    65.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/KNNs.py	Fri Sep 13 09:31:45 2013 +0200
    65.3 @@ -0,0 +1,105 @@
    65.4 +'''
    65.5 +Created on Aug 21, 2013
    65.6 +
    65.7 +@author: daniel
    65.8 +'''
    65.9 +
   65.10 +from math import log
   65.11 +from KNN import KNN,cosine
   65.12 +from numpy import array
   65.13 +
   65.14 +class KNNAdaptPointFeatures(KNN):
   65.15 +    
   65.16 +    def __init__(self,dicts,metric=cosine,alpha = 0.05):
   65.17 +        self.points = dicts.featureDict
   65.18 +        self.metric = self.euclidean    
   65.19 +        self.alpha = alpha
   65.20 +        self.count = 0
   65.21 +        self.featureCount = {}
   65.22 +
   65.23 +    def initializeModel(self,trainData,dicts):  
   65.24 +        """
   65.25 +        Build basic model from training data.
   65.26 +        """
   65.27 +        IS = open(dicts.accFile,'r')
   65.28 +        for line in IS:
   65.29 +            line = line.split(':')
   65.30 +            name = line[0]
   65.31 +            nameId = dicts.nameIdDict[name]
   65.32 +            features = dicts.featureDict[nameId]
   65.33 +            dependencies = dicts.dependenciesDict[nameId] 
   65.34 +            self.update(nameId, features, dependencies)
   65.35 +        IS.close()
   65.36 +        
   65.37 +    def update(self,dataPoint,features,dependencies):
   65.38 +        self.count += 1
   65.39 +        for f in features.iterkeys():
   65.40 +            try:
   65.41 +                self.featureCount[f] += 1
   65.42 +            except:
   65.43 +                self.featureCount[f] = 1
   65.44 +        for d in dependencies:
   65.45 +            dFeatures = self.points[d]
   65.46 +            featureUnion = set(dFeatures.keys()) | set(features.keys())
   65.47 +            for f in featureUnion:
   65.48 +                try:
   65.49 +                    pVal = features[f]
   65.50 +                except:
   65.51 +                    pVal = 0.0
   65.52 +                try:
   65.53 +                    dVal = dFeatures[f]
   65.54 +                except:
   65.55 +                    dVal = 0.0
   65.56 +                newDVal = dVal + self.alpha * (pVal - dVal)                
   65.57 +                dFeatures[f] = newDVal           
   65.58 +        
   65.59 +    def euclidean(self,f1,f2):
   65.60 +        diffSum = 0.0        
   65.61 +        f1Set = set(f1.keys())
   65.62 +        featureUnion = f1Set | set(f2.keys())
   65.63 +        for f in featureUnion:
   65.64 +            if not self.featureCount.has_key(f):
   65.65 +                continue
   65.66 +            if self.featureCount[f] == 1:
   65.67 +                continue
   65.68 +            try:
   65.69 +                f1Val = f1[f]
   65.70 +            except:
   65.71 +                f1Val = 0.0
   65.72 +            try:
   65.73 +                f2Val = f2[f]
   65.74 +            except:
   65.75 +                f2Val = 0.0
   65.76 +            diff = f1Val - f2Val
   65.77 +            diffSum += diff * diff
   65.78 +            if f in f1Set:
   65.79 +                diffSum += log(2+self.count/self.featureCount[f]) * diff * diff
   65.80 +            else:
   65.81 +                diffSum += diff * diff            
   65.82 +        #print diffSum,f1,f2
   65.83 +        return diffSum 
   65.84 +
   65.85 +class KNNUrban(KNN):
   65.86 +    def __init__(self,dicts,metric=cosine,nrOfNeighbours = 40):
   65.87 +        self.points = dicts.featureDict
   65.88 +        self.metric = metric    
   65.89 +        self.nrOfNeighbours = nrOfNeighbours # Ignored at the moment
   65.90 +    
   65.91 +    def predict(self,features,accessibles,dicts):
   65.92 +        predictions = map(lambda x: self.metric(features,self.points[x]),accessibles)
   65.93 +        pDict = dict(zip(accessibles,predictions))
   65.94 +        for a,p in zip(accessibles,predictions):
   65.95 +            aDeps = dicts.dependenciesDict[a]
   65.96 +            for d in aDeps:
   65.97 +                pDict[d] -= p 
   65.98 +        predictions = []
   65.99 +        names = []
  65.100 +        for n,p in pDict.items():
  65.101 +            predictions.append(p)
  65.102 +            names.append(n)        
  65.103 +        predictions = array(predictions)
  65.104 +        perm = predictions.argsort()
  65.105 +        return array(names)[perm],predictions[perm]
  65.106 +    
  65.107 +    
  65.108 +         
  65.109 \ No newline at end of file
    67.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/dictionaries.py	Thu Sep 12 22:10:17 2013 +0200
    67.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/dictionaries.py	Fri Sep 13 09:31:45 2013 +0200
    67.3 @@ -1,18 +1,13 @@
    67.4  #     Title:      HOL/Tools/Sledgehammer/MaSh/src/dictionaries.py
    67.5  #     Author:     Daniel Kuehlwein, ICIS, Radboud University Nijmegen
    67.6 -#     Copyright   2012
    67.7 +#     Copyright   2012-2013
    67.8  #
    67.9  # Persistent dictionaries: accessibility, dependencies, and features.
   67.10  
   67.11 -'''
   67.12 -Created on Jul 12, 2012
   67.13 -
   67.14 -@author: daniel
   67.15 -'''
   67.16 -
   67.17 +import logging,sys
   67.18  from os.path import join
   67.19  from Queue import Queue
   67.20 -from readData import create_accessible_dict,create_dependencies_dict,create_feature_dict
   67.21 +from readData import create_accessible_dict,create_dependencies_dict
   67.22  from cPickle import load,dump
   67.23  
   67.24  class Dictionaries(object):
   67.25 @@ -32,20 +27,17 @@
   67.26          self.dependenciesDict = {}
   67.27          self.accessibleDict = {}
   67.28          self.expandedAccessibles = {}
   67.29 -        # For SInE features
   67.30 -        self.useSine = False
   67.31 -        self.featureCountDict = {} 
   67.32 -        self.triggerFeaturesDict = {} 
   67.33 -        self.featureTriggeredFormulasDict = {}
   67.34 +        self.accFile =  ''
   67.35          self.changed = True
   67.36  
   67.37      """
   67.38      Init functions. nameIdDict, idNameDict, featureIdDict, articleDict get filled!
   67.39      """
   67.40 -    def init_featureDict(self,featureFile,sineFeatures):
   67.41 -        self.featureDict,self.maxNameId,self.maxFeatureId,self.featureCountDict,self.triggerFeaturesDict,self.featureTriggeredFormulasDict =\
   67.42 -         create_feature_dict(self.nameIdDict,self.idNameDict,self.maxNameId,self.featureIdDict,self.maxFeatureId,self.featureCountDict,\
   67.43 -                             self.triggerFeaturesDict,self.featureTriggeredFormulasDict,sineFeatures,featureFile)
   67.44 +    def init_featureDict(self,featureFile):
   67.45 +        self.create_feature_dict(featureFile)
   67.46 +        #self.featureDict,self.maxNameId,self.maxFeatureId,self.featureCountDict,self.triggerFeaturesDict,self.featureTriggeredFormulasDict =\
   67.47 +        # create_feature_dict(self.nameIdDict,self.idNameDict,self.maxNameId,self.featureIdDict,self.maxFeatureId,self.featureCountDict,\
   67.48 +        #                     self.triggerFeaturesDict,self.featureTriggeredFormulasDict,sineFeatures,featureFile)
   67.49      def init_dependenciesDict(self,depFile):
   67.50          self.dependenciesDict = create_dependencies_dict(self.nameIdDict,depFile)
   67.51      def init_accessibleDict(self,accFile):
   67.52 @@ -54,16 +46,37 @@
   67.53      def init_all(self,args):
   67.54          self.featureFileName = 'mash_features'
   67.55          self.accFileName = 'mash_accessibility'
   67.56 -        self.useSine = args.sineFeatures
   67.57          featureFile = join(args.inputDir,self.featureFileName)
   67.58          depFile = join(args.inputDir,args.depFile)
   67.59 -        accFile = join(args.inputDir,self.accFileName)
   67.60 -        self.init_featureDict(featureFile,self.useSine)
   67.61 -        self.init_accessibleDict(accFile)
   67.62 +        self.accFile = join(args.inputDir,self.accFileName)
   67.63 +        self.init_featureDict(featureFile)
   67.64 +        self.init_accessibleDict(self.accFile)
   67.65          self.init_dependenciesDict(depFile)
   67.66          self.expandedAccessibles = {}
   67.67          self.changed = True
   67.68  
   67.69 +    def create_feature_dict(self,inputFile):
   67.70 +        logger = logging.getLogger('create_feature_dict')
   67.71 +        self.featureDict = {}
   67.72 +        IS = open(inputFile,'r')
   67.73 +        for line in IS:
   67.74 +            line = line.split(':')
   67.75 +            name = line[0]
   67.76 +            # Name Id
   67.77 +            if self.nameIdDict.has_key(name):
   67.78 +                logger.warning('%s appears twice in the feature file. Aborting.',name)
   67.79 +                sys.exit(-1)
   67.80 +            else:
   67.81 +                self.nameIdDict[name] = self.maxNameId
   67.82 +                self.idNameDict[self.maxNameId] = name
   67.83 +                nameId = self.maxNameId
   67.84 +                self.maxNameId += 1
   67.85 +            features = self.get_features(line)
   67.86 +            # Store results
   67.87 +            self.featureDict[nameId] = features
   67.88 +        IS.close()
   67.89 +        return
   67.90 +
   67.91      def get_name_id(self,name):
   67.92          """
   67.93          Return the Id for a name.
   67.94 @@ -82,27 +95,23 @@
   67.95      def add_feature(self,featureName):
   67.96          if not self.featureIdDict.has_key(featureName):
   67.97              self.featureIdDict[featureName] = self.maxFeatureId
   67.98 -            if self.useSine:
   67.99 -                self.featureCountDict[self.maxFeatureId] = 0
  67.100              self.maxFeatureId += 1
  67.101              self.changed = True
  67.102          fId = self.featureIdDict[featureName]
  67.103 -        if self.useSine:
  67.104 -            self.featureCountDict[fId] += 1
  67.105          return fId
  67.106  
  67.107      def get_features(self,line):
  67.108 -        # Feature Ids
  67.109          featureNames = [f.strip() for f in line[1].split()]
  67.110 -        features = []
  67.111 +        features = {}
  67.112          for fn in featureNames:
  67.113              tmp = fn.split('=')
  67.114 -            weight = 1.0
  67.115 +            weight = 1.0 
  67.116              if len(tmp) == 2:
  67.117                  fn = tmp[0]
  67.118                  weight = float(tmp[1])
  67.119              fId = self.add_feature(tmp[0])
  67.120 -            features.append((fId,weight))
  67.121 +            features[fId] = weight
  67.122 +            #features[fId] = 1.0 ###
  67.123          return features
  67.124  
  67.125      def expand_accessibles(self,acc):
  67.126 @@ -142,16 +151,6 @@
  67.127          self.accessibleDict[nameId] = unExpAcc
  67.128          features = self.get_features(line)
  67.129          self.featureDict[nameId] = features
  67.130 -        if self.useSine:
  67.131 -            # SInE Features
  67.132 -            minFeatureCount = min([self.featureCountDict[f] for f,_w in features])
  67.133 -            triggerFeatures = [f for f,_w in features if self.featureCountDict[f] == minFeatureCount]
  67.134 -            self.triggerFeaturesDict[nameId] = triggerFeatures
  67.135 -            for f in triggerFeatures:
  67.136 -                if self.featureTriggeredFormulasDict.has_key(f): 
  67.137 -                    self.featureTriggeredFormulasDict[f].append(nameId)
  67.138 -                else:
  67.139 -                    self.featureTriggeredFormulasDict[f] = [nameId]        
  67.140          self.dependenciesDict[nameId] = [self.nameIdDict[d.strip()] for d in line[2].split()]        
  67.141          self.changed = True
  67.142          return nameId
  67.143 @@ -219,14 +218,12 @@
  67.144          if self.changed:
  67.145              dictsStream = open(fileName, 'wb')
  67.146              dump((self.accessibleDict,self.dependenciesDict,self.expandedAccessibles,self.featureDict,\
  67.147 -                self.featureIdDict,self.idNameDict,self.maxFeatureId,self.maxNameId,self.nameIdDict,\
  67.148 -                self.featureCountDict,self.triggerFeaturesDict,self.featureTriggeredFormulasDict,self.useSine),dictsStream)
  67.149 +                self.featureIdDict,self.idNameDict,self.maxFeatureId,self.maxNameId,self.nameIdDict),dictsStream)
  67.150              self.changed = False
  67.151              dictsStream.close()
  67.152      def load(self,fileName):
  67.153          dictsStream = open(fileName, 'rb')
  67.154          self.accessibleDict,self.dependenciesDict,self.expandedAccessibles,self.featureDict,\
  67.155 -              self.featureIdDict,self.idNameDict,self.maxFeatureId,self.maxNameId,self.nameIdDict,\
  67.156 -              self.featureCountDict,self.triggerFeaturesDict,self.featureTriggeredFormulasDict,self.useSine = load(dictsStream)
  67.157 +              self.featureIdDict,self.idNameDict,self.maxFeatureId,self.maxNameId,self.nameIdDict = load(dictsStream)
  67.158          self.changed = False
  67.159          dictsStream.close()
    69.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/mash.py	Thu Sep 12 22:10:17 2013 +0200
    69.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/mash.py	Fri Sep 13 09:31:45 2013 +0200
    69.3 @@ -41,7 +41,7 @@
    69.4      path = dirname(realpath(__file__))
    69.5      spawnDaemon(os.path.join(path,'server.py'))
    69.6      serverIsUp=False
    69.7 -    for _i in range(10):
    69.8 +    for _i in range(20):
    69.9          # Test if server is up
   69.10          try:
   69.11              sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
   69.12 @@ -118,11 +118,12 @@
   69.13                  OS.write('%s\n' % received)
   69.14          OS.close()
   69.15          IS.close()
   69.16 +        
   69.17 +        # Statistics
   69.18 +        if args.statistics:
   69.19 +            received = communicate('avgStats',args.host,args.port)
   69.20 +            logger.info(received)
   69.21  
   69.22 -    # Statistics
   69.23 -    if args.statistics:
   69.24 -        received = communicate('avgStats',args.host,args.port)
   69.25 -        logger.info(received)
   69.26      if args.saveModels:
   69.27          communicate('save',args.host,args.port)
   69.28  
    70.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/mashTest.py	Thu Sep 12 22:10:17 2013 +0200
    70.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    70.3 @@ -1,12 +0,0 @@
    70.4 -'''
    70.5 -Created on Aug 20, 2013
    70.6 -
    70.7 -@author: daniel
    70.8 -'''
    70.9 -from mash import mash
   70.10 -
   70.11 -if __name__ == "__main__":
   70.12 -    args = ['--statistics', '--init', '--inputDir', '../data/20130118/Jinja', '--log', '../tmp/auth.log', '--modelFile', '../tmp/m0', '--dictsFile', '../tmp/d0','--NBDefaultPriorWeight', '20.0', '--NBDefVal', '-15.0', '--NBPosWeight', '10.0']
   70.13 -    mash(args)
   70.14 -    args = ['-i', '../data/20130118/Jinja/mash_commands', '-p', '../tmp/auth.pred0', '--statistics', '--cutOff', '500', '--log', '../tmp/auth.log','--modelFile', '../tmp/m0', '--dictsFile', '../tmp/d0']
   70.15 -    mash(args) 
   70.16 \ No newline at end of file
    71.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/parameters.py	Thu Sep 12 22:10:17 2013 +0200
    71.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/parameters.py	Fri Sep 13 09:31:45 2013 +0200
    71.3 @@ -22,14 +22,13 @@
    71.4      parser.add_argument('--depFile', default='mash_dependencies',
    71.5                          help='Name of the file with the premise dependencies. The file must be in inputDir. Default = mash_dependencies')
    71.6      
    71.7 -    parser.add_argument('--algorithm',default='nb',help="Which learning algorithm is used. nb = Naive Bayes,predef=predefined. Default=nb.")
    71.8 +    parser.add_argument('--algorithm',default='nb',help="Which learning algorithm is used. nb = Naive Bayes,KNN,predef=predefined. Default=nb.")
    71.9 +    parser.add_argument('--predef',help="File containing the predefined suggestions. Only used when algorithm = predef.")
   71.10      # NB Parameters
   71.11      parser.add_argument('--NBDefaultPriorWeight',default=20.0,help="Initializes classifiers with value * p |- p. Default=20.0.",type=float)
   71.12      parser.add_argument('--NBDefVal',default=-15.0,help="Default value for unknown features. Default=-15.0.",type=float)
   71.13      parser.add_argument('--NBPosWeight',default=10.0,help="Weight value for positive features. Default=10.0.",type=float)
   71.14 -    # TODO: Rename to sineFeatures
   71.15 -    parser.add_argument('--sineFeatures',default=False,action='store_true',help="Uses a SInE like prior for premise lvl predictions. Default=False.")
   71.16 -    parser.add_argument('--sineWeight',default=0.5,help="How much the SInE prior is weighted. Default=0.5.",type=float)
   71.17 +    parser.add_argument('--expandFeatures',default=False,action='store_true',help="Learning-based feature expansion. Default=False.")
   71.18      
   71.19      parser.add_argument('--statistics',default=False,action='store_true',help="Create and show statistics for the top CUTOFF predictions.\
   71.20                          WARNING: This will make the program a lot slower! Default=False.")
    72.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/readData.py	Thu Sep 12 22:10:17 2013 +0200
    72.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/readData.py	Fri Sep 13 09:31:45 2013 +0200
    72.3 @@ -14,55 +14,6 @@
    72.4  
    72.5  import sys,logging
    72.6  
    72.7 -def create_feature_dict(nameIdDict,idNameDict,maxNameId,featureIdDict,maxFeatureId,featureCountDict,\
    72.8 -                        triggerFeaturesDict,featureTriggeredFormulasDict,sineFeatures,inputFile):
    72.9 -    logger = logging.getLogger('create_feature_dict')
   72.10 -    featureDict = {}
   72.11 -    IS = open(inputFile,'r')
   72.12 -    for line in IS:
   72.13 -        line = line.split(':')
   72.14 -        name = line[0]
   72.15 -        # Name Id
   72.16 -        if nameIdDict.has_key(name):
   72.17 -            logger.warning('%s appears twice in the feature file. Aborting.',name)
   72.18 -            sys.exit(-1)
   72.19 -        else:
   72.20 -            nameIdDict[name] = maxNameId
   72.21 -            idNameDict[maxNameId] = name
   72.22 -            nameId = maxNameId
   72.23 -            maxNameId += 1
   72.24 -        # Feature Ids
   72.25 -        featureNames = [f.strip() for f in line[1].split()]
   72.26 -        features = []     
   72.27 -        minFeatureCount = 9999999   
   72.28 -        for fn in featureNames:
   72.29 -            weight = 1.0
   72.30 -            tmp = fn.split('=')
   72.31 -            if len(tmp) == 2:
   72.32 -                fn = tmp[0]
   72.33 -                weight = float(tmp[1])
   72.34 -            if not featureIdDict.has_key(fn):
   72.35 -                featureIdDict[fn] = maxFeatureId
   72.36 -                featureCountDict[maxFeatureId] = 0
   72.37 -                maxFeatureId += 1
   72.38 -            fId = featureIdDict[fn]
   72.39 -            features.append((fId,weight))
   72.40 -            if sineFeatures:
   72.41 -                featureCountDict[fId] += 1
   72.42 -                minFeatureCount = min(minFeatureCount,featureCountDict[fId])
   72.43 -        # Store results
   72.44 -        featureDict[nameId] = features
   72.45 -        if sineFeatures:
   72.46 -            triggerFeatures = [f for f,_w in features if featureCountDict[f] == minFeatureCount]
   72.47 -            triggerFeaturesDict[nameId] = triggerFeatures
   72.48 -            for f in triggerFeatures:
   72.49 -                if featureTriggeredFormulasDict.has_key(f): 
   72.50 -                    featureTriggeredFormulasDict[f].append(nameId)
   72.51 -                else:
   72.52 -                    featureTriggeredFormulasDict[f] = [nameId]
   72.53 -    IS.close()
   72.54 -    return featureDict,maxNameId,maxFeatureId,featureCountDict,triggerFeaturesDict,featureTriggeredFormulasDict
   72.55 -
   72.56  def create_dependencies_dict(nameIdDict,inputFile):
   72.57      logger = logging.getLogger('create_dependencies_dict')
   72.58      dependenciesDict = {}
    73.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/server.py	Thu Sep 12 22:10:17 2013 +0200
    73.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/server.py	Fri Sep 13 09:31:45 2013 +0200
    73.3 @@ -7,10 +7,15 @@
    73.4  
    73.5  import SocketServer,os,string,logging
    73.6  from multiprocessing import Manager
    73.7 +from threading import Timer
    73.8  from time import time
    73.9  from dictionaries import Dictionaries
   73.10  from parameters import init_parser
   73.11  from sparseNaiveBayes import sparseNBClassifier
   73.12 +from KNN import KNN,euclidean
   73.13 +from KNNs import KNNAdaptPointFeatures,KNNUrban
   73.14 +from predefined import Predefined
   73.15 +#from ExpandFeatures import ExpandFeatures
   73.16  from stats import Statistics
   73.17  
   73.18  
   73.19 @@ -19,6 +24,21 @@
   73.20          SocketServer.ThreadingTCPServer.__init__(self,*args, **kwargs)
   73.21          self.manager = Manager()
   73.22          self.lock = Manager().Lock()
   73.23 +        self.idle_timeout = 28800.0 # 8 hours in seconds
   73.24 +        self.idle_timer = Timer(self.idle_timeout, self.shutdown)
   73.25 +        self.idle_timer.start()        
   73.26 +        
   73.27 +    def save(self):
   73.28 +        # Save Models
   73.29 +        self.model.save(self.args.modelFile)
   73.30 +        self.dicts.save(self.args.dictsFile)
   73.31 +        if not self.args.saveStats == None:
   73.32 +            statsFile = os.path.join(self.args.outputDir,self.args.saveStats)
   73.33 +            self.stats.save(statsFile)   
   73.34 +               
   73.35 +    def save_and_shutdown(self):     
   73.36 +        self.save()          
   73.37 +        self.shutdown()
   73.38  
   73.39  class MaShHandler(SocketServer.BaseRequestHandler):
   73.40  
   73.41 @@ -28,25 +48,32 @@
   73.42          else:
   73.43              argv = argv.split(';')
   73.44              self.server.args = init_parser(argv)
   73.45 -        # Pick model
   73.46 -        if self.server.args.algorithm == 'nb':
   73.47 -            self.server.model = sparseNBClassifier(self.server.args.NBDefaultPriorWeight,self.server.args.NBPosWeight,self.server.args.NBDefVal)
   73.48 -        else: # Default case
   73.49 -            self.server.model = sparseNBClassifier(self.server.args.NBDefaultPriorWeight,self.server.args.NBPosWeight,self.server.args.NBDefVal)
   73.50          # Load all data
   73.51 -        # TODO: rewrite dicts for concurrency and without sine
   73.52          self.server.dicts = Dictionaries()
   73.53          if os.path.isfile(self.server.args.dictsFile):
   73.54              self.server.dicts.load(self.server.args.dictsFile)            
   73.55          elif self.server.args.init:
   73.56              self.server.dicts.init_all(self.server.args)
   73.57 +        # Pick model
   73.58 +        if self.server.args.algorithm == 'nb':
   73.59 +            self.server.model = sparseNBClassifier(self.server.args.NBDefaultPriorWeight,self.server.args.NBPosWeight,self.server.args.NBDefVal)
   73.60 +        elif self.server.args.algorithm == 'KNN':
   73.61 +            #self.server.model = KNN(self.server.dicts)
   73.62 +            self.server.model = KNNAdaptPointFeatures(self.server.dicts)
   73.63 +        elif self.server.args.algorithm == 'predef':
   73.64 +            self.server.model = Predefined(self.server.args.predef)
   73.65 +        else: # Default case
   73.66 +            self.server.model = sparseNBClassifier(self.server.args.NBDefaultPriorWeight,self.server.args.NBPosWeight,self.server.args.NBDefVal)
   73.67 +#        if self.server.args.expandFeatures:
   73.68 +#            self.server.expandFeatures = ExpandFeatures(self.server.dicts)
   73.69 +#            self.server.expandFeatures.initialize(self.server.dicts)
   73.70          # Create Model
   73.71          if os.path.isfile(self.server.args.modelFile):
   73.72              self.server.model.load(self.server.args.modelFile)          
   73.73          elif self.server.args.init:
   73.74              trainData = self.server.dicts.featureDict.keys()
   73.75              self.server.model.initializeModel(trainData,self.server.dicts)
   73.76 -            
   73.77 +           
   73.78          if self.server.args.statistics:
   73.79              self.server.stats = Statistics(self.server.args.cutOff)
   73.80              self.server.statementCounter = 1
   73.81 @@ -77,6 +104,8 @@
   73.82                  self.server.logger.debug('Poor predictions: %s',bp)
   73.83              self.server.statementCounter += 1
   73.84  
   73.85 +#        if self.server.args.expandFeatures:
   73.86 +#            self.server.expandFeatures.update(self.server.dicts.featureDict[problemId],self.server.dicts.dependenciesDict[problemId])
   73.87          # Update Dependencies, p proves p
   73.88          self.server.dicts.dependenciesDict[problemId] = [problemId]+self.server.dicts.dependenciesDict[problemId]
   73.89          self.server.model.update(problemId,self.server.dicts.featureDict[problemId],self.server.dicts.dependenciesDict[problemId])
   73.90 @@ -92,22 +121,25 @@
   73.91          self.server.computeStats = True
   73.92          if self.server.args.algorithm == 'predef':
   73.93              return
   73.94 -        name,features,accessibles,hints,numberOfPredictions = self.server.dicts.parse_problem(self.data)  
   73.95 +        name,features,accessibles,hints,numberOfPredictions = self.server.dicts.parse_problem(self.data)
   73.96          if numberOfPredictions == None:
   73.97              numberOfPredictions = self.server.args.numberOfPredictions
   73.98          if not hints == []:
   73.99              self.server.model.update('hints',features,hints)
  73.100 -        
  73.101 +#        if self.server.args.expandFeatures:
  73.102 +#            features = self.server.expandFeatures.expand(features)
  73.103          # Create predictions
  73.104          self.server.logger.debug('Starting computation for line %s',self.server.callCounter)
  73.105 -        predictionsFeatures = features                    
  73.106 -        self.server.predictions,predictionValues = self.server.model.predict(predictionsFeatures,accessibles,self.server.dicts)
  73.107 +                
  73.108 +        self.server.predictions,predictionValues = self.server.model.predict(features,accessibles,self.server.dicts)
  73.109          assert len(self.server.predictions) == len(predictionValues)
  73.110          self.server.logger.debug('Time needed: '+str(round(time()-self.startTime,2)))
  73.111  
  73.112          # Output        
  73.113          predictionNames = [str(self.server.dicts.idNameDict[p]) for p in self.server.predictions[:numberOfPredictions]]
  73.114 -        predictionValues = [str(x) for x in predictionValues[:numberOfPredictions]]
  73.115 +        #predictionValues = [str(x) for x in predictionValues[:numberOfPredictions]]
  73.116 +        #predictionsStringList = ['%s=%s' % (predictionNames[i],predictionValues[i]) for i in range(len(predictionNames))]
  73.117 +        #predictionsString = string.join(predictionsStringList,' ')
  73.118          predictionsString = string.join(predictionNames,' ')
  73.119          outString = '%s: %s' % (name,predictionsString)
  73.120          self.request.sendall(outString)
  73.121 @@ -115,27 +147,18 @@
  73.122      def shutdown(self,saveModels=True):
  73.123          self.request.sendall('Shutting down server.')
  73.124          if saveModels:
  73.125 -            self.save()
  73.126 +            self.server.save()
  73.127          self.server.shutdown()
  73.128      
  73.129 -    def save(self):
  73.130 -        # Save Models
  73.131 -        self.server.model.save(self.server.args.modelFile)
  73.132 -        self.server.dicts.save(self.server.args.dictsFile)
  73.133 -        if not self.server.args.saveStats == None:
  73.134 -            statsFile = os.path.join(self.server.args.outputDir,self.server.args.saveStats)
  73.135 -            self.server.stats.save(statsFile)
  73.136 -    
  73.137      def handle(self):
  73.138          # self.request is the TCP socket connected to the client
  73.139          self.data = self.request.recv(4194304).strip()
  73.140          self.server.lock.acquire()
  73.141 -        #print "{} wrote:".format(self.client_address[0])
  73.142          self.startTime = time()  
  73.143          if self.data == 'shutdown':
  73.144              self.shutdown()         
  73.145          elif self.data == 'save':
  73.146 -            self.save()       
  73.147 +            self.server.save()       
  73.148          elif self.data.startswith('i'):            
  73.149              self.init(self.data[2:])
  73.150          elif self.data.startswith('!'):
  73.151 @@ -153,15 +176,16 @@
  73.152          else:
  73.153              self.request.sendall('Unspecified input format: \n%s',self.data)
  73.154          self.server.callCounter += 1
  73.155 +        # Update idle shutdown timer
  73.156 +        self.server.idle_timer.cancel()
  73.157 +        self.server.idle_timer = Timer(self.server.idle_timeout, self.server.save_and_shutdown)
  73.158 +        self.server.idle_timer.start()        
  73.159          self.server.lock.release()
  73.160  
  73.161  if __name__ == "__main__":
  73.162      HOST, PORT = "localhost", 9255
  73.163 -    #print 'Started Server'
  73.164 -    # Create the server, binding to localhost on port 9999
  73.165      SocketServer.TCPServer.allow_reuse_address = True
  73.166      server = ThreadingTCPServer((HOST, PORT), MaShHandler)
  73.167 -    #server = SocketServer.TCPServer((HOST, PORT), MaShHandler)
  73.168  
  73.169      # Activate the server; this will keep running until you
  73.170      # interrupt the program with Ctrl-C
    74.1 --- a/src/HOL/Tools/Sledgehammer/MaSh/src/sparseNaiveBayes.py	Thu Sep 12 22:10:17 2013 +0200
    74.2 +++ b/src/HOL/Tools/Sledgehammer/MaSh/src/sparseNaiveBayes.py	Fri Sep 13 09:31:45 2013 +0200
    74.3 @@ -36,7 +36,7 @@
    74.4              dFeatureCounts = {}
    74.5              # Add p proves p with weight self.defaultPriorWeight
    74.6              if not self.defaultPriorWeight == 0:            
    74.7 -                for f,_w in dicts.featureDict[d]:
    74.8 +                for f in dicts.featureDict[d].iterkeys():
    74.9                      dFeatureCounts[f] = self.defaultPriorWeight
   74.10              self.counts[d] = [self.defaultPriorWeight,dFeatureCounts]
   74.11  
   74.12 @@ -44,7 +44,7 @@
   74.13              for dep in keyDeps:
   74.14                  self.counts[dep][0] += 1
   74.15                  depFeatures = dicts.featureDict[key]
   74.16 -                for f,_w in depFeatures:
   74.17 +                for f in depFeatures.iterkeys():
   74.18                      if self.counts[dep][1].has_key(f):
   74.19                          self.counts[dep][1][f] += 1
   74.20                      else:
   74.21 @@ -59,12 +59,12 @@
   74.22              dFeatureCounts = {}            
   74.23              # Give p |- p a higher weight
   74.24              if not self.defaultPriorWeight == 0:               
   74.25 -                for f,_w in features:
   74.26 +                for f in features.iterkeys():
   74.27                      dFeatureCounts[f] = self.defaultPriorWeight
   74.28              self.counts[dataPoint] = [self.defaultPriorWeight,dFeatureCounts]            
   74.29          for dep in dependencies:
   74.30              self.counts[dep][0] += 1
   74.31 -            for f,_w in features:
   74.32 +            for f in features.iterkeys():
   74.33                  if self.counts[dep][1].has_key(f):
   74.34                      self.counts[dep][1][f] += 1
   74.35                  else:
   74.36 @@ -97,12 +97,14 @@
   74.37          """
   74.38          tau = 0.05 # Jasmin, change value here
   74.39          predictions = []
   74.40 +        #observedFeatures = [f for f,_w in features]
   74.41 +        observedFeatures = features.keys()
   74.42          for a in accessibles:
   74.43              posA = self.counts[a][0]
   74.44              fA = set(self.counts[a][1].keys())
   74.45              fWeightsA = self.counts[a][1]
   74.46              resultA = log(posA)
   74.47 -            for f,w in features:
   74.48 +            for f,w in features.iteritems():
   74.49                  # DEBUG
   74.50                  #w = 1.0
   74.51                  if f in fA:
   74.52 @@ -114,9 +116,10 @@
   74.53                  else:
   74.54                      resultA += w*self.defVal
   74.55              if not tau == 0.0:
   74.56 -                observedFeatures = [f for f,_w in features]
   74.57                  missingFeatures = list(fA.difference(observedFeatures))
   74.58 -                sumOfWeights = sum([log(float(fWeightsA[x])/posA) for x in missingFeatures])
   74.59 +                #sumOfWeights = sum([log(float(fWeightsA[x])/posA) for x in missingFeatures])  # slower
   74.60 +                sumOfWeights = sum([log(float(fWeightsA[x])) for x in missingFeatures]) - log(posA) * len(missingFeatures) #DEFAULT
   74.61 +                #sumOfWeights = sum([log(float(fWeightsA[x])/self.totalFeatureCounts[x]) for x in missingFeatures]) - log(posA) * len(missingFeatures)
   74.62                  resultA -= tau * sumOfWeights
<