Merged.
authorballarin
Thu, 01 Oct 2009 07:40:25 +0200
changeset 32805 9b535493ac8d
parent 32804 ca430e6aee1c (current diff)
parent 32783 e43d761a742d (diff)
child 32806 06561afcadaa
child 32845 d2d0b9b1a69d
Merged.
lib/Tools/codegen
lib/Tools/jedit
lib/scripts/mirabelle
src/HOL/Code_Eval.thy
src/HOL/HoareParallel/Gar_Coll.thy
src/HOL/HoareParallel/Graph.thy
src/HOL/HoareParallel/Mul_Gar_Coll.thy
src/HOL/HoareParallel/OG_Com.thy
src/HOL/HoareParallel/OG_Examples.thy
src/HOL/HoareParallel/OG_Hoare.thy
src/HOL/HoareParallel/OG_Syntax.thy
src/HOL/HoareParallel/OG_Tactics.thy
src/HOL/HoareParallel/OG_Tran.thy
src/HOL/HoareParallel/Quote_Antiquote.thy
src/HOL/HoareParallel/RG_Com.thy
src/HOL/HoareParallel/RG_Examples.thy
src/HOL/HoareParallel/RG_Hoare.thy
src/HOL/HoareParallel/RG_Syntax.thy
src/HOL/HoareParallel/RG_Tran.thy
src/HOL/HoareParallel/ROOT.ML
src/HOL/HoareParallel/document/root.bib
src/HOL/HoareParallel/document/root.tex
src/HOL/Library/Legacy_GCD.thy
src/HOL/Library/Pocklington.thy
src/HOL/Library/Primes.thy
src/HOL/NatTransfer.thy
src/HOL/NewNumberTheory/Binomial.thy
src/HOL/NewNumberTheory/Cong.thy
src/HOL/NewNumberTheory/Fib.thy
src/HOL/NewNumberTheory/MiscAlgebra.thy
src/HOL/NewNumberTheory/ROOT.ML
src/HOL/NewNumberTheory/Residues.thy
src/HOL/NewNumberTheory/UniqueFactorization.thy
src/HOL/NumberTheory/BijectionRel.thy
src/HOL/NumberTheory/Chinese.thy
src/HOL/NumberTheory/Euler.thy
src/HOL/NumberTheory/EulerFermat.thy
src/HOL/NumberTheory/EvenOdd.thy
src/HOL/NumberTheory/Factorization.thy
src/HOL/NumberTheory/Fib.thy
src/HOL/NumberTheory/Finite2.thy
src/HOL/NumberTheory/Gauss.thy
src/HOL/NumberTheory/Int2.thy
src/HOL/NumberTheory/IntFact.thy
src/HOL/NumberTheory/IntPrimes.thy
src/HOL/NumberTheory/Quadratic_Reciprocity.thy
src/HOL/NumberTheory/ROOT.ML
src/HOL/NumberTheory/Residues.thy
src/HOL/NumberTheory/WilsonBij.thy
src/HOL/NumberTheory/WilsonRuss.thy
src/HOL/NumberTheory/document/root.tex
src/HOL/Tools/ComputeFloat.thy
src/HOL/Tools/ComputeHOL.thy
src/HOL/Tools/ComputeNumeral.thy
src/HOL/Tools/transfer_data.ML
src/HOL/ex/Mirabelle.thy
src/HOL/ex/mirabelle.ML
src/Pure/Isar/class_target.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/isar.scala
src/Pure/Isar/isar_syn.ML
src/Pure/Tools/isabelle_syntax.scala
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Admin/E/eproof	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,93 @@
+#!/usr/bin/perl -w
+#
+# eproof - run E and translate its output into TSTP format
+#
+# Author: Sascha Boehme, TU Muenchen
+#
+# This script is a port of a Bash script with the same name coming with
+# E 1.0-004 (written by Stephan Schulz).
+#
+
+
+use File::Basename qw/ dirname /;
+use File::Temp qw/ tempfile /;
+use English;
+
+
+# E executables
+
+my $edir = dirname($0);
+my $eprover = "$edir/eprover";
+my $epclextract = "$edir/epclextract";
+
+
+# build E command from given commandline arguments
+
+my $format = "";
+my $timelimit = 2000000000;   # effectively unlimited
+
+my $eprover_cmd = "'$eprover'";
+foreach (@ARGV) {
+  if (m/--cpu-limit=([0-9]+)/) {
+    $timelimit = $1;
+  }
+
+  if (m/--tstp-out/) {
+    $format = $_;
+  }
+  else {
+    $eprover_cmd = "$eprover_cmd '$_'";
+  }
+}
+$eprover_cmd = "$eprover_cmd -l4 -R -o- --pcl-terms-compressed --pcl-compact";
+
+
+# run E, redirecting output into a temporary file
+
+my ($fh, $filename) = tempfile(UNLINK => 1);
+my $r = system "$eprover_cmd > '$filename'";
+exit ($r >> 8) if $r != 0;
+
+
+# analyze E output
+
+my @lines = <$fh>;
+my $content = join "", @lines[-60 .. -1];
+  # Note: Like the original eproof, we only look at the last 60 lines.
+
+if ($content =~ m/Total time\s*:\s*([0-9]+\.[0-9]+)/) {
+  $timelimit = int($timelimit - $1 - 1);
+
+  if ($content =~ m/No proof found!/) {
+    print "# Problem is satisfiable (or invalid), " .
+      "generating saturation derivation\n";
+  }
+  elsif ($content =~ m/Proof found!/) {
+    print "# Problem is unsatisfiable (or provable), " .
+      "constructing proof object\n";
+  }
+  elsif ($content =~ m/Watchlist is empty!/) {
+    print "# All watchlist clauses generated, constructing derivation\n";
+  }
+  else {
+    print "# Cannot determine problem status\n";
+    exit $r;
+  }
+}
+else {
+  print "# Cannot determine problem status within resource limit\n";
+  exit $r;
+}
+
+
+# translate E output
+
+foreach (@lines) {
+  print if (m/# SZS status/ or m/"# Failure"/);
+}
+$r = system ("exec bash -c \"ulimit -S -t $timelimit; " .
+  "'$epclextract' $format -f --competition-framing '$filename'\"");
+  # Note: Setting the user time is not supported on Cygwin, i.e., ulimit fails
+  # and prints and error message. How could we then limit the execution time?
+exit ($r >> 8);
+
--- a/Admin/isatest/annomaly.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/Admin/isatest/annomaly.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -20,7 +20,7 @@
   val isabelleHome =
       case OS.Process.getEnv "ISABELLE_HOME"
        of  NONE => OS.FileSys.getDir ()
-	 | SOME home => mkAbsolute home
+         | SOME home => mkAbsolute home
 
   fun noparent [] = []
     | noparent (n :: ns) =
@@ -33,12 +33,12 @@
 
   fun rewrite defPrefix name =
       let val abs = mkAbsolute name
-	  val rel = OS.Path.mkRelative { path = abs, relativeTo = isabelleHome }
-	  val exists = (OS.FileSys.access(abs, nil)
-			handle OS.SysErr _ => false)
+          val rel = OS.Path.mkRelative { path = abs, relativeTo = isabelleHome }
+          val exists = (OS.FileSys.access(abs, nil)
+                        handle OS.SysErr _ => false)
       in  if exists andalso rel <> ""
-	  then isabellePath (toArcs rel)
-	  else defPrefix @ noparent (toArcs name)
+          then isabellePath (toArcs rel)
+          else defPrefix @ noparent (toArcs name)
       end handle OS.Path.Path => defPrefix @ noparent (toArcs name)
 
 in
@@ -49,10 +49,10 @@
         (* should we have different files for different line numbers? *
         val arcs = if line <= 1 then arcs
                    else arcs @ [ "l." ^ Int.toString line ]
-	*)
-	val arcs = if t = "structure Isabelle =\nstruct\nend;"
-		      andalso name = "ML"
-		   then ["empty_Isabelle", "empty" ] else arcs
+        *)
+        val arcs = if t = "structure Isabelle =\nstruct\nend;"
+                      andalso name = "ML"
+                   then ["empty_Isabelle", "empty" ] else arcs
         val _    = AnnoMaLy.nameNextStream arcs
     in  smlnj_use_text tune str_of_pos name_space (line, name) p v t  end;
 
--- a/Admin/isatest/isatest-makeall	Tue Sep 29 22:15:54 2009 +0200
+++ b/Admin/isatest/isatest-makeall	Thu Oct 01 07:40:25 2009 +0200
@@ -10,6 +10,8 @@
 # max time until test is aborted (in sec)
 MAXTIME=28800
 
+PUBLISH_TEST=/home/isabelle-repository/repos/testtool/publish_test.py
+
 ## diagnostics
 
 PRG="$(basename "$0")"
@@ -80,7 +82,7 @@
         NICE=""
         ;;
 
-    macbroy21)
+    macbroy22)
         MFLAGS="-k"
         NICE=""
         ;;
@@ -120,6 +122,8 @@
   TOOL="$ISABELLE_TOOL makeall $MFLAGS all"
 fi
 
+IDENT=$(cat "$DISTPREFIX/ISABELLE_IDENT")
+
 # main test loop
 
 log "starting [$@]"
@@ -159,10 +163,16 @@
     then
         # test log and cleanup
         echo ------------------- test successful --- `date` --- $HOSTNAME >> $TESTLOG 2>&1
+        if [ -x $PUBLISH_TEST ]; then
+            $PUBLISH_TEST -r $IDENT -s "SUCCESS" -a log $TESTLOG
+        fi
         gzip -f $TESTLOG
     else
         # test log
         echo ------------------- test FAILED --- `date` --- $HOSTNAME >> $TESTLOG 2>&1
+        if [ -x $PUBLISH_TEST ]; then
+             $PUBLISH_TEST -r $IDENT -s "FAIL" -a log $TESTLOG
+        fi
 
         # error log
         echo "Test for platform ${SHORT} failed. Log file attached." >> $ERRORLOG
--- a/Admin/isatest/isatest-makedist	Tue Sep 29 22:15:54 2009 +0200
+++ b/Admin/isatest/isatest-makedist	Thu Oct 01 07:40:25 2009 +0200
@@ -94,17 +94,17 @@
 $SSH sunbroy2 "$MAKEALL $HOME/settings/sun-poly"
 # give test some time to copy settings and start
 sleep 15
-$SSH macbroy21 "$MAKEALL $HOME/settings/at-poly"
+$SSH macbroy22 "$MAKEALL $HOME/settings/at-poly"
 sleep 15
 $SSH macbroy20 "$MAKEALL $HOME/settings/at-poly-5.1-para-e"
 sleep 15
 #$SSH macbroy24 "$MAKEALL -l HOL proofterms $HOME/settings/at-sml-dev-p"
 #sleep 15
-$SSH macbroy22 "$MAKEALL $HOME/settings/at64-poly-5.1-para"
+$SSH macbroy21 "$MAKEALL $HOME/settings/at64-poly-5.1-para"
 sleep 15
-$SSH macbroy23 -l HOL images "$MAKEALL $HOME/settings/at-sml-dev-e"
+$SSH macbroy23 "$MAKEALL -l HOL images $HOME/settings/at-sml-dev-e"
 sleep 15
-$SSH atbroy101 "$MAKEALL $HOME/settings/at64-poly"
+$SSH atbroy99 "$MAKEALL $HOME/settings/at64-poly"
 sleep 15
 $SSH macbroy2 "$MAKEALL $HOME/settings/mac-poly-M4; $MAKEALL $HOME/settings/mac-poly-M8; $MAKEALL $HOME/settings/mac-poly64-M4; $MAKEALL $HOME/settings/mac-poly64-M8"
 sleep 15
--- a/Admin/isatest/isatest-stats	Tue Sep 29 22:15:54 2009 +0200
+++ b/Admin/isatest/isatest-stats	Thu Oct 01 07:40:25 2009 +0200
@@ -6,7 +6,7 @@
 
 THIS=$(cd "$(dirname "$0")"; pwd -P)
 
-PLATFORMS="at-poly at64-poly mac-poly-M4 mac-poly64-M4 mac-poly-M8 at-poly-5.1-para-e at64-poly-5.1-para at-mac-poly-5.1-para afp at-sml-dev"
+PLATFORMS="at-poly at64-poly mac-poly-M4 mac-poly64-M4 mac-poly-M8 mac-poly64-M8 at-poly-5.1-para-e at64-poly-5.1-para at-mac-poly-5.1-para afp at-sml-dev"
 
 ISABELLE_SESSIONS="\
   HOL-Plain \
@@ -24,9 +24,9 @@
   HOL-MetisExamples \
   HOL-MicroJava \
   HOL-NSA \
-  HOL-NewNumberTheory \
   HOL-Nominal-Examples \
-  HOL-NumberTheory \
+  HOL-Number_Theory \
+  HOL-Old_Number_Theory \
   HOL-SET-Protocol \
   HOL-UNITY \
   HOL-Word \
--- a/Admin/user-aliases	Tue Sep 29 22:15:54 2009 +0200
+++ b/Admin/user-aliases	Thu Oct 01 07:40:25 2009 +0200
@@ -4,3 +4,5 @@
 nipkow@lapbroy100.local nipkow
 chaieb@chaieb-laptop chaieb
 immler@in.tum.de immler
+tsewell@rubicon.NSW.bigpond.net.au tsewell
+tsewell@nicta.com.au tsewell
--- a/CONTRIBUTORS	Tue Sep 29 22:15:54 2009 +0200
+++ b/CONTRIBUTORS	Thu Oct 01 07:40:25 2009 +0200
@@ -7,6 +7,18 @@
 Contributions to this Isabelle version
 --------------------------------------
 
+* September 2009: Thomas Sewell, NICTA
+  More efficient HOL/record implementation
+
+* September 2009: Sascha Boehme, TUM
+  SMT method using external SMT solvers
+
+* September 2009: Florian Haftmann, TUM
+  Refinement of Sets and Lattices
+
+* July 2009: Jeremy Avigad and Amine Chaieb
+  New number theory
+
 * July 2009: Philipp Meyer, TUM
   HOL/Library/Sum_of_Squares: functionality to call a remote csdp prover
 
--- a/NEWS	Tue Sep 29 22:15:54 2009 +0200
+++ b/NEWS	Thu Oct 01 07:40:25 2009 +0200
@@ -18,51 +18,31 @@
 
 *** HOL ***
 
-* New proof method "sos" (sum of squares) for nonlinear real arithmetic
-(originally due to John Harison). It requires Library/Sum_Of_Squares.
-It is not a complete decision procedure but works well in practice
-on quantifier-free real arithmetic with +, -, *, ^, =, <= and <,
-i.e. boolean combinations of equalities and inequalities between
-polynomials. It makes use of external semidefinite programming solvers.
-For more information and examples see Library/Sum_Of_Squares.
-
-* Set.UNIV and Set.empty are mere abbreviations for top and bot.  INCOMPATIBILITY.
-
-* More convenient names for set intersection and union.  INCOMPATIBILITY:
-
-    Set.Int ~>  Set.inter
-    Set.Un ~>   Set.union
-
-* Code generator attributes follow the usual underscore convention:
-    code_unfold     replaces    code unfold
-    code_post       replaces    code post
-    etc.
-  INCOMPATIBILITY.
-
-* New quickcheck implementation using new code generator.
-
-* New class "boolean_algebra".
-
-* Refinements to lattices classes:
-  - added boolean_algebra type class
-  - less default intro/elim rules in locale variant, more default
-    intro/elim rules in class variant: more uniformity
-  - lemma ge_sup_conv renamed to le_sup_iff, in accordance with le_inf_iff
-  - dropped lemma alias inf_ACI for inf_aci (same for sup_ACI and sup_aci)
-  - renamed ACI to inf_sup_aci
-  - class "complete_lattice" moved to separate theory "complete_lattice";
-    corresponding constants renamed:
-    
-    Set.Inf ~>      Complete_Lattice.Inf
-    Set.Sup ~>      Complete_Lattice.Sup
-    Set.INFI ~>     Complete_Lattice.INFI
-    Set.SUPR ~>     Complete_Lattice.SUPR
-    Set.Inter ~>    Complete_Lattice.Inter
-    Set.Union ~>    Complete_Lattice.Union
-    Set.INTER ~>    Complete_Lattice.INTER
-    Set.UNION ~>    Complete_Lattice.UNION
-
-  INCOMPATIBILITY.
+* Most rules produced by inductive and datatype package
+have mandatory prefixes.
+INCOMPATIBILITY.
+
+* New proof method "smt" for a combination of first-order logic
+with equality, linear and nonlinear (natural/integer/real)
+arithmetic, and fixed-size bitvectors; there is also basic
+support for higher-order features (esp. lambda abstractions).
+It is an incomplete decision procedure based on external SMT
+solvers using the oracle mechanism.
+
+* Reorganization of number theory:
+  * former session NumberTheory now named Old_Number_Theory
+  * new session Number_Theory by Jeremy Avigad; if possible, prefer this.
+  * moved legacy theories Legacy_GCD and Primes from Library/ to Old_Number_Theory/;
+  * moved theory Pocklington from Library/ to Old_Number_Theory/;
+  * removed various references to Old_Number_Theory from HOL distribution.
+INCOMPATIBILITY.
+
+* Theory GCD now has functions Gcd/GCD and Lcm/LCM for the gcd and lcm
+of finite and infinite sets. It is shown that they form a complete
+lattice.
+
+* Split off prime number ingredients from theory GCD
+to theory Number_Theory/Primes;
 
 * Class semiring_div requires superclass no_zero_divisors and proof of
 div_mult_mult1; theorems div_mult_mult1, div_mult_mult2,
@@ -72,20 +52,83 @@
 zdiv_zmult_zmult2.  div_mult_mult1 is now [simp] by default.
 INCOMPATIBILITY.
 
+* New testing tool "Mirabelle" for automated (proof) tools. Applies
+several tools and tactics like sledgehammer, metis, or quickcheck, to
+every proof step in a theory. To be used in batch mode via the
+"mirabelle" utility.
+
+* New proof method "sos" (sum of squares) for nonlinear real
+arithmetic (originally due to John Harison). It requires
+Library/Sum_Of_Squares.  It is not a complete decision procedure but
+works well in practice on quantifier-free real arithmetic with +, -,
+*, ^, =, <= and <, i.e. boolean combinations of equalities and
+inequalities between polynomials. It makes use of external
+semidefinite programming solvers.  For more information and examples
+see src/HOL/Library/Sum_Of_Squares.
+
+* Code generator attributes follow the usual underscore convention:
+    code_unfold     replaces    code unfold
+    code_post       replaces    code post
+    etc.
+  INCOMPATIBILITY.
+
+* Refinements to lattice classes and sets:
+  - less default intro/elim rules in locale variant, more default
+    intro/elim rules in class variant: more uniformity
+  - lemma ge_sup_conv renamed to le_sup_iff, in accordance with le_inf_iff
+  - dropped lemma alias inf_ACI for inf_aci (same for sup_ACI and sup_aci)
+  - renamed ACI to inf_sup_aci
+  - new class "boolean_algebra"
+  - class "complete_lattice" moved to separate theory "complete_lattice";
+    corresponding constants (and abbreviations) renamed and with authentic syntax:
+    Set.Inf ~>      Complete_Lattice.Inf
+    Set.Sup ~>      Complete_Lattice.Sup
+    Set.INFI ~>     Complete_Lattice.INFI
+    Set.SUPR ~>     Complete_Lattice.SUPR
+    Set.Inter ~>    Complete_Lattice.Inter
+    Set.Union ~>    Complete_Lattice.Union
+    Set.INTER ~>    Complete_Lattice.INTER
+    Set.UNION ~>    Complete_Lattice.UNION
+  - more convenient names for set intersection and union:
+    Set.Int ~>      Set.inter
+    Set.Un ~>       Set.union
+  - authentic syntax for
+    Set.Pow
+    Set.image
+  - mere abbreviations:
+    Set.empty               (for bot)
+    Set.UNIV                (for top)
+    Set.inter               (for inf)
+    Set.union               (for sup)
+    Complete_Lattice.Inter  (for Inf)
+    Complete_Lattice.Union  (for Sup)
+    Complete_Lattice.INTER  (for INFI)
+    Complete_Lattice.UNION  (for SUPR)
+  - object-logic definitions as far as appropriate
+
+INCOMPATIBILITY.  Care is required when theorems Int_subset_iff or
+Un_subset_iff are explicitly deleted as default simp rules;  then
+also their lattice counterparts le_inf_iff and le_sup_iff have to be
+deleted to achieve the desired effect.
+
+* Rules inf_absorb1, inf_absorb2, sup_absorb1, sup_absorb2 are no
+simp rules by default any longer.  The same applies to
+min_max.inf_absorb1 etc.!  INCOMPATIBILITY.
+
+* sup_Int_eq and sup_Un_eq are no default pred_set_conv rules any longer.
+INCOMPATIBILITY.
+
 * Power operations on relations and functions are now one dedicate
-constant compow with infix syntax "^^".  Power operations on
+constant "compow" with infix syntax "^^".  Power operation on
 multiplicative monoids retains syntax "^" and is now defined generic
 in class power.  INCOMPATIBILITY.
 
-* Relation composition "R O S" now has a "more standard" argument order,
-i.e., "R O S = {(x,z). EX y. (x,y) : R & (y,z) : S }".
+* Relation composition "R O S" now has a "more standard" argument
+order, i.e., "R O S = {(x,z). EX y. (x,y) : R & (y,z) : S }".
 INCOMPATIBILITY: Rewrite propositions with "S O R" --> "R O S". Proofs
-may occationally break, since the O_assoc rule was not rewritten like this.
-Fix using O_assoc[symmetric].
-The same applies to the curried version "R OO S".
-
-* GCD now has functions Gcd/GCD and Lcm/LCM for the gcd and lcm of finite and
-infinite sets. It is shown that they form a complete lattice.
+may occationally break, since the O_assoc rule was not rewritten like
+this.  Fix using O_assoc[symmetric].  The same applies to the curried
+version "R OO S".
 
 * ML antiquotation @{code_datatype} inserts definition of a datatype
 generated by the code generator; see Predicate.thy for an example.
@@ -93,41 +136,36 @@
 * New method "linarith" invokes existing linear arithmetic decision
 procedure only.
 
-* Implementation of quickcheck using generic code generator; default
-generators are provided for all suitable HOL types, records and
-datatypes.
-
-* Constants Set.Pow and Set.image now with authentic syntax;
-object-logic definitions Set.Pow_def and Set.image_def.
-INCOMPATIBILITY.
+* New implementation of quickcheck uses generic code generator;
+default generators are provided for all suitable HOL types, records
+and datatypes.
 
 * Renamed theorems:
 Suc_eq_add_numeral_1 -> Suc_eq_plus1
 Suc_eq_add_numeral_1_left -> Suc_eq_plus1_left
 Suc_plus1 -> Suc_eq_plus1
 
+* Moved theorems:
+Wellfounded.in_inv_image -> Relation.in_inv_image
+
 * New sledgehammer option "Full Types" in Proof General settings menu.
 Causes full type information to be output to the ATPs.  This slows
 ATPs down considerably but eliminates a source of unsound "proofs"
 that fail later.
 
+* New method metisFT: A version of metis that uses full type information
+in order to avoid failures of proof reconstruction.
+
 * Discontinued ancient tradition to suffix certain ML module names
 with "_package", e.g.:
 
     DatatypePackage ~> Datatype
     InductivePackage ~> Inductive
 
-    etc.
-
 INCOMPATIBILITY.
 
-* NewNumberTheory: Jeremy Avigad's new version of part of
-NumberTheory.  If possible, use NewNumberTheory, not NumberTheory.
-
-* Simplified interfaces of datatype module.  INCOMPATIBILITY.
-
-* Abbreviation "arbitrary" of "undefined" has disappeared; use
-"undefined" directly.  INCOMPATIBILITY.
+* Discontinued abbreviation "arbitrary" of constant
+"undefined". INCOMPATIBILITY, use "undefined" directly.
 
 * New evaluator "approximate" approximates an real valued term using
 the same method as the approximation method.
@@ -148,13 +186,30 @@
 
 *** ML ***
 
+* Structure Synchronized (cf. src/Pure/Concurrent/synchronized.ML)
+provides a high-level programming interface to synchronized state
+variables with atomic update.  This works via pure function
+application within a critical section -- its runtime should be as
+short as possible; beware of deadlocks if critical code is nested,
+either directly or indirectly via other synchronized variables!
+
+* Structure Unsynchronized (cf. src/Pure/ML-Systems/unsynchronized.ML)
+wraps raw ML references, explicitly indicating their non-thread-safe
+behaviour.  The Isar toplevel keeps this structure open, to
+accommodate Proof General as well as quick and dirty interactive
+experiments with references.
+
 * PARALLEL_CHOICE and PARALLEL_GOALS provide basic support for
 parallel tactical reasoning.
 
-* Tactical FOCUS is similar to SUBPROOF, but allows the body tactic to
-introduce new subgoals and schematic variables.  FOCUS_PARAMS is
-similar, but focuses on the parameter prefix only, leaving subgoal
-premises unchanged.
+* Tacticals Subgoal.FOCUS, Subgoal.FOCUS_PREMS, Subgoal.FOCUS_PARAMS
+are similar to SUBPROOF, but are slightly more flexible: only the
+specified parts of the subgoal are imported into the context, and the
+body tactic may introduce new subgoals and schematic variables.
+
+* Old tactical METAHYPS, which does not observe the proof context, has
+been renamed to Old_Goals.METAHYPS and awaits deletion.  Use SUBPROOF
+or Subgoal.FOCUS etc.
 
 * Renamed functor TableFun to Table, and GraphFun to Graph.  (Since
 functors have their own ML name space there is no point to mark them
@@ -175,6 +230,10 @@
 or even Display.pretty_thm_without_context as last resort.
 INCOMPATIBILITY.
 
+* Discontinued Display.pretty_ctyp/cterm etc.  INCOMPATIBILITY, use
+Syntax.pretty_typ/term directly, preferably with proper context
+instead of global theory.
+
 
 *** System ***
 
--- a/bin/isabelle	Tue Sep 29 22:15:54 2009 +0200
+++ b/bin/isabelle	Thu Oct 01 07:40:25 2009 +0200
@@ -17,7 +17,7 @@
 ISABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)"
 source "$ISABELLE_HOME/lib/scripts/getsettings" || exit 2
 
-ORIG_IFS="$IFS"; IFS=":"; declare -a TOOLS=($ISABELLE_TOOLS); IFS="$ORIG_IFS"
+splitarray ":" "$ISABELLE_TOOLS"; TOOLS=("${SPLITARRAY[@]}")
 
 
 ## diagnostics
--- a/bin/isabelle-process	Tue Sep 29 22:15:54 2009 +0200
+++ b/bin/isabelle-process	Thu Oct 01 07:40:25 2009 +0200
@@ -160,7 +160,7 @@
     INFILE=""
     ISA_PATH=""
 
-    ORIG_IFS="$IFS"; IFS=":"; declare -a PATHS=($ISABELLE_PATH); IFS="$ORIG_IFS"
+    splitarray ":" "$ISABELLE_PATH"; PATHS=("${SPLITARRAY[@]}")
     for DIR in "${PATHS[@]}"
     do
       DIR="$DIR/$ML_IDENTIFIER"
--- a/doc-src/manual.bib	Tue Sep 29 22:15:54 2009 +0200
+++ b/doc-src/manual.bib	Thu Oct 01 07:40:25 2009 +0200
@@ -484,7 +484,7 @@
   booktitle     = {Types for Proofs and Programs, TYPES 2008},
   publisher     = {Springer},
   series        = {LNCS},
-  volume        = {????},
+  volume        = {5497},
   year          = {2009}
 }
 
--- a/doc-src/rail.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/doc-src/rail.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -99,7 +99,7 @@
       |> (if markup = "" then I else enclose ("\\" ^ markup ^ "{") "}")
       |> (if ! ThyOutput.quotes then quote else I)
       |> (if ! ThyOutput.display then enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
-	  else hyper o enclose "\\mbox{\\isa{" "}}")), style)
+          else hyper o enclose "\\mbox{\\isa{" "}}")), style)
   else ("Bad " ^ kind ^ " " ^ name, false)
   end;
 end;
@@ -147,8 +147,8 @@
   ) >> (Identifier o enclose "\\isa{" "}" o Output.output o implode) ||
   scan_link >> (decode_link ctxt) >>
     (fn (txt, style) =>
-	if style then Special_Identifier(txt)
-	else Identifier(txt))
+        if style then Special_Identifier(txt)
+        else Identifier(txt))
 end;
 
 fun scan_anot ctxt =
@@ -169,12 +169,12 @@
     val text_sq =
       Scan.repeat (
         Scan.one (fn s =>
-	  s <> "\n" andalso
-	  s <> "\t" andalso
-	  s <> "'" andalso
-	  s <> "\\" andalso
-	  Symbol.is_regular s) ||
-	($$ "\\" |-- $$ "'")
+          s <> "\n" andalso
+          s <> "\t" andalso
+          s <> "'" andalso
+          s <> "\\" andalso
+          Symbol.is_regular s) ||
+        ($$ "\\" |-- $$ "'")
       ) >> implode
   fun quoted scan = $$ "'" |-- scan --| $$ "'";
   in
@@ -305,9 +305,9 @@
   parse_body2 -- ($$$ "*" |-- !!! "body4e expected" (parse_body4e)) >>
     (fn (body1, body2) =>
       if is_empty body2 then
-	add_body(PLUS, new_empty_body, rev_body body1)
+        add_body(PLUS, new_empty_body, rev_body body1)
       else
-	add_body(BAR, new_empty_body, add_body (PLUS, body1, rev_body body2)) ) ||
+        add_body(BAR, new_empty_body, add_body (PLUS, body1, rev_body body2)) ) ||
   parse_body2 -- ($$$ "+" |-- !!! "body4e expected" (parse_body4e)) >>
     (fn (body1, body2) => new_body (PLUS, body1, rev_body body2) ) ||
   parse_body2e
@@ -365,36 +365,36 @@
 fun position_body (body as Body(kind, text, annot, id, bodies), ystart) =
   let fun max (x,y) = if x > y then x else y
     fun set_body_position (Body(kind, text, annot, id, bodies), ystart, ynext) =
-	  Body_Pos(kind, text, annot, id, bodies, ystart, ynext)
+          Body_Pos(kind, text, annot, id, bodies, ystart, ynext)
     fun pos_bodies_cat ([],_,ynext,liste) = (liste, ynext)
       | pos_bodies_cat (x::xs, ystart, ynext, liste) =
-	  if is_kind_of CR x then
-	      (case set_body_position(x, ystart, ynext+1) of
-		body as Body_Pos(_,_,_,_,_,_,ynext1) =>
-		  pos_bodies_cat(xs, ynext1, max(ynext,ynext1), liste@[body])
-	      )
-	  else
-	      (case position_body(x, ystart) of
-		body as Body_Pos(_,_,_,_,_,_,ynext1) =>
-		  pos_bodies_cat(xs, ystart, max(ynext,ynext1), liste@[body])
-	      )
+          if is_kind_of CR x then
+              (case set_body_position(x, ystart, ynext+1) of
+                body as Body_Pos(_,_,_,_,_,_,ynext1) =>
+                  pos_bodies_cat(xs, ynext1, max(ynext,ynext1), liste@[body])
+              )
+          else
+              (case position_body(x, ystart) of
+                body as Body_Pos(_,_,_,_,_,_,ynext1) =>
+                  pos_bodies_cat(xs, ystart, max(ynext,ynext1), liste@[body])
+              )
     fun pos_bodies_bar_plus ([],_,ynext,liste) = (liste, ynext)
       | pos_bodies_bar_plus (x::xs, ystart, ynext, liste) =
-	  (case position_body(x, ystart) of
-	    body as Body_Pos(_,_,_,_,_,_,ynext1) =>
-	      pos_bodies_bar_plus(xs, ynext1, max(ynext,ynext1), liste@[body])
-	  )
+          (case position_body(x, ystart) of
+            body as Body_Pos(_,_,_,_,_,_,ynext1) =>
+              pos_bodies_bar_plus(xs, ynext1, max(ynext,ynext1), liste@[body])
+          )
   in
   (case kind of
     CAT => (case pos_bodies_cat(bodies,ystart,ystart+1,[]) of
-	      (bodiesPos, ynext) =>
-		Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
+              (bodiesPos, ynext) =>
+                Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
   | BAR => (case pos_bodies_bar_plus(bodies,ystart,ystart+1,[]) of
-	      (bodiesPos, ynext) =>
-		Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
+              (bodiesPos, ynext) =>
+                Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
   | PLUS => (case pos_bodies_bar_plus(bodies,ystart,ystart+1,[]) of
-	      (bodiesPos, ynext) =>
-		Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
+              (bodiesPos, ynext) =>
+                Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
   | CR => set_body_position(body, ystart, ystart+3)
   | EMPTY => set_body_position(body, ystart, ystart+1)
   | ANNOTE => set_body_position(body, ystart, ystart+1)
@@ -406,15 +406,15 @@
 fun format_body (Body_Pos(EMPTY,_,_,_,_,_,_), _) = ""
   | format_body (Body_Pos(CAT,_,_,_,bodies,_,_), cent) =
     let fun format_bodies([]) = ""
-	  | format_bodies(x::xs) = format_body (x, "") ^ format_bodies(xs)
+          | format_bodies(x::xs) = format_body (x, "") ^ format_bodies(xs)
     in
       format_bodies(bodies)
     end
   | format_body (Body_Pos(BAR,_,_,_,bodies,_,_),cent) =
     let fun format_bodies([]) = "\\rail@endbar\n"
-	  | format_bodies(x::xs) =
-	      "\\rail@nextbar{" ^ string_of_int(getystart(x)) ^"}\n" ^
-	      format_body(x, "") ^ format_bodies(xs)
+          | format_bodies(x::xs) =
+              "\\rail@nextbar{" ^ string_of_int(getystart(x)) ^"}\n" ^
+              format_body(x, "") ^ format_bodies(xs)
     in
       "\\rail@bar\n" ^ format_body(hd(bodies), "") ^ format_bodies(tl(bodies))
     end
--- a/etc/components	Tue Sep 29 22:15:54 2009 +0200
+++ b/etc/components	Thu Oct 01 07:40:25 2009 +0200
@@ -11,6 +11,8 @@
 src/LCF
 src/Sequents
 #misc components
+src/Tools/Code
 src/HOL/Tools/ATP_Manager
+src/HOL/Mirabelle
 src/HOL/Library/Sum_Of_Squares
-
+src/HOL/SMT
--- a/etc/settings	Tue Sep 29 22:15:54 2009 +0200
+++ b/etc/settings	Thu Oct 01 07:40:25 2009 +0200
@@ -173,7 +173,7 @@
 
 # The pdf file viewer
 if [ $(uname -s) = Darwin ]; then
-  PDF_VIEWER=open
+  PDF_VIEWER="open -W -n"
 else
   PDF_VIEWER=xpdf
 fi
@@ -207,22 +207,6 @@
 
 
 ###
-### jEdit
-###
-
-JEDIT_HOME=$(choosefrom \
-  "$ISABELLE_HOME/contrib/jedit" \
-  "$ISABELLE_HOME/../jedit" \
-  "/usr/local/jedit" \
-  "/usr/share/jedit" \
-  "/opt/jedit" \
-  "")
-
-JEDIT_JAVA_OPTIONS=""
-#JEDIT_JAVA_OPTIONS="-server -Xms128m -Xmx512m"
-JEDIT_OPTIONS="-reuseview -noserver -nobackground"
-
-###
 ### External reasoning tools
 ###
 
--- a/lib/Tools/codegen	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,40 +0,0 @@
-#!/usr/bin/env bash
-#
-# Author: Florian Haftmann, TUM
-#
-# DESCRIPTION: issue code generation from shell
-
-
-## diagnostics
-
-PRG="$(basename "$0")"
-
-function usage()
-{
-  echo
-  echo "Usage: isabelle $PRG IMAGE THY CMD"
-  echo
-  echo "  Issues code generation using image IMAGE,"
-  echo "  theory THY,"
-  echo "  with Isar command 'export_code CMD'"
-  echo
-  exit 1
-}
-
-
-## process command line
-
-[ "$#" -lt 2 -o "$1" = "-?" ] && usage
-
-IMAGE="$1"; shift
-THY="$1"; shift
-CMD="$1"
-
-
-## main
-
-CODE_CMD=$(echo $CMD | perl -pe 's/\\/\\\\/g; s/"/\\\"/g')
-CTXT_CMD="ML_Context.eval_in (SOME (ProofContext.init (theory \"HOL\"))) false Position.none \"Code_Target.shell_command thyname cmd\";"
-FULL_CMD="val thyname = \"$THY\"; val cmd = \"$CODE_CMD\"; $CTXT_CMD"
-
-"$ISABELLE" -q -e "$FULL_CMD" "$IMAGE" || exit 1
--- a/lib/Tools/doc	Tue Sep 29 22:15:54 2009 +0200
+++ b/lib/Tools/doc	Thu Oct 01 07:40:25 2009 +0200
@@ -34,7 +34,7 @@
 
 ## main
 
-ORIG_IFS="$IFS"; IFS=":"; declare -a DOCS=($ISABELLE_DOCS); IFS="$ORIG_IFS"
+splitarray ":" "$ISABELLE_DOCS"; DOCS=("${SPLITARRAY[@]}")
 
 if [ -z "$DOC" ]; then
   for DIR in "${DOCS[@]}"
--- a/lib/Tools/document	Tue Sep 29 22:15:54 2009 +0200
+++ b/lib/Tools/document	Thu Oct 01 07:40:25 2009 +0200
@@ -53,7 +53,7 @@
       OUTFORMAT="$OPTARG"
       ;;
     t)
-      ORIG_IFS="$IFS"; IFS=","; TAGS=($OPTARG); IFS="$ORIG_IFS"
+      splitarray "," "$OPTARG"; TAGS=("${SPLITARRAY[@]}")
       ;;
     \?)
       usage
--- a/lib/Tools/findlogics	Tue Sep 29 22:15:54 2009 +0200
+++ b/lib/Tools/findlogics	Thu Oct 01 07:40:25 2009 +0200
@@ -25,7 +25,7 @@
 declare -a LOGICS=()
 declare -a ISABELLE_PATHS=()
 
-ORIG_IFS="$IFS"; IFS=":"; ISABELLE_PATHS=($ISABELLE_PATH); IFS=$ORIG_IFS
+splitarray ":" "$ISABELLE_PATH"; ISABELLE_PATHS=("${SPLITARRAY[@]}")
 
 for DIR in "${ISABELLE_PATHS[@]}"
 do
@@ -34,7 +34,7 @@
   do
     if [ -f "$FILE" ]; then
       NAME=$(basename "$FILE")
-      LOGICS+=("$NAME")
+      LOGICS["${#LOGICS[@]}"]="$NAME"
     fi
   done
 done
--- a/lib/Tools/jedit	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-#!/usr/bin/env bash
-#
-# Author: Makarius
-#
-# DESCRIPTION: Isabelle/jEdit interface wrapper
-
-
-## diagnostics
-
-function fail()
-{
-  echo "$1" >&2
-  exit 2
-}
-
-
-## main
-
-[ -z "$JEDIT_HOME" ] && fail "Missing Isabelle/jEdit installation (JEDIT_HOME)"
-
-INTERFACE="$JEDIT_HOME/interface"
-[ ! -x "$INTERFACE" ] && fail "Bad interface script: \"$INTERFACE\""
-
-exec "$INTERFACE" "$@"
--- a/lib/Tools/makeall	Tue Sep 29 22:15:54 2009 +0200
+++ b/lib/Tools/makeall	Thu Oct 01 07:40:25 2009 +0200
@@ -34,7 +34,7 @@
 echo "Started at $(date) ($ML_IDENTIFIER on $(hostname))"
 . "$ISABELLE_HOME/lib/scripts/timestart.bash"
 
-ORIG_IFS="$IFS"; IFS=":"; declare -a COMPONENTS=($ISABELLE_COMPONENTS); IFS="$ORIG_IFS"
+splitarray ":" "$ISABELLE_COMPONENTS"; COMPONENTS=("${SPLITARRAY[@]}")
 
 for DIR in "${COMPONENTS[@]}"
 do
--- a/lib/Tools/usedir	Tue Sep 29 22:15:54 2009 +0200
+++ b/lib/Tools/usedir	Thu Oct 01 07:40:25 2009 +0200
@@ -262,7 +262,7 @@
 else
   { echo "$ITEM FAILED";
     echo "(see also $LOG)";
-    echo; tail "$LOG"; echo; } >&2
+    echo; tail -n 20 "$LOG"; echo; } >&2
 fi
 
 exit "$RC"
--- a/lib/scripts/getsettings	Tue Sep 29 22:15:54 2009 +0200
+++ b/lib/scripts/getsettings	Thu Oct 01 07:40:25 2009 +0200
@@ -68,6 +68,17 @@
   done
 }
 
+#arrays
+function splitarray ()
+{
+  SPLITARRAY=()
+  local IFS="$1"; shift
+  for X in $*
+  do
+    SPLITARRAY["${#SPLITARRAY[@]}"]="$X"
+  done
+}
+
 #nested components
 ISABELLE_COMPONENTS=""
 function init_component ()
--- a/lib/scripts/mirabelle	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,129 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use File::Basename;
-
-# Taken from http://www.skywayradio.com/tech/perl/trim_blanks.html
-sub trim {
-    my @out = @_;
-    for (@out) {
-        s/^\s+//;
-        s/\s+$//;
-    }
-    return wantarray ? @out : $out[0];
-}
-
-sub quote {
-    my $str = pop;
-    return "\"" . $str . "\"";
-}
-
-sub print_usage_and_quit {
-    print STDERR "Usage: mirabelle actions file1.thy...\n" .
-                 "  actions: action1:...:actionN\n" .
-                 "  action: name or name[key1=value1,...,keyM=valueM]\n";
-    exit 1;
-}
-
-my $num_args = $#ARGV + 1;
-if ($num_args < 2) {
-    print_usage_and_quit();
-}
-
-my @action_names;
-my @action_settings;
-
-foreach (split(/:/, $ARGV[0])) {
-    my %settings;
-
-    $_ =~ /([^[]*)(?:\[(.*)\])?/;
-    my ($name, $settings_str) = ($1, $2 || "");
-    my @setting_strs = split(/,/, $settings_str);
-    foreach (@setting_strs) {
-        $_ =~ /(.*)=(.*)/;
-	    my $key = $1;
-	    my $value = $2;
-	    $settings{trim($key)} = trim($value);
-    }
-
-    push @action_names, trim($name);
-    push @action_settings, \%settings;
-}
-
-my $output_path = "/tmp/mirabelle"; # FIXME: generate path
-my $mirabellesetup_thy_name = $output_path . "/MirabelleSetup";
-my $mirabellesetup_file = $mirabellesetup_thy_name . ".thy";
-my $mirabelle_log_file = $output_path . "/mirabelle.log";
-
-mkdir $output_path, 0755;
-
-open(FILE, ">$mirabellesetup_file")
-    || die "Could not create file '$mirabellesetup_file'";
-
-my $invoke_lines;
-
-for my $i (0 .. $#action_names) { 
-    my $settings_str = "";
-    my $settings = $action_settings[$i];
-    my $key;
-    my $value;
-
-    while (($key, $value) = each(%$settings)) {
-        $settings_str .= "(" . quote ($key) . ", " . quote ($value) . "), ";
-    }
-    $settings_str =~ s/, $//;
-
-    $invoke_lines .= "setup {* Mirabelle.invoke \"$action_names[$i]\" ";
-    $invoke_lines .= "[$settings_str] *}\n"
-}
-
-print FILE <<EOF;
-theory MirabelleSetup
-imports Mirabelle
-begin
-
-setup {* Mirabelle.set_logfile "$mirabelle_log_file" *}
-
-$invoke_lines
-
-end
-EOF
-
-my $root_text = "";
-my @new_thy_files;
-
-for my $i (1 .. $num_args - 1) {
-    my $old_thy_file = $ARGV[$i];
-    my ($base, $dir, $ext) = fileparse($old_thy_file, "\.thy");
-    my $new_thy_name = $base . "Mirabelle";
-    my $new_thy_file = $dir . $new_thy_name . $ext;
-
-    open(OLD_FILE, "<$old_thy_file")
-        || die "Cannot open file $old_thy_file";
-    my @lines = <OLD_FILE>;
-    close(OLD_FILE);
-
-    my $thy_text = join("", @lines);
-    my $old_len = length($thy_text);
-    $thy_text =~ s/\btheory\b[^\n]*\s*\bimports\s/theory $new_thy_name\nimports "$mirabellesetup_thy_name" /gm;
-    die "No 'imports' found" if length($thy_text) == $old_len;
-
-    open(NEW_FILE, ">$new_thy_file");
-    print NEW_FILE $thy_text;
-    close(NEW_FILE);
-
-    $root_text .= "use_thy \"" . $dir . $new_thy_name . "\";\n";
-
-    push @new_thy_files, $new_thy_file;
-}
-
-my $root_file = "ROOT_mirabelle.ML";
-open(ROOT_FILE, ">$root_file") || die "Cannot open file $root_file";
-print ROOT_FILE $root_text;
-close(ROOT_FILE);
-
-system "isabelle-process -e 'use \"ROOT_mirabelle.ML\";' -f -q HOL";
-
-# unlink $mirabellesetup_file;
-unlink $root_file;
-unlink @new_thy_files;
--- a/src/CCL/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/CCL/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -3,12 +3,11 @@
     Copyright   1993  University of Cambridge
 
 Classical Computational Logic based on First-Order Logic.
+
+A computational logic for an untyped functional language with
+evaluation to weak head-normal form.
 *)
 
-set eta_contract;
-
-(* CCL - a computational logic for an untyped functional language *)
-(*                       with evaluation to weak head-normal form *)
+Unsynchronized.set eta_contract;
 
 use_thys ["Wfd", "Fix"];
-
--- a/src/FOL/fologic.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/FOL/fologic.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -6,28 +6,28 @@
 
 signature FOLOGIC =
 sig
-  val oT		: typ
-  val mk_Trueprop	: term -> term
-  val dest_Trueprop	: term -> term
-  val not		: term
-  val conj		: term
-  val disj		: term
-  val imp		: term
-  val iff		: term
-  val mk_conj		: term * term -> term
-  val mk_disj		: term * term -> term
-  val mk_imp		: term * term -> term
-  val dest_imp	       	: term -> term*term
-  val dest_conj         : term -> term list
-  val mk_iff		: term * term -> term
-  val dest_iff	       	: term -> term*term
-  val all_const		: typ -> term
-  val mk_all		: term * term -> term
-  val exists_const	: typ -> term
-  val mk_exists		: term * term -> term
-  val eq_const		: typ -> term
-  val mk_eq		: term * term -> term
-  val dest_eq 		: term -> term*term
+  val oT: typ
+  val mk_Trueprop: term -> term
+  val dest_Trueprop: term -> term
+  val not: term
+  val conj: term
+  val disj: term
+  val imp: term
+  val iff: term
+  val mk_conj: term * term -> term
+  val mk_disj: term * term -> term
+  val mk_imp: term * term -> term
+  val dest_imp: term -> term * term
+  val dest_conj: term -> term list
+  val mk_iff: term * term -> term
+  val dest_iff: term -> term * term
+  val all_const: typ -> term
+  val mk_all: term * term -> term
+  val exists_const: typ -> term
+  val mk_exists: term * term -> term
+  val eq_const: typ -> term
+  val mk_eq: term * term -> term
+  val dest_eq: term -> term * term
   val mk_binop: string -> term * term -> term
   val mk_binrel: string -> term * term -> term
   val dest_bin: string -> typ -> term -> term * term
@@ -46,7 +46,8 @@
 fun dest_Trueprop (Const ("Trueprop", _) $ P) = P
   | dest_Trueprop t = raise TERM ("dest_Trueprop", [t]);
 
-(** Logical constants **)
+
+(* Logical constants *)
 
 val not = Const ("Not", oT --> oT);
 val conj = Const("op &", [oT,oT]--->oT);
@@ -80,6 +81,7 @@
 fun exists_const T = Const ("Ex", [T --> oT] ---> oT);
 fun mk_exists (Free(x,T),P) = exists_const T $ (absfree (x,T,P));
 
+
 (* binary oprations and relations *)
 
 fun mk_binop c (t, u) =
@@ -97,5 +99,4 @@
       else raise TERM ("dest_bin " ^ c, [tm])
   | dest_bin c _ tm = raise TERM ("dest_bin " ^ c, [tm]);
 
-
 end;
--- a/src/FOL/intprover.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/FOL/intprover.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -79,8 +79,7 @@
 (*One safe or unsafe step. *)
 fun step_tac i = FIRST [safe_tac, inst_step_tac i, biresolve_tac haz_brls i];
 
-fun step_dup_tac i = FIRST [safe_tac, inst_step_tac i, 
-			    biresolve_tac haz_dup_brls i];
+fun step_dup_tac i = FIRST [safe_tac, inst_step_tac i, biresolve_tac haz_dup_brls i];
 
 (*Dumb but fast*)
 val fast_tac = SELECT_GOAL (DEPTH_SOLVE (step_tac 1));
--- a/src/FOLP/IFOLP.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/FOLP/IFOLP.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -69,7 +69,7 @@
 ML {*
 
 (*show_proofs:=true displays the proof terms -- they are ENORMOUS*)
-val show_proofs = ref false;
+val show_proofs = Unsynchronized.ref false;
 
 fun proof_tr [p,P] = Const (@{const_name Proof}, dummyT) $ P $ p;
 
--- a/src/FOLP/hypsubst.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/FOLP/hypsubst.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -27,7 +27,7 @@
   val inspect_pair        : bool -> term * term -> thm
   end;
 
-functor HypsubstFun(Data: HYPSUBST_DATA): HYPSUBST = 
+functor HypsubstFun(Data: HYPSUBST_DATA): HYPSUBST =
 struct
 
 local open Data in
@@ -43,13 +43,13 @@
     but how could we check for this?*)
 fun inspect_pair bnd (t,u) =
   case (Envir.eta_contract t, Envir.eta_contract u) of
-       (Bound i, _) => if loose(i,u) then raise Match 
+       (Bound i, _) => if loose(i,u) then raise Match
                        else sym         (*eliminates t*)
-     | (_, Bound i) => if loose(i,t) then raise Match 
+     | (_, Bound i) => if loose(i,t) then raise Match
                        else asm_rl      (*eliminates u*)
-     | (Free _, _) => if bnd orelse Logic.occs(t,u) then raise Match 
+     | (Free _, _) => if bnd orelse Logic.occs(t,u) then raise Match
                       else sym          (*eliminates t*)
-     | (_, Free _) => if bnd orelse Logic.occs(u,t) then raise Match 
+     | (_, Free _) => if bnd orelse Logic.occs(u,t) then raise Match
                       else asm_rl       (*eliminates u*)
      | _ => raise Match;
 
@@ -58,7 +58,7 @@
    the rule asm_rl (resp. sym). *)
 fun eq_var bnd =
   let fun eq_var_aux k (Const("all",_) $ Abs(_,_,t)) = eq_var_aux k t
-        | eq_var_aux k (Const("==>",_) $ A $ B) = 
+        | eq_var_aux k (Const("==>",_) $ A $ B) =
               ((k, inspect_pair bnd (dest_eq A))
                       (*Exception Match comes from inspect_pair or dest_eq*)
                handle Match => eq_var_aux (k+1) B)
@@ -70,13 +70,13 @@
 fun gen_hyp_subst_tac bnd = SUBGOAL(fn (Bi,i) =>
       let val n = length(Logic.strip_assums_hyp Bi) - 1
           val (k,symopt) = eq_var bnd Bi
-      in 
+      in
          DETERM
            (EVERY [REPEAT_DETERM_N k (etac rev_mp i),
-		   etac revcut_rl i,
-		   REPEAT_DETERM_N (n-k) (etac rev_mp i),
-		   etac (symopt RS subst) i,
-		   REPEAT_DETERM_N n (rtac imp_intr i)])
+                   etac revcut_rl i,
+                   REPEAT_DETERM_N (n-k) (etac rev_mp i),
+                   etac (symopt RS subst) i,
+                   REPEAT_DETERM_N n (rtac imp_intr i)])
       end
       handle THM _ => no_tac | EQ_VAR => no_tac);
 
--- a/src/FOLP/simp.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/FOLP/simp.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -49,10 +49,10 @@
 (* temporarily disabled:
   val extract_free_congs        : unit -> thm list
 *)
-  val tracing   : bool ref
+  val tracing   : bool Unsynchronized.ref
 end;
 
-functor SimpFun (Simp_data: SIMP_DATA) : SIMP = 
+functor SimpFun (Simp_data: SIMP_DATA) : SIMP =
 struct
 
 local open Simp_data in
@@ -74,12 +74,12 @@
   Similar to match_from_nat_tac, but the net does not contain numbers;
   rewrite rules are not ordered.*)
 fun net_tac net =
-  SUBGOAL(fn (prem,i) => 
+  SUBGOAL(fn (prem,i) =>
           resolve_tac (Net.unify_term net (Logic.strip_assums_concl prem)) i);
 
 (*match subgoal i against possible theorems indexed by lhs in the net*)
 fun lhs_net_tac net =
-  SUBGOAL(fn (prem,i) => 
+  SUBGOAL(fn (prem,i) =>
           biresolve_tac (Net.unify_term net
                        (lhs_of (Logic.strip_assums_concl prem))) i);
 
@@ -110,7 +110,7 @@
 
 (*Get the norm constants from norm_thms*)
 val norms =
-  let fun norm thm = 
+  let fun norm thm =
       case lhs_of(concl_of thm) of
           Const(n,_)$_ => n
         | _ => error "No constant in lhs of a norm_thm"
@@ -144,7 +144,7 @@
 (**** Adding "NORM" tags ****)
 
 (*get name of the constant from conclusion of a congruence rule*)
-fun cong_const cong = 
+fun cong_const cong =
     case head_of (lhs_of (concl_of cong)) of
         Const(c,_) => c
       | _ => ""                 (*a placeholder distinct from const names*);
@@ -156,9 +156,9 @@
 fun add_hidden_vars ccs =
   let fun add_hvars tm hvars = case tm of
               Abs(_,_,body) => OldTerm.add_term_vars(body,hvars)
-            | _$_ => let val (f,args) = strip_comb tm 
+            | _$_ => let val (f,args) = strip_comb tm
                      in case f of
-                            Const(c,T) => 
+                            Const(c,T) =>
                                 if member (op =) ccs c
                                 then fold_rev add_hvars args hvars
                                 else OldTerm.add_term_vars (tm, hvars)
@@ -202,13 +202,13 @@
     val hvs = map (#1 o dest_Var) hvars
     val refl1_tac = refl_tac 1
     fun norm_step_tac st = st |>
-	 (case head_of(rhs_of_eq 1 st) of
-	    Var(ixn,_) => if ixn mem hvs then refl1_tac
-			  else resolve_tac normI_thms 1 ORELSE refl1_tac
-	  | Const _ => resolve_tac normI_thms 1 ORELSE
-		       resolve_tac congs 1 ORELSE refl1_tac
-	  | Free _ => resolve_tac congs 1 ORELSE refl1_tac
-	  | _ => refl1_tac)
+         (case head_of(rhs_of_eq 1 st) of
+            Var(ixn,_) => if ixn mem hvs then refl1_tac
+                          else resolve_tac normI_thms 1 ORELSE refl1_tac
+          | Const _ => resolve_tac normI_thms 1 ORELSE
+                       resolve_tac congs 1 ORELSE refl1_tac
+          | Free _ => resolve_tac congs 1 ORELSE refl1_tac
+          | _ => refl1_tac)
     val add_norm_tac = DEPTH_FIRST (has_fewer_prems nops) norm_step_tac
     val SOME(thm'',_) = Seq.pull(add_norm_tac thm')
 in thm'' end;
@@ -246,9 +246,9 @@
 (** Insertion of congruences and rewrites **)
 
 (*insert a thm in a thm net*)
-fun insert_thm_warn th net = 
+fun insert_thm_warn th net =
   Net.insert_term Thm.eq_thm_prop (concl_of th, th) net
-  handle Net.INSERT => 
+  handle Net.INSERT =>
     (writeln ("Duplicate rewrite or congruence rule:\n" ^
         Display.string_of_thm_without_context th); net);
 
@@ -272,9 +272,9 @@
 (** Deletion of congruences and rewrites **)
 
 (*delete a thm from a thm net*)
-fun delete_thm_warn th net = 
+fun delete_thm_warn th net =
   Net.delete_term Thm.eq_thm_prop (concl_of th, th) net
-  handle Net.DELETE => 
+  handle Net.DELETE =>
     (writeln ("No such rewrite or congruence rule:\n" ^
         Display.string_of_thm_without_context th); net);
 
@@ -337,17 +337,17 @@
     in find_if(tm,0) end;
 
 fun IF1_TAC cong_tac i =
-    let fun seq_try (ifth::ifths,ifc::ifcs) thm = 
+    let fun seq_try (ifth::ifths,ifc::ifcs) thm =
                 (COND (if_rewritable ifc i) (DETERM(rtac ifth i))
                         (seq_try(ifths,ifcs))) thm
               | seq_try([],_) thm = no_tac thm
         and try_rew thm = (seq_try(case_rews,case_consts) ORELSE one_subt) thm
         and one_subt thm =
                 let val test = has_fewer_prems (nprems_of thm + 1)
-                    fun loop thm = 
-			COND test no_tac
+                    fun loop thm =
+                        COND test no_tac
                           ((try_rew THEN DEPTH_FIRST test (refl_tac i))
-			   ORELSE (refl_tac i THEN loop)) thm
+                           ORELSE (refl_tac i THEN loop)) thm
                 in (cong_tac THEN loop) thm end
     in COND (may_match(case_consts,i)) try_rew no_tac end;
 
@@ -366,7 +366,7 @@
 
 (** Tracing **)
 
-val tracing = ref false;
+val tracing = Unsynchronized.ref false;
 
 (*Replace parameters by Free variables in P*)
 fun variants_abs ([],P) = P
@@ -381,12 +381,12 @@
 
 (*print lhs of conclusion of subgoal i*)
 fun pr_goal_lhs i st =
-    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st) 
+    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st)
              (lhs_of (prepare_goal i st)));
 
 (*print conclusion of subgoal i*)
 fun pr_goal_concl i st =
-    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st) (prepare_goal i st)) 
+    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st) (prepare_goal i st))
 
 (*print subgoals i to j (inclusive)*)
 fun pr_goals (i,j) st =
@@ -439,7 +439,7 @@
         then writeln (cat_lines
           ("Adding rewrites:" :: map Display.string_of_thm_without_context new_rws))
         else ();
-        (ss,thm,anet',anet::ats,cs) 
+        (ss,thm,anet',anet::ats,cs)
     end;
 
 fun rew(seq,thm,ss,anet,ats,cs, more) = case Seq.pull seq of
@@ -492,7 +492,7 @@
 
 fun EXEC_TAC(ss,fl) (SS{auto_tac,cong_net,simp_net,...}) =
 let val cong_tac = net_tac cong_net
-in fn i => 
+in fn i =>
     (fn thm =>
      if i <= 0 orelse nprems_of thm < i then Seq.empty
      else Seq.single(execute(ss,fl,auto_tac,cong_tac,simp_net,i,thm)))
--- a/src/HOL/Algebra/Divisibility.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/Divisibility.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -2656,25 +2656,7 @@
   shows "(x \<in> carrier G \<and> x gcdof a b) =
          greatest (division_rel G) x (Lower (division_rel G) {a, b})"
 unfolding isgcd_def greatest_def Lower_def elem_def
-proof (simp, safe)
-  fix xa
-  assume r1[rule_format]: "\<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> xa divides x"
-  assume r2[rule_format]: "\<forall>y\<in>carrier G. y divides a \<and> y divides b \<longrightarrow> y divides x"
-
-  assume "xa \<in> carrier G"  "x divides a"  "x divides b"
-  with carr
-  show "xa divides x"
-      by (fast intro: r1 r2)
-next
-  fix a' y
-  assume r1[rule_format]:
-         "\<forall>xa\<in>{l. \<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> l divides x} \<inter> carrier G.
-           xa divides x"
-  assume "y \<in> carrier G"  "y divides a"  "y divides b"
-  with carr
-       show "y divides x"
-       by (fast intro: r1)
-qed (simp, simp)
+by auto
 
 lemma lcmof_leastUpper:
   fixes G (structure)
@@ -2682,25 +2664,7 @@
   shows "(x \<in> carrier G \<and> x lcmof a b) =
          least (division_rel G) x (Upper (division_rel G) {a, b})"
 unfolding islcm_def least_def Upper_def elem_def
-proof (simp, safe)
-  fix xa
-  assume r1[rule_format]: "\<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> x divides xa"
-  assume r2[rule_format]: "\<forall>y\<in>carrier G. a divides y \<and> b divides y \<longrightarrow> x divides y"
-
-  assume "xa \<in> carrier G"  "a divides x"  "b divides x"
-  with carr
-  show "x divides xa"
-      by (fast intro: r1 r2)
-next
-  fix a' y
-  assume r1[rule_format]:
-         "\<forall>xa\<in>{l. \<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> x divides l} \<inter> carrier G.
-           x divides xa"
-  assume "y \<in> carrier G"  "a divides y"  "b divides y"
-  with carr
-       show "x divides y"
-       by (fast intro: r1)
-qed (simp, simp)
+by auto
 
 lemma somegcd_meet:
   fixes G (structure)
--- a/src/HOL/Algebra/Exponent.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/Exponent.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1,16 +1,13 @@
 (*  Title:      HOL/Algebra/Exponent.thy
-    ID:         $Id$
     Author:     Florian Kammueller, with new proofs by L C Paulson
 
     exponent p s   yields the greatest power of p that divides s.
 *)
 
 theory Exponent
-imports Main Primes Binomial
+imports Main "~~/src/HOL/Old_Number_Theory/Primes" Binomial
 begin
 
-hide (open) const GCD.gcd GCD.coprime GCD.prime
-
 section {*Sylow's Theorem*}
 
 subsection {*The Combinatorial Argument Underlying the First Sylow Theorem*}
--- a/src/HOL/Algebra/FiniteProduct.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/FiniteProduct.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -212,7 +212,7 @@
   apply (induct set: finite)
    apply simp
   apply (simp add: foldD_insert foldD_commute Int_insert_left insert_absorb
-    Int_mono2 Un_subset_iff)
+    Int_mono2)
   done
 
 lemma (in LCD) foldD_nest_Un_disjoint:
@@ -274,14 +274,14 @@
   apply (simp add: AC insert_absorb Int_insert_left
     LCD.foldD_insert [OF LCD.intro [of D]]
     LCD.foldD_closed [OF LCD.intro [of D]]
-    Int_mono2 Un_subset_iff)
+    Int_mono2)
   done
 
 lemma (in ACeD) foldD_Un_disjoint:
   "[| finite A; finite B; A Int B = {}; A \<subseteq> D; B \<subseteq> D |] ==>
     foldD D f e (A Un B) = foldD D f e A \<cdot> foldD D f e B"
   by (simp add: foldD_Un_Int
-    left_commute LCD.foldD_closed [OF LCD.intro [of D]] Un_subset_iff)
+    left_commute LCD.foldD_closed [OF LCD.intro [of D]])
 
 
 subsubsection {* Products over Finite Sets *}
@@ -377,7 +377,7 @@
   from insert have A: "g \<in> A -> carrier G" by fast
   from insert A a show ?case
     by (simp add: m_ac Int_insert_left insert_absorb finprod_closed
-          Int_mono2 Un_subset_iff) 
+          Int_mono2) 
 qed
 
 lemma finprod_Un_disjoint:
--- a/src/HOL/Algebra/IntRing.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/IntRing.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -4,7 +4,7 @@
 *)
 
 theory IntRing
-imports QuotRing Lattice Int Primes
+imports QuotRing Lattice Int "~~/src/HOL/Old_Number_Theory/Primes"
 begin
 
 
--- a/src/HOL/Algebra/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -5,7 +5,7 @@
 *)
 
 (* Preliminaries from set and number theory *)
-no_document use_thys ["FuncSet", "Primes", "Binomial", "Permutation"];
+no_document use_thys ["FuncSet", "~~/src/HOL/Old_Number_Theory/Primes", "Binomial", "Permutation"];
 
 
 (*** New development, based on explicit structures ***)
--- a/src/HOL/Algebra/UnivPoly.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/UnivPoly.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -592,15 +592,14 @@
         proof (cases "n = k")
           case True
           then have "\<zero> = (\<Oplus>i \<in> {..<n} \<union> {n}. ?s i)"
-            by (simp cong: R.finsum_cong add: ivl_disj_int_singleton Pi_def)
+            by (simp cong: R.finsum_cong add: Pi_def)
           also from True have "... = (\<Oplus>i \<in> {..k}. ?s i)"
             by (simp only: ivl_disj_un_singleton)
           finally show ?thesis .
         next
           case False with n_le_k have n_less_k: "n < k" by arith
           with neq have "\<zero> = (\<Oplus>i \<in> {..<n} \<union> {n}. ?s i)"
-            by (simp add: R.finsum_Un_disjoint f1 f2
-              ivl_disj_int_singleton Pi_def del: Un_insert_right)
+            by (simp add: R.finsum_Un_disjoint f1 f2 Pi_def del: Un_insert_right)
           also have "... = (\<Oplus>i \<in> {..n}. ?s i)"
             by (simp only: ivl_disj_un_singleton)
           also from n_less_k neq have "... = (\<Oplus>i \<in> {..n} \<union> {n<..k}. ?s i)"
@@ -817,15 +816,9 @@
 text {* Degree and polynomial operations *}
 
 lemma deg_add [simp]:
-  assumes R: "p \<in> carrier P" "q \<in> carrier P"
-  shows "deg R (p \<oplus>\<^bsub>P\<^esub> q) <= max (deg R p) (deg R q)"
-proof (cases "deg R p <= deg R q")
-  case True show ?thesis
-    by (rule deg_aboveI) (simp_all add: True R deg_aboveD)
-next
-  case False show ?thesis
-    by (rule deg_aboveI) (simp_all add: False R deg_aboveD)
-qed
+  "p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow>
+  deg R (p \<oplus>\<^bsub>P\<^esub> q) <= max (deg R p) (deg R q)"
+by(rule deg_aboveI)(simp_all add: deg_aboveD)
 
 lemma deg_monom_le:
   "a \<in> carrier R ==> deg R (monom P a n) <= n"
@@ -945,8 +938,7 @@
     also have "...= (\<Oplus>i \<in> {deg R p} \<union> {deg R p <.. deg R p + deg R q}. ?s i)"
       by (simp only: ivl_disj_un_singleton)
     also have "... = coeff P p (deg R p) \<otimes> coeff P q (deg R q)"
-      by (simp cong: R.finsum_cong
-	add: ivl_disj_int_singleton deg_aboveD R Pi_def)
+      by (simp cong: R.finsum_cong add: deg_aboveD R Pi_def)
     finally have "(\<Oplus>i \<in> {.. deg R p + deg R q}. ?s i)
       = coeff P p (deg R p) \<otimes> coeff P q (deg R q)" .
     with nz show "(\<Oplus>i \<in> {.. deg R p + deg R q}. ?s i) ~= \<zero>"
@@ -989,8 +981,7 @@
     have "... = coeff P (\<Oplus>\<^bsub>P\<^esub> i \<in> {..<k} \<union> {k}. ?s i) k"
       by (simp only: ivl_disj_un_singleton)
     also have "... = coeff P p k"
-      by (simp cong: R.finsum_cong
-	add: ivl_disj_int_singleton coeff_finsum deg_aboveD R RR Pi_def)
+      by (simp cong: R.finsum_cong add: coeff_finsum deg_aboveD R RR Pi_def)
     finally show ?thesis .
   next
     case False
@@ -998,8 +989,7 @@
           coeff P (\<Oplus>\<^bsub>P\<^esub> i \<in> {..<deg R p} \<union> {deg R p}. ?s i) k"
       by (simp only: ivl_disj_un_singleton)
     also from False have "... = coeff P p k"
-      by (simp cong: R.finsum_cong
-	add: ivl_disj_int_singleton coeff_finsum deg_aboveD R Pi_def)
+      by (simp cong: R.finsum_cong add: coeff_finsum deg_aboveD R Pi_def)
     finally show ?thesis .
   qed
 qed (simp_all add: R Pi_def)
--- a/src/HOL/Algebra/abstract/Ring2.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/abstract/Ring2.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -241,7 +241,7 @@
 proof (induct n)
   case 0 show ?case by simp
 next
-  case Suc thus ?case by (simp add: add_assoc) 
+  case Suc thus ?case by (simp add: add_assoc)
 qed
 
 lemma natsum_cong [cong]:
@@ -269,21 +269,21 @@
 
 ML {*
   local
-    val lhss = 
+    val lhss =
         ["t + u::'a::ring",
-	 "t - u::'a::ring",
-	 "t * u::'a::ring",
-	 "- t::'a::ring"];
-    fun proc ss t = 
+         "t - u::'a::ring",
+         "t * u::'a::ring",
+         "- t::'a::ring"];
+    fun proc ss t =
       let val rew = Goal.prove (Simplifier.the_context ss) [] []
             (HOLogic.mk_Trueprop
               (HOLogic.mk_eq (t, Var (("x", Term.maxidx_of_term t + 1), fastype_of t))))
                 (fn _ => simp_tac (Simplifier.inherit_context ss ring_ss) 1)
             |> mk_meta_eq;
           val (t', u) = Logic.dest_equals (Thm.prop_of rew);
-      in if t' aconv u 
+      in if t' aconv u
         then NONE
-        else SOME rew 
+        else SOME rew
     end;
   in
     val ring_simproc = Simplifier.simproc @{theory} "ring" lhss (K proc);
@@ -305,7 +305,7 @@
 declare one_not_zero [simp]
 
 lemma zero_not_one [simp]:
-  "0 ~= (1::'a::domain)" 
+  "0 ~= (1::'a::domain)"
 by (rule not_sym) simp
 
 lemma integral_iff: (* not by default a simp rule! *)
@@ -322,7 +322,7 @@
 *)
 (*
 lemma bug: "(b::'a::ring) - (b - a) = a" by simp
-   simproc for rings cannot prove "(a::'a::ring) - (a - b) = b" 
+   simproc for rings cannot prove "(a::'a::ring) - (a - b) = b"
 *)
 lemma m_lcancel:
   assumes prem: "(a::'a::domain) ~= 0" shows conc: "(a * b = a * c) = (b = c)"
@@ -330,8 +330,8 @@
   assume eq: "a * b = a * c"
   then have "a * (b - c) = 0" by simp
   then have "a = 0 | (b - c) = 0" by (simp only: integral_iff)
-  with prem have "b - c = 0" by auto 
-  then have "b = b - (b - c)" by simp 
+  with prem have "b - c = 0" by auto
+  then have "b = b - (b - c)" by simp
   also have "b - (b - c) = c" by simp
   finally show "b = c" .
 next
@@ -386,7 +386,7 @@
 qed
 
 
-lemma unit_mult: 
+lemma unit_mult:
   "!!a::'a::ring. [| a dvd 1; b dvd 1 |] ==> a * b dvd 1"
   apply (unfold dvd_def)
   apply clarify
--- a/src/HOL/Algebra/poly/UnivPoly2.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Algebra/poly/UnivPoly2.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -563,11 +563,7 @@
 
 lemma deg_add [simp]:
   "deg ((p::'a::ring up) + q) <= max (deg p) (deg q)"
-proof (cases "deg p <= deg q")
-  case True show ?thesis by (rule deg_aboveI) (simp add: True deg_aboveD) 
-next
-  case False show ?thesis by (rule deg_aboveI) (simp add: False deg_aboveD)
-qed
+by (rule deg_aboveI) (simp add: deg_aboveD)
 
 lemma deg_monom_ring:
   "deg (monom a n::'a::ring up) <= n"
@@ -678,8 +674,7 @@
     also have "... = setsum ?s ({deg p} Un {deg p <.. deg p + deg q})"
       by (simp only: ivl_disj_un_singleton)
     also have "... = coeff p (deg p) * coeff q (deg q)" 
-      by (simp add: setsum_Un_disjoint ivl_disj_int_singleton 
-        setsum_0 deg_aboveD)
+      by (simp add: setsum_Un_disjoint setsum_0 deg_aboveD)
     finally have "setsum ?s {.. deg p + deg q} 
       = coeff p (deg p) * coeff q (deg q)" .
     with nz show "setsum ?s {.. deg p + deg q} ~= 0"
@@ -723,8 +718,7 @@
     have "... = coeff (setsum ?s ({..<k} Un {k})) k"
       by (simp only: ivl_disj_un_singleton)
     also have "... = coeff p k"
-      by (simp add: setsum_Un_disjoint ivl_disj_int_singleton 
-        setsum_0 coeff_natsum deg_aboveD)
+      by (simp add: setsum_Un_disjoint setsum_0 coeff_natsum deg_aboveD)
     finally show ?thesis .
   next
     case False
@@ -732,8 +726,7 @@
           coeff (setsum ?s ({..<deg p} Un {deg p})) k"
       by (simp only: ivl_disj_un_singleton)
     also from False have "... = coeff p k"
-      by (simp add: setsum_Un_disjoint ivl_disj_int_singleton 
-        setsum_0 coeff_natsum deg_aboveD)
+      by (simp add: setsum_Un_disjoint setsum_0 coeff_natsum deg_aboveD)
     finally show ?thesis .
   qed
 qed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Auth/All_Symmetric.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,12 @@
+theory All_Symmetric
+imports Message
+begin
+
+text {* All keys are symmetric *}
+
+defs all_symmetric_def: "all_symmetric \<equiv> True"
+
+lemma isSym_keys: "K \<in> symKeys"
+  by (simp add: symKeys_def all_symmetric_def invKey_symmetric) 
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Auth/Auth_Public.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,15 @@
+(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1996  University of Cambridge
+*)
+
+header {* Conventional protocols: rely on conventional Message, Event and Public -- Public-key protocols *}
+
+theory Auth_Public
+imports
+  "NS_Public_Bad"
+  "NS_Public"
+  "TLS"
+  "CertifiedEmail"
+begin
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Auth/Auth_Shared.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,27 @@
+(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1996  University of Cambridge
+*)
+
+header {* Conventional protocols: rely on conventional Message, Event and Public -- Shared-key protocols *}
+
+theory Auth_Shared
+imports
+  "NS_Shared"
+  "Kerberos_BAN"
+  "Kerberos_BAN_Gets"
+  "KerberosIV"
+  "KerberosIV_Gets"
+  "KerberosV"
+  "OtwayRees"
+  "OtwayRees_AN"
+  "OtwayRees_Bad"
+  "OtwayReesBella"
+  "WooLam"
+  "Recur"
+  "Yahalom"
+  "Yahalom2"
+  "Yahalom_Bad"
+  "ZhouGollmann"
+begin
+
+end
--- a/src/HOL/Auth/Event.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Event.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -139,9 +139,11 @@
 
 text{*Elimination rules: derive contradictions from old Says events containing
   items known to be fresh*}
+lemmas Says_imp_parts_knows_Spy = 
+       Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
+
 lemmas knows_Spy_partsEs =
-     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
-     parts.Body [THEN revcut_rl, standard]
+     Says_imp_parts_knows_Spy parts.Body [THEN revcut_rl, standard]
 
 lemmas Says_imp_analz_Spy = Says_imp_knows_Spy [THEN analz.Inj]
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Auth/Guard/Auth_Guard_Public.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,15 @@
+(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1996  University of Cambridge
+*)
+
+header {* Blanqui's "guard" concept: protocol-independent secrecy *}
+
+theory Auth_Guard_Public
+imports
+  "P1"
+  "P2"
+  "Guard_NS_Public"
+  "Proto"
+begin
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Auth/Guard/Auth_Guard_Shared.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,13 @@
+(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1996  University of Cambridge
+*)
+
+header {* Blanqui's "guard" concept: protocol-independent secrecy *}
+
+theory Auth_Guard_Shared
+imports
+  "Guard_OtwayRees"
+  "Guard_Yahalom"
+begin
+
+end
--- a/src/HOL/Auth/Guard/Extensions.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Guard/Extensions.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -11,7 +11,9 @@
 
 header {*Extensions to Standard Theories*}
 
-theory Extensions imports "../Event" begin
+theory Extensions
+imports "../Event"
+begin
 
 subsection{*Extensions to Theory @{text Set}*}
 
@@ -173,7 +175,7 @@
 subsubsection{*lemmas on analz*}
 
 lemma analz_UnI1 [intro]: "X:analz G ==> X:analz (G Un H)"
-by (subgoal_tac "G <= G Un H", auto dest: analz_mono)
+  by (subgoal_tac "G <= G Un H") (blast dest: analz_mono)+
 
 lemma analz_sub: "[| X:analz G; G <= H |] ==> X:analz H"
 by (auto dest: analz_mono)
--- a/src/HOL/Auth/KerberosIV.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/KerberosIV.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -899,7 +899,6 @@
 apply (frule_tac [7] Says_ticket_parts)
 apply (simp_all (no_asm_simp))
 apply blast
-atp_minimize [atp=spass] Crypt_imp_invKey_keysFor invKey_K new_keys_not_used
 apply (metis Crypt_imp_invKey_keysFor invKey_K new_keys_not_used)
 apply (clarify)
 apply (frule Says_Tgs_message_form, assumption)
@@ -1316,7 +1315,6 @@
 txt{*K4*}
 apply blast
 txt{*Level 8: K5*}
-atp_minimize [atp=e] Tgs_not_bad authKeysI less_SucI mem_def nat_add_commute servK_notin_authKeysD spies_partsEs(1)
 apply (blast dest: servK_notin_authKeysD Says_Kas_message_form intro: less_SucI)
 txt{*Oops1*}
 apply (blast dest!: unique_authKeys intro: less_SucI)
--- a/src/HOL/Auth/KerberosV.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/KerberosV.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -697,9 +697,7 @@
 txt{*K4*}
 apply (force dest!: Crypt_imp_keysFor, clarify)
 txt{*K6*}
-apply (drule  Says_imp_spies [THEN parts.Inj, THEN parts.Fst])
-apply (drule  Says_imp_spies [THEN parts.Inj, THEN parts.Snd])
-apply (blast dest!: unique_CryptKey)
+apply (metis Says_imp_spies Says_ticket_parts analz.Fst analz.Inj analz_conj_parts unique_CryptKey)
 done
 
 text{*Needs a unicity theorem, hence moved here*}
@@ -841,13 +839,10 @@
 apply (erule kerbV.induct, analz_mono_contra)
 apply (frule_tac [7] Says_ticket_parts)
 apply (frule_tac [5] Says_ticket_parts, simp_all, blast)
-txt{*K4 splits into distinct subcases*}
-apply auto
-txt{*servK can't have been enclosed in two certificates*}
- prefer 2 apply (blast dest: unique_CryptKey)
-txt{*servK is fresh and so could not have been used, by
-   @{text new_keys_not_used}*}
-apply (force dest!: Crypt_imp_invKey_keysFor simp add: AKcryptSK_def)
+txt{*K4*}
+apply (metis Auth_fresh_not_AKcryptSK Crypt_imp_invKey_keysFor Says_ticket_analz
+         analz.Fst invKey_K new_keys_not_analzd parts.Fst Says_imp_parts_knows_Spy
+         unique_CryptKey)
 done
 
 text{*Long term keys are not issued as servKeys*}
@@ -981,9 +976,7 @@
 txt{*K4*}
 apply (blast dest!: authK_not_AKcryptSK)
 txt{*Oops1*}
-apply clarify
-apply simp
-apply (blast dest!: AKcryptSK_analz_insert)
+apply (metis AKcryptSK_analz_insert insert_Key_singleton)
 done
 
 text{* First simplification law for analz: no session keys encrypt
@@ -1039,8 +1032,8 @@
         \<in> set evs;  authK \<in> symKeys;
          Key authK \<in> analz (spies evs); evs \<in> kerbV \<rbrakk>
       \<Longrightarrow> Key servK \<in> analz (spies evs)"
-apply (force dest: Says_imp_spies [THEN analz.Inj, THEN analz.Fst, THEN analz.Decrypt, THEN analz.Fst])
-done
+  by (metis Says_imp_analz_Spy analz.Fst analz_Decrypt')
+
 
 text{*lemma @{text servK_notin_authKeysD} not needed in version V*}
 
@@ -1112,16 +1105,16 @@
 apply (frule_tac [5] Says_ticket_analz)
 apply (safe del: impI conjI impCE)
 apply (simp_all add: less_SucI new_keys_not_analzd Says_Kas_message_form Says_Tgs_message_form analz_insert_eq not_parts_not_analz analz_insert_freshK1 analz_insert_freshK2 analz_insert_freshK3_bis pushes)
-txt{*Fake*}
-apply spy_analz
-txt{*K2*}
-apply (blast intro: parts_insertI less_SucI)
-txt{*K4*}
-apply (blast dest: authTicket_authentic Confidentiality_Kas)
-txt{*Oops1*}
+    txt{*Fake*}
+    apply spy_analz
+   txt{*K2*}
+   apply (blast intro: parts_insertI less_SucI)
+  txt{*K4*}
+  apply (blast dest: authTicket_authentic Confidentiality_Kas)
+ txt{*Oops1*}
  apply (blast dest: Says_Kas_message_form Says_Tgs_message_form intro: less_SucI)
 txt{*Oops2*}
-  apply (blast dest: Says_imp_spies [THEN parts.Inj] Key_unique_SesKey intro: less_SucI)
+apply (metis Suc_le_eq linorder_linear linorder_not_le msg.simps(2) unique_servKeys)
 done
 
 
@@ -1270,17 +1263,7 @@
          Key authK \<notin> analz (spies evs); Key servK \<notin> analz (spies evs);
          A \<notin> bad;  B \<notin> bad; evs \<in> kerbV \<rbrakk>
       \<Longrightarrow> Says B A (Crypt servK (Number T3)) \<in> set evs"
-apply (frule authK_authentic)
-apply assumption+
-apply (frule servK_authentic)
-prefer 2 apply (blast dest: authK_authentic Says_Kas_message_form)
-apply assumption+
-apply clarify
-apply (blast dest: K4_imp_K2 Key_unique_SesKey intro!: Says_K6)
-(*Single command proof: much slower!
-apply (blast dest: authK_authentic servK_authentic Says_Kas_message_form Key_unique_SesKey K4_imp_K2 intro!: Says_K6)
-*)
-done
+  by (metis authK_authentic Oops_range_spies1 Says_K6 servK_authentic u_K4_imp_K2 unique_authKeys)
 
 lemma A_authenticates_B_r:
      "\<lbrakk> Crypt servK (Number T3) \<in> parts (spies evs);
@@ -1301,8 +1284,7 @@
 apply (erule_tac [9] exE)
 apply (frule_tac [9] K4_imp_K2)
 apply assumption+
-apply (blast dest: Key_unique_SesKey intro!: Says_K6 dest: Confidentiality_Tgs
-)
+apply (blast dest: Key_unique_SesKey intro!: Says_K6 dest: Confidentiality_Tgs)
 done
 
 
@@ -1478,7 +1460,7 @@
 ...expands as follows - including extra exE because of new form of lemmas*)
 apply (frule K3_imp_K2, assumption, assumption, erule exE, erule exE)
 apply (case_tac "Key authK \<in> analz (spies evs5)")
-apply (drule Says_imp_knows_Spy [THEN analz.Inj, THEN analz.Fst, THEN analz_Decrypt', THEN analz.Fst], assumption, assumption, simp)
+ apply (metis Says_imp_analz_Spy analz.Fst analz_Decrypt')
 apply (frule K3_imp_K2, assumption, assumption, erule exE, erule exE)
 apply (drule Says_imp_knows_Spy [THEN parts.Inj, THEN parts.Fst])
 apply (frule servK_authentic_ter, blast, assumption+)
--- a/src/HOL/Auth/Kerberos_BAN.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Kerberos_BAN.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -288,15 +288,8 @@
                   on evs)"
 apply (unfold before_def)
 apply (erule rev_mp)
-apply (erule bankerberos.induct, simp_all)
-txt{*We need this simplification only for Message 2*}
-apply (simp (no_asm) add: takeWhile_tail)
-apply auto
-txt{*Two subcases of Message 2. Subcase: used before*}
-apply (blast dest: used_evs_rev [THEN equalityD2, THEN contra_subsetD] 
-                   used_takeWhile_used)
-txt{*subcase: CT before*}
-apply (fastsimp dest!: set_evs_rev [THEN equalityD2, THEN contra_subsetD, THEN takeWhile_void])
+apply (erule bankerberos.induct, simp_all add: takeWhile_tail)
+apply (metis length_rev set_rev takeWhile_void used_evs_rev)
 done
 
 
@@ -492,6 +485,7 @@
 txt{*BK3*}
 apply (blast dest: Kab_authentic unique_session_keys)
 done
+
 lemma lemma_B [rule_format]:
      "\<lbrakk> B \<notin> bad;  evs \<in> bankerberos \<rbrakk>
       \<Longrightarrow> Key K \<notin> analz (spies evs) \<longrightarrow>
@@ -585,9 +579,8 @@
 txt{*BK2*}
 apply (blast intro: parts_insertI less_SucI)
 txt{*BK3*}
-apply (case_tac "Aa \<in> bad")
- prefer 2 apply (blast dest: Kab_authentic unique_session_keys)
-apply (blast dest: Says_imp_spies [THEN analz.Inj] Crypt_Spy_analz_bad elim!: MPair_analz intro: less_SucI)
+apply (metis Crypt_Spy_analz_bad Kab_authentic Says_imp_analz_Spy 
+          Says_imp_parts_knows_Spy analz.Snd less_SucI unique_session_keys)
 txt{*Oops: PROOF FAILS if unsafe intro below*}
 apply (blast dest: unique_session_keys intro!: less_SucI)
 done
--- a/src/HOL/Auth/NS_Shared.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/NS_Shared.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -273,11 +273,11 @@
 apply (simp_all add: analz_insert_eq analz_insert_freshK pushes split_ifs, spy_analz)
 txt{*NS2*}
 apply blast
-txt{*NS3, Server sub-case*}
+txt{*NS3*}
 apply (blast dest!: Crypt_Spy_analz_bad A_trusts_NS2
 	     dest:  Says_imp_knows_Spy analz.Inj unique_session_keys)
-txt{*NS3, Spy sub-case; also Oops*}
-apply (blast dest: unique_session_keys)+
+txt{*Oops*}
+apply (blast dest: unique_session_keys)
 done
 
 
@@ -318,9 +318,7 @@
     @{term "Crypt K (Nonce NB) \<in> parts (spies evs2)"} *} 
 apply (force dest!: Crypt_imp_keysFor)
 txt{*NS4*}
-apply (blast dest: B_trusts_NS3
-	           Says_imp_knows_Spy [THEN analz.Inj]
-                   Crypt_Spy_analz_bad unique_session_keys)
+apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
 done
 
 text{*This version no longer assumes that K is secure*}
@@ -349,9 +347,7 @@
 txt{*NS2*}
 apply (blast dest!: new_keys_not_used Crypt_imp_keysFor)
 txt{*NS4*}
-apply (blast dest: B_trusts_NS3
-	     dest: Says_imp_knows_Spy [THEN analz.Inj]
-                   unique_session_keys Crypt_Spy_analz_bad)
+apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
 done
 
 
@@ -475,18 +471,15 @@
 apply (erule rev_mp)
 apply (erule rev_mp)
 apply (erule ns_shared.induct, analz_mono_contra)
-apply (frule_tac [5] Says_S_message_form)
 apply (simp_all)
 txt{*Fake*}
 apply blast
 txt{*NS2*}
 apply (force dest!: Crypt_imp_keysFor)
-txt{*NS3, much quicker having installed @{term Says_S_message_form} before simplication*}
-apply fastsimp
+txt{*NS3*}
+apply (metis NS3_msg_in_parts_spies parts_cut_eq)
 txt{*NS5, the most important case, can be solved by unicity*}
-apply (case_tac "Aa \<in> bad")
-apply (force dest!: Says_imp_spies [THEN analz.Inj, THEN analz.Decrypt, THEN analz.Snd, THEN analz.Snd, THEN analz.Fst])
-apply (blast dest: A_trusts_NS2 unique_session_keys)
+apply (metis A_trusts_NS2 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst analz.Snd unique_session_keys)
 done
 
 lemma A_Issues_B:
--- a/src/HOL/Auth/Public.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Public.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Auth/Public
-    ID:         $Id$
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1996  University of Cambridge
 
@@ -8,7 +7,9 @@
 Private and public keys; initial states of agents
 *)
 
-theory Public imports Event begin
+theory Public
+imports Event
+begin
 
 lemma invKey_K: "K \<in> symKeys ==> invKey K = K"
 by (simp add: symKeys_def)
--- a/src/HOL/Auth/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -1,51 +1,2 @@
-(*  Title:      HOL/Auth/ROOT.ML
-    ID:         $Id$
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-    Copyright   1996  University of Cambridge
 
-Root file for protocol proofs.
-*)
-
-use_thys [
-
-(* Conventional protocols: rely on 
-   conventional Message, Event and Public *)
-
-(*Shared-key protocols*)
-  "NS_Shared",
-  "Kerberos_BAN",
-  "Kerberos_BAN_Gets",
-  "KerberosIV",
-  "KerberosIV_Gets",
-  "KerberosV",
-  "OtwayRees",
-  "OtwayRees_AN",
-  "OtwayRees_Bad",
-  "OtwayReesBella",
-  "WooLam",
-  "Recur",
-  "Yahalom",
-  "Yahalom2",
-  "Yahalom_Bad",
-  "ZhouGollmann",
-
-(*Public-key protocols*)
-  "NS_Public_Bad",
-  "NS_Public",
-  "TLS",
-  "CertifiedEmail",
-
-(*Smartcard protocols: rely on conventional Message and on new
-  EventSC and Smartcard *)
-
-  "Smartcard/ShoupRubin",
-  "Smartcard/ShoupRubinBella",
-
-(*Blanqui's "guard" concept: protocol-independent secrecy*)
-  "Guard/P1",
-  "Guard/P2",
-  "Guard/Guard_NS_Public",
-  "Guard/Guard_OtwayRees",
-  "Guard/Guard_Yahalom",
-  "Guard/Proto"
-];
+use_thys ["Auth_Shared", "Auth_Public", "Smartcard/Auth_Smartcard", "Guard/Auth_Guard_Shared", "Guard/Auth_Guard_Public"];
--- a/src/HOL/Auth/Recur.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Recur.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -419,15 +419,10 @@
 apply spy_analz
 txt{*RA2*}
 apply blast 
-txt{*RA3 remains*}
+txt{*RA3*}
 apply (simp add: parts_insert_spies)
-txt{*Now we split into two cases.  A single blast could do it, but it would take
-  a CPU minute.*}
-apply (safe del: impCE)
-txt{*RA3, case 1: use lemma previously proved by induction*}
-apply (blast elim: rev_notE [OF _ respond_Spy_not_see_session_key])
-txt{*RA3, case 2: K is an old key*}
-apply (blast dest: resp_analz_insert dest: Key_in_parts_respond)
+apply (metis Key_in_parts_respond parts.Body parts.Fst resp_analz_insert 
+             respond_Spy_not_see_session_key usedI)
 txt{*RA4*}
 apply blast 
 done
--- a/src/HOL/Auth/Shared.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Shared.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Auth/Shared
-    ID:         $Id$
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1996  University of Cambridge
 
@@ -8,7 +7,9 @@
 Shared, long-term keys; initial states of agents
 *)
 
-theory Shared imports Event begin
+theory Shared
+imports Event All_Symmetric
+begin
 
 consts
   shrK    :: "agent => key"  (*symmetric keys*);
@@ -20,13 +21,6 @@
    apply (simp add: inj_on_def split: agent.split) 
    done
 
-text{*All keys are symmetric*}
-
-defs  all_symmetric_def: "all_symmetric == True"
-
-lemma isSym_keys: "K \<in> symKeys"	
-by (simp add: symKeys_def all_symmetric_def invKey_symmetric) 
-
 text{*Server knows all long-term keys; other agents know only their own*}
 primrec
   initState_Server:  "initState Server     = Key ` range shrK"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Auth/Smartcard/Auth_Smartcard.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,13 @@
+(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1996  University of Cambridge
+*)
+
+header {* Smartcard protocols: rely on conventional Message and on new EventSC and Smartcard *}
+
+theory Auth_Smartcard
+imports
+  "ShoupRubin"
+  "ShoupRubinBella"
+begin
+
+end
--- a/src/HOL/Auth/Smartcard/Smartcard.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Auth/Smartcard/Smartcard.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1,10 +1,11 @@
-(*  ID:         $Id$
-    Author:     Giampaolo Bella, Catania University
+(* Author:     Giampaolo Bella, Catania University
 *)
 
 header{*Theory of smartcards*}
 
-theory Smartcard imports EventSC begin
+theory Smartcard
+imports EventSC All_Symmetric
+begin
 
 text{*  
 As smartcards handle long-term (symmetric) keys, this theoy extends and 
@@ -42,14 +43,6 @@
   shrK_disj_pin [iff]:  "shrK P \<noteq> pin Q"
   crdK_disj_pin [iff]:   "crdK C \<noteq> pin P"
 
-
-text{*All keys are symmetric*}
-defs  all_symmetric_def: "all_symmetric == True"
-
-lemma isSym_keys: "K \<in> symKeys"	
-by (simp add: symKeys_def all_symmetric_def invKey_symmetric) 
-
-
 constdefs
   legalUse :: "card => bool" ("legalUse (_)")
   "legalUse C == C \<notin> stolen"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Bali/Bali.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,11 @@
+(*  Author:     David von Oheimb
+    Copyright   1999 Technische Universitaet Muenchen
+*)
+
+header {* The Hoare logic for Bali. *}
+
+theory Bali
+imports AxExample AxSound AxCompl Trans
+begin
+
+end
--- a/src/HOL/Bali/DeclConcepts.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Bali/DeclConcepts.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -154,21 +154,14 @@
 
 instance decl_ext_type :: ("has_static") has_static ..
 
-defs (overloaded)
-decl_is_static_def: 
- "is_static (m::('a::has_static) decl_scheme) \<equiv> is_static (Decl.decl.more m)" 
-
 instance member_ext_type :: ("type") has_static ..
 
 defs (overloaded)
 static_field_type_is_static_def: 
- "is_static (m::('b::type) member_ext_type) \<equiv> static_sel m"
+ "is_static (m::('b member_scheme)) \<equiv> static m"
 
 lemma member_is_static_simp: "is_static (m::'a member_scheme) = static m"
-apply (cases m)
-apply (simp add: static_field_type_is_static_def 
-                 decl_is_static_def Decl.member.dest_convs)
-done
+by (simp add: static_field_type_is_static_def)
 
 instance * :: ("type","has_static") has_static ..
 
@@ -402,30 +395,16 @@
 
 instance decl_ext_type :: ("has_resTy") has_resTy ..
 
-defs (overloaded)
-decl_resTy_def: 
- "resTy (m::('a::has_resTy) decl_scheme) \<equiv> resTy (Decl.decl.more m)" 
-
 instance member_ext_type :: ("has_resTy") has_resTy ..
 
-defs (overloaded)
-member_ext_type_resTy_def: 
- "resTy (m::('b::has_resTy) member_ext_type) 
-  \<equiv> resTy (member.more_sel m)" 
-
 instance mhead_ext_type :: ("type") has_resTy ..
 
 defs (overloaded)
 mhead_ext_type_resTy_def: 
- "resTy (m::('b mhead_ext_type)) 
-  \<equiv> resT_sel m" 
+ "resTy (m::('b mhead_scheme)) \<equiv> resT m"
 
 lemma mhead_resTy_simp: "resTy (m::'a mhead_scheme) = resT m"
-apply (cases m)
-apply (simp add: decl_resTy_def member_ext_type_resTy_def 
-                 mhead_ext_type_resTy_def 
-                 member.dest_convs mhead.dest_convs)
-done
+by (simp add: mhead_ext_type_resTy_def)
 
 lemma resTy_mhead [simp]:"resTy (mhead m) = resTy m"
 by (simp add: mhead_def mhead_resTy_simp)
--- a/src/HOL/Bali/DefiniteAssignmentCorrect.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Bali/DefiniteAssignmentCorrect.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1747,7 +1747,7 @@
       have "assigns (In1l e2) \<subseteq> dom (locals (store s2))"
 	by (simp add: need_second_arg_def)
       with s2
-      show ?thesis using False by (simp add: Un_subset_iff)
+      show ?thesis using False by simp
     qed
   next
     case Super thus ?case by simp
--- a/src/HOL/Bali/Example.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Bali/Example.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1167,7 +1167,6 @@
 apply    (simp,rule assigned.select_convs)
 apply   (simp)
 apply  simp
-apply  blast
 apply simp
 apply (simp add: intersect_ts_def)
 done
--- a/src/HOL/Bali/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Bali/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -1,9 +1,2 @@
-(*  Title:      HOL/Bali/ROOT.ML
-    ID:         $Id$
-    Author:     David von Oheimb
-    Copyright   1999 Technische Universitaet Muenchen
 
-The Hoare logic for Bali.
-*)
-
-use_thys ["AxExample", "AxSound", "AxCompl", "Trans"];
+use_thy "Bali"
--- a/src/HOL/Bali/TypeSafe.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Bali/TypeSafe.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -2953,7 +2953,7 @@
 	  by simp
 	from da_e1 s0_s1 True obtain E1' where
 	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s1)))\<guillemotright>In1l e1\<guillemotright> E1'"
-	  by - (rule da_weakenE, auto iff del: Un_subset_iff)
+	  by - (rule da_weakenE, auto iff del: Un_subset_iff le_sup_iff)
 	with conf_s1 wt_e1
 	obtain 
 	  "s2\<Colon>\<preceq>(G, L)"
@@ -2972,7 +2972,7 @@
 	  by simp
 	from da_e2 s0_s1 False obtain E2' where
 	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s1)))\<guillemotright>In1l e2\<guillemotright> E2'"
-	  by - (rule da_weakenE, auto iff del: Un_subset_iff)
+	  by - (rule da_weakenE, auto iff del: Un_subset_iff le_sup_iff)
 	with conf_s1 wt_e2
 	obtain 
 	  "s2\<Colon>\<preceq>(G, L)"
--- a/src/HOL/Code_Eval.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,271 +0,0 @@
-(*  Title:      HOL/Code_Eval.thy
-    Author:     Florian Haftmann, TU Muenchen
-*)
-
-header {* Term evaluation using the generic code generator *}
-
-theory Code_Eval
-imports Plain Typerep Code_Numeral
-begin
-
-subsection {* Term representation *}
-
-subsubsection {* Terms and class @{text term_of} *}
-
-datatype "term" = dummy_term
-
-definition Const :: "String.literal \<Rightarrow> typerep \<Rightarrow> term" where
-  "Const _ _ = dummy_term"
-
-definition App :: "term \<Rightarrow> term \<Rightarrow> term" where
-  "App _ _ = dummy_term"
-
-code_datatype Const App
-
-class term_of = typerep +
-  fixes term_of :: "'a \<Rightarrow> term"
-
-lemma term_of_anything: "term_of x \<equiv> t"
-  by (rule eq_reflection) (cases "term_of x", cases t, simp)
-
-definition valapp :: "('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)
-  \<Rightarrow> 'a \<times> (unit \<Rightarrow> term) \<Rightarrow> 'b \<times> (unit \<Rightarrow> term)" where
-  "valapp f x = (fst f (fst x), \<lambda>u. App (snd f ()) (snd x ()))"
-
-lemma valapp_code [code, code_unfold]:
-  "valapp (f, tf) (x, tx) = (f x, \<lambda>u. App (tf ()) (tx ()))"
-  by (simp only: valapp_def fst_conv snd_conv)
-
-
-subsubsection {* @{text term_of} instances *}
-
-instantiation "fun" :: (typerep, typerep) term_of
-begin
-
-definition
-  "term_of (f \<Colon> 'a \<Rightarrow> 'b) = Const (STR ''dummy_pattern'') (Typerep.Typerep (STR ''fun'')
-     [Typerep.typerep TYPE('a), Typerep.typerep TYPE('b)])"
-
-instance ..
-
-end
-
-setup {*
-let
-  fun add_term_of tyco raw_vs thy =
-    let
-      val vs = map (fn (v, _) => (v, @{sort typerep})) raw_vs;
-      val ty = Type (tyco, map TFree vs);
-      val lhs = Const (@{const_name term_of}, ty --> @{typ term})
-        $ Free ("x", ty);
-      val rhs = @{term "undefined \<Colon> term"};
-      val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
-      fun triv_name_of t = (fst o dest_Free o fst o strip_comb o fst
-        o HOLogic.dest_eq o HOLogic.dest_Trueprop) t ^ "_triv";
-    in
-      thy
-      |> TheoryTarget.instantiation ([tyco], vs, @{sort term_of})
-      |> `(fn lthy => Syntax.check_term lthy eq)
-      |-> (fn eq => Specification.definition (NONE, ((Binding.name (triv_name_of eq), []), eq)))
-      |> snd
-      |> Class.prove_instantiation_exit (K (Class.intro_classes_tac []))
-    end;
-  fun ensure_term_of (tyco, (raw_vs, _)) thy =
-    let
-      val need_inst = not (can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of})
-        andalso can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort typerep};
-    in if need_inst then add_term_of tyco raw_vs thy else thy end;
-in
-  Code.type_interpretation ensure_term_of
-end
-*}
-
-setup {*
-let
-  fun mk_term_of_eq thy ty vs tyco (c, tys) =
-    let
-      val t = list_comb (Const (c, tys ---> ty),
-        map Free (Name.names Name.context "a" tys));
-      val (arg, rhs) = pairself (Thm.cterm_of thy o map_types Logic.unvarifyT o Logic.varify)
-        (t, (map_aterms (fn t as Free (v, ty) => HOLogic.mk_term_of ty t | t => t) o HOLogic.reflect_term) t)
-      val cty = Thm.ctyp_of thy ty;
-    in
-      @{thm term_of_anything}
-      |> Drule.instantiate' [SOME cty] [SOME arg, SOME rhs]
-      |> Thm.varifyT
-    end;
-  fun add_term_of_code tyco raw_vs raw_cs thy =
-    let
-      val algebra = Sign.classes_of thy;
-      val vs = map (fn (v, sort) =>
-        (v, curry (Sorts.inter_sort algebra) @{sort typerep} sort)) raw_vs;
-      val ty = Type (tyco, map TFree vs);
-      val cs = (map o apsnd o map o map_atyps)
-        (fn TFree (v, _) => TFree (v, (the o AList.lookup (op =) vs) v)) raw_cs;
-      val const = AxClass.param_of_inst thy (@{const_name term_of}, tyco);
-      val eqs = map (mk_term_of_eq thy ty vs tyco) cs;
-   in
-      thy
-      |> Code.del_eqns const
-      |> fold Code.add_eqn eqs
-    end;
-  fun ensure_term_of_code (tyco, (raw_vs, cs)) thy =
-    let
-      val has_inst = can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of};
-    in if has_inst then add_term_of_code tyco raw_vs cs thy else thy end;
-in
-  Code.type_interpretation ensure_term_of_code
-end
-*}
-
-
-subsubsection {* Code generator setup *}
-
-lemmas [code del] = term.recs term.cases term.size
-lemma [code, code del]: "eq_class.eq (t1\<Colon>term) t2 \<longleftrightarrow> eq_class.eq t1 t2" ..
-
-lemma [code, code del]: "(term_of \<Colon> typerep \<Rightarrow> term) = term_of" ..
-lemma [code, code del]: "(term_of \<Colon> term \<Rightarrow> term) = term_of" ..
-lemma [code, code del]: "(term_of \<Colon> String.literal \<Rightarrow> term) = term_of" ..
-lemma [code, code del]:
-  "(Code_Eval.term_of \<Colon> 'a::{type, term_of} Predicate.pred \<Rightarrow> Code_Eval.term) = Code_Eval.term_of" ..
-lemma [code, code del]:
-  "(Code_Eval.term_of \<Colon> 'a::{type, term_of} Predicate.seq \<Rightarrow> Code_Eval.term) = Code_Eval.term_of" ..
-
-lemma term_of_char [unfolded typerep_fun_def typerep_char_def typerep_nibble_def, code]: "Code_Eval.term_of c =
-    (let (n, m) = nibble_pair_of_char c
-  in Code_Eval.App (Code_Eval.App (Code_Eval.Const (STR ''String.char.Char'') (TYPEREP(nibble \<Rightarrow> nibble \<Rightarrow> char)))
-    (Code_Eval.term_of n)) (Code_Eval.term_of m))"
-  by (subst term_of_anything) rule 
-
-code_type "term"
-  (Eval "Term.term")
-
-code_const Const and App
-  (Eval "Term.Const/ ((_), (_))" and "Term.$/ ((_), (_))")
-
-code_const "term_of \<Colon> String.literal \<Rightarrow> term"
-  (Eval "HOLogic.mk'_message'_string")
-
-code_reserved Eval HOLogic
-
-
-subsubsection {* Syntax *}
-
-definition termify :: "'a \<Rightarrow> term" where
-  [code del]: "termify x = dummy_term"
-
-abbreviation valtermify :: "'a \<Rightarrow> 'a \<times> (unit \<Rightarrow> term)" where
-  "valtermify x \<equiv> (x, \<lambda>u. termify x)"
-
-setup {*
-let
-  fun map_default f xs =
-    let val ys = map f xs
-    in if exists is_some ys
-      then SOME (map2 the_default xs ys)
-      else NONE
-    end;
-  fun subst_termify_app (Const (@{const_name termify}, T), [t]) =
-        if not (Term.has_abs t)
-        then if fold_aterms (fn Const _ => I | _ => K false) t true
-          then SOME (HOLogic.reflect_term t)
-          else error "Cannot termify expression containing variables"
-        else error "Cannot termify expression containing abstraction"
-    | subst_termify_app (t, ts) = case map_default subst_termify ts
-       of SOME ts' => SOME (list_comb (t, ts'))
-        | NONE => NONE
-  and subst_termify (Abs (v, T, t)) = (case subst_termify t
-       of SOME t' => SOME (Abs (v, T, t'))
-        | NONE => NONE)
-    | subst_termify t = subst_termify_app (strip_comb t) 
-  fun check_termify ts ctxt = map_default subst_termify ts
-    |> Option.map (rpair ctxt)
-in
-  Context.theory_map (Syntax.add_term_check 0 "termify" check_termify)
-end;
-*}
-
-locale term_syntax
-begin
-
-notation App (infixl "<\<cdot>>" 70)
-  and valapp (infixl "{\<cdot>}" 70)
-
-end
-
-interpretation term_syntax .
-
-no_notation App (infixl "<\<cdot>>" 70)
-  and valapp (infixl "{\<cdot>}" 70)
-
-
-subsection {* Numeric types *}
-
-definition term_of_num :: "'a\<Colon>{semiring_div} \<Rightarrow> 'a\<Colon>{semiring_div} \<Rightarrow> term" where
-  "term_of_num two = (\<lambda>_. dummy_term)"
-
-lemma (in term_syntax) term_of_num_code [code]:
-  "term_of_num two k = (if k = 0 then termify Int.Pls
-    else (if k mod two = 0
-      then termify Int.Bit0 <\<cdot>> term_of_num two (k div two)
-      else termify Int.Bit1 <\<cdot>> term_of_num two (k div two)))"
-  by (auto simp add: term_of_anything Const_def App_def term_of_num_def Let_def)
-
-lemma (in term_syntax) term_of_nat_code [code]:
-  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num (2::nat) n"
-  by (simp only: term_of_anything)
-
-lemma (in term_syntax) term_of_int_code [code]:
-  "term_of (k::int) = (if k = 0 then termify (0 :: int)
-    else if k > 0 then termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) k
-      else termify (uminus :: int \<Rightarrow> int) <\<cdot>> (termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) (- k)))"
-  by (simp only: term_of_anything)
-
-lemma (in term_syntax) term_of_code_numeral_code [code]:
-  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num (2::code_numeral) k"
-  by (simp only: term_of_anything)
-
-subsection {* Obfuscate *}
-
-print_translation {*
-let
-  val term = Const ("<TERM>", dummyT);
-  fun tr1' [_, _] = term;
-  fun tr2' [] = term;
-in
-  [(@{const_syntax Const}, tr1'),
-    (@{const_syntax App}, tr1'),
-    (@{const_syntax dummy_term}, tr2')]
-end
-*}
-
-hide const dummy_term App valapp
-hide (open) const Const termify valtermify term_of term_of_num
-
-
-subsection {* Evaluation setup *}
-
-ML {*
-signature EVAL =
-sig
-  val eval_ref: (unit -> term) option ref
-  val eval_term: theory -> term -> term
-end;
-
-structure Eval : EVAL =
-struct
-
-val eval_ref = ref (NONE : (unit -> term) option);
-
-fun eval_term thy t =
-  Code_ML.eval NONE ("Eval.eval_ref", eval_ref) I thy (HOLogic.mk_term_of (fastype_of t) t) [];
-
-end;
-*}
-
-setup {*
-  Value.add_evaluator ("code", Eval.eval_term o ProofContext.theory_of)
-*}
-
-end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Code_Evaluation.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -0,0 +1,271 @@
+(*  Title:      HOL/Code_Evaluation.thy
+    Author:     Florian Haftmann, TU Muenchen
+*)
+
+header {* Term evaluation using the generic code generator *}
+
+theory Code_Evaluation
+imports Plain Typerep Code_Numeral
+begin
+
+subsection {* Term representation *}
+
+subsubsection {* Terms and class @{text term_of} *}
+
+datatype "term" = dummy_term
+
+definition Const :: "String.literal \<Rightarrow> typerep \<Rightarrow> term" where
+  "Const _ _ = dummy_term"
+
+definition App :: "term \<Rightarrow> term \<Rightarrow> term" where
+  "App _ _ = dummy_term"
+
+code_datatype Const App
+
+class term_of = typerep +
+  fixes term_of :: "'a \<Rightarrow> term"
+
+lemma term_of_anything: "term_of x \<equiv> t"
+  by (rule eq_reflection) (cases "term_of x", cases t, simp)
+
+definition valapp :: "('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)
+  \<Rightarrow> 'a \<times> (unit \<Rightarrow> term) \<Rightarrow> 'b \<times> (unit \<Rightarrow> term)" where
+  "valapp f x = (fst f (fst x), \<lambda>u. App (snd f ()) (snd x ()))"
+
+lemma valapp_code [code, code_unfold]:
+  "valapp (f, tf) (x, tx) = (f x, \<lambda>u. App (tf ()) (tx ()))"
+  by (simp only: valapp_def fst_conv snd_conv)
+
+
+subsubsection {* @{text term_of} instances *}
+
+instantiation "fun" :: (typerep, typerep) term_of
+begin
+
+definition
+  "term_of (f \<Colon> 'a \<Rightarrow> 'b) = Const (STR ''dummy_pattern'') (Typerep.Typerep (STR ''fun'')
+     [Typerep.typerep TYPE('a), Typerep.typerep TYPE('b)])"
+
+instance ..
+
+end
+
+setup {*
+let
+  fun add_term_of tyco raw_vs thy =
+    let
+      val vs = map (fn (v, _) => (v, @{sort typerep})) raw_vs;
+      val ty = Type (tyco, map TFree vs);
+      val lhs = Const (@{const_name term_of}, ty --> @{typ term})
+        $ Free ("x", ty);
+      val rhs = @{term "undefined \<Colon> term"};
+      val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
+      fun triv_name_of t = (fst o dest_Free o fst o strip_comb o fst
+        o HOLogic.dest_eq o HOLogic.dest_Trueprop) t ^ "_triv";
+    in
+      thy
+      |> TheoryTarget.instantiation ([tyco], vs, @{sort term_of})
+      |> `(fn lthy => Syntax.check_term lthy eq)
+      |-> (fn eq => Specification.definition (NONE, ((Binding.name (triv_name_of eq), []), eq)))
+      |> snd
+      |> Class.prove_instantiation_exit (K (Class.intro_classes_tac []))
+    end;
+  fun ensure_term_of (tyco, (raw_vs, _)) thy =
+    let
+      val need_inst = not (can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of})
+        andalso can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort typerep};
+    in if need_inst then add_term_of tyco raw_vs thy else thy end;
+in
+  Code.type_interpretation ensure_term_of
+end
+*}
+
+setup {*
+let
+  fun mk_term_of_eq thy ty vs tyco (c, tys) =
+    let
+      val t = list_comb (Const (c, tys ---> ty),
+        map Free (Name.names Name.context "a" tys));
+      val (arg, rhs) = pairself (Thm.cterm_of thy o map_types Logic.unvarifyT o Logic.varify)
+        (t, (map_aterms (fn t as Free (v, ty) => HOLogic.mk_term_of ty t | t => t) o HOLogic.reflect_term) t)
+      val cty = Thm.ctyp_of thy ty;
+    in
+      @{thm term_of_anything}
+      |> Drule.instantiate' [SOME cty] [SOME arg, SOME rhs]
+      |> Thm.varifyT
+    end;
+  fun add_term_of_code tyco raw_vs raw_cs thy =
+    let
+      val algebra = Sign.classes_of thy;
+      val vs = map (fn (v, sort) =>
+        (v, curry (Sorts.inter_sort algebra) @{sort typerep} sort)) raw_vs;
+      val ty = Type (tyco, map TFree vs);
+      val cs = (map o apsnd o map o map_atyps)
+        (fn TFree (v, _) => TFree (v, (the o AList.lookup (op =) vs) v)) raw_cs;
+      val const = AxClass.param_of_inst thy (@{const_name term_of}, tyco);
+      val eqs = map (mk_term_of_eq thy ty vs tyco) cs;
+   in
+      thy
+      |> Code.del_eqns const
+      |> fold Code.add_eqn eqs
+    end;
+  fun ensure_term_of_code (tyco, (raw_vs, cs)) thy =
+    let
+      val has_inst = can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of};
+    in if has_inst then add_term_of_code tyco raw_vs cs thy else thy end;
+in
+  Code.type_interpretation ensure_term_of_code
+end
+*}
+
+
+subsubsection {* Code generator setup *}
+
+lemmas [code del] = term.recs term.cases term.size
+lemma [code, code del]: "eq_class.eq (t1\<Colon>term) t2 \<longleftrightarrow> eq_class.eq t1 t2" ..
+
+lemma [code, code del]: "(term_of \<Colon> typerep \<Rightarrow> term) = term_of" ..
+lemma [code, code del]: "(term_of \<Colon> term \<Rightarrow> term) = term_of" ..
+lemma [code, code del]: "(term_of \<Colon> String.literal \<Rightarrow> term) = term_of" ..
+lemma [code, code del]:
+  "(Code_Evaluation.term_of \<Colon> 'a::{type, term_of} Predicate.pred \<Rightarrow> Code_Evaluation.term) = Code_Evaluation.term_of" ..
+lemma [code, code del]:
+  "(Code_Evaluation.term_of \<Colon> 'a::{type, term_of} Predicate.seq \<Rightarrow> Code_Evaluation.term) = Code_Evaluation.term_of" ..
+
+lemma term_of_char [unfolded typerep_fun_def typerep_char_def typerep_nibble_def, code]: "Code_Evaluation.term_of c =
+    (let (n, m) = nibble_pair_of_char c
+  in Code_Evaluation.App (Code_Evaluation.App (Code_Evaluation.Const (STR ''String.char.Char'') (TYPEREP(nibble \<Rightarrow> nibble \<Rightarrow> char)))
+    (Code_Evaluation.term_of n)) (Code_Evaluation.term_of m))"
+  by (subst term_of_anything) rule 
+
+code_type "term"
+  (Eval "Term.term")
+
+code_const Const and App
+  (Eval "Term.Const/ ((_), (_))" and "Term.$/ ((_), (_))")
+
+code_const "term_of \<Colon> String.literal \<Rightarrow> term"
+  (Eval "HOLogic.mk'_message'_string")
+
+code_reserved Eval HOLogic
+
+
+subsubsection {* Syntax *}
+
+definition termify :: "'a \<Rightarrow> term" where
+  [code del]: "termify x = dummy_term"
+
+abbreviation valtermify :: "'a \<Rightarrow> 'a \<times> (unit \<Rightarrow> term)" where
+  "valtermify x \<equiv> (x, \<lambda>u. termify x)"
+
+setup {*
+let
+  fun map_default f xs =
+    let val ys = map f xs
+    in if exists is_some ys
+      then SOME (map2 the_default xs ys)
+      else NONE
+    end;
+  fun subst_termify_app (Const (@{const_name termify}, T), [t]) =
+        if not (Term.has_abs t)
+        then if fold_aterms (fn Const _ => I | _ => K false) t true
+          then SOME (HOLogic.reflect_term t)
+          else error "Cannot termify expression containing variables"
+        else error "Cannot termify expression containing abstraction"
+    | subst_termify_app (t, ts) = case map_default subst_termify ts
+       of SOME ts' => SOME (list_comb (t, ts'))
+        | NONE => NONE
+  and subst_termify (Abs (v, T, t)) = (case subst_termify t
+       of SOME t' => SOME (Abs (v, T, t'))
+        | NONE => NONE)
+    | subst_termify t = subst_termify_app (strip_comb t) 
+  fun check_termify ts ctxt = map_default subst_termify ts
+    |> Option.map (rpair ctxt)
+in
+  Context.theory_map (Syntax.add_term_check 0 "termify" check_termify)
+end;
+*}
+
+locale term_syntax
+begin
+
+notation App (infixl "<\<cdot>>" 70)
+  and valapp (infixl "{\<cdot>}" 70)
+
+end
+
+interpretation term_syntax .
+
+no_notation App (infixl "<\<cdot>>" 70)
+  and valapp (infixl "{\<cdot>}" 70)
+
+
+subsection {* Numeric types *}
+
+definition term_of_num :: "'a\<Colon>{semiring_div} \<Rightarrow> 'a\<Colon>{semiring_div} \<Rightarrow> term" where
+  "term_of_num two = (\<lambda>_. dummy_term)"
+
+lemma (in term_syntax) term_of_num_code [code]:
+  "term_of_num two k = (if k = 0 then termify Int.Pls
+    else (if k mod two = 0
+      then termify Int.Bit0 <\<cdot>> term_of_num two (k div two)
+      else termify Int.Bit1 <\<cdot>> term_of_num two (k div two)))"
+  by (auto simp add: term_of_anything Const_def App_def term_of_num_def Let_def)
+
+lemma (in term_syntax) term_of_nat_code [code]:
+  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num (2::nat) n"
+  by (simp only: term_of_anything)
+
+lemma (in term_syntax) term_of_int_code [code]:
+  "term_of (k::int) = (if k = 0 then termify (0 :: int)
+    else if k > 0 then termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) k
+      else termify (uminus :: int \<Rightarrow> int) <\<cdot>> (termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) (- k)))"
+  by (simp only: term_of_anything)
+
+lemma (in term_syntax) term_of_code_numeral_code [code]:
+  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num (2::code_numeral) k"
+  by (simp only: term_of_anything)
+
+subsection {* Obfuscate *}
+
+print_translation {*
+let
+  val term = Const ("<TERM>", dummyT);
+  fun tr1' [_, _] = term;
+  fun tr2' [] = term;
+in
+  [(@{const_syntax Const}, tr1'),
+    (@{const_syntax App}, tr1'),
+    (@{const_syntax dummy_term}, tr2')]
+end
+*}
+
+hide const dummy_term App valapp
+hide (open) const Const termify valtermify term_of term_of_num
+
+
+subsection {* Evaluation setup *}
+
+ML {*
+signature EVAL =
+sig
+  val eval_ref: (unit -> term) option Unsynchronized.ref
+  val eval_term: theory -> term -> term
+end;
+
+structure Eval : EVAL =
+struct
+
+val eval_ref = Unsynchronized.ref (NONE : (unit -> term) option);
+
+fun eval_term thy t =
+  Code_ML.eval NONE ("Eval.eval_ref", eval_ref) I thy (HOLogic.mk_term_of (fastype_of t) t) [];
+
+end;
+*}
+
+setup {*
+  Value.add_evaluator ("code", Eval.eval_term o ProofContext.theory_of)
+*}
+
+end
--- a/src/HOL/Complete_Lattice.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Complete_Lattice.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -10,7 +10,9 @@
   less_eq  (infix "\<sqsubseteq>" 50) and
   less (infix "\<sqsubset>" 50) and
   inf  (infixl "\<sqinter>" 70) and
-  sup  (infixl "\<squnion>" 65)
+  sup  (infixl "\<squnion>" 65) and
+  top ("\<top>") and
+  bot ("\<bottom>")
 
 
 subsection {* Abstract complete lattices *}
@@ -24,6 +26,15 @@
      and Sup_least: "(\<And>x. x \<in> A \<Longrightarrow> x \<sqsubseteq> z) \<Longrightarrow> \<Squnion>A \<sqsubseteq> z"
 begin
 
+term complete_lattice
+
+lemma dual_complete_lattice:
+  "complete_lattice (op \<ge>) (op >) (op \<squnion>) (op \<sqinter>) \<top> \<bottom> Sup Inf"
+  by (auto intro!: complete_lattice.intro dual_lattice
+    bot.intro top.intro dual_preorder, unfold_locales)
+      (fact bot_least top_greatest
+        Sup_upper Sup_least Inf_lower Inf_greatest)+
+
 lemma Inf_Sup: "\<Sqinter>A = \<Squnion>{b. \<forall>a \<in> A. b \<le> a}"
   by (auto intro: antisym Inf_lower Inf_greatest Sup_upper Sup_least)
 
@@ -76,11 +87,11 @@
 
 lemma sup_bot [simp]:
   "x \<squnion> bot = x"
-  using bot_least [of x] by (simp add: le_iff_sup sup_commute)
+  using bot_least [of x] by (simp add: sup_commute sup_absorb2)
 
 lemma inf_top [simp]:
   "x \<sqinter> top = x"
-  using top_greatest [of x] by (simp add: le_iff_inf inf_commute)
+  using top_greatest [of x] by (simp add: inf_commute inf_absorb2)
 
 definition SUPR :: "'b set \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a" where
   "SUPR A f = \<Squnion> (f ` A)"
@@ -203,8 +214,8 @@
 
 subsection {* Union *}
 
-definition Union :: "'a set set \<Rightarrow> 'a set" where
-  Sup_set_eq [symmetric]: "Union S = \<Squnion>S"
+abbreviation Union :: "'a set set \<Rightarrow> 'a set" where
+  "Union S \<equiv> \<Squnion>S"
 
 notation (xsymbols)
   Union  ("\<Union>_" [90] 90)
@@ -216,7 +227,7 @@
   have "(\<exists>Q\<in>{P. \<exists>B\<in>A. P \<longleftrightarrow> x \<in> B}. Q) \<longleftrightarrow> (\<exists>B\<in>A. x \<in> B)"
     by auto
   then show "x \<in> \<Union>A \<longleftrightarrow> x \<in> {x. \<exists>B\<in>A. x \<in> B}"
-    by (simp add: Sup_set_eq [symmetric] Sup_fun_def Sup_bool_def) (simp add: mem_def)
+    by (simp add: Sup_fun_def Sup_bool_def) (simp add: mem_def)
 qed
 
 lemma Union_iff [simp, noatp]:
@@ -278,8 +289,8 @@
 
 subsection {* Unions of families *}
 
-definition UNION :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
-  SUPR_set_eq [symmetric]: "UNION S f = (SUP x:S. f x)"
+abbreviation UNION :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
+  "UNION \<equiv> SUPR"
 
 syntax
   "@UNION1"     :: "pttrns => 'b set => 'b set"           ("(3UN _./ _)" [0, 10] 10)
@@ -314,7 +325,7 @@
 
 lemma UNION_eq_Union_image:
   "(\<Union>x\<in>A. B x) = \<Union>(B`A)"
-  by (simp add: SUPR_def SUPR_set_eq [symmetric] Sup_set_eq)
+  by (fact SUPR_def)
 
 lemma Union_def:
   "\<Union>S = (\<Union>x\<in>S. x)"
@@ -351,7 +362,7 @@
   by blast
 
 lemma UN_upper: "a \<in> A ==> B a \<subseteq> (\<Union>x\<in>A. B x)"
-  by blast
+  by (fact le_SUPI)
 
 lemma UN_least: "(!!x. x \<in> A ==> B x \<subseteq> C) ==> (\<Union>x\<in>A. B x) \<subseteq> C"
   by (iprover intro: subsetI elim: UN_E dest: subsetD)
@@ -439,8 +450,8 @@
 
 subsection {* Inter *}
 
-definition Inter :: "'a set set \<Rightarrow> 'a set" where
-  Inf_set_eq [symmetric]: "Inter S = \<Sqinter>S"
+abbreviation Inter :: "'a set set \<Rightarrow> 'a set" where
+  "Inter S \<equiv> \<Sqinter>S"
   
 notation (xsymbols)
   Inter  ("\<Inter>_" [90] 90)
@@ -452,7 +463,7 @@
   have "(\<forall>Q\<in>{P. \<exists>B\<in>A. P \<longleftrightarrow> x \<in> B}. Q) \<longleftrightarrow> (\<forall>B\<in>A. x \<in> B)"
     by auto
   then show "x \<in> \<Inter>A \<longleftrightarrow> x \<in> {x. \<forall>B \<in> A. x \<in> B}"
-    by (simp add: Inf_fun_def Inf_bool_def Inf_set_eq [symmetric]) (simp add: mem_def)
+    by (simp add: Inf_fun_def Inf_bool_def) (simp add: mem_def)
 qed
 
 lemma Inter_iff [simp,noatp]: "(A : Inter C) = (ALL X:C. A:X)"
@@ -514,8 +525,8 @@
 
 subsection {* Intersections of families *}
 
-definition INTER :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
-  INFI_set_eq [symmetric]: "INTER S f = (INF x:S. f x)"
+abbreviation INTER :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
+  "INTER \<equiv> INFI"
 
 syntax
   "@INTER1"     :: "pttrns => 'b set => 'b set"           ("(3INT _./ _)" [0, 10] 10)
@@ -541,7 +552,7 @@
 
 lemma INTER_eq_Inter_image:
   "(\<Inter>x\<in>A. B x) = \<Inter>(B`A)"
-  by (simp add: INFI_def INFI_set_eq [symmetric] Inf_set_eq)
+  by (fact INFI_def)
   
 lemma Inter_def:
   "\<Inter>S = (\<Inter>x\<in>S. x)"
@@ -579,10 +590,10 @@
   by blast
 
 lemma INT_lower: "a \<in> A ==> (\<Inter>x\<in>A. B x) \<subseteq> B a"
-  by blast
+  by (fact INF_leI)
 
 lemma INT_greatest: "(!!x. x \<in> A ==> C \<subseteq> B x) ==> C \<subseteq> (\<Inter>x\<in>A. B x)"
-  by (iprover intro: INT_I subsetI dest: subsetD)
+  by (fact le_INFI)
 
 lemma INT_empty [simp]: "(\<Inter>x\<in>{}. B x) = UNIV"
   by blast
@@ -784,7 +795,9 @@
   inf  (infixl "\<sqinter>" 70) and
   sup  (infixl "\<squnion>" 65) and
   Inf  ("\<Sqinter>_" [900] 900) and
-  Sup  ("\<Squnion>_" [900] 900)
+  Sup  ("\<Squnion>_" [900] 900) and
+  top ("\<top>") and
+  bot ("\<bottom>")
 
 lemmas mem_simps =
   insert_iff empty_iff Un_iff Int_iff Compl_iff Diff_iff
--- a/src/HOL/Decision_Procs/Approximation.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Decision_Procs/Approximation.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1904,7 +1904,7 @@
 	show "0 < real x * 2/3" using * by auto
 	show "real ?max + 1 \<le> real x * 2/3" using * up
 	  by (cases "0 < real x * real (lapprox_posrat prec 2 3) - 1",
-	      auto simp add: real_of_float_max max_def)
+	      auto simp add: real_of_float_max min_max.sup_absorb1)
       qed
       finally have "real (?lb_horner (Float 1 -1)) + real (?lb_horner ?max)
 	\<le> ln (real x)"
@@ -3246,12 +3246,13 @@
         = map (` (variable_of_bound o prop_of)) prems
 
       fun add_deps (name, bnds)
-        = Graph.add_deps_acyclic
-            (name, remove (op =) name (Term.add_free_names (prop_of bnds) []))
+        = Graph.add_deps_acyclic (name,
+            remove (op =) name (Term.add_free_names (prop_of bnds) []))
+
       val order = Graph.empty
                   |> fold Graph.new_node variable_bounds
                   |> fold add_deps variable_bounds
-                  |> Graph.topological_order |> rev
+                  |> Graph.strong_conn |> map the_single |> rev
                   |> map_filter (AList.lookup (op =) variable_bounds)
 
       fun prepend_prem th tac
@@ -3338,7 +3339,7 @@
                       etac @{thm meta_eqE},
                       rtac @{thm impI}] i)
       THEN Subgoal.FOCUS (fn {prems, ...} => reorder_bounds_tac prems i) @{context} i
-      THEN TRY (filter_prems_tac (K false) i)
+      THEN DETERM (TRY (filter_prems_tac (K false) i))
       THEN DETERM (Reflection.genreify_tac ctxt form_equations NONE i)
       THEN rewrite_interpret_form_tac ctxt prec splitting taylor i
       THEN gen_eval_tac eval_oracle ctxt i))
@@ -3350,7 +3351,7 @@
 
   fun mk_approx' prec t = (@{const "approx'"}
                          $ HOLogic.mk_number @{typ nat} prec
-                         $ t $ @{term "[] :: (float * float) list"})
+                         $ t $ @{term "[] :: (float * float) option list"})
 
   fun dest_result (Const (@{const_name "Some"}, _) $
                    ((Const (@{const_name "Pair"}, _)) $
--- a/src/HOL/Decision_Procs/Ferrack.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Decision_Procs/Ferrack.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -512,7 +512,7 @@
   assumes g0: "numgcd t = 0"
   shows "Inum bs t = 0"
   using g0[simplified numgcd_def] 
-  by (induct t rule: numgcdh.induct, auto simp add: natabs0 max_def maxcoeff_pos)
+  by (induct t rule: numgcdh.induct, auto simp add: natabs0 maxcoeff_pos min_max.sup_absorb2)
 
 lemma numgcdh_pos: assumes gp: "g \<ge> 0" shows "numgcdh t g \<ge> 0"
   using gp
--- a/src/HOL/Decision_Procs/cooper_tac.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Decision_Procs/cooper_tac.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -4,7 +4,7 @@
 
 signature COOPER_TAC =
 sig
-  val trace: bool ref
+  val trace: bool Unsynchronized.ref
   val linz_tac: Proof.context -> bool -> int -> tactic
   val setup: theory -> theory
 end
@@ -12,7 +12,7 @@
 structure Cooper_Tac: COOPER_TAC =
 struct
 
-val trace = ref false;
+val trace = Unsynchronized.ref false;
 fun trace_msg s = if !trace then tracing s else ();
 
 val cooper_ss = @{simpset};
--- a/src/HOL/Decision_Procs/ex/Approximation_Ex.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Decision_Procs/ex/Approximation_Ex.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -72,7 +72,9 @@
   shows "g / v * tan (35 * d) \<in> { 3 * d .. 3.1 * d }"
   using assms by (approximation 80)
 
-lemma "\<phi> \<in> { 0 .. 1 :: real } \<longrightarrow> \<phi> ^ 2 \<le> \<phi>"
-  by (approximation 30 splitting: \<phi>=1 taylor: \<phi> = 3)
+lemma "x \<in> { 0 .. 1 :: real } \<longrightarrow> x ^ 2 \<le> x"
+  by (approximation 30 splitting: x=1 taylor: x = 3)
+
+value [approximate] "10"
 
 end
--- a/src/HOL/Decision_Procs/ferrack_tac.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -4,7 +4,7 @@
 
 signature FERRACK_TAC =
 sig
-  val trace: bool ref
+  val trace: bool Unsynchronized.ref
   val linr_tac: Proof.context -> bool -> int -> tactic
   val setup: theory -> theory
 end
@@ -12,7 +12,7 @@
 structure Ferrack_Tac =
 struct
 
-val trace = ref false;
+val trace = Unsynchronized.ref false;
 fun trace_msg s = if !trace then tracing s else ();
 
 val ferrack_ss = let val ths = [@{thm real_of_int_inject}, @{thm real_of_int_less_iff}, 
--- a/src/HOL/Decision_Procs/mir_tac.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Decision_Procs/mir_tac.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -4,7 +4,7 @@
 
 signature MIR_TAC =
 sig
-  val trace: bool ref
+  val trace: bool Unsynchronized.ref
   val mir_tac: Proof.context -> bool -> int -> tactic
   val setup: theory -> theory
 end
@@ -12,7 +12,7 @@
 structure Mir_Tac =
 struct
 
-val trace = ref false;
+val trace = Unsynchronized.ref false;
 fun trace_msg s = if !trace then tracing s else ();
 
 val mir_ss = 
--- a/src/HOL/Extraction/Euclid.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Extraction/Euclid.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Extraction/Euclid.thy
-    ID:         $Id$
     Author:     Markus Wenzel, TU Muenchen
                 Freek Wiedijk, Radboud University Nijmegen
                 Stefan Berghofer, TU Muenchen
@@ -8,7 +7,7 @@
 header {* Euclid's theorem *}
 
 theory Euclid
-imports "~~/src/HOL/NumberTheory/Factorization" Util Efficient_Nat
+imports "~~/src/HOL/Old_Number_Theory/Factorization" Util Efficient_Nat
 begin
 
 text {*
--- a/src/HOL/Extraction/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Extraction/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Extraction/ROOT.ML
-    ID:         $Id$
 
 Examples for program extraction in Higher-Order Logic.
 *)
@@ -8,5 +7,5 @@
   warning "HOL proof terms required for running extraction examples"
 else
   (Proofterm.proofs := 2;
-   no_document use_thys ["Efficient_Nat", "~~/src/HOL/NumberTheory/Factorization"];
+   no_document use_thys ["Efficient_Nat", "~~/src/HOL/Old_Number_Theory/Factorization"];
    use_thys ["Greatest_Common_Divisor", "Warshall", "Higman", "Pigeonhole", "Euclid"]);
--- a/src/HOL/Fact.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Fact.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -8,7 +8,7 @@
 header{*Factorial Function*}
 
 theory Fact
-imports NatTransfer
+imports Nat_Transfer
 begin
 
 class fact =
--- a/src/HOL/Finite_Set.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Finite_Set.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1565,9 +1565,7 @@
   apply (rule finite_subset)
   prefer 2
   apply assumption
-  apply auto
-  apply (rule setsum_cong)
-  apply auto
+  apply (auto simp add: sup_absorb2)
 done
 
 lemma setsum_right_distrib: 
@@ -2615,6 +2613,23 @@
   finally show ?case .
 qed
 
+lemma fold1_eq_fold_idem:
+  assumes "finite A"
+  shows "fold1 times (insert a A) = fold times a A"
+proof (cases "a \<in> A")
+  case False
+  with assms show ?thesis by (simp add: fold1_eq_fold)
+next
+  interpret fun_left_comm_idem times by (fact fun_left_comm_idem)
+  case True then obtain b B
+    where A: "A = insert a B" and "a \<notin> B" by (rule set_insert)
+  with assms have "finite B" by auto
+  then have "fold times a (insert a B) = fold times (a * a) B"
+    using `a \<notin> B` by (rule fold_insert2)
+  then show ?thesis
+    using `a \<notin> B` `finite B` by (simp add: fold1_eq_fold A)
+qed
+
 end
 
 
@@ -2966,11 +2981,11 @@
 
 lemma dual_max:
   "ord.max (op \<ge>) = min"
-  by (auto simp add: ord.max_def_raw min_def_raw expand_fun_eq)
+  by (auto simp add: ord.max_def_raw min_def expand_fun_eq)
 
 lemma dual_min:
   "ord.min (op \<ge>) = max"
-  by (auto simp add: ord.min_def_raw max_def_raw expand_fun_eq)
+  by (auto simp add: ord.min_def_raw max_def expand_fun_eq)
 
 lemma strict_below_fold1_iff:
   assumes "finite A" and "A \<noteq> {}"
--- a/src/HOL/Fun.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/Fun.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -7,6 +7,7 @@
 
 theory Fun
 imports Complete_Lattice
+uses ("Tools/transfer.ML")
 begin
 
 text{*As a simplification rule, it replaces all function equalities by
@@ -568,6 +569,16 @@
 *}
 
 
+subsection {* Generic transfer procedure *}
+
+definition TransferMorphism:: "('b \<Rightarrow> 'a) \<Rightarrow> 'b set \<Rightarrow> bool"
+  where "TransferMorphism a B \<longleftrightarrow> True"
+
+use "Tools/transfer.ML"
+
+setup Transfer.setup
+
+
 subsection {* Code generator setup *}
 
 types_code
@@ -578,7 +589,7 @@
 attach (test) {*
 fun gen_fun_type aF aT bG bT i =
   let
-    val tab = ref [];
+    val tab = Unsynchronized.ref [];
     fun mk_upd (x, (_, y)) t = Const ("Fun.fun_upd",
       (aT --> bT) --> aT --> bT --> aT --> bT) $ t $ aF x $ y ()
   in
--- a/src/HOL/GCD.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/GCD.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -1,11 +1,9 @@
-(*  Title:      GCD.thy
-    Authors:    Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb,
+(*  Authors:    Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb,
                 Thomas M. Rasmussen, Jeremy Avigad, Tobias Nipkow
 
 
-This file deals with the functions gcd and lcm, and properties of
-primes. Definitions and lemmas are proved uniformly for the natural
-numbers and integers.
+This file deals with the functions gcd and lcm.  Definitions and
+lemmas are proved uniformly for the natural numbers and integers.
 
 This file combines and revises a number of prior developments.
 
@@ -52,11 +50,6 @@
 
 end
 
-class prime = one +
-
-fixes
-  prime :: "'a \<Rightarrow> bool"
-
 
 (* definitions for the natural numbers *)
 
@@ -80,20 +73,6 @@
 end
 
 
-instantiation nat :: prime
-
-begin
-
-definition
-  prime_nat :: "nat \<Rightarrow> bool"
-where
-  [code del]: "prime_nat p = (1 < p \<and> (\<forall>m. m dvd p --> m = 1 \<or> m = p))"
-
-instance proof qed
-
-end
-
-
 (* definitions for the integers *)
 
 instantiation int :: gcd
@@ -115,28 +94,13 @@
 end
 
 
-instantiation int :: prime
-
-begin
-
-definition
-  prime_int :: "int \<Rightarrow> bool"
-where
-  [code del]: "prime_int p = prime (nat p)"
-
-instance proof qed
-
-end
-
-
 subsection {* Set up Transfer *}
 
 
 lemma transfer_nat_int_gcd:
   "(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> gcd (nat x) (nat y) = nat (gcd x y)"
   "(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> lcm (nat x) (nat y) = nat (lcm x y)"
-  "(x::int) >= 0 \<Longrightarrow> prime (nat x) = prime x"
-  unfolding gcd_int_def lcm_int_def prime_int_def
+  unfolding gcd_int_def lcm_int_def
   by auto
 
 lemma transfer_nat_int_gcd_closures:
@@ -150,8 +114,7 @@
 lemma transfer_int_nat_gcd:
   "gcd (int x) (int y) = int (gcd x y)"
   "lcm (int x) (int y) = int (lcm x y)"
-  "prime (int x) = prime x"
-  by (unfold gcd_int_def lcm_int_def prime_int_def, auto)
+  by (unfold gcd_int_def lcm_int_def, auto)
 
 lemma transfer_int_nat_gcd_closures:
   "is_nat x \<Longrightarrow> is_nat y \<Longrightarrow> gcd x y >= 0"
@@ -1003,20 +966,6 @@
   apply (auto simp add: gcd_mult_cancel_int)
 done
 
-lemma prime_odd_nat: "prime (p::nat) \<Longrightarrow> p > 2 \<Longrightarrow> odd p"
-  unfolding prime_nat_def
-  apply (subst even_mult_two_ex)
-  apply clarify
-  apply (drule_tac x = 2 in spec)
-  apply auto
-done
-
-lemma prime_odd_int: "prime (p::int) \<Longrightarrow> p > 2 \<Longrightarrow> odd p"
-  unfolding prime_int_def
-  apply (frule prime_odd_nat)
-  apply (auto simp add: even_nat_def)
-done
-
 lemma coprime_common_divisor_nat: "coprime (a::nat) b \<Longrightarrow> x dvd a \<Longrightarrow>
     x dvd b \<Longrightarrow> x = 1"
   apply (subgoal_tac "x dvd gcd a b")
@@ -1753,329 +1702,4 @@
   show ?thesis by(simp add: Gcd_def fold_set gcd_commute_int)
 qed
 
-
-subsection {* Primes *}
-
-(* FIXME Is there a better way to handle these, rather than making them elim rules? *)
-
-lemma prime_ge_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= 0"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_gt_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p > 0"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_ge_1_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= 1"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_gt_1_nat [elim]: "prime (p::nat) \<Longrightarrow> p > 1"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_ge_Suc_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= Suc 0"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_gt_Suc_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p > Suc 0"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_ge_2_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= 2"
-  by (unfold prime_nat_def, auto)
-
-lemma prime_ge_0_int [elim]: "prime (p::int) \<Longrightarrow> p >= 0"
-  by (unfold prime_int_def prime_nat_def) auto
-
-lemma prime_gt_0_int [elim]: "prime (p::int) \<Longrightarrow> p > 0"
-  by (unfold prime_int_def prime_nat_def, auto)
-
-lemma prime_ge_1_int [elim]: "prime (p::int) \<Longrightarrow> p >= 1"
-  by (unfold prime_int_def prime_nat_def, auto)
-
-lemma prime_gt_1_int [elim]: "prime (p::int) \<Longrightarrow> p > 1"
-  by (unfold prime_int_def prime_nat_def, auto)
-
-lemma prime_ge_2_int [elim]: "prime (p::int) \<Longrightarrow> p >= 2"
-  by (unfold prime_int_def prime_nat_def, auto)
-
-
-lemma prime_int_altdef: "prime (p::int) = (1 < p \<and> (\<forall>m \<ge> 0. m dvd p \<longrightarrow>
-    m = 1 \<or> m = p))"
-  using prime_nat_def [transferred]
-    apply (case_tac "p >= 0")
-    by (blast, auto simp add: prime_ge_0_int)
-
-lemma prime_imp_coprime_nat: "prime (p::nat) \<Longrightarrow> \<not> p dvd n \<Longrightarrow> coprime p n"
-  apply (unfold prime_nat_def)
-  apply (metis gcd_dvd1_nat gcd_dvd2_nat)
-  done
-
-lemma prime_imp_coprime_int: "prime (p::int) \<Longrightarrow> \<not> p dvd n \<Longrightarrow> coprime p n"
-  apply (unfold prime_int_altdef)
-  apply (metis gcd_dvd1_int gcd_dvd2_int gcd_ge_0_int)
-  done
-
-lemma prime_dvd_mult_nat: "prime (p::nat) \<Longrightarrow> p dvd m * n \<Longrightarrow> p dvd m \<or> p dvd n"
-  by (blast intro: coprime_dvd_mult_nat prime_imp_coprime_nat)
-
-lemma prime_dvd_mult_int: "prime (p::int) \<Longrightarrow> p dvd m * n \<Longrightarrow> p dvd m \<or> p dvd n"
-  by (blast intro: coprime_dvd_mult_int prime_imp_coprime_int)
-
-lemma prime_dvd_mult_eq_nat [simp]: "prime (p::nat) \<Longrightarrow>
-    p dvd m * n = (p dvd m \<or> p dvd n)"
-  by (rule iffI, rule prime_dvd_mult_nat, auto)
-
-lemma prime_dvd_mult_eq_int [simp]: "prime (p::int) \<Longrightarrow>
-    p dvd m * n = (p dvd m \<or> p dvd n)"
-  by (rule iffI, rule prime_dvd_mult_int, auto)
-
-lemma not_prime_eq_prod_nat: "(n::nat) > 1 \<Longrightarrow> ~ prime n \<Longrightarrow>
-    EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n"
-  unfolding prime_nat_def dvd_def apply auto
-  by(metis mult_commute linorder_neq_iff linorder_not_le mult_1 n_less_n_mult_m one_le_mult_iff less_imp_le_nat)
-
-lemma not_prime_eq_prod_int: "(n::int) > 1 \<Longrightarrow> ~ prime n \<Longrightarrow>
-    EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n"
-  unfolding prime_int_altdef dvd_def
-  apply auto
-  by(metis div_mult_self1_is_id div_mult_self2_is_id int_div_less_self int_one_le_iff_zero_less zero_less_mult_pos zless_le)
-
-lemma prime_dvd_power_nat [rule_format]: "prime (p::nat) -->
-    n > 0 --> (p dvd x^n --> p dvd x)"
-  by (induct n rule: nat_induct, auto)
-
-lemma prime_dvd_power_int [rule_format]: "prime (p::int) -->
-    n > 0 --> (p dvd x^n --> p dvd x)"
-  apply (induct n rule: nat_induct, auto)
-  apply (frule prime_ge_0_int)
-  apply auto
-done
-
-subsubsection{* Make prime naively executable *}
-
-lemma zero_not_prime_nat [simp]: "~prime (0::nat)"
-  by (simp add: prime_nat_def)
-
-lemma zero_not_prime_int [simp]: "~prime (0::int)"
-  by (simp add: prime_int_def)
-
-lemma one_not_prime_nat [simp]: "~prime (1::nat)"
-  by (simp add: prime_nat_def)
-
-lemma Suc_0_not_prime_nat [simp]: "~prime (Suc 0)"
-  by (simp add: prime_nat_def One_nat_def)
-
-lemma one_not_prime_int [simp]: "~prime (1::int)"
-  by (simp add: prime_int_def)
-
-lemma prime_nat_code[code]:
- "prime(p::nat) = (p > 1 & (ALL n : {1<..<p}. ~(n dvd p)))"
-apply(simp add: Ball_def)
-apply (metis less_not_refl prime_nat_def dvd_triv_right not_prime_eq_prod_nat)
-done
-
-lemma prime_nat_simp:
- "prime(p::nat) = (p > 1 & (list_all (%n. ~ n dvd p) [2..<p]))"
-apply(simp only:prime_nat_code list_ball_code greaterThanLessThan_upt)
-apply(simp add:nat_number One_nat_def)
-done
-
-lemmas prime_nat_simp_number_of[simp] = prime_nat_simp[of "number_of m", standard]
-
-lemma prime_int_code[code]:
-  "prime(p::int) = (p > 1 & (ALL n : {1<..<p}. ~(n dvd p)))" (is "?L = ?R")
-proof
-  assume "?L" thus "?R"
-    by (clarsimp simp: prime_gt_1_int) (metis int_one_le_iff_zero_less prime_int_altdef zless_le)
-next
-    assume "?R" thus "?L" by (clarsimp simp:Ball_def) (metis dvdI not_prime_eq_prod_int)
-qed
-
-lemma prime_int_simp:
-  "prime(p::int) = (p > 1 & (list_all (%n. ~ n dvd p) [2..p - 1]))"
-apply(simp only:prime_int_code list_ball_code greaterThanLessThan_upto)
-apply simp
-done
-
-lemmas prime_int_simp_number_of[simp] = prime_int_simp[of "number_of m", standard]
-
-declare successor_int_def[simp]
-
-lemma two_is_prime_nat [simp]: "prime (2::nat)"
-by simp
-
-lemma two_is_prime_int [simp]: "prime (2::int)"
-by simp
-
-text{* A bit of regression testing: *}
-
-lemma "prime(97::nat)"
-by simp
-
-lemma "prime(97::int)"
-by simp
-
-lemma "prime(997::nat)"
-by eval
-
-lemma "prime(997::int)"
-by eval
-
-
-lemma prime_imp_power_coprime_nat: "prime (p::nat) \<Longrightarrow> ~ p dvd a \<Longrightarrow> coprime a (p^m)"
-  apply (rule coprime_exp_nat)
-  apply (subst gcd_commute_nat)
-  apply (erule (1) prime_imp_coprime_nat)
-done
-
-lemma prime_imp_power_coprime_int: "prime (p::int) \<Longrightarrow> ~ p dvd a \<Longrightarrow> coprime a (p^m)"
-  apply (rule coprime_exp_int)
-  apply (subst gcd_commute_int)
-  apply (erule (1) prime_imp_coprime_int)
-done
-
-lemma primes_coprime_nat: "prime (p::nat) \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
-  apply (rule prime_imp_coprime_nat, assumption)
-  apply (unfold prime_nat_def, auto)
-done
-
-lemma primes_coprime_int: "prime (p::int) \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
-  apply (rule prime_imp_coprime_int, assumption)
-  apply (unfold prime_int_altdef, clarify)
-  apply (drule_tac x = q in spec)
-  apply (drule_tac x = p in spec)
-  apply auto
-done
-
-lemma primes_imp_powers_coprime_nat: "prime (p::nat) \<Longrightarrow> prime q \<Longrightarrow> p ~= q \<Longrightarrow> coprime (p^m) (q^n)"
-  by (rule coprime_exp2_nat, rule primes_coprime_nat)
-
-lemma primes_imp_powers_coprime_int: "prime (p::int) \<Longrightarrow> prime q \<Longrightarrow> p ~= q \<Longrightarrow> coprime (p^m) (q^n)"
-  by (rule coprime_exp2_int, rule primes_coprime_int)
-
-lemma prime_factor_nat: "n \<noteq> (1::nat) \<Longrightarrow> \<exists> p. prime p \<and> p dvd n"
-  apply (induct n rule: nat_less_induct)
-  apply (case_tac "n = 0")
-  using two_is_prime_nat apply blast
-  apply (case_tac "prime n")
-  apply blast
-  apply (subgoal_tac "n > 1")
-  apply (frule (1) not_prime_eq_prod_nat)
-  apply (auto intro: dvd_mult dvd_mult2)
-done
-
-(* An Isar version:
-
-lemma prime_factor_b_nat:
-  fixes n :: nat
-  assumes "n \<noteq> 1"
-  shows "\<exists>p. prime p \<and> p dvd n"
-
-using `n ~= 1`
-proof (induct n rule: less_induct_nat)
-  fix n :: nat
-  assume "n ~= 1" and
-    ih: "\<forall>m<n. m \<noteq> 1 \<longrightarrow> (\<exists>p. prime p \<and> p dvd m)"
-  thus "\<exists>p. prime p \<and> p dvd n"
-  proof -
-  {
-    assume "n = 0"
-    moreover note two_is_prime_nat
-    ultimately have ?thesis
-      by (auto simp del: two_is_prime_nat)
-  }
-  moreover
-  {
-    assume "prime n"
-    hence ?thesis by auto
-  }
-  moreover
-  {
-    assume "n ~= 0" and "~ prime n"
-    with `n ~= 1` have "n > 1" by auto
-    with `~ prime n` and not_prime_eq_prod_nat obtain m k where
-      "n = m * k" and "1 < m" and "m < n" by blast
-    with ih obtain p where "prime p" and "p dvd m" by blast
-    with `n = m * k` have ?thesis by auto
-  }
-  ultimately show ?thesis by blast
-  qed
-qed
-
-*)
-
-text {* One property of coprimality is easier to prove via prime factors. *}
-
-lemma prime_divprod_pow_nat:
-  assumes p: "prime (p::nat)" and ab: "coprime a b" and pab: "p^n dvd a * b"
-  shows "p^n dvd a \<or> p^n dvd b"
-proof-
-  {assume "n = 0 \<or> a = 1 \<or> b = 1" with pab have ?thesis
-      apply (cases "n=0", simp_all)
-      apply (cases "a=1", simp_all) done}
-  moreover
-  {assume n: "n \<noteq> 0" and a: "a\<noteq>1" and b: "b\<noteq>1"
-    then obtain m where m: "n = Suc m" by (cases n, auto)
-    from n have "p dvd p^n" by (intro dvd_power, auto)
-    also note pab
-    finally have pab': "p dvd a * b".
-    from prime_dvd_mult_nat[OF p pab']
-    have "p dvd a \<or> p dvd b" .
-    moreover
-    {assume pa: "p dvd a"
-      have pnba: "p^n dvd b*a" using pab by (simp add: mult_commute)
-      from coprime_common_divisor_nat [OF ab, OF pa] p have "\<not> p dvd b" by auto
-      with p have "coprime b p"
-        by (subst gcd_commute_nat, intro prime_imp_coprime_nat)
-      hence pnb: "coprime (p^n) b"
-        by (subst gcd_commute_nat, rule coprime_exp_nat)
-      from coprime_divprod_nat[OF pnba pnb] have ?thesis by blast }
-    moreover
-    {assume pb: "p dvd b"
-      have pnba: "p^n dvd b*a" using pab by (simp add: mult_commute)
-      from coprime_common_divisor_nat [OF ab, of p] pb p have "\<not> p dvd a"
-        by auto
-      with p have "coprime a p"
-        by (subst gcd_commute_nat, intro prime_imp_coprime_nat)
-      hence pna: "coprime (p^n) a"
-        by (subst gcd_commute_nat, rule coprime_exp_nat)
-      from coprime_divprod_nat[OF pab pna] have ?thesis by blast }
-    ultimately have ?thesis by blast}
-  ultimately show ?thesis by blast
-qed
-
-subsection {* Infinitely many primes *}
-
-lemma next_prime_bound: "\<exists>(p::nat). prime p \<and> n < p \<and> p <= fact n + 1"
-proof-
-  have f1: "fact n + 1 \<noteq> 1" using fact_ge_one_nat [of n] by arith 
-  from prime_factor_nat [OF f1]
-      obtain p where "prime p" and "p dvd fact n + 1" by auto
-  hence "p \<le> fact n + 1" 
-    by (intro dvd_imp_le, auto)
-  {assume "p \<le> n"
-    from `prime p` have "p \<ge> 1" 
-      by (cases p, simp_all)
-    with `p <= n` have "p dvd fact n" 
-      by (intro dvd_fact_nat)
-    with `p dvd fact n + 1` have "p dvd fact n + 1 - fact n"
-      by (rule dvd_diff_nat)
-    hence "p dvd 1" by simp
-    hence "p <= 1" by auto
-    moreover from `prime p` have "p > 1" by auto
-    ultimately have False by auto}
-  hence "n < p" by arith
-  with `prime p` and `p <= fact n + 1` show ?thesis by auto
-qed
-
-lemma bigger_prime: "\<exists>p. prime p \<and> p > (n::nat)" 
-using next_prime_bound by auto
-
-lemma primes_infinite: "\<not> (finite {(p::nat). prime p})"
-proof
-  assume "finite {(p::nat). prime p}"
-  with Max_ge have "(EX b. (ALL x : {(p::nat). prime p}. x <= b))"
-    by auto
-  then obtain b where "ALL (x::nat). prime x \<longrightarrow> x <= b"
-    by auto
-  with bigger_prime [of b] show False by auto
-qed
-
-
 end
--- a/src/HOL/HOL.thy	Tue Sep 29 22:15:54 2009 +0200
+++ b/src/HOL/HOL.thy	Thu Oct 01 07:40:25 2009 +0200
@@ -15,6 +15,7 @@
   "~~/src/Tools/IsaPlanner/rw_inst.ML"
   "~~/src/Tools/intuitionistic.ML"
   "~~/src/Tools/project_rule.ML"
+  "~~/src/Tools/cong_tac.ML"
   "~~/src/Provers/hypsubst.ML"
   "~~/src/Provers/splitter.ML"
   "~~/src/Provers/classical.ML"
@@ -29,6 +30,7 @@
   "~~/src/Tools/induct.ML"
   ("~~/src/Tools/induct_tacs.ML")
   ("Tools/recfun_codegen.ML")
+  "~~/src/Tools/more_conv.ML"
 begin
 
 setup {* Intuitionistic.method_setup @{binding iprover} *}
@@ -239,15 +241,15 @@
   by (rule subst)
 
 
-subsubsection {*Congruence rules for application*}
+subsubsection {* Congruence rules for application *}
 
-(*similar to AP_THM in Gordon's HOL*)
+text {* Similar to @{text AP_THM} in Gordon's HOL. *}
 lemma fun_cong: "(f::'a=>'b) = g ==> f(x)=g(x)"
 apply (erule subst)
 apply (rule refl)
 done
 
-(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
+text {* Similar to @{text AP_TERM} in Gordon's HOL and FOL's @{text subst_context}. *}
 lemma arg_cong: "x=y ==> f(x)=f(y)"
 apply (erule subst)
 apply (rule refl)
@@ -258,13 +260,15 @@
 apply (rule refl)
 done
 
-lemma cong: "[| f = g; (x::'a) = y |] ==> f(x) = g(y)"
+lemma cong: "[| f = g; (x::'a) = y |] ==> f x = g y"
 apply (erule subst)+
 apply (rule refl)
 done
 
+ML {* val cong_tac = Cong_Tac.cong_tac @{thm cong} *}
 
-subsubsection {*Equality of booleans -- iff*}
+
+subsubsection {* Equality of booleans -- iff *}
 
 lemma iffI: assumes "P ==> Q" and "Q ==> P" shows "P=Q"
   by (iprover intro: iff [THEN mp, THEN mp] impI assms)
@@ -1465,7 +1469,7 @@
 subsubsection {* Coherent logic *}
 
 ML {*
-structure Coherent = CoherentFun
+structure Coherent = Coherent
 (
   val atomize_elimL = @{thm atomize_elimL}
   val atomize_exL = @{thm atomize_exL}
@@ -1886,7 +1890,7 @@
 *}
 
 setup {*
-  Code.add_const_alias @{thm equals_alias_cert}
+  Nbe.add_const_alias @{thm equals_alias_cert}
 *}
 
 hide (open) const eq
@@ -1966,7 +1970,7 @@
 structure Eval_Method =
 struct
 
-val eval_ref : (unit -> bool) option ref = ref NONE;
+val eval_ref : (unit -> bool) option Unsynchronized.ref = Unsynchronized.ref NONE;
 
 end;
 *}
@@ -2020,6 +2024,29 @@
 
 quickcheck_params [size = 5, iterations = 50]
 
+subsection {* Preprocessing for the predicate compiler *}
+
+ML {*
+structure Predicate_Compile_Alternative_Defs = Named_Thms
+(
+  val name = "code_pred_def"
+  val description = "alternative definitions of constants for the Predicate Compiler"
+)
+*}
+
+ML {*
+structure Predicate_Compile_Inline_Defs = Named_Thms
+(
+  val name = "code_pred_inline"
+  val description = "inlining definitions for the Predicate Compiler"
+)
+*}
+
+setup {*
+  Predicate_Compile_Alternative_Defs.setup
+  #> Predicate_Compile_Inline_Defs.setup
+  #> Predicate_Compile_Preproc_Const_Defs.setup
+*}
 
 subsection {* Nitpick setup *}
 
--- a/src/HOL/HoareParallel/Gar_Coll.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,846 +0,0 @@
-
-header {* \section{The Single Mutator Case} *}
-
-theory Gar_Coll imports Graph OG_Syntax begin
-
-declare psubsetE [rule del]
-
-text {* Declaration of variables: *}
-
-record gar_coll_state =
-  M :: nodes
-  E :: edges
-  bc :: "nat set"
-  obc :: "nat set"
-  Ma :: nodes
-  ind :: nat 
-  k :: nat
-  z :: bool
-
-subsection {* The Mutator *}
-
-text {* The mutator first redirects an arbitrary edge @{text "R"} from
-an arbitrary accessible node towards an arbitrary accessible node
-@{text "T"}.  It then colors the new target @{text "T"} black. 
-
-We declare the arbitrarily selected node and edge as constants:*}
-
-consts R :: nat  T :: nat
-
-text {* \noindent The following predicate states, given a list of
-nodes @{text "m"} and a list of edges @{text "e"}, the conditions
-under which the selected edge @{text "R"} and node @{text "T"} are
-valid: *}
-
-constdefs
-  Mut_init :: "gar_coll_state \<Rightarrow> bool"
-  "Mut_init \<equiv> \<guillemotleft> T \<in> Reach \<acute>E \<and> R < length \<acute>E \<and> T < length \<acute>M \<guillemotright>"
-
-text {* \noindent For the mutator we
-consider two modules, one for each action.  An auxiliary variable
-@{text "\<acute>z"} is set to false if the mutator has already redirected an
-edge but has not yet colored the new target.   *}
-
-constdefs
-  Redirect_Edge :: "gar_coll_state ann_com"
-  "Redirect_Edge \<equiv> .{\<acute>Mut_init \<and> \<acute>z}. \<langle>\<acute>E:=\<acute>E[R:=(fst(\<acute>E!R), T)],, \<acute>z:= (\<not>\<acute>z)\<rangle>"
-
-  Color_Target :: "gar_coll_state ann_com"
-  "Color_Target \<equiv> .{\<acute>Mut_init \<and> \<not>\<acute>z}. \<langle>\<acute>M:=\<acute>M[T:=Black],, \<acute>z:= (\<not>\<acute>z)\<rangle>"
-
-  Mutator :: "gar_coll_state ann_com"
-  "Mutator \<equiv>
-  .{\<acute>Mut_init \<and> \<acute>z}. 
-  WHILE True INV .{\<acute>Mut_init \<and> \<acute>z}. 
-  DO  Redirect_Edge ;; Color_Target  OD"
-
-subsubsection {* Correctness of the mutator *}
-
-lemmas mutator_defs = Mut_init_def Redirect_Edge_def Color_Target_def
-
-lemma Redirect_Edge: 
-  "\<turnstile> Redirect_Edge pre(Color_Target)"
-apply (unfold mutator_defs)
-apply annhoare
-apply(simp_all)
-apply(force elim:Graph2)
-done
-
-lemma Color_Target:
-  "\<turnstile> Color_Target .{\<acute>Mut_init \<and> \<acute>z}."
-apply (unfold mutator_defs)
-apply annhoare
-apply(simp_all)
-done
-
-lemma Mutator: 
- "\<turnstile> Mutator .{False}."
-apply(unfold Mutator_def)
-apply annhoare
-apply(simp_all add:Redirect_Edge Color_Target)
-apply(simp add:mutator_defs Redirect_Edge_def)
-done
-
-subsection {* The Collector *}
-
-text {* \noindent A constant @{text "M_init"} is used to give @{text "\<acute>Ma"} a
-suitable first value, defined as a list of nodes where only the @{text
-"Roots"} are black. *}
-
-consts  M_init :: nodes
-
-constdefs
-  Proper_M_init :: "gar_coll_state \<Rightarrow> bool"
-  "Proper_M_init \<equiv>  \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
- 
-  Proper :: "gar_coll_state \<Rightarrow> bool"
-  "Proper \<equiv> \<guillemotleft> Proper_Roots \<acute>M \<and> Proper_Edges(\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<guillemotright>"
-
-  Safe :: "gar_coll_state \<Rightarrow> bool"
-  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
-
-lemmas collector_defs = Proper_M_init_def Proper_def Safe_def
-
-subsubsection {* Blackening the roots *}
-
-constdefs
-  Blacken_Roots :: " gar_coll_state ann_com"
-  "Blacken_Roots \<equiv> 
-  .{\<acute>Proper}.
-  \<acute>ind:=0;;
-  .{\<acute>Proper \<and> \<acute>ind=0}.
-  WHILE \<acute>ind<length \<acute>M 
-   INV .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M}.
-  DO .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
-   IF \<acute>ind\<in>Roots THEN 
-   .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<in>Roots}. 
-    \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
-   .{\<acute>Proper \<and> (\<forall>i<\<acute>ind+1. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
-    \<acute>ind:=\<acute>ind+1 
-  OD"
-
-lemma Blacken_Roots: 
- "\<turnstile> Blacken_Roots .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}."
-apply (unfold Blacken_Roots_def)
-apply annhoare
-apply(simp_all add:collector_defs Graph_defs)
-apply safe
-apply(simp_all add:nth_list_update)
-  apply (erule less_SucE)
-   apply simp+
- apply force
-apply force
-done
-
-subsubsection {* Propagating black *}
-
-constdefs
-  PBInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
-  "PBInv \<equiv> \<guillemotleft> \<lambda>ind. \<acute>obc < Blacks \<acute>M \<or> (\<forall>i <ind. \<not>BtoW (\<acute>E!i, \<acute>M) \<or>
-   (\<not>\<acute>z \<and> i=R \<and> (snd(\<acute>E!R)) = T \<and> (\<exists>r. ind \<le> r \<and> r < length \<acute>E \<and> BtoW(\<acute>E!r,\<acute>M))))\<guillemotright>"
-
-constdefs  
-  Propagate_Black_aux :: "gar_coll_state ann_com"
-  "Propagate_Black_aux \<equiv>
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
-  \<acute>ind:=0;;
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> \<acute>ind=0}. 
-  WHILE \<acute>ind<length \<acute>E 
-   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
-  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
-   IF \<acute>M!(fst (\<acute>E!\<acute>ind)) = Black THEN 
-    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black}.
-     \<acute>M:=\<acute>M[snd(\<acute>E!\<acute>ind):=Black];;
-    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-       \<and> \<acute>PBInv (\<acute>ind + 1) \<and> \<acute>ind<length \<acute>E}.
-     \<acute>ind:=\<acute>ind+1
-   FI
-  OD"
-
-lemma Propagate_Black_aux: 
-  "\<turnstile>  Propagate_Black_aux
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
-apply (unfold Propagate_Black_aux_def  PBInv_def collector_defs)
-apply annhoare
-apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
-      apply force
-     apply force
-    apply force
---{* 4 subgoals left *}
-apply clarify
-apply(simp add:Proper_Edges_def Proper_Roots_def Graph6 Graph7 Graph8 Graph12)
-apply (erule disjE)
- apply(rule disjI1)
- apply(erule Graph13)
- apply force
-apply (case_tac "M x ! snd (E x ! ind x)=Black")
- apply (simp add: Graph10 BtoW_def)
- apply (rule disjI2)
- apply clarify
- apply (erule less_SucE)
-  apply (erule_tac x=i in allE , erule (1) notE impE)
-  apply simp
-  apply clarify
-  apply (drule_tac y = r in le_imp_less_or_eq)
-  apply (erule disjE)
-   apply (subgoal_tac "Suc (ind x)\<le>r")
-    apply fast
-   apply arith
-  apply fast
- apply fast
-apply(rule disjI1)
-apply(erule subset_psubset_trans)
-apply(erule Graph11)
-apply fast
---{* 3 subgoals left *}
-apply force
-apply force
---{* last *}
-apply clarify
-apply simp
-apply(subgoal_tac "ind x = length (E x)")
- apply (rotate_tac -1)
- apply (simp (asm_lr))
- apply(drule Graph1)
-   apply simp
-  apply clarify  
- apply(erule allE, erule impE, assumption)
-  apply force
- apply force
-apply arith
-done
-
-subsubsection {* Refining propagating black *}
-
-constdefs
-  Auxk :: "gar_coll_state \<Rightarrow> bool"
-  "Auxk \<equiv> \<guillemotleft>\<acute>k<length \<acute>M \<and> (\<acute>M!\<acute>k\<noteq>Black \<or> \<not>BtoW(\<acute>E!\<acute>ind, \<acute>M) \<or> 
-          \<acute>obc<Blacks \<acute>M \<or> (\<not>\<acute>z \<and> \<acute>ind=R \<and> snd(\<acute>E!R)=T  
-          \<and> (\<exists>r. \<acute>ind<r \<and> r<length \<acute>E \<and> BtoW(\<acute>E!r, \<acute>M))))\<guillemotright>"
-
-constdefs  
-  Propagate_Black :: " gar_coll_state ann_com"
-  "Propagate_Black \<equiv>
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
-  \<acute>ind:=0;;
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> \<acute>ind=0}.
-  WHILE \<acute>ind<length \<acute>E 
-   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
-  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
-   IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))=Black THEN 
-    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black}.
-     \<acute>k:=(snd(\<acute>E!\<acute>ind));;
-    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black 
-      \<and> \<acute>Auxk}.
-     \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],, \<acute>ind:=\<acute>ind+1\<rangle>
-   ELSE .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-          \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
-         \<langle>IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> 
-   FI
-  OD"
-
-lemma Propagate_Black: 
-  "\<turnstile>  Propagate_Black
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
-apply (unfold Propagate_Black_def  PBInv_def Auxk_def collector_defs)
-apply annhoare
-apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
-       apply force
-      apply force
-     apply force
---{* 5 subgoals left *}
-apply clarify
-apply(simp add:BtoW_def Proper_Edges_def)
---{* 4 subgoals left *}
-apply clarify
-apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
-apply (erule disjE)
- apply (rule disjI1)
- apply (erule psubset_subset_trans)
- apply (erule Graph9)
-apply (case_tac "M x!k x=Black")
- apply (case_tac "M x ! snd (E x ! ind x)=Black")
-  apply (simp add: Graph10 BtoW_def)
-  apply (rule disjI2)
-  apply clarify
-  apply (erule less_SucE)
-   apply (erule_tac x=i in allE , erule (1) notE impE)
-   apply simp
-   apply clarify
-   apply (drule_tac y = r in le_imp_less_or_eq)
-   apply (erule disjE)
-    apply (subgoal_tac "Suc (ind x)\<le>r")
-     apply fast
-    apply arith
-   apply fast
-  apply fast
- apply (simp add: Graph10 BtoW_def)
- apply (erule disjE)
-  apply (erule disjI1)
- apply clarify
- apply (erule less_SucE)
-  apply force
- apply simp
- apply (subgoal_tac "Suc R\<le>r")
-  apply fast
- apply arith
-apply(rule disjI1)
-apply(erule subset_psubset_trans)
-apply(erule Graph11)
-apply fast
---{* 3 subgoals left *}
-apply force
---{* 2 subgoals left *}
-apply clarify
-apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
-apply (erule disjE)
- apply fast
-apply clarify
-apply (erule less_SucE)
- apply (erule_tac x=i in allE , erule (1) notE impE)
- apply simp
- apply clarify
- apply (drule_tac y = r in le_imp_less_or_eq)
- apply (erule disjE)
-  apply (subgoal_tac "Suc (ind x)\<le>r")
-   apply fast
-  apply arith
- apply (simp add: BtoW_def)
-apply (simp add: BtoW_def)
---{* last *}
-apply clarify
-apply simp
-apply(subgoal_tac "ind x = length (E x)")
- apply (rotate_tac -1)
- apply (simp (asm_lr))
- apply(drule Graph1)
-   apply simp
-  apply clarify  
- apply(erule allE, erule impE, assumption)
-  apply force
- apply force
-apply arith
-done
-
-subsubsection {* Counting black nodes *}
-
-constdefs
-  CountInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
-  "CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
-
-constdefs
-  Count :: " gar_coll_state ann_com"
-  "Count \<equiv>
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={}}.
-  \<acute>ind:=0;;
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-   \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={} 
-   \<and> \<acute>ind=0}.
-   WHILE \<acute>ind<length \<acute>M 
-     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-           \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
-           \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind\<le>length \<acute>M}.
-   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-         \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-         \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind 
-         \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}. 
-       IF \<acute>M!\<acute>ind=Black 
-          THEN .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-                 \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-                 \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
-                 \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
-          \<acute>bc:=insert \<acute>ind \<acute>bc
-       FI;;
-      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-        \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-        \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv (\<acute>ind+1)
-        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}.
-      \<acute>ind:=\<acute>ind+1
-   OD"
-
-lemma Count: 
-  "\<turnstile> Count 
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-   \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> length \<acute>Ma=length \<acute>M
-   \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}."
-apply(unfold Count_def)
-apply annhoare
-apply(simp_all add:CountInv_def Graph6 Graph7 Graph8 Graph12 Blacks_def collector_defs)
-      apply force
-     apply force
-    apply force
-   apply clarify
-   apply simp
-   apply(fast elim:less_SucE)
-  apply clarify
-  apply simp
-  apply(fast elim:less_SucE)
- apply force
-apply force
-done
-
-subsubsection {* Appending garbage nodes to the free list *}
-
-consts Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
-
-axioms
-  Append_to_free0: "length (Append_to_free (i, e)) = length e"
-  Append_to_free1: "Proper_Edges (m, e) 
-                   \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
-  Append_to_free2: "i \<notin> Reach e 
-     \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
-
-constdefs
-  AppendInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
-  "AppendInv \<equiv> \<guillemotleft>\<lambda>ind. \<forall>i<length \<acute>M. ind\<le>i \<longrightarrow> i\<in>Reach \<acute>E \<longrightarrow> \<acute>M!i=Black\<guillemotright>"
-
-constdefs
-  Append :: " gar_coll_state ann_com"
-   "Append \<equiv>
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
-  \<acute>ind:=0;;
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
-    WHILE \<acute>ind<length \<acute>M 
-      INV .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
-    DO .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
-       IF \<acute>M!\<acute>ind=Black THEN 
-          .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
-          \<acute>M:=\<acute>M[\<acute>ind:=White] 
-       ELSE .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}.
-              \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
-       FI;;
-     .{\<acute>Proper \<and> \<acute>AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
-       \<acute>ind:=\<acute>ind+1
-    OD"
-
-lemma Append: 
-  "\<turnstile> Append .{\<acute>Proper}."
-apply(unfold Append_def AppendInv_def)
-apply annhoare
-apply(simp_all add:collector_defs Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
-       apply(force simp:Blacks_def nth_list_update)
-      apply force
-     apply force
-    apply(force simp add:Graph_defs)
-   apply force
-  apply clarify
-  apply simp
-  apply(rule conjI)
-   apply (erule Append_to_free1)
-  apply clarify
-  apply (drule_tac n = "i" in Append_to_free2)
-  apply force
- apply force
-apply force
-done
-
-subsubsection {* Correctness of the Collector *}
-
-constdefs 
-  Collector :: " gar_coll_state ann_com"
-  "Collector \<equiv>
-.{\<acute>Proper}.  
- WHILE True INV .{\<acute>Proper}. 
- DO  
-  Blacken_Roots;; 
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}.  
-   \<acute>obc:={};; 
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}. 
-   \<acute>bc:=Roots;; 
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
-   \<acute>Ma:=M_init;;  
-  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>Ma=M_init}. 
-   WHILE \<acute>obc\<noteq>\<acute>bc  
-     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
-           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-           \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}. 
-   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
-       \<acute>obc:=\<acute>bc;;
-       Propagate_Black;; 
-      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-        \<and> (\<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}. 
-       \<acute>Ma:=\<acute>M;;
-      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma 
-        \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> length \<acute>Ma=length \<acute>M 
-        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}.
-       \<acute>bc:={};;
-       Count 
-   OD;; 
-  Append  
- OD"
-
-lemma Collector: 
-  "\<turnstile> Collector .{False}."
-apply(unfold Collector_def)
-apply annhoare
-apply(simp_all add: Blacken_Roots Propagate_Black Count Append)
-apply(simp_all add:Blacken_Roots_def Propagate_Black_def Count_def Append_def collector_defs)
-   apply (force simp add: Proper_Roots_def)
-  apply force
- apply force
-apply clarify
-apply (erule disjE)
-apply(simp add:psubsetI)
- apply(force dest:subset_antisym)
-done
-
-subsection {* Interference Freedom *}
-
-lemmas modules = Redirect_Edge_def Color_Target_def Blacken_Roots_def 
-                 Propagate_Black_def Count_def Append_def
-lemmas Invariants = PBInv_def Auxk_def CountInv_def AppendInv_def
-lemmas abbrev = collector_defs mutator_defs Invariants
-
-lemma interfree_Blacken_Roots_Redirect_Edge: 
- "interfree_aux (Some Blacken_Roots, {}, Some Redirect_Edge)"
-apply (unfold modules)
-apply interfree_aux
-apply safe
-apply (simp_all add:Graph6 Graph12 abbrev)
-done
-
-lemma interfree_Redirect_Edge_Blacken_Roots: 
-  "interfree_aux (Some Redirect_Edge, {}, Some Blacken_Roots)"
-apply (unfold modules)
-apply interfree_aux
-apply safe
-apply(simp add:abbrev)+
-done
-
-lemma interfree_Blacken_Roots_Color_Target: 
-  "interfree_aux (Some Blacken_Roots, {}, Some Color_Target)"
-apply (unfold modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:Graph7 Graph8 nth_list_update abbrev)
-done
-
-lemma interfree_Color_Target_Blacken_Roots: 
-  "interfree_aux (Some Color_Target, {}, Some Blacken_Roots)"
-apply (unfold modules )
-apply interfree_aux
-apply safe
-apply(simp add:abbrev)+
-done
-
-lemma interfree_Propagate_Black_Redirect_Edge: 
-  "interfree_aux (Some Propagate_Black, {}, Some Redirect_Edge)"
-apply (unfold modules )
-apply interfree_aux
---{* 11 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(erule conjE)+
-apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
- apply(erule Graph4) 
-   apply(simp)+
-  apply (simp add:BtoW_def)
- apply (simp add:BtoW_def)
-apply(rule conjI)
- apply (force simp add:BtoW_def)
-apply(erule Graph4)
-   apply simp+
---{* 7 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(erule conjE)+
-apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
- apply(erule Graph4) 
-   apply(simp)+
-  apply (simp add:BtoW_def)
- apply (simp add:BtoW_def)
-apply(rule conjI)
- apply (force simp add:BtoW_def)
-apply(erule Graph4)
-   apply simp+
---{* 6 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(erule conjE)+
-apply(rule conjI)
- apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
-  apply(erule Graph4) 
-    apply(simp)+
-   apply (simp add:BtoW_def)
-  apply (simp add:BtoW_def)
- apply(rule conjI)
-  apply (force simp add:BtoW_def)
- apply(erule Graph4)
-    apply simp+
-apply(simp add:BtoW_def nth_list_update) 
-apply force
---{* 5 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
---{* 4 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(rule conjI)
- apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
-  apply(erule Graph4) 
-    apply(simp)+
-   apply (simp add:BtoW_def)
-  apply (simp add:BtoW_def)
- apply(rule conjI)
-  apply (force simp add:BtoW_def)
- apply(erule Graph4)
-    apply simp+
-apply(rule conjI)
- apply(simp add:nth_list_update)
- apply force
-apply(rule impI, rule impI, erule disjE, erule disjI1, case_tac "R = (ind x)" ,case_tac "M x ! T = Black")
-  apply(force simp add:BtoW_def)
- apply(case_tac "M x !snd (E x ! ind x)=Black")
-  apply(rule disjI2)
-  apply simp
-  apply (erule Graph5)
-  apply simp+
- apply(force simp add:BtoW_def)
-apply(force simp add:BtoW_def)
---{* 3 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
---{* 2 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12)
-apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
- apply clarify
- apply(erule Graph4) 
-   apply(simp)+
-  apply (simp add:BtoW_def)
- apply (simp add:BtoW_def)
-apply(rule conjI)
- apply (force simp add:BtoW_def)
-apply(erule Graph4)
-   apply simp+
-done
-
-lemma interfree_Redirect_Edge_Propagate_Black: 
-  "interfree_aux (Some Redirect_Edge, {}, Some Propagate_Black)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify, simp add:abbrev)+
-done
-
-lemma interfree_Propagate_Black_Color_Target: 
-  "interfree_aux (Some Propagate_Black, {}, Some Color_Target)"
-apply (unfold modules )
-apply interfree_aux
---{* 11 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)+
-apply(erule conjE)+
-apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
-      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
-      erule allE, erule impE, assumption, erule impE, assumption, 
-      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
---{* 7 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
-apply(erule conjE)+
-apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
-      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
-      erule allE, erule impE, assumption, erule impE, assumption, 
-      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
---{* 6 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
-apply clarify
-apply (rule conjI)
- apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
-      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
-      erule allE, erule impE, assumption, erule impE, assumption, 
-      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
-apply(simp add:nth_list_update)
---{* 5 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
---{* 4 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
-apply (rule conjI)
- apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
-      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
-      erule allE, erule impE, assumption, erule impE, assumption, 
-      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
-apply(rule conjI)
-apply(simp add:nth_list_update)
-apply(rule impI,rule impI, case_tac "M x!T=Black",rotate_tac -1, force simp add: BtoW_def Graph10, 
-      erule subset_psubset_trans, erule Graph11, force)
---{* 3 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
---{* 2 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
-apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
-      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
-      erule allE, erule impE, assumption, erule impE, assumption, 
-      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
---{* 3 subgoals left *}
-apply(simp add:abbrev)
-done
-
-lemma interfree_Color_Target_Propagate_Black: 
-  "interfree_aux (Some Color_Target, {}, Some Propagate_Black)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify, simp add:abbrev)+
-done
-
-lemma interfree_Count_Redirect_Edge: 
-  "interfree_aux (Some Count, {}, Some Redirect_Edge)"
-apply (unfold modules)
-apply interfree_aux
---{* 9 subgoals left *}
-apply(simp_all add:abbrev Graph6 Graph12)
---{* 6 subgoals left *}
-apply(clarify, simp add:abbrev Graph6 Graph12,
-      erule disjE,erule disjI1,rule disjI2,rule subset_trans, erule Graph3,force,force)+
-done
-
-lemma interfree_Redirect_Edge_Count: 
-  "interfree_aux (Some Redirect_Edge, {}, Some Count)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify,simp add:abbrev)+
-apply(simp add:abbrev)
-done
-
-lemma interfree_Count_Color_Target: 
-  "interfree_aux (Some Count, {}, Some Color_Target)"
-apply (unfold modules )
-apply interfree_aux
---{* 9 subgoals left *}
-apply(simp_all add:abbrev Graph7 Graph8 Graph12)
---{* 6 subgoals left *}
-apply(clarify,simp add:abbrev Graph7 Graph8 Graph12,
-      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)+
---{* 2 subgoals left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
-apply(rule conjI)
- apply(erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9) 
-apply(simp add:nth_list_update)
---{* 1 subgoal left *}
-apply(clarify, simp add:abbrev Graph7 Graph8 Graph12,
-      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)
-done
-
-lemma interfree_Color_Target_Count: 
-  "interfree_aux (Some Color_Target, {}, Some Count)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify, simp add:abbrev)+
-apply(simp add:abbrev)
-done
-
-lemma interfree_Append_Redirect_Edge: 
-  "interfree_aux (Some Append, {}, Some Redirect_Edge)"
-apply (unfold modules )
-apply interfree_aux
-apply( simp_all add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12)
-apply(clarify, simp add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12, force dest:Graph3)+
-done
-
-lemma interfree_Redirect_Edge_Append: 
-  "interfree_aux (Some Redirect_Edge, {}, Some Append)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify, simp add:abbrev Append_to_free0)+
-apply (force simp add: Append_to_free2)
-apply(clarify, simp add:abbrev Append_to_free0)+
-done
-
-lemma interfree_Append_Color_Target: 
-  "interfree_aux (Some Append, {}, Some Color_Target)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify, simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)+
-apply(simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)
-done
-
-lemma interfree_Color_Target_Append: 
-  "interfree_aux (Some Color_Target, {}, Some Append)"
-apply (unfold modules )
-apply interfree_aux
-apply(clarify, simp add:abbrev Append_to_free0)+
-apply (force simp add: Append_to_free2)
-apply(clarify,simp add:abbrev Append_to_free0)+
-done
-
-lemmas collector_mutator_interfree = 
- interfree_Blacken_Roots_Redirect_Edge interfree_Blacken_Roots_Color_Target 
- interfree_Propagate_Black_Redirect_Edge interfree_Propagate_Black_Color_Target  
- interfree_Count_Redirect_Edge interfree_Count_Color_Target 
- interfree_Append_Redirect_Edge interfree_Append_Color_Target 
- interfree_Redirect_Edge_Blacken_Roots interfree_Color_Target_Blacken_Roots 
- interfree_Redirect_Edge_Propagate_Black interfree_Color_Target_Propagate_Black  
- interfree_Redirect_Edge_Count interfree_Color_Target_Count 
- interfree_Redirect_Edge_Append interfree_Color_Target_Append
-
-subsubsection {* Interference freedom Collector-Mutator *}
-
-lemma interfree_Collector_Mutator:
- "interfree_aux (Some Collector, {}, Some Mutator)"
-apply(unfold Collector_def Mutator_def)
-apply interfree_aux
-apply(simp_all add:collector_mutator_interfree)
-apply(unfold modules collector_defs mutator_defs)
-apply(tactic  {* TRYALL (interfree_aux_tac) *})
---{* 32 subgoals left *}
-apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
---{* 20 subgoals left *}
-apply(tactic{* TRYALL (clarify_tac @{claset}) *})
-apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
-apply(tactic {* TRYALL (etac disjE) *})
-apply simp_all
-apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac subset_trans,etac @{thm Graph3},force_tac @{clasimpset}, assume_tac]) *})
-apply(tactic {* TRYALL(EVERY'[rtac disjI2,etac subset_trans,rtac @{thm Graph9},force_tac @{clasimpset}]) *})
-apply(tactic {* TRYALL(EVERY'[rtac disjI1,etac @{thm psubset_subset_trans},rtac @{thm Graph9},force_tac @{clasimpset}]) *})
-done
-
-subsubsection {* Interference freedom Mutator-Collector *}
-
-lemma interfree_Mutator_Collector:
- "interfree_aux (Some Mutator, {}, Some Collector)"
-apply(unfold Collector_def Mutator_def)
-apply interfree_aux
-apply(simp_all add:collector_mutator_interfree)
-apply(unfold modules collector_defs mutator_defs)
-apply(tactic  {* TRYALL (interfree_aux_tac) *})
---{* 64 subgoals left *}
-apply(simp_all add:nth_list_update Invariants Append_to_free0)+
-apply(tactic{* TRYALL (clarify_tac @{claset}) *})
---{* 4 subgoals left *}
-apply force
-apply(simp add:Append_to_free2)
-apply force
-apply(simp add:Append_to_free2)
-done
-
-subsubsection {* The Garbage Collection algorithm *}
-
-text {* In total there are 289 verification conditions.  *}
-
-lemma Gar_Coll: 
-  "\<parallel>- .{\<acute>Proper \<and> \<acute>Mut_init \<and> \<acute>z}.  
-  COBEGIN  
-   Collector
-  .{False}.
- \<parallel>  
-   Mutator
-  .{False}. 
- COEND 
-  .{False}."
-apply oghoare
-apply(force simp add: Mutator_def Collector_def modules)
-apply(rule Collector)
-apply(rule Mutator)
-apply(simp add:interfree_Collector_Mutator)
-apply(simp add:interfree_Mutator_Collector)
-apply force
-done
-
-end
--- a/src/HOL/HoareParallel/Graph.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,411 +0,0 @@
-header {* \chapter{Case Study: Single and Multi-Mutator Garbage Collection Algorithms}
-
-\section {Formalization of the Memory} *}
-
-theory Graph imports Main begin
-
-datatype node = Black | White
-
-types 
-  nodes = "node list"
-  edge  = "nat \<times> nat"
-  edges = "edge list"
-
-consts Roots :: "nat set"
-
-constdefs
-  Proper_Roots :: "nodes \<Rightarrow> bool"
-  "Proper_Roots M \<equiv> Roots\<noteq>{} \<and> Roots \<subseteq> {i. i<length M}"
-
-  Proper_Edges :: "(nodes \<times> edges) \<Rightarrow> bool"
-  "Proper_Edges \<equiv> (\<lambda>(M,E). \<forall>i<length E. fst(E!i)<length M \<and> snd(E!i)<length M)"
-
-  BtoW :: "(edge \<times> nodes) \<Rightarrow> bool"
-  "BtoW \<equiv> (\<lambda>(e,M). (M!fst e)=Black \<and> (M!snd e)\<noteq>Black)"
-
-  Blacks :: "nodes \<Rightarrow> nat set"
-  "Blacks M \<equiv> {i. i<length M \<and> M!i=Black}"
-
-  Reach :: "edges \<Rightarrow> nat set"
-  "Reach E \<equiv> {x. (\<exists>path. 1<length path \<and> path!(length path - 1)\<in>Roots \<and> x=path!0
-              \<and> (\<forall>i<length path - 1. (\<exists>j<length E. E!j=(path!(i+1), path!i))))
-	      \<or> x\<in>Roots}"
-
-text{* Reach: the set of reachable nodes is the set of Roots together with the
-nodes reachable from some Root by a path represented by a list of
-  nodes (at least two since we traverse at least one edge), where two
-consecutive nodes correspond to an edge in E. *}
-
-subsection {* Proofs about Graphs *}
-
-lemmas Graph_defs= Blacks_def Proper_Roots_def Proper_Edges_def BtoW_def
-declare Graph_defs [simp]
-
-subsubsection{* Graph 1 *}
-
-lemma Graph1_aux [rule_format]: 
-  "\<lbrakk> Roots\<subseteq>Blacks M; \<forall>i<length E. \<not>BtoW(E!i,M)\<rbrakk>
-  \<Longrightarrow> 1< length path \<longrightarrow> (path!(length path - 1))\<in>Roots \<longrightarrow>  
-  (\<forall>i<length path - 1. (\<exists>j. j < length E \<and> E!j=(path!(Suc i), path!i))) 
-  \<longrightarrow> M!(path!0) = Black"
-apply(induct_tac "path")
- apply force
-apply clarify
-apply simp
-apply(case_tac "list")
- apply force
-apply simp
-apply(rotate_tac -2)
-apply(erule_tac x = "0" in all_dupE)
-apply simp
-apply clarify
-apply(erule allE , erule (1) notE impE)
-apply simp
-apply(erule mp)
-apply(case_tac "lista")
- apply force
-apply simp
-apply(erule mp)
-apply clarify
-apply(erule_tac x = "Suc i" in allE)
-apply force
-done
-
-lemma Graph1: 
-  "\<lbrakk>Roots\<subseteq>Blacks M; Proper_Edges(M, E); \<forall>i<length E. \<not>BtoW(E!i,M) \<rbrakk> 
-  \<Longrightarrow> Reach E\<subseteq>Blacks M"
-apply (unfold Reach_def)
-apply simp
-apply clarify
-apply(erule disjE)
- apply clarify
- apply(rule conjI)
-  apply(subgoal_tac "0< length path - Suc 0")
-   apply(erule allE , erule (1) notE impE)
-   apply force
-  apply simp
- apply(rule Graph1_aux)
-apply auto
-done
-
-subsubsection{* Graph 2 *}
-
-lemma Ex_first_occurrence [rule_format]: 
-  "P (n::nat) \<longrightarrow> (\<exists>m. P m \<and> (\<forall>i. i<m \<longrightarrow> \<not> P i))";
-apply(rule nat_less_induct)
-apply clarify
-apply(case_tac "\<forall>m. m<n \<longrightarrow> \<not> P m")
-apply auto
-done
-
-lemma Compl_lemma: "(n::nat)\<le>l \<Longrightarrow> (\<exists>m. m\<le>l \<and> n=l - m)"
-apply(rule_tac x = "l - n" in exI)
-apply arith
-done
-
-lemma Ex_last_occurrence: 
-  "\<lbrakk>P (n::nat); n\<le>l\<rbrakk> \<Longrightarrow> (\<exists>m. P (l - m) \<and> (\<forall>i. i<m \<longrightarrow> \<not>P (l - i)))"
-apply(drule Compl_lemma)
-apply clarify
-apply(erule Ex_first_occurrence)
-done
-
-lemma Graph2: 
-  "\<lbrakk>T \<in> Reach E; R<length E\<rbrakk> \<Longrightarrow> T \<in> Reach (E[R:=(fst(E!R), T)])"
-apply (unfold Reach_def)
-apply clarify
-apply simp
-apply(case_tac "\<forall>z<length path. fst(E!R)\<noteq>path!z")
- apply(rule_tac x = "path" in exI)
- apply simp
- apply clarify
- apply(erule allE , erule (1) notE impE)
- apply clarify
- apply(rule_tac x = "j" in exI)
- apply(case_tac "j=R")
-  apply(erule_tac x = "Suc i" in allE)
-  apply simp
- apply (force simp add:nth_list_update)
-apply simp
-apply(erule exE)
-apply(subgoal_tac "z \<le> length path - Suc 0")
- prefer 2 apply arith
-apply(drule_tac P = "\<lambda>m. m<length path \<and> fst(E!R)=path!m" in Ex_last_occurrence)
- apply assumption
-apply clarify
-apply simp
-apply(rule_tac x = "(path!0)#(drop (length path - Suc m) path)" in exI)
-apply simp
-apply(case_tac "length path - (length path - Suc m)")
- apply arith
-apply simp
-apply(subgoal_tac "(length path - Suc m) + nat \<le> length path")
- prefer 2 apply arith
-apply(drule nth_drop)
-apply simp
-apply(subgoal_tac "length path - Suc m + nat = length path - Suc 0")
- prefer 2 apply arith 
-apply simp
-apply clarify
-apply(case_tac "i")
- apply(force simp add: nth_list_update)
-apply simp
-apply(subgoal_tac "(length path - Suc m) + nata \<le> length path")
- prefer 2 apply arith
-apply(subgoal_tac "(length path - Suc m) + (Suc nata) \<le> length path")
- prefer 2 apply arith
-apply simp
-apply(erule_tac x = "length path - Suc m + nata" in allE)
-apply simp
-apply clarify
-apply(rule_tac x = "j" in exI)
-apply(case_tac "R=j")
- prefer 2 apply force
-apply simp
-apply(drule_tac t = "path ! (length path - Suc m)" in sym)
-apply simp
-apply(case_tac " length path - Suc 0 < m")
- apply(subgoal_tac "(length path - Suc m)=0")
-  prefer 2 apply arith
- apply(simp del: diff_is_0_eq)
- apply(subgoal_tac "Suc nata\<le>nat")
- prefer 2 apply arith
- apply(drule_tac n = "Suc nata" in Compl_lemma)
- apply clarify
- using [[linarith_split_limit = 0]]
- apply force
- using [[linarith_split_limit = 9]]
-apply(drule leI)
-apply(subgoal_tac "Suc (length path - Suc m + nata)=(length path - Suc 0) - (m - Suc nata)")
- apply(erule_tac x = "m - (Suc nata)" in allE)
- apply(case_tac "m")
-  apply simp
- apply simp
-apply simp
-done
-
-
-subsubsection{* Graph 3 *}
-
-lemma Graph3: 
-  "\<lbrakk> T\<in>Reach E; R<length E \<rbrakk> \<Longrightarrow> Reach(E[R:=(fst(E!R),T)]) \<subseteq> Reach E"
-apply (unfold Reach_def)
-apply clarify
-apply simp
-apply(case_tac "\<exists>i<length path - 1. (fst(E!R),T)=(path!(Suc i),path!i)")
---{* the changed edge is part of the path *}
- apply(erule exE)
- apply(drule_tac P = "\<lambda>i. i<length path - 1 \<and> (fst(E!R),T)=(path!Suc i,path!i)" in Ex_first_occurrence)
- apply clarify
- apply(erule disjE)
---{* T is NOT a root *}
-  apply clarify
-  apply(rule_tac x = "(take m path)@patha" in exI)
-  apply(subgoal_tac "\<not>(length path\<le>m)")
-   prefer 2 apply arith
-  apply(simp add: min_def)
-  apply(rule conjI)
-   apply(subgoal_tac "\<not>(m + length patha - 1 < m)")
-    prefer 2 apply arith
-   apply(simp add: nth_append min_def)
-  apply(rule conjI)
-   apply(case_tac "m")
-    apply force
-   apply(case_tac "path")
-    apply force
-   apply force
-  apply clarify
-  apply(case_tac "Suc i\<le>m")
-   apply(erule_tac x = "i" in allE)
-   apply simp
-   apply clarify
-   apply(rule_tac x = "j" in exI)
-   apply(case_tac "Suc i<m")
-    apply(simp add: nth_append)
-    apply(case_tac "R=j")
-     apply(simp add: nth_list_update)
-     apply(case_tac "i=m")
-      apply force
-     apply(erule_tac x = "i" in allE)
-     apply force
-    apply(force simp add: nth_list_update)
-   apply(simp add: nth_append)
-   apply(subgoal_tac "i=m - 1")
-    prefer 2 apply arith
-   apply(case_tac "R=j")
-    apply(erule_tac x = "m - 1" in allE)
-    apply(simp add: nth_list_update)
-   apply(force simp add: nth_list_update)
-  apply(simp add: nth_append min_def)
-  apply(rotate_tac -4)
-  apply(erule_tac x = "i - m" in allE)
-  apply(subgoal_tac "Suc (i - m)=(Suc i - m)" )
-    prefer 2 apply arith
-   apply simp
---{* T is a root *}
- apply(case_tac "m=0")
-  apply force
- apply(rule_tac x = "take (Suc m) path" in exI)
- apply(subgoal_tac "\<not>(length path\<le>Suc m)" )
-  prefer 2 apply arith
- apply(simp add: min_def)
- apply clarify
- apply(erule_tac x = "i" in allE)
- apply simp
- apply clarify
- apply(case_tac "R=j")
-  apply(force simp add: nth_list_update)
- apply(force simp add: nth_list_update)
---{* the changed edge is not part of the path *}
-apply(rule_tac x = "path" in exI)
-apply simp
-apply clarify
-apply(erule_tac x = "i" in allE)
-apply clarify
-apply(case_tac "R=j")
- apply(erule_tac x = "i" in allE)
- apply simp
-apply(force simp add: nth_list_update)
-done
-
-subsubsection{* Graph 4 *}
-
-lemma Graph4: 
-  "\<lbrakk>T \<in> Reach E; Roots\<subseteq>Blacks M; I\<le>length E; T<length M; R<length E; 
-  \<forall>i<I. \<not>BtoW(E!i,M); R<I; M!fst(E!R)=Black; M!T\<noteq>Black\<rbrakk> \<Longrightarrow> 
-  (\<exists>r. I\<le>r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
-apply (unfold Reach_def)
-apply simp
-apply(erule disjE)
- prefer 2 apply force
-apply clarify
---{* there exist a black node in the path to T *}
-apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
- apply(erule exE)
- apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
- apply clarify
- apply(case_tac "ma")
-  apply force
- apply simp
- apply(case_tac "length path")
-  apply force
- apply simp
- apply(erule_tac P = "\<lambda>i. i < nata \<longrightarrow> ?P i" and x = "nat" in allE)
- apply simp
- apply clarify
- apply(erule_tac P = "\<lambda>i. i < Suc nat \<longrightarrow> ?P i" and x = "nat" in allE)
- apply simp
- apply(case_tac "j<I")
-  apply(erule_tac x = "j" in allE)
-  apply force
- apply(rule_tac x = "j" in exI)
- apply(force  simp add: nth_list_update)
-apply simp
-apply(rotate_tac -1)
-apply(erule_tac x = "length path - 1" in allE)
-apply(case_tac "length path")
- apply force
-apply force
-done
-
-subsubsection {* Graph 5 *}
-
-lemma Graph5: 
-  "\<lbrakk> T \<in> Reach E ; Roots \<subseteq> Blacks M; \<forall>i<R. \<not>BtoW(E!i,M); T<length M; 
-    R<length E; M!fst(E!R)=Black; M!snd(E!R)=Black; M!T \<noteq> Black\<rbrakk> 
-   \<Longrightarrow> (\<exists>r. R<r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
-apply (unfold Reach_def)
-apply simp
-apply(erule disjE)
- prefer 2 apply force
-apply clarify
---{* there exist a black node in the path to T*}
-apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
- apply(erule exE)
- apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
- apply clarify
- apply(case_tac "ma")
-  apply force
- apply simp
- apply(case_tac "length path")
-  apply force
- apply simp
- apply(erule_tac P = "\<lambda>i. i < nata \<longrightarrow> ?P i" and x = "nat" in allE)
- apply simp
- apply clarify
- apply(erule_tac P = "\<lambda>i. i < Suc nat \<longrightarrow> ?P i" and x = "nat" in allE)
- apply simp
- apply(case_tac "j\<le>R")
-  apply(drule le_imp_less_or_eq [of _ R])
-  apply(erule disjE)
-   apply(erule allE , erule (1) notE impE)
-   apply force
-  apply force
- apply(rule_tac x = "j" in exI)
- apply(force  simp add: nth_list_update)
-apply simp
-apply(rotate_tac -1)
-apply(erule_tac x = "length path - 1" in allE)
-apply(case_tac "length path")
- apply force
-apply force
-done
-
-subsubsection {* Other lemmas about graphs *}
-
-lemma Graph6: 
- "\<lbrakk>Proper_Edges(M,E); R<length E ; T<length M\<rbrakk> \<Longrightarrow> Proper_Edges(M,E[R:=(fst(E!R),T)])"
-apply (unfold Proper_Edges_def)
- apply(force  simp add: nth_list_update)
-done
-
-lemma Graph7: 
- "\<lbrakk>Proper_Edges(M,E)\<rbrakk> \<Longrightarrow> Proper_Edges(M[T:=a],E)"
-apply (unfold Proper_Edges_def)
-apply force
-done
-
-lemma Graph8: 
- "\<lbrakk>Proper_Roots(M)\<rbrakk> \<Longrightarrow> Proper_Roots(M[T:=a])"
-apply (unfold Proper_Roots_def)
-apply force
-done
-
-text{* Some specific lemmata for the verification of garbage collection algorithms. *}
-
-lemma Graph9: "j<length M \<Longrightarrow> Blacks M\<subseteq>Blacks (M[j := Black])"
-apply (unfold Blacks_def)
- apply(force simp add: nth_list_update)
-done
-
-lemma Graph10 [rule_format (no_asm)]: "\<forall>i. M!i=a \<longrightarrow>M[i:=a]=M"
-apply(induct_tac "M")
-apply auto
-apply(case_tac "i")
-apply auto
-done
-
-lemma Graph11 [rule_format (no_asm)]: 
-  "\<lbrakk> M!j\<noteq>Black;j<length M\<rbrakk> \<Longrightarrow> Blacks M \<subset> Blacks (M[j := Black])"
-apply (unfold Blacks_def)
-apply(rule psubsetI)
- apply(force simp add: nth_list_update)
-apply safe
-apply(erule_tac c = "j" in equalityCE)
-apply auto
-done
-
-lemma Graph12: "\<lbrakk>a\<subseteq>Blacks M;j<length M\<rbrakk> \<Longrightarrow> a\<subseteq>Blacks (M[j := Black])"
-apply (unfold Blacks_def)
-apply(force simp add: nth_list_update)
-done
-
-lemma Graph13: "\<lbrakk>a\<subset> Blacks M;j<length M\<rbrakk> \<Longrightarrow> a \<subset> Blacks (M[j := Black])"
-apply (unfold Blacks_def)
-apply(erule psubset_subset_trans)
-apply(force simp add: nth_list_update)
-done
-
-declare Graph_defs [simp del]
-
-end
--- a/src/HOL/HoareParallel/Mul_Gar_Coll.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1283 +0,0 @@
-
-header {* \section{The Multi-Mutator Case} *}
-
-theory Mul_Gar_Coll imports Graph OG_Syntax begin
-
-text {*  The full theory takes aprox. 18 minutes.  *}
-
-record mut =
-  Z :: bool
-  R :: nat
-  T :: nat
-
-text {* Declaration of variables: *}
-
-record mul_gar_coll_state =
-  M :: nodes
-  E :: edges
-  bc :: "nat set"
-  obc :: "nat set"
-  Ma :: nodes
-  ind :: nat 
-  k :: nat
-  q :: nat
-  l :: nat
-  Muts :: "mut list"
-
-subsection {* The Mutators *}
-
-constdefs 
-  Mul_mut_init :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
-  "Mul_mut_init \<equiv> \<guillemotleft> \<lambda>n. n=length \<acute>Muts \<and> (\<forall>i<n. R (\<acute>Muts!i)<length \<acute>E 
-                          \<and> T (\<acute>Muts!i)<length \<acute>M) \<guillemotright>"
-
-  Mul_Redirect_Edge  :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
-  "Mul_Redirect_Edge j n \<equiv>
-  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.
-  \<langle>IF T(\<acute>Muts!j) \<in> Reach \<acute>E THEN  
-  \<acute>E:= \<acute>E[R (\<acute>Muts!j):= (fst (\<acute>E!R(\<acute>Muts!j)), T (\<acute>Muts!j))] FI,, 
-  \<acute>Muts:= \<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=False\<rparr>]\<rangle>"
-
-  Mul_Color_Target :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
-  "Mul_Color_Target j n \<equiv>
-  .{\<acute>Mul_mut_init n \<and> \<not> Z (\<acute>Muts!j)}. 
-  \<langle>\<acute>M:=\<acute>M[T (\<acute>Muts!j):=Black],, \<acute>Muts:=\<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=True\<rparr>]\<rangle>"
-
-  Mul_Mutator :: "nat \<Rightarrow> nat \<Rightarrow>  mul_gar_coll_state ann_com"
-  "Mul_Mutator j n \<equiv>
-  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
-  WHILE True  
-    INV .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
-  DO Mul_Redirect_Edge j n ;; 
-     Mul_Color_Target j n 
-  OD"
-
-lemmas mul_mutator_defs = Mul_mut_init_def Mul_Redirect_Edge_def Mul_Color_Target_def 
-
-subsubsection {* Correctness of the proof outline of one mutator *}
-
-lemma Mul_Redirect_Edge: "0\<le>j \<and> j<n \<Longrightarrow> 
-  \<turnstile> Mul_Redirect_Edge j n 
-     pre(Mul_Color_Target j n)"
-apply (unfold mul_mutator_defs)
-apply annhoare
-apply(simp_all)
-apply clarify
-apply(simp add:nth_list_update)
-done
-
-lemma Mul_Color_Target: "0\<le>j \<and> j<n \<Longrightarrow> 
-  \<turnstile>  Mul_Color_Target j n  
-    .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}."
-apply (unfold mul_mutator_defs)
-apply annhoare
-apply(simp_all)
-apply clarify
-apply(simp add:nth_list_update)
-done
-
-lemma Mul_Mutator: "0\<le>j \<and> j<n \<Longrightarrow>  
- \<turnstile> Mul_Mutator j n .{False}."
-apply(unfold Mul_Mutator_def)
-apply annhoare
-apply(simp_all add:Mul_Redirect_Edge Mul_Color_Target)
-apply(simp add:mul_mutator_defs Mul_Redirect_Edge_def)
-done
-
-subsubsection {* Interference freedom between mutators *}
-
-lemma Mul_interfree_Redirect_Edge_Redirect_Edge: 
-  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
-  interfree_aux (Some (Mul_Redirect_Edge i n),{}, Some(Mul_Redirect_Edge j n))"
-apply (unfold mul_mutator_defs)
-apply interfree_aux
-apply safe
-apply(simp_all add: nth_list_update)
-done
-
-lemma Mul_interfree_Redirect_Edge_Color_Target: 
-  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
-  interfree_aux (Some(Mul_Redirect_Edge i n),{},Some(Mul_Color_Target j n))"
-apply (unfold mul_mutator_defs)
-apply interfree_aux
-apply safe
-apply(simp_all add: nth_list_update)
-done
-
-lemma Mul_interfree_Color_Target_Redirect_Edge: 
-  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
-  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Redirect_Edge j n))"
-apply (unfold mul_mutator_defs)
-apply interfree_aux
-apply safe
-apply(simp_all add:nth_list_update)
-done
-
-lemma Mul_interfree_Color_Target_Color_Target: 
-  " \<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
-  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Color_Target j n))"
-apply (unfold mul_mutator_defs)
-apply interfree_aux
-apply safe
-apply(simp_all add: nth_list_update)
-done
-
-lemmas mul_mutator_interfree = 
-  Mul_interfree_Redirect_Edge_Redirect_Edge Mul_interfree_Redirect_Edge_Color_Target
-  Mul_interfree_Color_Target_Redirect_Edge Mul_interfree_Color_Target_Color_Target
-
-lemma Mul_interfree_Mutator_Mutator: "\<lbrakk>i < n; j < n; i \<noteq> j\<rbrakk> \<Longrightarrow> 
-  interfree_aux (Some (Mul_Mutator i n), {}, Some (Mul_Mutator j n))"
-apply(unfold Mul_Mutator_def)
-apply(interfree_aux)
-apply(simp_all add:mul_mutator_interfree)
-apply(simp_all add: mul_mutator_defs)
-apply(tactic {* TRYALL (interfree_aux_tac) *})
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply (simp_all add:nth_list_update)
-done
-
-subsubsection {* Modular Parameterized Mutators *}
-
-lemma Mul_Parameterized_Mutators: "0<n \<Longrightarrow>
- \<parallel>- .{\<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.
- COBEGIN
- SCHEME  [0\<le> j< n]
-  Mul_Mutator j n
- .{False}.
- COEND
- .{False}."
-apply oghoare
-apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
-apply(erule Mul_Mutator)
-apply(simp add:Mul_interfree_Mutator_Mutator)
-apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
-done
-
-subsection {* The Collector *}
-
-constdefs
-  Queue :: "mul_gar_coll_state \<Rightarrow> nat"
- "Queue \<equiv> \<guillemotleft> length (filter (\<lambda>i. \<not> Z i \<and> \<acute>M!(T i) \<noteq> Black) \<acute>Muts) \<guillemotright>"
-
-consts  M_init :: nodes
-
-constdefs
-  Proper_M_init :: "mul_gar_coll_state \<Rightarrow> bool"
-  "Proper_M_init \<equiv> \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
-
-  Mul_Proper :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
-  "Mul_Proper \<equiv> \<guillemotleft> \<lambda>n. Proper_Roots \<acute>M \<and> Proper_Edges (\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<and> n=length \<acute>Muts \<guillemotright>"
-
-  Safe :: "mul_gar_coll_state \<Rightarrow> bool"
-  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
-
-lemmas mul_collector_defs = Proper_M_init_def Mul_Proper_def Safe_def
-
-subsubsection {* Blackening Roots *}
-
-constdefs
-  Mul_Blacken_Roots :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
-  "Mul_Blacken_Roots n \<equiv>
-  .{\<acute>Mul_Proper n}.
-  \<acute>ind:=0;;
-  .{\<acute>Mul_Proper n \<and> \<acute>ind=0}.
-  WHILE \<acute>ind<length \<acute>M 
-    INV .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M}.
-  DO .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
-       IF \<acute>ind\<in>Roots THEN 
-     .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<in>Roots}. 
-       \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
-     .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind+1. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
-       \<acute>ind:=\<acute>ind+1 
-  OD"
-
-lemma Mul_Blacken_Roots: 
-  "\<turnstile> Mul_Blacken_Roots n  
-  .{\<acute>Mul_Proper n \<and> Roots \<subseteq> Blacks \<acute>M}."
-apply (unfold Mul_Blacken_Roots_def)
-apply annhoare
-apply(simp_all add:mul_collector_defs Graph_defs)
-apply safe
-apply(simp_all add:nth_list_update)
-  apply (erule less_SucE)
-   apply simp+
- apply force
-apply force
-done
-
-subsubsection {* Propagating Black *} 
-
-constdefs
-  Mul_PBInv :: "mul_gar_coll_state \<Rightarrow> bool"
-  "Mul_PBInv \<equiv>  \<guillemotleft>\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
-                 \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M)) \<and> \<acute>l\<le>\<acute>Queue\<guillemotright>"
-
-  Mul_Auxk :: "mul_gar_coll_state \<Rightarrow> bool"
-  "Mul_Auxk \<equiv> \<guillemotleft>\<acute>l<\<acute>Queue \<or> \<acute>M!\<acute>k\<noteq>Black \<or> \<not>BtoW(\<acute>E!\<acute>ind, \<acute>M) \<or> \<acute>obc\<subset>Blacks \<acute>M\<guillemotright>"
-
-constdefs
-  Mul_Propagate_Black :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
-  "Mul_Propagate_Black n \<equiv>
- .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-  \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)}. 
- \<acute>ind:=0;;
- .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-   \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> Blacks \<acute>M\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-   \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) \<and> \<acute>ind=0}. 
- WHILE \<acute>ind<length \<acute>E 
-  INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-        \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-        \<and> \<acute>Mul_PBInv \<and> \<acute>ind\<le>length \<acute>E}.
- DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-     \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
-   IF \<acute>M!(fst (\<acute>E!\<acute>ind))=Black THEN 
-   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-     \<and> \<acute>Mul_PBInv \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black \<and> \<acute>ind<length \<acute>E}.
-    \<acute>k:=snd(\<acute>E!\<acute>ind);;
-   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-     \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M)) 
-        \<and> \<acute>l\<le>\<acute>Queue \<and> \<acute>Mul_Auxk ) \<and> \<acute>k<length \<acute>M \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black 
-     \<and> \<acute>ind<length \<acute>E}.
-   \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],,\<acute>ind:=\<acute>ind+1\<rangle>
-   ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-         \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-         \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
-	 \<langle>IF \<acute>M!(fst (\<acute>E!\<acute>ind))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> FI
- OD"
-
-lemma Mul_Propagate_Black: 
-  "\<turnstile> Mul_Propagate_Black n  
-   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-     \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))}."
-apply(unfold Mul_Propagate_Black_def)
-apply annhoare
-apply(simp_all add:Mul_PBInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
---{* 8 subgoals left *}
-apply force
-apply force
-apply force
-apply(force simp add:BtoW_def Graph_defs)
---{* 4 subgoals left *}
-apply clarify
-apply(simp add: mul_collector_defs Graph12 Graph6 Graph7 Graph8)
-apply(disjE_tac)
- apply(simp_all add:Graph12 Graph13)
- apply(case_tac "M x! k x=Black")
-  apply(simp add: Graph10)
- apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
-apply(case_tac "M x! k x=Black")
- apply(simp add: Graph10 BtoW_def)
- apply(rule disjI2, clarify, erule less_SucE, force)
- apply(case_tac "M x!snd(E x! ind x)=Black")
-  apply(force)
- apply(force)
-apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
---{* 3 subgoals left *}
-apply force
---{* 2 subgoals left *}
-apply clarify
-apply(conjI_tac)
-apply(disjE_tac)
- apply (simp_all)
-apply clarify
-apply(erule less_SucE)
- apply force
-apply (simp add:BtoW_def)
---{* 1 subgoal left *}
-apply clarify
-apply simp
-apply(disjE_tac)
-apply (simp_all)
-apply(rule disjI1 , rule Graph1)
- apply simp_all
-done
-
-subsubsection {* Counting Black Nodes *}
-
-constdefs
-  Mul_CountInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
- "Mul_CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
-
-  Mul_Count :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
-  "Mul_Count n \<equiv> 
-  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> length \<acute>Ma=length \<acute>M 
-    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) ) 
-    \<and> \<acute>q<n+1 \<and> \<acute>bc={}}.
-  \<acute>ind:=0;;
-  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> length \<acute>Ma=length \<acute>M 
-    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) ) 
-    \<and> \<acute>q<n+1 \<and> \<acute>bc={} \<and> \<acute>ind=0}.
-  WHILE \<acute>ind<length \<acute>M 
-     INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
-          \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
-          \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
-	  \<and> \<acute>q<n+1 \<and> \<acute>ind\<le>length \<acute>M}.
-  DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-       \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-       \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
-       \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
-       \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}. 
-     IF \<acute>M!\<acute>ind=Black 
-     THEN .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-            \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
-            \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
-            \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
-            \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
-          \<acute>bc:=insert \<acute>ind \<acute>bc
-     FI;;
-  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv (\<acute>ind+1) 
-    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
-    \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}.
-  \<acute>ind:=\<acute>ind+1
-  OD"
- 
-lemma Mul_Count: 
-  "\<turnstile> Mul_Count n  
-  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-    \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
-    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
-    \<and> \<acute>q<n+1}."
-apply (unfold Mul_Count_def)
-apply annhoare
-apply(simp_all add:Mul_CountInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
---{* 7 subgoals left *}
-apply force
-apply force
-apply force
---{* 4 subgoals left *}
-apply clarify
-apply(conjI_tac)
-apply(disjE_tac)
- apply simp_all
-apply(simp add:Blacks_def)
-apply clarify
-apply(erule less_SucE)
- back
- apply force
-apply force
---{* 3 subgoals left *}
-apply clarify
-apply(conjI_tac)
-apply(disjE_tac)
- apply simp_all
-apply clarify
-apply(erule less_SucE)
- back
- apply force
-apply simp
-apply(rotate_tac -1)
-apply (force simp add:Blacks_def)
---{* 2 subgoals left *}
-apply force
---{* 1 subgoal left *}
-apply clarify
-apply(drule_tac x = "ind x" in le_imp_less_or_eq)
-apply (simp_all add:Blacks_def)
-done
-
-subsubsection {* Appending garbage nodes to the free list *}
-
-consts  Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
-
-axioms
-  Append_to_free0: "length (Append_to_free (i, e)) = length e"
-  Append_to_free1: "Proper_Edges (m, e) 
-                    \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
-  Append_to_free2: "i \<notin> Reach e 
-           \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
-
-constdefs
-  Mul_AppendInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
-  "Mul_AppendInv \<equiv> \<guillemotleft> \<lambda>ind. (\<forall>i. ind\<le>i \<longrightarrow> i<length \<acute>M \<longrightarrow> i\<in>Reach \<acute>E \<longrightarrow> \<acute>M!i=Black)\<guillemotright>"
-
-  Mul_Append :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
-  "Mul_Append n \<equiv> 
-  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
-  \<acute>ind:=0;;
-  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
-  WHILE \<acute>ind<length \<acute>M 
-    INV .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
-  DO .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
-      IF \<acute>M!\<acute>ind=Black THEN 
-     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
-      \<acute>M:=\<acute>M[\<acute>ind:=White] 
-      ELSE 
-     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}. 
-      \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
-      FI;;
-  .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
-   \<acute>ind:=\<acute>ind+1
-  OD"
-
-lemma Mul_Append: 
-  "\<turnstile> Mul_Append n  
-     .{\<acute>Mul_Proper n}."
-apply(unfold Mul_Append_def)
-apply annhoare
-apply(simp_all add: mul_collector_defs Mul_AppendInv_def 
-      Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
-apply(force simp add:Blacks_def)
-apply(force simp add:Blacks_def)
-apply(force simp add:Blacks_def)
-apply(force simp add:Graph_defs)
-apply force
-apply(force simp add:Append_to_free1 Append_to_free2)
-apply force
-apply force
-done
-
-subsubsection {* Collector *}
-
-constdefs 
-  Mul_Collector :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
-  "Mul_Collector n \<equiv>
-.{\<acute>Mul_Proper n}.  
-WHILE True INV .{\<acute>Mul_Proper n}. 
-DO  
-Mul_Blacken_Roots n ;; 
-.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M}.  
- \<acute>obc:={};; 
-.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}.  
- \<acute>bc:=Roots;; 
-.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
- \<acute>l:=0;; 
-.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>l=0}. 
- WHILE \<acute>l<n+1  
-   INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and>  
-         (\<acute>Safe \<or> (\<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M) \<and> \<acute>l<n+1)}. 
- DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M)}.
-    \<acute>obc:=\<acute>bc;;
-    Mul_Propagate_Black n;; 
-    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
-      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))}. 
-    \<acute>bc:={};;
-    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
-      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) \<and> \<acute>bc={}}. 
-       \<langle> \<acute>Ma:=\<acute>M,, \<acute>q:=\<acute>Queue \<rangle>;;
-    Mul_Count n;; 
-    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
-      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
-      \<and> \<acute>q<n+1}. 
-    IF \<acute>obc=\<acute>bc THEN
-    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
-      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
-      \<and> \<acute>q<n+1 \<and> \<acute>obc=\<acute>bc}.  
-    \<acute>l:=\<acute>l+1  
-    ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
-          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
-          \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
-          \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
-          \<and> \<acute>q<n+1 \<and> \<acute>obc\<noteq>\<acute>bc}.  
-        \<acute>l:=0 FI 
- OD;; 
- Mul_Append n  
-OD"
-
-lemmas mul_modules = Mul_Redirect_Edge_def Mul_Color_Target_def 
- Mul_Blacken_Roots_def Mul_Propagate_Black_def 
- Mul_Count_def Mul_Append_def
-
-lemma Mul_Collector:
-  "\<turnstile> Mul_Collector n 
-  .{False}."
-apply(unfold Mul_Collector_def)
-apply annhoare
-apply(simp_all only:pre.simps Mul_Blacken_Roots 
-       Mul_Propagate_Black Mul_Count Mul_Append)
-apply(simp_all add:mul_modules)
-apply(simp_all add:mul_collector_defs Queue_def)
-apply force
-apply force
-apply force
-apply (force simp add: less_Suc_eq_le)
-apply force
-apply (force dest:subset_antisym)
-apply force
-apply force
-apply force
-done
-
-subsection {* Interference Freedom *}
-
-lemma le_length_filter_update[rule_format]: 
- "\<forall>i. (\<not>P (list!i) \<or> P j) \<and> i<length list 
- \<longrightarrow> length(filter P list) \<le> length(filter P (list[i:=j]))"
-apply(induct_tac "list")
- apply(simp)
-apply(clarify)
-apply(case_tac i)
- apply(simp)
-apply(simp)
-done
-
-lemma less_length_filter_update [rule_format]: 
- "\<forall>i. P j \<and> \<not>(P (list!i)) \<and> i<length list 
- \<longrightarrow> length(filter P list) < length(filter P (list[i:=j]))"
-apply(induct_tac "list")
- apply(simp)
-apply(clarify)
-apply(case_tac i)
- apply(simp)
-apply(simp)
-done
-
-lemma Mul_interfree_Blacken_Roots_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk> \<Longrightarrow>  
-  interfree_aux (Some(Mul_Blacken_Roots n),{},Some(Mul_Redirect_Edge j n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:Graph6 Graph9 Graph12 nth_list_update mul_mutator_defs mul_collector_defs)
-done
-
-lemma Mul_interfree_Redirect_Edge_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow> 
-  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Blacken_Roots n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Blacken_Roots_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Blacken_Roots n),{},Some (Mul_Color_Target j n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs mul_collector_defs nth_list_update Graph7 Graph8 Graph9 Graph12)
-done
-
-lemma Mul_interfree_Color_Target_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Color_Target j n ),{},Some (Mul_Blacken_Roots n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Propagate_Black_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Redirect_Edge j n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_PBInv_def nth_list_update Graph6)
---{* 7 subgoals left *}
-apply clarify
-apply(disjE_tac)
-  apply(simp_all add:Graph6)
- apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
---{* 6 subgoals left *}
-apply clarify
-apply(disjE_tac)
-  apply(simp_all add:Graph6)
- apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
---{* 5 subgoals left *}
-apply clarify
-apply(disjE_tac)
-  apply(simp_all add:Graph6)
- apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(erule conjE)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply(rule conjI)
-  apply(rule impI,(rule disjI2)+,rule conjI)
-   apply clarify
-   apply(case_tac "R (Muts x! j)=i")
-    apply (force simp add: nth_list_update BtoW_def)
-   apply (force simp add: nth_list_update)
-  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,(rule disjI2)+, erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
- apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
-apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
---{* 4 subgoals left *}
-apply clarify
-apply(disjE_tac)
-  apply(simp_all add:Graph6)
- apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(erule conjE)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply(rule conjI)
-  apply(rule impI,(rule disjI2)+,rule conjI)
-   apply clarify
-   apply(case_tac "R (Muts x! j)=i")
-    apply (force simp add: nth_list_update BtoW_def)
-   apply (force simp add: nth_list_update)
-  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,(rule disjI2)+, erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
- apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
-apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
---{* 3 subgoals left *}
-apply clarify
-apply(disjE_tac)
-  apply(simp_all add:Graph6)
-  apply (rule impI)
-   apply(rule conjI)
-    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-   apply(case_tac "R (Muts x ! j)= ind x")
-    apply(simp add:nth_list_update)
-   apply(simp add:nth_list_update)
-  apply(case_tac "R (Muts x ! j)= ind x")
-   apply(simp add:nth_list_update)
-  apply(simp add:nth_list_update)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule conjI)
-   apply(rule impI)
-   apply(rule conjI)
-    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-   apply(case_tac "R (Muts x ! j)= ind x")
-    apply(simp add:nth_list_update)
-   apply(simp add:nth_list_update)
-  apply(rule impI)
-  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule conjI)
-  apply(rule impI)
-   apply(rule conjI)
-    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-   apply(case_tac "R (Muts x ! j)= ind x")
-    apply(simp add:nth_list_update)
-   apply(simp add:nth_list_update)
-  apply(rule impI)
-  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(erule conjE)
- apply(rule conjI)
-  apply(case_tac "M x!(T (Muts x!j))=Black")
-   apply(rule impI,rule conjI,(rule disjI2)+,rule conjI)
-    apply clarify
-    apply(case_tac "R (Muts x! j)=i")
-     apply (force simp add: nth_list_update BtoW_def)
-    apply (force simp add: nth_list_update)
-   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-  apply(case_tac "R (Muts x ! j)= ind x")
-   apply(simp add:nth_list_update)
-  apply(simp add:nth_list_update)
- apply(rule impI,rule conjI)
-  apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
- apply(case_tac "R (Muts x! j)=ind x")
-  apply (force simp add: nth_list_update)
- apply (force simp add: nth_list_update)
-apply(rule impI, (rule disjI2)+, erule le_trans)
-apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
---{* 2 subgoals left *}
-apply clarify
-apply(rule conjI)
- apply(disjE_tac)
-  apply(simp_all add:Mul_Auxk_def Graph6)
-  apply (rule impI)
-   apply(rule conjI)
-    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-   apply(case_tac "R (Muts x ! j)= ind x")
-    apply(simp add:nth_list_update)
-   apply(simp add:nth_list_update)
-  apply(case_tac "R (Muts x ! j)= ind x")
-   apply(simp add:nth_list_update)
-  apply(simp add:nth_list_update)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule impI)
-  apply(rule conjI)
-   apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-  apply(case_tac "R (Muts x ! j)= ind x")
-   apply(simp add:nth_list_update)
-  apply(simp add:nth_list_update)
- apply(rule impI)
- apply(rule conjI)
-  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(case_tac "R (Muts x ! j)= ind x")
-  apply(simp add:nth_list_update)
- apply(simp add:nth_list_update)
-apply(rule impI)
-apply(rule conjI)
- apply(erule conjE)+
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply((rule disjI2)+,rule conjI)
-   apply clarify
-   apply(case_tac "R (Muts x! j)=i")
-    apply (force simp add: nth_list_update BtoW_def)
-   apply (force simp add: nth_list_update)
-  apply(rule conjI)
-   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-  apply(rule impI)
-  apply(case_tac "R (Muts x ! j)= ind x")
-   apply(simp add:nth_list_update BtoW_def)
-  apply (simp  add:nth_list_update)
-  apply(rule impI)
-  apply simp
-  apply(disjE_tac)
-   apply(rule disjI1, erule less_le_trans)
-   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-  apply force
- apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
- apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
- apply(case_tac "R (Muts x ! j)= ind x")
-  apply(simp add:nth_list_update)
- apply(simp add:nth_list_update)
-apply(disjE_tac) 
-apply simp_all
-apply(conjI_tac)
- apply(rule impI)
- apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(erule conjE)+
-apply(rule impI,(rule disjI2)+,rule conjI)
- apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule impI)+
-apply simp
-apply(disjE_tac)
- apply(rule disjI1, erule less_le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply force
---{* 1 subgoal left *} 
-apply clarify
-apply(disjE_tac)
-  apply(simp_all add:Graph6)
- apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(erule conjE)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply(rule conjI)
-  apply(rule impI,(rule disjI2)+,rule conjI)
-   apply clarify
-   apply(case_tac "R (Muts x! j)=i")
-    apply (force simp add: nth_list_update BtoW_def)
-   apply (force simp add: nth_list_update)
-  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,(rule disjI2)+, erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule conjI)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
- apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
-apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
-apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
-done
-
-lemma Mul_interfree_Redirect_Edge_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Propagate_Black n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Propagate_Black_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Color_Target j n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(simp_all add: mul_collector_defs mul_mutator_defs)
---{* 7 subgoals left *}
-apply clarify
-apply (simp add:Graph7 Graph8 Graph12)
-apply(disjE_tac)
-  apply(simp add:Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
---{* 6 subgoals left *}
-apply clarify
-apply (simp add:Graph7 Graph8 Graph12)
-apply(disjE_tac)
-  apply(simp add:Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
---{* 5 subgoals left *}
-apply clarify
-apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
-apply(disjE_tac)
-   apply(simp add:Graph7 Graph8 Graph12) 
-  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
-apply(erule conjE)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply((rule disjI2)+)
- apply (rule conjI)
-  apply(simp add:Graph10)
- apply(erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
-apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
---{* 4 subgoals left *}
-apply clarify
-apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
-apply(disjE_tac)
-   apply(simp add:Graph7 Graph8 Graph12)
-  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
-apply(erule conjE)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply((rule disjI2)+)
- apply (rule conjI)
-  apply(simp add:Graph10)
- apply(erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
-apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
---{* 3 subgoals left *}
-apply clarify
-apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply(simp add:Graph10)
- apply(disjE_tac)
-  apply simp_all
-  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply(erule conjE)
- apply((rule disjI2)+,erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
-apply(rule conjI)
- apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
-apply (force simp add:nth_list_update)
---{* 2 subgoals left *}
-apply clarify 
-apply(simp add:Mul_Auxk_def Graph7 Graph8 Graph12)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply(simp add:Graph10)
- apply(disjE_tac)
-  apply simp_all
-  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply(erule conjE)+
- apply((rule disjI2)+,rule conjI, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule impI)+)
- apply simp
- apply(erule disjE)
-  apply(rule disjI1, erule less_le_trans) 
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply force
-apply(rule conjI)
- apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
-apply (force simp add:nth_list_update)
---{* 1 subgoal left *}
-apply clarify
-apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
-apply(case_tac "M x!(T (Muts x!j))=Black")
- apply(simp add:Graph10)
- apply(disjE_tac)
-  apply simp_all
-  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply(erule conjE)
- apply((rule disjI2)+,erule le_trans)
- apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
-apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
-done
-
-lemma Mul_interfree_Color_Target_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Color_Target j n),{},Some(Mul_Propagate_Black n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Count_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Redirect_Edge j n))"
-apply (unfold mul_modules)
-apply interfree_aux
---{* 9 subgoals left *}
-apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def Graph6)
-apply clarify
-apply disjE_tac
-   apply(simp add:Graph6)
-  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
- apply(simp add:Graph6)
-apply clarify
-apply disjE_tac
- apply(simp add:Graph6)
- apply(rule conjI)
-  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(simp add:Graph6)
---{* 8 subgoals left *}
-apply(simp add:mul_mutator_defs nth_list_update)
---{* 7 subgoals left *}
-apply(simp add:mul_mutator_defs mul_collector_defs)
-apply clarify
-apply disjE_tac
-   apply(simp add:Graph6)
-  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
- apply(simp add:Graph6)
-apply clarify
-apply disjE_tac
- apply(simp add:Graph6)
- apply(rule conjI)
-  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(simp add:Graph6)
---{* 6 subgoals left *}
-apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
-apply clarify
-apply disjE_tac
-   apply(simp add:Graph6 Queue_def)
-  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
- apply(simp add:Graph6)
-apply clarify
-apply disjE_tac
- apply(simp add:Graph6)
- apply(rule conjI)
-  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(simp add:Graph6)
---{* 5 subgoals left *}
-apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
-apply clarify
-apply disjE_tac
-   apply(simp add:Graph6)
-  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
- apply(simp add:Graph6)
-apply clarify
-apply disjE_tac
- apply(simp add:Graph6)
- apply(rule conjI)
-  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(simp add:Graph6)
---{* 4 subgoals left *}
-apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
-apply clarify
-apply disjE_tac
-   apply(simp add:Graph6)
-  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
- apply(simp add:Graph6)
-apply clarify
-apply disjE_tac
- apply(simp add:Graph6)
- apply(rule conjI)
-  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(simp add:Graph6)
---{* 3 subgoals left *}
-apply(simp add:mul_mutator_defs nth_list_update)
---{* 2 subgoals left *}
-apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
-apply clarify
-apply disjE_tac
-   apply(simp add:Graph6)
-  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
- apply(simp add:Graph6)
-apply clarify
-apply disjE_tac
- apply(simp add:Graph6)
- apply(rule conjI)
-  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
- apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(simp add:Graph6)
---{* 1 subgoal left *}
-apply(simp add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Redirect_Edge_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Count n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Count_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Color_Target j n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(simp_all add:mul_collector_defs mul_mutator_defs Mul_CountInv_def)
---{* 6 subgoals left *}
-apply clarify
-apply disjE_tac
-  apply (simp add: Graph7 Graph8 Graph12)
- apply (simp add: Graph7 Graph8 Graph12)
-apply clarify
-apply disjE_tac
- apply (simp add: Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
-apply (simp add: Graph7 Graph8 Graph12)
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
---{* 5 subgoals left *}
-apply clarify
-apply disjE_tac
-  apply (simp add: Graph7 Graph8 Graph12)
- apply (simp add: Graph7 Graph8 Graph12)
-apply clarify
-apply disjE_tac
- apply (simp add: Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
-apply (simp add: Graph7 Graph8 Graph12)
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
---{* 4 subgoals left *}
-apply clarify
-apply disjE_tac
-  apply (simp add: Graph7 Graph8 Graph12)
- apply (simp add: Graph7 Graph8 Graph12)
-apply clarify
-apply disjE_tac
- apply (simp add: Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
-apply (simp add: Graph7 Graph8 Graph12)
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
---{* 3 subgoals left *}
-apply clarify
-apply disjE_tac
-  apply (simp add: Graph7 Graph8 Graph12)
- apply (simp add: Graph7 Graph8 Graph12)
-apply clarify
-apply disjE_tac
- apply (simp add: Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
-apply (simp add: Graph7 Graph8 Graph12)
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
---{* 2 subgoals left *}
-apply clarify
-apply disjE_tac
-  apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
- apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
-apply clarify
-apply disjE_tac
- apply (simp add: Graph7 Graph8 Graph12)
- apply(rule conjI)
-  apply(case_tac "M x!(T (Muts x!j))=Black")
-   apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
-   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
-  apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
- apply (simp add: nth_list_update)
-apply (simp add: Graph7 Graph8 Graph12)
-apply(rule conjI)
- apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
-apply (simp add: nth_list_update)
---{* 1 subgoal left *}
-apply clarify
-apply disjE_tac
-  apply (simp add: Graph7 Graph8 Graph12)
- apply (simp add: Graph7 Graph8 Graph12)
-apply clarify
-apply disjE_tac
- apply (simp add: Graph7 Graph8 Graph12)
- apply(case_tac "M x!(T (Muts x!j))=Black")
-  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
-  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
- apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
-apply (simp add: Graph7 Graph8 Graph12)
-apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
-done
-
-lemma Mul_interfree_Color_Target_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Count n ))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply safe
-apply(simp_all add:mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Append_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Redirect_Edge j n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply(simp_all add:Graph6 Append_to_free0 Append_to_free1 mul_collector_defs mul_mutator_defs Mul_AppendInv_def)
-apply(erule_tac x=j in allE, force dest:Graph3)+
-done
-
-lemma Mul_interfree_Redirect_Edge_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Append n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply(simp_all add:mul_collector_defs Append_to_free0 Mul_AppendInv_def  mul_mutator_defs nth_list_update)
-done
-
-lemma Mul_interfree_Append_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Color_Target j n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_AppendInv_def Graph7 Graph8 Append_to_free0 Append_to_free1 
-              Graph12 nth_list_update)
-done
-
-lemma Mul_interfree_Color_Target_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
-  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Append n))"
-apply (unfold mul_modules)
-apply interfree_aux
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply(simp_all add: mul_mutator_defs nth_list_update)
-apply(simp add:Mul_AppendInv_def Append_to_free0)
-done
-
-subsubsection {* Interference freedom Collector-Mutator *}
-
-lemmas mul_collector_mutator_interfree =  
- Mul_interfree_Blacken_Roots_Redirect_Edge Mul_interfree_Blacken_Roots_Color_Target 
- Mul_interfree_Propagate_Black_Redirect_Edge Mul_interfree_Propagate_Black_Color_Target  
- Mul_interfree_Count_Redirect_Edge Mul_interfree_Count_Color_Target 
- Mul_interfree_Append_Redirect_Edge Mul_interfree_Append_Color_Target 
- Mul_interfree_Redirect_Edge_Blacken_Roots Mul_interfree_Color_Target_Blacken_Roots 
- Mul_interfree_Redirect_Edge_Propagate_Black Mul_interfree_Color_Target_Propagate_Black  
- Mul_interfree_Redirect_Edge_Count Mul_interfree_Color_Target_Count 
- Mul_interfree_Redirect_Edge_Append Mul_interfree_Color_Target_Append
-
-lemma Mul_interfree_Collector_Mutator: "j<n  \<Longrightarrow> 
-  interfree_aux (Some (Mul_Collector n), {}, Some (Mul_Mutator j n))"
-apply(unfold Mul_Collector_def Mul_Mutator_def)
-apply interfree_aux
-apply(simp_all add:mul_collector_mutator_interfree)
-apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
-apply(tactic  {* TRYALL (interfree_aux_tac) *})
---{* 42 subgoals left *}
-apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
---{* 24 subgoals left *}
-apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
---{* 14 subgoals left *}
-apply(tactic {* TRYALL (clarify_tac @{claset}) *})
-apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
-apply(tactic {* TRYALL (rtac conjI) *})
-apply(tactic {* TRYALL (rtac impI) *})
-apply(tactic {* TRYALL (etac disjE) *})
-apply(tactic {* TRYALL (etac conjE) *})
-apply(tactic {* TRYALL (etac disjE) *})
-apply(tactic {* TRYALL (etac disjE) *})
---{* 72 subgoals left *}
-apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
---{* 35 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[rtac disjI1,rtac subset_trans,etac @{thm Graph3},force_tac @{clasimpset}, assume_tac]) *})
---{* 28 subgoals left *}
-apply(tactic {* TRYALL (etac conjE) *})
-apply(tactic {* TRYALL (etac disjE) *})
---{* 34 subgoals left *}
-apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
-apply(case_tac [!] "M x!(T (Muts x ! j))=Black")
-apply(simp_all add:Graph10)
---{* 47 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac (thm "subset_psubset_trans"),etac (thm "Graph11"),force_tac @{clasimpset}]) *})
---{* 41 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI1, etac @{thm le_trans}, force_tac (@{claset},@{simpset} addsimps [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}])]) *})
---{* 35 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac (thm "psubset_subset_trans"),rtac (thm "Graph9"),force_tac @{clasimpset}]) *})
---{* 31 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac (thm "subset_psubset_trans"),etac (thm "Graph11"),force_tac @{clasimpset}]) *})
---{* 29 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac (thm "subset_psubset_trans"),etac (thm "subset_psubset_trans"),etac (thm "Graph11"),force_tac @{clasimpset}]) *})
---{* 25 subgoals left *}
-apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI2, rtac disjI1, etac @{thm le_trans}, force_tac (@{claset},@{simpset} addsimps [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}])]) *})
---{* 10 subgoals left *}
-apply(rule disjI2,rule disjI2,rule conjI,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update, rule disjI1, rule less_imp_le, erule less_le_trans, force simp add:Queue_def less_Suc_eq_le le_length_filter_update)+
-done
-
-subsubsection {* Interference freedom Mutator-Collector *}
-
-lemma Mul_interfree_Mutator_Collector: " j < n \<Longrightarrow> 
-  interfree_aux (Some (Mul_Mutator j n), {}, Some (Mul_Collector n))"
-apply(unfold Mul_Collector_def Mul_Mutator_def)
-apply interfree_aux
-apply(simp_all add:mul_collector_mutator_interfree)
-apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
-apply(tactic  {* TRYALL (interfree_aux_tac) *})
---{* 76 subgoals left *}
-apply (clarify,simp add: nth_list_update)+
---{* 56 subgoals left *}
-apply(clarify,simp add:Mul_AppendInv_def Append_to_free0 nth_list_update)+
-done
-
-subsubsection {* The Multi-Mutator Garbage Collection Algorithm *}
-
-text {* The total number of verification conditions is 328 *}
-
-lemma Mul_Gar_Coll: 
- "\<parallel>- .{\<acute>Mul_Proper n \<and> \<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.  
- COBEGIN  
-  Mul_Collector n
- .{False}.
- \<parallel>  
- SCHEME  [0\<le> j< n]
-  Mul_Mutator j n
- .{False}.  
- COEND  
- .{False}."
-apply oghoare
---{* Strengthening the precondition *}
-apply(rule Int_greatest)
- apply (case_tac n)
-  apply(force simp add: Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
- apply(simp add: Mul_Mutator_def mul_collector_defs mul_mutator_defs nth_append)
- apply force
-apply clarify
-apply(case_tac i)
- apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
-apply(simp add: Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append nth_map_upt)
---{* Collector *}
-apply(rule Mul_Collector)
---{* Mutator *}
-apply(erule Mul_Mutator)
---{* Interference freedom *}
-apply(simp add:Mul_interfree_Collector_Mutator)
-apply(simp add:Mul_interfree_Mutator_Collector)
-apply(simp add:Mul_interfree_Mutator_Mutator)
---{* Weakening of the postcondition *}
-apply(case_tac n)
- apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
-apply(simp add:Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append)
-done
-
-end
--- a/src/HOL/HoareParallel/OG_Com.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,55 +0,0 @@
-
-header {* \chapter{The Owicki-Gries Method} 
-
-\section{Abstract Syntax} *} 
-
-theory OG_Com imports Main begin
-
-text {* Type abbreviations for boolean expressions and assertions: *}
-
-types
-    'a bexp = "'a set"
-    'a assn = "'a set"
-
-text {* The syntax of commands is defined by two mutually recursive
-datatypes: @{text "'a ann_com"} for annotated commands and @{text "'a
-com"} for non-annotated commands. *}
-
-datatype 'a ann_com = 
-     AnnBasic "('a assn)"  "('a \<Rightarrow> 'a)"         
-   | AnnSeq "('a ann_com)"  "('a ann_com)"   
-   | AnnCond1 "('a assn)"  "('a bexp)"  "('a ann_com)"  "('a ann_com)" 
-   | AnnCond2 "('a assn)"  "('a bexp)"  "('a ann_com)" 
-   | AnnWhile "('a assn)"  "('a bexp)"  "('a assn)"  "('a ann_com)" 
-   | AnnAwait "('a assn)"  "('a bexp)"  "('a com)" 
-and 'a com = 
-     Parallel "('a ann_com option \<times> 'a assn) list"
-   | Basic "('a \<Rightarrow> 'a)" 
-   | Seq "('a com)"  "('a com)" 
-   | Cond "('a bexp)"  "('a com)"  "('a com)" 
-   | While "('a bexp)"  "('a assn)"  "('a com)"
-
-text {* The function @{text pre} extracts the precondition of an
-annotated command: *}
-
-consts
-  pre ::"'a ann_com \<Rightarrow> 'a assn" 
-primrec 
-  "pre (AnnBasic r f) = r"
-  "pre (AnnSeq c1 c2) = pre c1"
-  "pre (AnnCond1 r b c1 c2) = r"
-  "pre (AnnCond2 r b c) = r"
-  "pre (AnnWhile r b i c) = r"
-  "pre (AnnAwait r b c) = r"
-
-text {* Well-formedness predicate for atomic programs: *}
-
-consts atom_com :: "'a com \<Rightarrow> bool"
-primrec  
-  "atom_com (Parallel Ts) = False"
-  "atom_com (Basic f) = True"
-  "atom_com (Seq c1 c2) = (atom_com c1 \<and> atom_com c2)"
-  "atom_com (Cond b c1 c2) = (atom_com c1 \<and> atom_com c2)"
-  "atom_com (While b i c) = atom_com c"
-  
-end
\ No newline at end of file
--- a/src/HOL/HoareParallel/OG_Examples.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,549 +0,0 @@
-
-header {* \section{Examples} *}
-
-theory OG_Examples imports OG_Syntax begin
-
-subsection {* Mutual Exclusion *}
-
-subsubsection {* Peterson's Algorithm I*}
-
-text {* Eike Best. "Semantics of Sequential and Parallel Programs", page 217. *}
-
-record Petersons_mutex_1 =
- pr1 :: nat
- pr2 :: nat
- in1 :: bool
- in2 :: bool 
- hold :: nat
-
-lemma Petersons_mutex_1: 
-  "\<parallel>- .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2 }.  
-  COBEGIN .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
-  WHILE True INV .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
-  DO  
-  .{\<acute>pr1=0 \<and> \<not>\<acute>in1}. \<langle> \<acute>in1:=True,,\<acute>pr1:=1 \<rangle>;;  
-  .{\<acute>pr1=1 \<and> \<acute>in1}.  \<langle> \<acute>hold:=1,,\<acute>pr1:=2 \<rangle>;;  
-  .{\<acute>pr1=2 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}.  
-  AWAIT (\<not>\<acute>in2 \<or> \<not>(\<acute>hold=1)) THEN \<acute>pr1:=3 END;;    
-  .{\<acute>pr1=3 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}. 
-   \<langle>\<acute>in1:=False,,\<acute>pr1:=0\<rangle> 
-  OD .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
-  \<parallel>  
-  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
-  WHILE True INV .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
-  DO  
-  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}. \<langle> \<acute>in2:=True,,\<acute>pr2:=1 \<rangle>;;  
-  .{\<acute>pr2=1 \<and> \<acute>in2}. \<langle>  \<acute>hold:=2,,\<acute>pr2:=2 \<rangle>;;  
-  .{\<acute>pr2=2 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}.  
-  AWAIT (\<not>\<acute>in1 \<or> \<not>(\<acute>hold=2)) THEN \<acute>pr2:=3  END;;    
-  .{\<acute>pr2=3 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}. 
-    \<langle>\<acute>in2:=False,,\<acute>pr2:=0\<rangle> 
-  OD .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
-  COEND  
-  .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2}."
-apply oghoare
---{* 104 verification conditions. *}
-apply auto
-done
-
-subsubsection {*Peterson's Algorithm II: A Busy Wait Solution *}
- 
-text {* Apt and Olderog. "Verification of sequential and concurrent Programs", page 282. *}
-
-record Busy_wait_mutex =
- flag1 :: bool
- flag2 :: bool
- turn  :: nat
- after1 :: bool 
- after2 :: bool
-
-lemma Busy_wait_mutex: 
- "\<parallel>-  .{True}.  
-  \<acute>flag1:=False,, \<acute>flag2:=False,,  
-  COBEGIN .{\<not>\<acute>flag1}.  
-        WHILE True  
-        INV .{\<not>\<acute>flag1}.  
-        DO .{\<not>\<acute>flag1}. \<langle> \<acute>flag1:=True,,\<acute>after1:=False \<rangle>;;  
-           .{\<acute>flag1 \<and> \<not>\<acute>after1}. \<langle> \<acute>turn:=1,,\<acute>after1:=True \<rangle>;;  
-           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
-            WHILE \<not>(\<acute>flag2 \<longrightarrow> \<acute>turn=2)  
-            INV .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
-            DO .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;; 
-           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>flag2 \<and> \<acute>after2 \<longrightarrow> \<acute>turn=2)}.
-            \<acute>flag1:=False  
-        OD  
-       .{False}.  
-  \<parallel>  
-     .{\<not>\<acute>flag2}.  
-        WHILE True  
-        INV .{\<not>\<acute>flag2}.  
-        DO .{\<not>\<acute>flag2}. \<langle> \<acute>flag2:=True,,\<acute>after2:=False \<rangle>;;  
-           .{\<acute>flag2 \<and> \<not>\<acute>after2}. \<langle> \<acute>turn:=2,,\<acute>after2:=True \<rangle>;;  
-           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
-            WHILE \<not>(\<acute>flag1 \<longrightarrow> \<acute>turn=1)  
-            INV .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
-            DO .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;;  
-           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>flag1 \<and> \<acute>after1 \<longrightarrow> \<acute>turn=1)}. 
-            \<acute>flag2:=False  
-        OD  
-       .{False}.  
-  COEND  
-  .{False}."
-apply oghoare
---{* 122 vc *}
-apply auto
-done
-
-subsubsection {* Peterson's Algorithm III: A Solution using Semaphores  *}
-
-record  Semaphores_mutex =
- out :: bool
- who :: nat
-
-lemma Semaphores_mutex: 
- "\<parallel>- .{i\<noteq>j}.  
-  \<acute>out:=True ,,  
-  COBEGIN .{i\<noteq>j}.  
-       WHILE True INV .{i\<noteq>j}.  
-       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
-          .{\<not>\<acute>out \<and> \<acute>who=i \<and> i\<noteq>j}. \<acute>out:=True OD  
-       .{False}.  
-  \<parallel>  
-       .{i\<noteq>j}.  
-       WHILE True INV .{i\<noteq>j}.  
-       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,,\<acute>who:=j END;;  
-          .{\<not>\<acute>out \<and> \<acute>who=j \<and> i\<noteq>j}. \<acute>out:=True OD  
-       .{False}.  
-  COEND  
-  .{False}."
-apply oghoare
---{* 38 vc *}
-apply auto
-done
-
-subsubsection {* Peterson's Algorithm III: Parameterized version: *}
-
-lemma Semaphores_parameterized_mutex: 
- "0<n \<Longrightarrow> \<parallel>- .{True}.  
-  \<acute>out:=True ,,  
- COBEGIN
-  SCHEME [0\<le> i< n]
-    .{True}.  
-     WHILE True INV .{True}.  
-      DO .{True}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
-         .{\<not>\<acute>out \<and> \<acute>who=i}. \<acute>out:=True OD
-    .{False}. 
- COEND
-  .{False}." 
-apply oghoare
---{* 20 vc *}
-apply auto
-done
-
-subsubsection{* The Ticket Algorithm *}
-
-record Ticket_mutex =
- num :: nat
- nextv :: nat
- turn :: "nat list"
- index :: nat 
-
-lemma Ticket_mutex: 
- "\<lbrakk> 0<n; I=\<guillemotleft>n=length \<acute>turn \<and> 0<\<acute>nextv \<and> (\<forall>k l. k<n \<and> l<n \<and> k\<noteq>l 
-    \<longrightarrow> \<acute>turn!k < \<acute>num \<and> (\<acute>turn!k =0 \<or> \<acute>turn!k\<noteq>\<acute>turn!l))\<guillemotright> \<rbrakk>
-   \<Longrightarrow> \<parallel>- .{n=length \<acute>turn}.  
-   \<acute>index:= 0,,
-   WHILE \<acute>index < n INV .{n=length \<acute>turn \<and> (\<forall>i<\<acute>index. \<acute>turn!i=0)}. 
-    DO \<acute>turn:= \<acute>turn[\<acute>index:=0],, \<acute>index:=\<acute>index +1 OD,,
-  \<acute>num:=1 ,, \<acute>nextv:=1 ,, 
- COBEGIN
-  SCHEME [0\<le> i< n]
-    .{\<acute>I}.  
-     WHILE True INV .{\<acute>I}.  
-      DO .{\<acute>I}. \<langle> \<acute>turn :=\<acute>turn[i:=\<acute>num],, \<acute>num:=\<acute>num+1 \<rangle>;;  
-         .{\<acute>I}. WAIT \<acute>turn!i=\<acute>nextv END;;
-         .{\<acute>I \<and> \<acute>turn!i=\<acute>nextv}. \<acute>nextv:=\<acute>nextv+1
-      OD
-    .{False}. 
- COEND
-  .{False}." 
-apply oghoare
---{* 35 vc *}
-apply simp_all
---{* 21 vc *}
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
---{* 11 vc *}
-apply simp_all
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
---{* 10 subgoals left *}
-apply(erule less_SucE)
- apply simp
-apply simp
---{* 9 subgoals left *}
-apply(case_tac "i=k")
- apply force
-apply simp
-apply(case_tac "i=l")
- apply force
-apply force
---{* 8 subgoals left *}
-prefer 8
-apply force
-apply force
---{* 6 subgoals left *}
-prefer 6
-apply(erule_tac x=i in allE)
-apply fastsimp
---{* 5 subgoals left *}
-prefer 5
-apply(case_tac [!] "j=k")
---{* 10 subgoals left *}
-apply simp_all
-apply(erule_tac x=k in allE)
-apply force
---{* 9 subgoals left *}
-apply(case_tac "j=l")
- apply simp
- apply(erule_tac x=k in allE)
- apply(erule_tac x=k in allE)
- apply(erule_tac x=l in allE)
- apply force
-apply(erule_tac x=k in allE)
-apply(erule_tac x=k in allE)
-apply(erule_tac x=l in allE)
-apply force
---{* 8 subgoals left *}
-apply force
-apply(case_tac "j=l")
- apply simp
-apply(erule_tac x=k in allE)
-apply(erule_tac x=l in allE)
-apply force
-apply force
-apply force
---{* 5 subgoals left *}
-apply(erule_tac x=k in allE)
-apply(erule_tac x=l in allE)
-apply(case_tac "j=l")
- apply force
-apply force
-apply force
---{* 3 subgoals left *}
-apply(erule_tac x=k in allE)
-apply(erule_tac x=l in allE)
-apply(case_tac "j=l")
- apply force
-apply force
-apply force
---{* 1 subgoals left *}
-apply(erule_tac x=k in allE)
-apply(erule_tac x=l in allE)
-apply(case_tac "j=l")
- apply force
-apply force
-done
-
-subsection{* Parallel Zero Search *}
-
-text {* Synchronized Zero Search. Zero-6 *}
-
-text {*Apt and Olderog. "Verification of sequential and concurrent Programs" page 294: *}
-
-record Zero_search =
-   turn :: nat
-   found :: bool
-   x :: nat
-   y :: nat
-
-lemma Zero_search: 
-  "\<lbrakk>I1= \<guillemotleft> a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
-      \<and> (\<not>\<acute>found \<and> a<\<acute> x \<longrightarrow> f(\<acute>x)\<noteq>0) \<guillemotright> ;  
-    I2= \<guillemotleft>\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
-      \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0) \<guillemotright> \<rbrakk> \<Longrightarrow>  
-  \<parallel>- .{\<exists> u. f(u)=0}.  
-  \<acute>turn:=1,, \<acute>found:= False,,  
-  \<acute>x:=a,, \<acute>y:=a+1 ,,  
-  COBEGIN .{\<acute>I1}.  
-       WHILE \<not>\<acute>found  
-       INV .{\<acute>I1}.  
-       DO .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.  
-          WAIT \<acute>turn=1 END;;  
-          .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.  
-          \<acute>turn:=2;;  
-          .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.    
-          \<langle> \<acute>x:=\<acute>x+1,,  
-            IF f(\<acute>x)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
-       OD;;  
-       .{\<acute>I1  \<and> \<acute>found}.  
-       \<acute>turn:=2  
-       .{\<acute>I1 \<and> \<acute>found}.  
-  \<parallel>  
-      .{\<acute>I2}.  
-       WHILE \<not>\<acute>found  
-       INV .{\<acute>I2}.  
-       DO .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
-          WAIT \<acute>turn=2 END;;  
-          .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
-          \<acute>turn:=1;;  
-          .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
-          \<langle> \<acute>y:=(\<acute>y - 1),,  
-            IF f(\<acute>y)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
-       OD;;  
-       .{\<acute>I2 \<and> \<acute>found}.  
-       \<acute>turn:=1  
-       .{\<acute>I2 \<and> \<acute>found}.  
-  COEND  
-  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
-apply oghoare
---{* 98 verification conditions *}
-apply auto 
---{* auto takes about 3 minutes !! *}
-done
-
-text {* Easier Version: without AWAIT.  Apt and Olderog. page 256: *}
-
-lemma Zero_Search_2: 
-"\<lbrakk>I1=\<guillemotleft> a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
-    \<and> (\<not>\<acute>found \<and> a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)\<guillemotright>;  
- I2= \<guillemotleft>\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
-    \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)\<guillemotright>\<rbrakk> \<Longrightarrow>  
-  \<parallel>- .{\<exists>u. f(u)=0}.  
-  \<acute>found:= False,,  
-  \<acute>x:=a,, \<acute>y:=a+1,,  
-  COBEGIN .{\<acute>I1}.  
-       WHILE \<not>\<acute>found  
-       INV .{\<acute>I1}.  
-       DO .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.  
-          \<langle> \<acute>x:=\<acute>x+1,,IF f(\<acute>x)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
-       OD  
-       .{\<acute>I1 \<and> \<acute>found}.  
-  \<parallel>  
-      .{\<acute>I2}.  
-       WHILE \<not>\<acute>found  
-       INV .{\<acute>I2}.  
-       DO .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
-          \<langle> \<acute>y:=(\<acute>y - 1),,IF f(\<acute>y)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
-       OD  
-       .{\<acute>I2 \<and> \<acute>found}.  
-  COEND  
-  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
-apply oghoare
---{* 20 vc *}
-apply auto
---{* auto takes aprox. 2 minutes. *}
-done
-
-subsection {* Producer/Consumer *}
-
-subsubsection {* Previous lemmas *}
-
-lemma nat_lemma2: "\<lbrakk> b = m*(n::nat) + t; a = s*n + u; t=u; b-a < n \<rbrakk> \<Longrightarrow> m \<le> s"
-proof -
-  assume "b = m*(n::nat) + t" "a = s*n + u" "t=u"
-  hence "(m - s) * n = b - a" by (simp add: diff_mult_distrib)
-  also assume "\<dots> < n"
-  finally have "m - s < 1" by simp
-  thus ?thesis by arith
-qed
-
-lemma mod_lemma: "\<lbrakk> (c::nat) \<le> a; a < b; b - c < n \<rbrakk> \<Longrightarrow> b mod n \<noteq> a mod n"
-apply(subgoal_tac "b=b div n*n + b mod n" )
- prefer 2  apply (simp add: mod_div_equality [symmetric])
-apply(subgoal_tac "a=a div n*n + a mod n")
- prefer 2
- apply(simp add: mod_div_equality [symmetric])
-apply(subgoal_tac "b - a \<le> b - c")
- prefer 2 apply arith
-apply(drule le_less_trans)
-back
- apply assumption
-apply(frule less_not_refl2)
-apply(drule less_imp_le)
-apply (drule_tac m = "a" and k = n in div_le_mono)
-apply(safe)
-apply(frule_tac b = "b" and a = "a" and n = "n" in nat_lemma2, assumption, assumption)
-apply assumption
-apply(drule order_antisym, assumption)
-apply(rotate_tac -3)
-apply(simp)
-done
-
-
-subsubsection {* Producer/Consumer Algorithm *}
-
-record Producer_consumer =
-  ins :: nat
-  outs :: nat
-  li :: nat
-  lj :: nat
-  vx :: nat
-  vy :: nat
-  buffer :: "nat list"
-  b :: "nat list"
-
-text {* The whole proof takes aprox. 4 minutes. *}
-
-lemma Producer_consumer: 
-  "\<lbrakk>INIT= \<guillemotleft>0<length a \<and> 0<length \<acute>buffer \<and> length \<acute>b=length a\<guillemotright> ;  
-    I= \<guillemotleft>(\<forall>k<\<acute>ins. \<acute>outs\<le>k \<longrightarrow> (a ! k) = \<acute>buffer ! (k mod (length \<acute>buffer))) \<and>  
-            \<acute>outs\<le>\<acute>ins \<and> \<acute>ins-\<acute>outs\<le>length \<acute>buffer\<guillemotright> ;  
-    I1= \<guillemotleft>\<acute>I \<and> \<acute>li\<le>length a\<guillemotright> ;  
-    p1= \<guillemotleft>\<acute>I1 \<and> \<acute>li=\<acute>ins\<guillemotright> ;  
-    I2 = \<guillemotleft>\<acute>I \<and> (\<forall>k<\<acute>lj. (a ! k)=(\<acute>b ! k)) \<and> \<acute>lj\<le>length a\<guillemotright> ;
-    p2 = \<guillemotleft>\<acute>I2 \<and> \<acute>lj=\<acute>outs\<guillemotright> \<rbrakk> \<Longrightarrow>   
-  \<parallel>- .{\<acute>INIT}.  
- \<acute>ins:=0,, \<acute>outs:=0,, \<acute>li:=0,, \<acute>lj:=0,,
- COBEGIN .{\<acute>p1 \<and> \<acute>INIT}. 
-   WHILE \<acute>li <length a 
-     INV .{\<acute>p1 \<and> \<acute>INIT}.   
-   DO .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a}.  
-       \<acute>vx:= (a ! \<acute>li);;  
-      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li)}. 
-        WAIT \<acute>ins-\<acute>outs < length \<acute>buffer END;; 
-      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li) 
-         \<and> \<acute>ins-\<acute>outs < length \<acute>buffer}. 
-       \<acute>buffer:=(list_update \<acute>buffer (\<acute>ins mod (length \<acute>buffer)) \<acute>vx);; 
-      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a 
-         \<and> (a ! \<acute>li)=(\<acute>buffer ! (\<acute>ins mod (length \<acute>buffer))) 
-         \<and> \<acute>ins-\<acute>outs <length \<acute>buffer}.  
-       \<acute>ins:=\<acute>ins+1;; 
-      .{\<acute>I1 \<and> \<acute>INIT \<and> (\<acute>li+1)=\<acute>ins \<and> \<acute>li<length a}.  
-       \<acute>li:=\<acute>li+1  
-   OD  
-  .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li=length a}.  
-  \<parallel>  
-  .{\<acute>p2 \<and> \<acute>INIT}.  
-   WHILE \<acute>lj < length a  
-     INV .{\<acute>p2 \<and> \<acute>INIT}.  
-   DO .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>INIT}.  
-        WAIT \<acute>outs<\<acute>ins END;; 
-      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>INIT}.  
-       \<acute>vy:=(\<acute>buffer ! (\<acute>outs mod (length \<acute>buffer)));; 
-      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
-       \<acute>outs:=\<acute>outs+1;;  
-      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
-       \<acute>b:=(list_update \<acute>b \<acute>lj \<acute>vy);; 
-      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> (a ! \<acute>lj)=(\<acute>b ! \<acute>lj) \<and> \<acute>INIT}.  
-       \<acute>lj:=\<acute>lj+1  
-   OD  
-  .{\<acute>p2 \<and> \<acute>lj=length a \<and> \<acute>INIT}.  
- COEND  
- .{ \<forall>k<length a. (a ! k)=(\<acute>b ! k)}."
-apply oghoare
---{* 138 vc  *}
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
---{* 112 subgoals left *}
-apply(simp_all (no_asm))
-apply(tactic {*ALLGOALS (conjI_Tac (K all_tac)) *})
---{* 930 subgoals left *}
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply(simp_all (asm_lr) only:length_0_conv [THEN sym])
---{* 44 subgoals left *}
-apply (simp_all (asm_lr) del:length_0_conv add: neq0_conv nth_list_update mod_less_divisor mod_lemma)
---{* 32 subgoals left *}
-apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
-
-apply(tactic {* TRYALL (Lin_Arith.tac @{context}) *})
---{* 9 subgoals left *}
-apply (force simp add:less_Suc_eq)
-apply(drule sym)
-apply (force simp add:less_Suc_eq)+
-done
-
-subsection {* Parameterized Examples *}
-
-subsubsection {* Set Elements of an Array to Zero *}
-
-record Example1 =
-  a :: "nat \<Rightarrow> nat"
-
-lemma Example1: 
- "\<parallel>- .{True}.
-   COBEGIN SCHEME [0\<le>i<n] .{True}. \<acute>a:=\<acute>a (i:=0) .{\<acute>a i=0}. COEND 
-  .{\<forall>i < n. \<acute>a i = 0}."
-apply oghoare
-apply simp_all
-done
-
-text {* Same example with lists as auxiliary variables. *}
-record Example1_list =
-  A :: "nat list"
-lemma Example1_list: 
- "\<parallel>- .{n < length \<acute>A}. 
-   COBEGIN 
-     SCHEME [0\<le>i<n] .{n < length \<acute>A}. \<acute>A:=\<acute>A[i:=0] .{\<acute>A!i=0}. 
-   COEND 
-    .{\<forall>i < n. \<acute>A!i = 0}."
-apply oghoare
-apply force+
-done
-
-subsubsection {* Increment a Variable in Parallel *}
-
-text {* First some lemmas about summation properties. *}
-(*
-lemma Example2_lemma1: "!!b. j<n \<Longrightarrow> (\<Sum>i::nat<n. b i) = (0::nat) \<Longrightarrow> b j = 0 "
-apply(induct n)
- apply simp_all
-apply(force simp add: less_Suc_eq)
-done
-*)
-lemma Example2_lemma2_aux: "!!b. j<n \<Longrightarrow> 
- (\<Sum>i=0..<n. (b i::nat)) =
- (\<Sum>i=0..<j. b i) + b j + (\<Sum>i=0..<n-(Suc j) . b (Suc j + i))"
-apply(induct n)
- apply simp_all
-apply(simp add:less_Suc_eq)
- apply(auto)
-apply(subgoal_tac "n - j = Suc(n- Suc j)")
-  apply simp
-apply arith
-done
-
-lemma Example2_lemma2_aux2: 
-  "!!b. j\<le> s \<Longrightarrow> (\<Sum>i::nat=0..<j. (b (s:=t)) i) = (\<Sum>i=0..<j. b i)"
-apply(induct j) 
- apply simp_all
-done
-
-lemma Example2_lemma2: 
- "!!b. \<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i::nat=0..<n. b i)=(\<Sum>i=0..<n. (b (j := Suc 0)) i)"
-apply(frule_tac b="(b (j:=(Suc 0)))" in Example2_lemma2_aux)
-apply(erule_tac  t="setsum (b(j := (Suc 0))) {0..<n}" in ssubst)
-apply(frule_tac b=b in Example2_lemma2_aux)
-apply(erule_tac  t="setsum b {0..<n}" in ssubst)
-apply(subgoal_tac "Suc (setsum b {0..<j} + b j + (\<Sum>i=0..<n - Suc j. b (Suc j + i)))=(setsum b {0..<j} + Suc (b j) + (\<Sum>i=0..<n - Suc j. b (Suc j + i)))")
-apply(rotate_tac -1)
-apply(erule ssubst)
-apply(subgoal_tac "j\<le>j")
- apply(drule_tac b="b" and t="(Suc 0)" in Example2_lemma2_aux2)
-apply(rotate_tac -1)
-apply(erule ssubst)
-apply simp_all
-done
-
-
-record Example2 = 
- c :: "nat \<Rightarrow> nat" 
- x :: nat
-
-lemma Example_2: "0<n \<Longrightarrow> 
- \<parallel>- .{\<acute>x=0 \<and> (\<Sum>i=0..<n. \<acute>c i)=0}.  
- COBEGIN 
-   SCHEME [0\<le>i<n] 
-  .{\<acute>x=(\<Sum>i=0..<n. \<acute>c i) \<and> \<acute>c i=0}. 
-   \<langle> \<acute>x:=\<acute>x+(Suc 0),, \<acute>c:=\<acute>c (i:=(Suc 0)) \<rangle>
-  .{\<acute>x=(\<Sum>i=0..<n. \<acute>c i) \<and> \<acute>c i=(Suc 0)}.
- COEND 
- .{\<acute>x=n}."
-apply oghoare
-apply (simp_all cong del: strong_setsum_cong)
-apply (tactic {* ALLGOALS (clarify_tac @{claset}) *})
-apply (simp_all cong del: strong_setsum_cong)
-   apply(erule (1) Example2_lemma2)
-  apply(erule (1) Example2_lemma2)
- apply(erule (1) Example2_lemma2)
-apply(simp)
-done
-
-end
--- a/src/HOL/HoareParallel/OG_Hoare.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,469 +0,0 @@
-
-header {* \section{The Proof System} *}
-
-theory OG_Hoare imports OG_Tran begin
-
-consts assertions :: "'a ann_com \<Rightarrow> ('a assn) set"
-primrec
-  "assertions (AnnBasic r f) = {r}"
-  "assertions (AnnSeq c1 c2) = assertions c1 \<union> assertions c2"
-  "assertions (AnnCond1 r b c1 c2) = {r} \<union> assertions c1 \<union> assertions c2"
-  "assertions (AnnCond2 r b c) = {r} \<union> assertions c"
-  "assertions (AnnWhile r b i c) = {r, i} \<union> assertions c"
-  "assertions (AnnAwait r b c) = {r}" 
-
-consts atomics :: "'a ann_com \<Rightarrow> ('a assn \<times> 'a com) set"       
-primrec
-  "atomics (AnnBasic r f) = {(r, Basic f)}"
-  "atomics (AnnSeq c1 c2) = atomics c1 \<union> atomics c2"
-  "atomics (AnnCond1 r b c1 c2) = atomics c1 \<union> atomics c2"
-  "atomics (AnnCond2 r b c) = atomics c"
-  "atomics (AnnWhile r b i c) = atomics c" 
-  "atomics (AnnAwait r b c) = {(r \<inter> b, c)}"
-
-consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
-primrec "com (c, q) = c"
-
-consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
-primrec "post (c, q) = q"
-
-constdefs  interfree_aux :: "('a ann_com_op \<times> 'a assn \<times> 'a ann_com_op) \<Rightarrow> bool"
-  "interfree_aux \<equiv> \<lambda>(co, q, co'). co'= None \<or>  
-                    (\<forall>(r,a) \<in> atomics (the co'). \<parallel>= (q \<inter> r) a q \<and>
-                    (co = None \<or> (\<forall>p \<in> assertions (the co). \<parallel>= (p \<inter> r) a p)))"
-
-constdefs interfree :: "(('a ann_triple_op) list) \<Rightarrow> bool" 
-  "interfree Ts \<equiv> \<forall>i j. i < length Ts \<and> j < length Ts \<and> i \<noteq> j \<longrightarrow> 
-                         interfree_aux (com (Ts!i), post (Ts!i), com (Ts!j)) "
-
-inductive
-  oghoare :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>- _//_//_)" [90,55,90] 50)
-  and ann_hoare :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(2\<turnstile> _// _)" [60,90] 45)
-where
-  AnnBasic: "r \<subseteq> {s. f s \<in> q} \<Longrightarrow> \<turnstile> (AnnBasic r f) q"
-
-| AnnSeq:   "\<lbrakk> \<turnstile> c0 pre c1; \<turnstile> c1 q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnSeq c0 c1) q"
-  
-| AnnCond1: "\<lbrakk> r \<inter> b \<subseteq> pre c1; \<turnstile> c1 q; r \<inter> -b \<subseteq> pre c2; \<turnstile> c2 q\<rbrakk> 
-              \<Longrightarrow> \<turnstile> (AnnCond1 r b c1 c2) q"
-| AnnCond2: "\<lbrakk> r \<inter> b \<subseteq> pre c; \<turnstile> c q; r \<inter> -b \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnCond2 r b c) q"
-  
-| AnnWhile: "\<lbrakk> r \<subseteq> i; i \<inter> b \<subseteq> pre c; \<turnstile> c i; i \<inter> -b \<subseteq> q \<rbrakk> 
-              \<Longrightarrow> \<turnstile> (AnnWhile r b i c) q"
-  
-| AnnAwait:  "\<lbrakk> atom_com c; \<parallel>- (r \<inter> b) c q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b c) q"
-  
-| AnnConseq: "\<lbrakk>\<turnstile> c q; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<turnstile> c q'"
-
-
-| Parallel: "\<lbrakk> \<forall>i<length Ts. \<exists>c q. Ts!i = (Some c, q) \<and> \<turnstile> c q; interfree Ts \<rbrakk>
-	   \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
-                     Parallel Ts 
-                  (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
-
-| Basic:   "\<parallel>- {s. f s \<in>q} (Basic f) q"
-  
-| Seq:    "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q "
-
-| Cond:   "\<lbrakk> \<parallel>- (p \<inter> b) c1 q; \<parallel>- (p \<inter> -b) c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
-
-| While:  "\<lbrakk> \<parallel>- (p \<inter> b) c p \<rbrakk> \<Longrightarrow> \<parallel>- p (While b i c) (p \<inter> -b)"
-
-| Conseq: "\<lbrakk> p' \<subseteq> p; \<parallel>- p c q ; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<parallel>- p' c q'"
-					    
-section {* Soundness *}
-(* In the version Isabelle-10-Sep-1999: HOL: The THEN and ELSE
-parts of conditional expressions (if P then x else y) are no longer
-simplified.  (This allows the simplifier to unfold recursive
-functional programs.)  To restore the old behaviour, we declare
-@{text "lemmas [cong del] = if_weak_cong"}. *)
-
-lemmas [cong del] = if_weak_cong
-
-lemmas ann_hoare_induct = oghoare_ann_hoare.induct [THEN conjunct2]
-lemmas oghoare_induct = oghoare_ann_hoare.induct [THEN conjunct1]
-
-lemmas AnnBasic = oghoare_ann_hoare.AnnBasic
-lemmas AnnSeq = oghoare_ann_hoare.AnnSeq
-lemmas AnnCond1 = oghoare_ann_hoare.AnnCond1
-lemmas AnnCond2 = oghoare_ann_hoare.AnnCond2
-lemmas AnnWhile = oghoare_ann_hoare.AnnWhile
-lemmas AnnAwait = oghoare_ann_hoare.AnnAwait
-lemmas AnnConseq = oghoare_ann_hoare.AnnConseq
-
-lemmas Parallel = oghoare_ann_hoare.Parallel
-lemmas Basic = oghoare_ann_hoare.Basic
-lemmas Seq = oghoare_ann_hoare.Seq
-lemmas Cond = oghoare_ann_hoare.Cond
-lemmas While = oghoare_ann_hoare.While
-lemmas Conseq = oghoare_ann_hoare.Conseq
-
-subsection {* Soundness of the System for Atomic Programs *}
-
-lemma Basic_ntran [rule_format]: 
- "(Basic f, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow> t = f s"
-apply(induct "n")
- apply(simp (no_asm))
-apply(fast dest: rel_pow_Suc_D2 Parallel_empty_lemma elim: transition_cases)
-done
-
-lemma SEM_fwhile: "SEM S (p \<inter> b) \<subseteq> p \<Longrightarrow> SEM (fwhile b S k) p \<subseteq> (p \<inter> -b)"
-apply (induct "k")
- apply(simp (no_asm) add: L3_5v_lemma3)
-apply(simp (no_asm) add: L3_5iv L3_5ii Parallel_empty)
-apply(rule conjI)
- apply (blast dest: L3_5i) 
-apply(simp add: SEM_def sem_def id_def)
-apply (blast dest: Basic_ntran rtrancl_imp_UN_rel_pow) 
-done
-
-lemma atom_hoare_sound [rule_format]: 
- " \<parallel>- p c q \<longrightarrow> atom_com(c) \<longrightarrow> \<parallel>= p c q"
-apply (unfold com_validity_def)
-apply(rule oghoare_induct)
-apply simp_all
---{*Basic*}
-    apply(simp add: SEM_def sem_def)
-    apply(fast dest: rtrancl_imp_UN_rel_pow Basic_ntran)
---{* Seq *}
-   apply(rule impI)
-   apply(rule subset_trans)
-    prefer 2 apply simp
-   apply(simp add: L3_5ii L3_5i)
---{* Cond *}
-  apply(simp add: L3_5iv)
---{* While *}
- apply (force simp add: L3_5v dest: SEM_fwhile) 
---{* Conseq *}
-apply(force simp add: SEM_def sem_def)
-done
-    
-subsection {* Soundness of the System for Component Programs *}
-
-inductive_cases ann_transition_cases:
-    "(None,s) -1\<rightarrow> (c', s')"
-    "(Some (AnnBasic r f),s) -1\<rightarrow> (c', s')"
-    "(Some (AnnSeq c1 c2), s) -1\<rightarrow> (c', s')"
-    "(Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (c', s')"
-    "(Some (AnnCond2 r b c), s) -1\<rightarrow> (c', s')"
-    "(Some (AnnWhile r b I c), s) -1\<rightarrow> (c', s')"
-    "(Some (AnnAwait r b c),s) -1\<rightarrow> (c', s')"
-
-text {* Strong Soundness for Component Programs:*}
-
-lemma ann_hoare_case_analysis [rule_format]: 
-  defines I: "I \<equiv> \<lambda>C q'.
-  ((\<forall>r f. C = AnnBasic r f \<longrightarrow> (\<exists>q. r \<subseteq> {s. f s \<in> q} \<and> q \<subseteq> q')) \<and>  
-  (\<forall>c0 c1. C = AnnSeq c0 c1 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<turnstile> c0 pre c1 \<and> \<turnstile> c1 q)) \<and>  
-  (\<forall>r b c1 c2. C = AnnCond1 r b c1 c2 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and>  
-  r \<inter> b \<subseteq> pre c1 \<and> \<turnstile> c1 q \<and> r \<inter> -b \<subseteq> pre c2 \<and> \<turnstile> c2 q)) \<and>  
-  (\<forall>r b c. C = AnnCond2 r b c \<longrightarrow> 
-  (\<exists>q. q \<subseteq> q' \<and> r \<inter> b \<subseteq> pre c  \<and> \<turnstile> c q \<and> r \<inter> -b \<subseteq> q)) \<and>  
-  (\<forall>r i b c. C = AnnWhile r b i c \<longrightarrow>  
-  (\<exists>q. q \<subseteq> q' \<and> r \<subseteq> i \<and> i \<inter> b \<subseteq> pre c \<and> \<turnstile> c i \<and> i \<inter> -b \<subseteq> q)) \<and>  
-  (\<forall>r b c. C = AnnAwait r b c \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<parallel>- (r \<inter> b) c q)))"
-  shows "\<turnstile> C q' \<longrightarrow> I C q'"
-apply(rule ann_hoare_induct)
-apply (simp_all add: I)
- apply(rule_tac x=q in exI,simp)+
-apply(rule conjI,clarify,simp,clarify,rule_tac x=qa in exI,fast)+
-apply(clarify,simp,clarify,rule_tac x=qa in exI,fast)
-done
-
-lemma Help: "(transition \<inter> {(x,y). True}) = (transition)"
-apply force
-done
-
-lemma Strong_Soundness_aux_aux [rule_format]: 
- "(co, s) -1\<rightarrow> (co', t) \<longrightarrow> (\<forall>c. co = Some c \<longrightarrow> s\<in> pre c \<longrightarrow> 
- (\<forall>q. \<turnstile> c q \<longrightarrow> (if co' = None then t\<in>q else t \<in> pre(the co') \<and> \<turnstile> (the co') q )))"
-apply(rule ann_transition_transition.induct [THEN conjunct1])
-apply simp_all 
---{* Basic *}
-         apply clarify
-         apply(frule ann_hoare_case_analysis)
-         apply force
---{* Seq *}
-        apply clarify
-        apply(frule ann_hoare_case_analysis,simp)
-        apply(fast intro: AnnConseq)
-       apply clarify
-       apply(frule ann_hoare_case_analysis,simp)
-       apply clarify
-       apply(rule conjI)
-        apply force
-       apply(rule AnnSeq,simp)
-       apply(fast intro: AnnConseq)
---{* Cond1 *}
-      apply clarify
-      apply(frule ann_hoare_case_analysis,simp)
-      apply(fast intro: AnnConseq)
-     apply clarify
-     apply(frule ann_hoare_case_analysis,simp)
-     apply(fast intro: AnnConseq)
---{* Cond2 *}
-    apply clarify
-    apply(frule ann_hoare_case_analysis,simp)
-    apply(fast intro: AnnConseq)
-   apply clarify
-   apply(frule ann_hoare_case_analysis,simp)
-   apply(fast intro: AnnConseq)
---{* While *}
-  apply clarify
-  apply(frule ann_hoare_case_analysis,simp)
-  apply force
- apply clarify
- apply(frule ann_hoare_case_analysis,simp)
- apply auto
- apply(rule AnnSeq)
-  apply simp
- apply(rule AnnWhile)
-  apply simp_all
---{* Await *}
-apply(frule ann_hoare_case_analysis,simp)
-apply clarify
-apply(drule atom_hoare_sound)
- apply simp 
-apply(simp add: com_validity_def SEM_def sem_def)
-apply(simp add: Help All_None_def)
-apply force
-done
-
-lemma Strong_Soundness_aux: "\<lbrakk> (Some c, s) -*\<rightarrow> (co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
-  \<Longrightarrow> if co = None then t \<in> q else t \<in> pre (the co) \<and> \<turnstile> (the co) q"
-apply(erule rtrancl_induct2)
- apply simp
-apply(case_tac "a")
- apply(fast elim: ann_transition_cases)
-apply(erule Strong_Soundness_aux_aux)
- apply simp
-apply simp_all
-done
-
-lemma Strong_Soundness: "\<lbrakk> (Some c, s)-*\<rightarrow>(co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
-  \<Longrightarrow> if co = None then t\<in>q else t \<in> pre (the co)"
-apply(force dest:Strong_Soundness_aux)
-done
-
-lemma ann_hoare_sound: "\<turnstile> c q  \<Longrightarrow> \<Turnstile> c q"
-apply (unfold ann_com_validity_def ann_SEM_def ann_sem_def)
-apply clarify
-apply(drule Strong_Soundness)
-apply simp_all
-done
-
-subsection {* Soundness of the System for Parallel Programs *}
-
-lemma Parallel_length_post_P1: "(Parallel Ts,s) -P1\<rightarrow> (R', t) \<Longrightarrow>  
-  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>
-  (\<forall>i. i<length Ts \<longrightarrow> post(Rs ! i) = post(Ts ! i)))"
-apply(erule transition_cases)
-apply simp
-apply clarify
-apply(case_tac "i=ia")
-apply simp+
-done
-
-lemma Parallel_length_post_PStar: "(Parallel Ts,s) -P*\<rightarrow> (R',t) \<Longrightarrow>   
-  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>  
-  (\<forall>i. i<length Ts \<longrightarrow> post(Ts ! i) = post(Rs ! i)))"
-apply(erule rtrancl_induct2)
- apply(simp_all)
-apply clarify
-apply simp
-apply(drule Parallel_length_post_P1)
-apply auto
-done
-
-lemma assertions_lemma: "pre c \<in> assertions c"
-apply(rule ann_com_com.induct [THEN conjunct1])
-apply auto
-done
-
-lemma interfree_aux1 [rule_format]: 
-  "(c,s) -1\<rightarrow> (r,t)  \<longrightarrow> (interfree_aux(c1, q1, c) \<longrightarrow> interfree_aux(c1, q1, r))"
-apply (rule ann_transition_transition.induct [THEN conjunct1])
-apply(safe)
-prefer 13
-apply (rule TrueI)
-apply (simp_all add:interfree_aux_def)
-apply force+
-done
-
-lemma interfree_aux2 [rule_format]: 
-  "(c,s) -1\<rightarrow> (r,t) \<longrightarrow> (interfree_aux(c, q, a)  \<longrightarrow> interfree_aux(r, q, a) )"
-apply (rule ann_transition_transition.induct [THEN conjunct1])
-apply(force simp add:interfree_aux_def)+
-done
-
-lemma interfree_lemma: "\<lbrakk> (Some c, s) -1\<rightarrow> (r, t);interfree Ts ; i<length Ts;  
-           Ts!i = (Some c, q) \<rbrakk> \<Longrightarrow> interfree (Ts[i:= (r, q)])"
-apply(simp add: interfree_def)
-apply clarify
-apply(case_tac "i=j")
- apply(drule_tac t = "ia" in not_sym)
- apply simp_all
-apply(force elim: interfree_aux1)
-apply(force elim: interfree_aux2 simp add:nth_list_update)
-done
-
-text {* Strong Soundness Theorem for Parallel Programs:*}
-
-lemma Parallel_Strong_Soundness_Seq_aux: 
-  "\<lbrakk>interfree Ts; i<length Ts; com(Ts ! i) = Some(AnnSeq c0 c1) \<rbrakk> 
-  \<Longrightarrow>  interfree (Ts[i:=(Some c0, pre c1)])"
-apply(simp add: interfree_def)
-apply clarify
-apply(case_tac "i=j")
- apply(force simp add: nth_list_update interfree_aux_def)
-apply(case_tac "i=ia")
- apply(erule_tac x=ia in allE)
- apply(force simp add:interfree_aux_def assertions_lemma)
-apply simp
-done
-
-lemma Parallel_Strong_Soundness_Seq [rule_format (no_asm)]: 
- "\<lbrakk> \<forall>i<length Ts. (if com(Ts!i) = None then b \<in> post(Ts!i) 
-  else b \<in> pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i));  
-  com(Ts ! i) = Some(AnnSeq c0 c1); i<length Ts; interfree Ts \<rbrakk> \<Longrightarrow> 
- (\<forall>ia<length Ts. (if com(Ts[i:=(Some c0, pre c1)]! ia) = None  
-  then b \<in> post(Ts[i:=(Some c0, pre c1)]! ia) 
- else b \<in> pre(the(com(Ts[i:=(Some c0, pre c1)]! ia))) \<and>  
- \<turnstile> the(com(Ts[i:=(Some c0, pre c1)]! ia)) post(Ts[i:=(Some c0, pre c1)]! ia))) 
-  \<and> interfree (Ts[i:= (Some c0, pre c1)])"
-apply(rule conjI)
- apply safe
- apply(case_tac "i=ia")
-  apply simp
-  apply(force dest: ann_hoare_case_analysis)
- apply simp
-apply(fast elim: Parallel_Strong_Soundness_Seq_aux)
-done
-
-lemma Parallel_Strong_Soundness_aux_aux [rule_format]: 
- "(Some c, b) -1\<rightarrow> (co, t) \<longrightarrow>  
-  (\<forall>Ts. i<length Ts \<longrightarrow> com(Ts ! i) = Some c \<longrightarrow>  
-  (\<forall>i<length Ts. (if com(Ts ! i) = None then b\<in>post(Ts!i)  
-  else b\<in>pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i))) \<longrightarrow>  
- interfree Ts \<longrightarrow>  
-  (\<forall>j. j<length Ts \<and> i\<noteq>j \<longrightarrow> (if com(Ts!j) = None then t\<in>post(Ts!j)  
-  else t\<in>pre(the(com(Ts!j))) \<and> \<turnstile> the(com(Ts!j)) post(Ts!j))) )"
-apply(rule ann_transition_transition.induct [THEN conjunct1])
-apply safe
-prefer 11
-apply(rule TrueI)
-apply simp_all
---{* Basic *}
-   apply(erule_tac x = "i" in all_dupE, erule (1) notE impE)
-   apply(erule_tac x = "j" in allE , erule (1) notE impE)
-   apply(simp add: interfree_def)
-   apply(erule_tac x = "j" in allE,simp)
-   apply(erule_tac x = "i" in allE,simp)
-   apply(drule_tac t = "i" in not_sym)
-   apply(case_tac "com(Ts ! j)=None")
-    apply(force intro: converse_rtrancl_into_rtrancl
-          simp add: interfree_aux_def com_validity_def SEM_def sem_def All_None_def)
-   apply(simp add:interfree_aux_def)
-   apply clarify
-   apply simp
-   apply(erule_tac x="pre y" in ballE)
-    apply(force intro: converse_rtrancl_into_rtrancl 
-          simp add: com_validity_def SEM_def sem_def All_None_def)
-   apply(simp add:assertions_lemma)
---{* Seqs *}
-  apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
-  apply(drule  Parallel_Strong_Soundness_Seq,simp+)
- apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
- apply(drule  Parallel_Strong_Soundness_Seq,simp+)
---{* Await *}
-apply(rule_tac x = "i" in allE , assumption , erule (1) notE impE)
-apply(erule_tac x = "j" in allE , erule (1) notE impE)
-apply(simp add: interfree_def)
-apply(erule_tac x = "j" in allE,simp)
-apply(erule_tac x = "i" in allE,simp)
-apply(drule_tac t = "i" in not_sym)
-apply(case_tac "com(Ts ! j)=None")
- apply(force intro: converse_rtrancl_into_rtrancl simp add: interfree_aux_def 
-        com_validity_def SEM_def sem_def All_None_def Help)
-apply(simp add:interfree_aux_def)
-apply clarify
-apply simp
-apply(erule_tac x="pre y" in ballE)
- apply(force intro: converse_rtrancl_into_rtrancl 
-       simp add: com_validity_def SEM_def sem_def All_None_def Help)
-apply(simp add:assertions_lemma)
-done
-
-lemma Parallel_Strong_Soundness_aux [rule_format]: 
- "\<lbrakk>(Ts',s) -P*\<rightarrow> (Rs',t);  Ts' = (Parallel Ts); interfree Ts;
- \<forall>i. i<length Ts \<longrightarrow> (\<exists>c q. (Ts ! i) = (Some c, q) \<and> s\<in>(pre c) \<and> \<turnstile> c q ) \<rbrakk> \<Longrightarrow>  
-  \<forall>Rs. Rs' = (Parallel Rs) \<longrightarrow> (\<forall>j. j<length Rs \<longrightarrow> 
-  (if com(Rs ! j) = None then t\<in>post(Ts ! j) 
-  else t\<in>pre(the(com(Rs ! j))) \<and> \<turnstile> the(com(Rs ! j)) post(Ts ! j))) \<and> interfree Rs"
-apply(erule rtrancl_induct2)
- apply clarify
---{* Base *}
- apply force
---{* Induction step *}
-apply clarify
-apply(drule Parallel_length_post_PStar)
-apply clarify
-apply (ind_cases "(Parallel Ts, s) -P1\<rightarrow> (Parallel Rs, t)" for Ts s Rs t)
-apply(rule conjI)
- apply clarify
- apply(case_tac "i=j")
-  apply(simp split del:split_if)
-  apply(erule Strong_Soundness_aux_aux,simp+)
-   apply force
-  apply force
- apply(simp split del: split_if)
- apply(erule Parallel_Strong_Soundness_aux_aux)
- apply(simp_all add: split del:split_if)
- apply force
-apply(rule interfree_lemma)
-apply simp_all
-done
-
-lemma Parallel_Strong_Soundness: 
- "\<lbrakk>(Parallel Ts, s) -P*\<rightarrow> (Parallel Rs, t); interfree Ts; j<length Rs; 
-  \<forall>i. i<length Ts \<longrightarrow> (\<exists>c q. Ts ! i = (Some c, q) \<and> s\<in>pre c \<and> \<turnstile> c q) \<rbrakk> \<Longrightarrow>  
-  if com(Rs ! j) = None then t\<in>post(Ts ! j) else t\<in>pre (the(com(Rs ! j)))"
-apply(drule  Parallel_Strong_Soundness_aux)
-apply simp+
-done
-
-lemma oghoare_sound [rule_format]: "\<parallel>- p c q \<longrightarrow> \<parallel>= p c q"
-apply (unfold com_validity_def)
-apply(rule oghoare_induct)
-apply(rule TrueI)+
---{* Parallel *}     
-      apply(simp add: SEM_def sem_def)
-      apply clarify
-      apply(frule Parallel_length_post_PStar)
-      apply clarify
-      apply(drule_tac j=xb in Parallel_Strong_Soundness)
-         apply clarify
-        apply simp
-       apply force
-      apply simp
-      apply(erule_tac V = "\<forall>i. ?P i" in thin_rl)
-      apply(drule_tac s = "length Rs" in sym)
-      apply(erule allE, erule impE, assumption)
-      apply(force dest: nth_mem simp add: All_None_def)
---{* Basic *}
-    apply(simp add: SEM_def sem_def)
-    apply(force dest: rtrancl_imp_UN_rel_pow Basic_ntran)
---{* Seq *}
-   apply(rule subset_trans)
-    prefer 2 apply assumption
-   apply(simp add: L3_5ii L3_5i)
---{* Cond *}
-  apply(simp add: L3_5iv)
---{* While *}
- apply(simp add: L3_5v)
- apply (blast dest: SEM_fwhile) 
---{* Conseq *}
-apply(auto simp add: SEM_def sem_def)
-done
-
-end
\ No newline at end of file
--- a/src/HOL/HoareParallel/OG_Syntax.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,140 +0,0 @@
-theory OG_Syntax
-imports OG_Tactics Quote_Antiquote
-begin
-
-text{* Syntax for commands and for assertions and boolean expressions in 
- commands @{text com} and annotated commands @{text ann_com}. *}
-
-syntax
-  "_Assign"      :: "idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(\<acute>_ :=/ _)" [70, 65] 61)
-  "_AnnAssign"   :: "'a assn \<Rightarrow> idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(_ \<acute>_ :=/ _)" [90,70,65] 61)
-
-translations
-  "\<acute>\<spacespace>x := a" \<rightharpoonup> "Basic \<guillemotleft>\<acute>\<spacespace>(_update_name x (\<lambda>_. a))\<guillemotright>"
-  "r \<acute>\<spacespace>x := a" \<rightharpoonup> "AnnBasic r \<guillemotleft>\<acute>\<spacespace>(_update_name x (\<lambda>_. a))\<guillemotright>"
-
-syntax
-  "_AnnSkip"     :: "'a assn \<Rightarrow> 'a ann_com"              ("_//SKIP" [90] 63)
-  "_AnnSeq"      :: "'a ann_com \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"  ("_;;/ _" [60,61] 60)
-  
-  "_AnnCond1"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
-                    ("_ //IF _ /THEN _ /ELSE _ /FI"  [90,0,0,0] 61)
-  "_AnnCond2"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
-                    ("_ //IF _ /THEN _ /FI"  [90,0,0] 61)
-  "_AnnWhile"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a assn \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com" 
-                    ("_ //WHILE _ /INV _ //DO _//OD"  [90,0,0,0] 61)
-  "_AnnAwait"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"
-                    ("_ //AWAIT _ /THEN /_ /END"  [90,0,0] 61)
-  "_AnnAtom"     :: "'a assn  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"   ("_//\<langle>_\<rangle>" [90,0] 61)
-  "_AnnWait"     :: "'a assn \<Rightarrow> 'a bexp \<Rightarrow> 'a ann_com"   ("_//WAIT _ END" [90,0] 61)
-
-  "_Skip"        :: "'a com"                 ("SKIP" 63)
-  "_Seq"         :: "'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" ("_,,/ _" [55, 56] 55)
-  "_Cond"        :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" 
-                                  ("(0IF _/ THEN _/ ELSE _/ FI)" [0, 0, 0] 61)
-  "_Cond2"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"   ("IF _ THEN _ FI" [0,0] 56)
-  "_While_inv"   :: "'a bexp \<Rightarrow> 'a assn \<Rightarrow> 'a com \<Rightarrow> 'a com"
-                    ("(0WHILE _/ INV _ //DO _ /OD)"  [0, 0, 0] 61)
-  "_While"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"
-                    ("(0WHILE _ //DO _ /OD)"  [0, 0] 61)
-
-translations
-  "SKIP" \<rightleftharpoons> "Basic id"
-  "c_1,, c_2" \<rightleftharpoons> "Seq c_1 c_2"
-
-  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "Cond .{b}. c1 c2"
-  "IF b THEN c FI" \<rightleftharpoons> "IF b THEN c ELSE SKIP FI"
-  "WHILE b INV i DO c OD" \<rightharpoonup> "While .{b}. i c"
-  "WHILE b DO c OD" \<rightleftharpoons> "WHILE b INV CONST undefined DO c OD"
-
-  "r SKIP" \<rightleftharpoons> "AnnBasic r id"
-  "c_1;; c_2" \<rightleftharpoons> "AnnSeq c_1 c_2" 
-  "r IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "AnnCond1 r .{b}. c1 c2"
-  "r IF b THEN c FI" \<rightharpoonup> "AnnCond2 r .{b}. c"
-  "r WHILE b INV i DO c OD" \<rightharpoonup> "AnnWhile r .{b}. i c"
-  "r AWAIT b THEN c END" \<rightharpoonup> "AnnAwait r .{b}. c"
-  "r \<langle>c\<rangle>" \<rightleftharpoons> "r AWAIT True THEN c END"
-  "r WAIT b END" \<rightleftharpoons> "r AWAIT b THEN SKIP END"
- 
-nonterminals
-  prgs
-
-syntax
-  "_PAR" :: "prgs \<Rightarrow> 'a"              ("COBEGIN//_//COEND" [57] 56)
-  "_prg" :: "['a, 'a] \<Rightarrow> prgs"        ("_//_" [60, 90] 57)
-  "_prgs" :: "['a, 'a, prgs] \<Rightarrow> prgs"  ("_//_//\<parallel>//_" [60,90,57] 57)
-
-  "_prg_scheme" :: "['a, 'a, 'a, 'a, 'a] \<Rightarrow> prgs"  
-                  ("SCHEME [_ \<le> _ < _] _// _" [0,0,0,60, 90] 57)
-
-translations
-  "_prg c q" \<rightleftharpoons> "[(Some c, q)]"
-  "_prgs c q ps" \<rightleftharpoons> "(Some c, q) # ps"
-  "_PAR ps" \<rightleftharpoons> "Parallel ps"
-
-  "_prg_scheme j i k c q" \<rightleftharpoons> "map (\<lambda>i. (Some c, q)) [j..<k]"
-
-print_translation {*
-  let
-    fun quote_tr' f (t :: ts) =
-          Term.list_comb (f $ Syntax.quote_tr' "_antiquote" t, ts)
-      | quote_tr' _ _ = raise Match;
-
-    fun annquote_tr' f (r :: t :: ts) =
-          Term.list_comb (f $ r $ Syntax.quote_tr' "_antiquote" t, ts)
-      | annquote_tr' _ _ = raise Match;
-
-    val assert_tr' = quote_tr' (Syntax.const "_Assert");
-
-    fun bexp_tr' name ((Const ("Collect", _) $ t) :: ts) =
-          quote_tr' (Syntax.const name) (t :: ts)
-      | bexp_tr' _ _ = raise Match;
-
-    fun annbexp_tr' name (r :: (Const ("Collect", _) $ t) :: ts) =
-          annquote_tr' (Syntax.const name) (r :: t :: ts)
-      | annbexp_tr' _ _ = raise Match;
-
-    fun upd_tr' (x_upd, T) =
-      (case try (unsuffix Record.updateN) x_upd of
-        SOME x => (x, if T = dummyT then T else Term.domain_type T)
-      | NONE => raise Match);
-
-    fun update_name_tr' (Free x) = Free (upd_tr' x)
-      | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
-          c $ Free (upd_tr' x)
-      | update_name_tr' (Const x) = Const (upd_tr' x)
-      | update_name_tr' _ = raise Match;
-
-    fun K_tr' (Abs (_,_,t)) = if null (loose_bnos t) then t else raise Match
-      | K_tr' (Abs (_,_,Abs (_,_,t)$Bound 0)) = if null (loose_bnos t) then t else raise Match
-      | K_tr' _ = raise Match;
-
-    fun assign_tr' (Abs (x, _, f $ k $ Bound 0) :: ts) =
-          quote_tr' (Syntax.const "_Assign" $ update_name_tr' f)
-            (Abs (x, dummyT, K_tr' k) :: ts)
-      | assign_tr' _ = raise Match;
-
-    fun annassign_tr' (r :: Abs (x, _, f $ k $ Bound 0) :: ts) =
-          quote_tr' (Syntax.const "_AnnAssign" $ r $ update_name_tr' f)
-            (Abs (x, dummyT, K_tr' k) :: ts)
-      | annassign_tr' _ = raise Match;
-
-    fun Parallel_PAR [(Const ("Cons",_) $ (Const ("Pair",_) $ (Const ("Some",_) $ t1 ) $ t2) $ Const ("Nil",_))] = 
-                   (Syntax.const "_prg" $ t1 $ t2)
-      | Parallel_PAR [(Const ("Cons",_) $ (Const ("Pair",_) $ (Const ("Some",_) $ t1) $ t2) $ ts)] =
-                     (Syntax.const "_prgs" $ t1 $ t2 $ Parallel_PAR [ts])
-      | Parallel_PAR _ = raise Match;
-
-fun Parallel_tr' ts = Syntax.const "_PAR" $ Parallel_PAR ts;
-  in
-    [("Collect", assert_tr'), ("Basic", assign_tr'), 
-      ("Cond", bexp_tr' "_Cond"), ("While", bexp_tr' "_While_inv"),
-      ("AnnBasic", annassign_tr'), 
-      ("AnnWhile", annbexp_tr' "_AnnWhile"), ("AnnAwait", annbexp_tr' "_AnnAwait"),
-      ("AnnCond1", annbexp_tr' "_AnnCond1"), ("AnnCond2", annbexp_tr' "_AnnCond2")]
-
-  end
-
-*}
-
-end
\ No newline at end of file
--- a/src/HOL/HoareParallel/OG_Tactics.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,496 +0,0 @@
-header {* \section{Generation of Verification Conditions} *}
-
-theory OG_Tactics
-imports OG_Hoare
-begin
-
-lemmas ann_hoare_intros=AnnBasic AnnSeq AnnCond1 AnnCond2 AnnWhile AnnAwait AnnConseq
-lemmas oghoare_intros=Parallel Basic Seq Cond While Conseq
-
-lemma ParallelConseqRule: 
- "\<lbrakk> p \<subseteq> (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts ! i))));  
-  \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts ! i)))) 
-      (Parallel Ts) 
-     (\<Inter>i\<in>{i. i<length Ts}. post(Ts ! i));  
-  (\<Inter>i\<in>{i. i<length Ts}. post(Ts ! i)) \<subseteq> q \<rbrakk>  
-  \<Longrightarrow> \<parallel>- p (Parallel Ts) q"
-apply (rule Conseq)
-prefer 2 
- apply fast
-apply assumption+
-done
-
-lemma SkipRule: "p \<subseteq> q \<Longrightarrow> \<parallel>- p (Basic id) q"
-apply(rule oghoare_intros)
-  prefer 2 apply(rule Basic)
- prefer 2 apply(rule subset_refl)
-apply(simp add:Id_def)
-done
-
-lemma BasicRule: "p \<subseteq> {s. (f s)\<in>q} \<Longrightarrow> \<parallel>- p (Basic f) q"
-apply(rule oghoare_intros)
-  prefer 2 apply(rule oghoare_intros)
- prefer 2 apply(rule subset_refl)
-apply assumption
-done
-
-lemma SeqRule: "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q"
-apply(rule Seq)
-apply fast+
-done
-
-lemma CondRule: 
- "\<lbrakk> p \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>w) \<and> (s\<notin>b \<longrightarrow> s\<in>w')}; \<parallel>- w c1 q; \<parallel>- w' c2 q \<rbrakk> 
-  \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
-apply(rule Cond)
- apply(rule Conseq)
- prefer 4 apply(rule Conseq)
-apply simp_all
-apply force+
-done
-
-lemma WhileRule: "\<lbrakk> p \<subseteq> i; \<parallel>- (i \<inter> b) c i ; (i \<inter> (-b)) \<subseteq> q \<rbrakk>  
-        \<Longrightarrow> \<parallel>- p (While b i c) q"
-apply(rule Conseq)
- prefer 2 apply(rule While)
-apply assumption+
-done
-
-text {* Three new proof rules for special instances of the @{text
-AnnBasic} and the @{text AnnAwait} commands when the transformation
-performed on the state is the identity, and for an @{text AnnAwait}
-command where the boolean condition is @{text "{s. True}"}: *}
-
-lemma AnnatomRule:
-  "\<lbrakk> atom_com(c); \<parallel>- r c q \<rbrakk>  \<Longrightarrow> \<turnstile> (AnnAwait r {s. True} c) q"
-apply(rule AnnAwait)
-apply simp_all
-done
-
-lemma AnnskipRule:
-  "r \<subseteq> q \<Longrightarrow> \<turnstile> (AnnBasic r id) q"
-apply(rule AnnBasic)
-apply simp
-done
-
-lemma AnnwaitRule:
-  "\<lbrakk> (r \<inter> b) \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b (Basic id)) q"
-apply(rule AnnAwait)
- apply simp
-apply(rule BasicRule)
-apply simp
-done
-
-text {* Lemmata to avoid using the definition of @{text
-map_ann_hoare}, @{text interfree_aux}, @{text interfree_swap} and
-@{text interfree} by splitting it into different cases: *}
-
-lemma interfree_aux_rule1: "interfree_aux(co, q, None)"
-by(simp add:interfree_aux_def)
-
-lemma interfree_aux_rule2: 
-  "\<forall>(R,r)\<in>(atomics a). \<parallel>- (q \<inter> R) r q \<Longrightarrow> interfree_aux(None, q, Some a)"
-apply(simp add:interfree_aux_def)
-apply(force elim:oghoare_sound)
-done
-
-lemma interfree_aux_rule3: 
-  "(\<forall>(R, r)\<in>(atomics a). \<parallel>- (q \<inter> R) r q \<and> (\<forall>p\<in>(assertions c). \<parallel>- (p \<inter> R) r p))
-  \<Longrightarrow> interfree_aux(Some c, q, Some a)"
-apply(simp add:interfree_aux_def)
-apply(force elim:oghoare_sound)
-done
-
-lemma AnnBasic_assertions: 
-  "\<lbrakk>interfree_aux(None, r, Some a); interfree_aux(None, q, Some a)\<rbrakk> \<Longrightarrow> 
-    interfree_aux(Some (AnnBasic r f), q, Some a)"
-apply(simp add: interfree_aux_def)
-by force
-
-lemma AnnSeq_assertions: 
-  "\<lbrakk> interfree_aux(Some c1, q, Some a); interfree_aux(Some c2, q, Some a)\<rbrakk>\<Longrightarrow> 
-   interfree_aux(Some (AnnSeq c1 c2), q, Some a)"
-apply(simp add: interfree_aux_def)
-by force
-
-lemma AnnCond1_assertions: 
-  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(Some c1, q, Some a); 
-  interfree_aux(Some c2, q, Some a)\<rbrakk>\<Longrightarrow> 
-  interfree_aux(Some(AnnCond1 r b c1 c2), q, Some a)"
-apply(simp add: interfree_aux_def)
-by force
-
-lemma AnnCond2_assertions: 
-  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(Some c, q, Some a)\<rbrakk>\<Longrightarrow> 
-  interfree_aux(Some (AnnCond2 r b c), q, Some a)"
-apply(simp add: interfree_aux_def)
-by force
-
-lemma AnnWhile_assertions: 
-  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(None, i, Some a); 
-  interfree_aux(Some c, q, Some a)\<rbrakk>\<Longrightarrow> 
-  interfree_aux(Some (AnnWhile r b i c), q, Some a)"
-apply(simp add: interfree_aux_def)
-by force
- 
-lemma AnnAwait_assertions: 
-  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(None, q, Some a)\<rbrakk>\<Longrightarrow> 
-  interfree_aux(Some (AnnAwait r b c), q, Some a)"
-apply(simp add: interfree_aux_def)
-by force
- 
-lemma AnnBasic_atomics: 
-  "\<parallel>- (q \<inter> r) (Basic f) q \<Longrightarrow> interfree_aux(None, q, Some (AnnBasic r f))"
-by(simp add: interfree_aux_def oghoare_sound)
-
-lemma AnnSeq_atomics: 
-  "\<lbrakk> interfree_aux(Any, q, Some a1); interfree_aux(Any, q, Some a2)\<rbrakk>\<Longrightarrow> 
-  interfree_aux(Any, q, Some (AnnSeq a1 a2))"
-apply(simp add: interfree_aux_def)
-by force
-
-lemma AnnCond1_atomics:
-  "\<lbrakk> interfree_aux(Any, q, Some a1); interfree_aux(Any, q, Some a2)\<rbrakk>\<Longrightarrow> 
-   interfree_aux(Any, q, Some (AnnCond1 r b a1 a2))"
-apply(simp add: interfree_aux_def)
-by force
-
-lemma AnnCond2_atomics: 
-  "interfree_aux (Any, q, Some a)\<Longrightarrow> interfree_aux(Any, q, Some (AnnCond2 r b a))"
-by(simp add: interfree_aux_def)
-
-lemma AnnWhile_atomics: "interfree_aux (Any, q, Some a) 
-     \<Longrightarrow> interfree_aux(Any, q, Some (AnnWhile r b i a))"
-by(simp add: interfree_aux_def)
-
-lemma Annatom_atomics: 
-  "\<parallel>- (q \<inter> r) a q \<Longrightarrow> interfree_aux (None, q, Some (AnnAwait r {x. True} a))"
-by(simp add: interfree_aux_def oghoare_sound) 
-
-lemma AnnAwait_atomics: 
-  "\<parallel>- (q \<inter> (r \<inter> b)) a q \<Longrightarrow> interfree_aux (None, q, Some (AnnAwait r b a))"
-by(simp add: interfree_aux_def oghoare_sound)
-
-constdefs 
-  interfree_swap :: "('a ann_triple_op * ('a ann_triple_op) list) \<Rightarrow> bool"
-  "interfree_swap == \<lambda>(x, xs). \<forall>y\<in>set xs. interfree_aux (com x, post x, com y)
-  \<and> interfree_aux(com y, post y, com x)"
-
-lemma interfree_swap_Empty: "interfree_swap (x, [])"
-by(simp add:interfree_swap_def)
-
-lemma interfree_swap_List:  
-  "\<lbrakk> interfree_aux (com x, post x, com y); 
-  interfree_aux (com y, post y ,com x); interfree_swap (x, xs) \<rbrakk> 
-  \<Longrightarrow> interfree_swap (x, y#xs)"
-by(simp add:interfree_swap_def)
-
-lemma interfree_swap_Map: "\<forall>k. i\<le>k \<and> k<j \<longrightarrow> interfree_aux (com x, post x, c k) 
- \<and> interfree_aux (c k, Q k, com x)   
- \<Longrightarrow> interfree_swap (x, map (\<lambda>k. (c k, Q k)) [i..<j])"
-by(force simp add: interfree_swap_def less_diff_conv)
-
-lemma interfree_Empty: "interfree []"
-by(simp add:interfree_def)
-
-lemma interfree_List: 
-  "\<lbrakk> interfree_swap(x, xs); interfree xs \<rbrakk> \<Longrightarrow> interfree (x#xs)"
-apply(simp add:interfree_def interfree_swap_def)
-apply clarify
-apply(case_tac i)
- apply(case_tac j)
-  apply simp_all
-apply(case_tac j,simp+)
-done
-
-lemma interfree_Map: 
-  "(\<forall>i j. a\<le>i \<and> i<b \<and> a\<le>j \<and> j<b  \<and> i\<noteq>j \<longrightarrow> interfree_aux (c i, Q i, c j))  
-  \<Longrightarrow> interfree (map (\<lambda>k. (c k, Q k)) [a..<b])"
-by(force simp add: interfree_def less_diff_conv)
-
-constdefs map_ann_hoare :: "(('a ann_com_op * 'a assn) list) \<Rightarrow> bool " ("[\<turnstile>] _" [0] 45)
-  "[\<turnstile>] Ts == (\<forall>i<length Ts. \<exists>c q. Ts!i=(Some c, q) \<and> \<turnstile> c q)"
-
-lemma MapAnnEmpty: "[\<turnstile>] []"
-by(simp add:map_ann_hoare_def)
-
-lemma MapAnnList: "\<lbrakk> \<turnstile> c q ; [\<turnstile>] xs \<rbrakk> \<Longrightarrow> [\<turnstile>] (Some c,q)#xs"
-apply(simp add:map_ann_hoare_def)
-apply clarify
-apply(case_tac i,simp+)
-done
-
-lemma MapAnnMap: 
-  "\<forall>k. i\<le>k \<and> k<j \<longrightarrow> \<turnstile> (c k) (Q k) \<Longrightarrow> [\<turnstile>] map (\<lambda>k. (Some (c k), Q k)) [i..<j]"
-apply(simp add: map_ann_hoare_def less_diff_conv)
-done
-
-lemma ParallelRule:"\<lbrakk> [\<turnstile>] Ts ; interfree Ts \<rbrakk>
-  \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
-          Parallel Ts 
-        (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
-apply(rule Parallel)
- apply(simp add:map_ann_hoare_def)
-apply simp
-done
-(*
-lemma ParamParallelRule:
- "\<lbrakk> \<forall>k<n. \<turnstile> (c k) (Q k); 
-   \<forall>k l. k<n \<and> l<n  \<and> k\<noteq>l \<longrightarrow> interfree_aux (Some(c k), Q k, Some(c l)) \<rbrakk>
-  \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<n} . pre(c i)) COBEGIN SCHEME [0\<le>i<n] (c i) (Q i) COEND  (\<Inter>i\<in>{i. i<n} . Q i )"
-apply(rule ParallelConseqRule)
-  apply simp
-  apply clarify
-  apply force
- apply(rule ParallelRule)
-  apply(rule MapAnnMap)
-  apply simp
- apply(rule interfree_Map)
- apply simp
-apply simp
-apply clarify
-apply force
-done
-*)
-
-text {* The following are some useful lemmas and simplification
-tactics to control which theorems are used to simplify at each moment,
-so that the original input does not suffer any unexpected
-transformation. *}
-
-lemma Compl_Collect: "-(Collect b) = {x. \<not>(b x)}"
-by fast
-lemma list_length: "length []=0 \<and> length (x#xs) = Suc(length xs)"
-by simp
-lemma list_lemmas: "length []=0 \<and> length (x#xs) = Suc(length xs) 
-\<and> (x#xs) ! 0=x \<and> (x#xs) ! Suc n = xs ! n"
-by simp
-lemma le_Suc_eq_insert: "{i. i <Suc n} = insert n {i. i< n}"
-by auto
-lemmas primrecdef_list = "pre.simps" "assertions.simps" "atomics.simps" "atom_com.simps"
-lemmas my_simp_list = list_lemmas fst_conv snd_conv
-not_less0 refl le_Suc_eq_insert Suc_not_Zero Zero_not_Suc nat.inject
-Collect_mem_eq ball_simps option.simps primrecdef_list
-lemmas ParallelConseq_list = INTER_def Collect_conj_eq length_map length_upt length_append list_length
-
-ML {*
-val before_interfree_simp_tac = (simp_tac (HOL_basic_ss addsimps [thm "com.simps", thm "post.simps"]))
-
-val  interfree_simp_tac = (asm_simp_tac (HOL_ss addsimps [thm "split", thm "ball_Un", thm "ball_empty"]@(thms "my_simp_list")))
-
-val ParallelConseq = (simp_tac (HOL_basic_ss addsimps (thms "ParallelConseq_list")@(thms "my_simp_list")))
-*}
-
-text {* The following tactic applies @{text tac} to each conjunct in a
-subgoal of the form @{text "A \<Longrightarrow> a1 \<and> a2 \<and> .. \<and> an"}  returning
-@{text n} subgoals, one for each conjunct: *}
-
-ML {*
-fun conjI_Tac tac i st = st |>
-       ( (EVERY [rtac conjI i,
-          conjI_Tac tac (i+1),
-          tac i]) ORELSE (tac i) )
-*}
-
-
-subsubsection {* Tactic for the generation of the verification conditions *} 
-
-text {* The tactic basically uses two subtactics:
-
-\begin{description}
-
-\item[HoareRuleTac] is called at the level of parallel programs, it        
- uses the ParallelTac to solve parallel composition of programs.         
- This verification has two parts, namely, (1) all component programs are 
- correct and (2) they are interference free.  @{text HoareRuleTac} is
- also called at the level of atomic regions, i.e.  @{text "\<langle> \<rangle>"} and
- @{text "AWAIT b THEN _ END"}, and at each interference freedom test.
-
-\item[AnnHoareRuleTac] is for component programs which  
- are annotated programs and so, there are not unknown assertions         
- (no need to use the parameter precond, see NOTE).
-
- NOTE: precond(::bool) informs if the subgoal has the form @{text "\<parallel>- ?p c q"},
- in this case we have precond=False and the generated  verification     
- condition would have the form @{text "?p \<subseteq> \<dots>"} which can be solved by        
- @{text "rtac subset_refl"}, if True we proceed to simplify it using
- the simplification tactics above.
-
-\end{description}
-*}
-
-ML {*
-
- fun WlpTac i = (rtac (@{thm SeqRule}) i) THEN (HoareRuleTac false (i+1))
-and HoareRuleTac precond i st = st |>  
-    ( (WlpTac i THEN HoareRuleTac precond i)
-      ORELSE
-      (FIRST[rtac (@{thm SkipRule}) i,
-             rtac (@{thm BasicRule}) i,
-             EVERY[rtac (@{thm ParallelConseqRule}) i,
-                   ParallelConseq (i+2),
-                   ParallelTac (i+1),
-                   ParallelConseq i], 
-             EVERY[rtac (@{thm CondRule}) i,
-                   HoareRuleTac false (i+2),
-                   HoareRuleTac false (i+1)],
-             EVERY[rtac (@{thm WhileRule}) i,
-                   HoareRuleTac true (i+1)],
-             K all_tac i ]
-       THEN (if precond then (K all_tac i) else (rtac (@{thm subset_refl}) i))))
-
-and  AnnWlpTac i = (rtac (@{thm AnnSeq}) i) THEN (AnnHoareRuleTac (i+1))
-and AnnHoareRuleTac i st = st |>  
-    ( (AnnWlpTac i THEN AnnHoareRuleTac i )
-     ORELSE
-      (FIRST[(rtac (@{thm AnnskipRule}) i),
-             EVERY[rtac (@{thm AnnatomRule}) i,
-                   HoareRuleTac true (i+1)],
-             (rtac (@{thm AnnwaitRule}) i),
-             rtac (@{thm AnnBasic}) i,
-             EVERY[rtac (@{thm AnnCond1}) i,
-                   AnnHoareRuleTac (i+3),
-                   AnnHoareRuleTac (i+1)],
-             EVERY[rtac (@{thm AnnCond2}) i,
-                   AnnHoareRuleTac (i+1)],
-             EVERY[rtac (@{thm AnnWhile}) i,
-                   AnnHoareRuleTac (i+2)],
-             EVERY[rtac (@{thm AnnAwait}) i,
-                   HoareRuleTac true (i+1)],
-             K all_tac i]))
-
-and ParallelTac i = EVERY[rtac (@{thm ParallelRule}) i,
-                          interfree_Tac (i+1),
-                           MapAnn_Tac i]
-
-and MapAnn_Tac i st = st |>
-    (FIRST[rtac (@{thm MapAnnEmpty}) i,
-           EVERY[rtac (@{thm MapAnnList}) i,
-                 MapAnn_Tac (i+1),
-                 AnnHoareRuleTac i],
-           EVERY[rtac (@{thm MapAnnMap}) i,
-                 rtac (@{thm allI}) i,rtac (@{thm impI}) i,
-                 AnnHoareRuleTac i]])
-
-and interfree_swap_Tac i st = st |>
-    (FIRST[rtac (@{thm interfree_swap_Empty}) i,
-           EVERY[rtac (@{thm interfree_swap_List}) i,
-                 interfree_swap_Tac (i+2),
-                 interfree_aux_Tac (i+1),
-                 interfree_aux_Tac i ],
-           EVERY[rtac (@{thm interfree_swap_Map}) i,
-                 rtac (@{thm allI}) i,rtac (@{thm impI}) i,
-                 conjI_Tac (interfree_aux_Tac) i]])
-
-and interfree_Tac i st = st |> 
-   (FIRST[rtac (@{thm interfree_Empty}) i,
-          EVERY[rtac (@{thm interfree_List}) i,
-                interfree_Tac (i+1),
-                interfree_swap_Tac i],
-          EVERY[rtac (@{thm interfree_Map}) i,
-                rtac (@{thm allI}) i,rtac (@{thm allI}) i,rtac (@{thm impI}) i,
-                interfree_aux_Tac i ]])
-
-and interfree_aux_Tac i = (before_interfree_simp_tac i ) THEN 
-        (FIRST[rtac (@{thm interfree_aux_rule1}) i,
-               dest_assertions_Tac i])
-
-and dest_assertions_Tac i st = st |>
-    (FIRST[EVERY[rtac (@{thm AnnBasic_assertions}) i,
-                 dest_atomics_Tac (i+1),
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnSeq_assertions}) i,
-                 dest_assertions_Tac (i+1),
-                 dest_assertions_Tac i],
-           EVERY[rtac (@{thm AnnCond1_assertions}) i,
-                 dest_assertions_Tac (i+2),
-                 dest_assertions_Tac (i+1),
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnCond2_assertions}) i,
-                 dest_assertions_Tac (i+1),
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnWhile_assertions}) i,
-                 dest_assertions_Tac (i+2),
-                 dest_atomics_Tac (i+1),
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnAwait_assertions}) i,
-                 dest_atomics_Tac (i+1),
-                 dest_atomics_Tac i],
-           dest_atomics_Tac i])
-
-and dest_atomics_Tac i st = st |>
-    (FIRST[EVERY[rtac (@{thm AnnBasic_atomics}) i,
-                 HoareRuleTac true i],
-           EVERY[rtac (@{thm AnnSeq_atomics}) i,
-                 dest_atomics_Tac (i+1),
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnCond1_atomics}) i,
-                 dest_atomics_Tac (i+1),
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnCond2_atomics}) i,
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm AnnWhile_atomics}) i,
-                 dest_atomics_Tac i],
-           EVERY[rtac (@{thm Annatom_atomics}) i,
-                 HoareRuleTac true i],
-           EVERY[rtac (@{thm AnnAwait_atomics}) i,
-                 HoareRuleTac true i],
-                 K all_tac i])
-*}
-
-
-text {* The final tactic is given the name @{text oghoare}: *}
-
-ML {* 
-val oghoare_tac = SUBGOAL (fn (_, i) =>
-   (HoareRuleTac true i))
-*}
-
-text {* Notice that the tactic for parallel programs @{text
-"oghoare_tac"} is initially invoked with the value @{text true} for
-the parameter @{text precond}.
-
-Parts of the tactic can be also individually used to generate the
-verification conditions for annotated sequential programs and to
-generate verification conditions out of interference freedom tests: *}
-
-ML {* val annhoare_tac = SUBGOAL (fn (_, i) =>
-  (AnnHoareRuleTac i))
-
-val interfree_aux_tac = SUBGOAL (fn (_, i) =>
-   (interfree_aux_Tac i))
-*}
-
-text {* The so defined ML tactics are then ``exported'' to be used in
-Isabelle proofs. *}
-
-method_setup oghoare = {*
-  Scan.succeed (K (SIMPLE_METHOD' oghoare_tac)) *}
-  "verification condition generator for the oghoare logic"
-
-method_setup annhoare = {*
-  Scan.succeed (K (SIMPLE_METHOD' annhoare_tac)) *}
-  "verification condition generator for the ann_hoare logic"
-
-method_setup interfree_aux = {*
-  Scan.succeed (K (SIMPLE_METHOD' interfree_aux_tac)) *}
-  "verification condition generator for interference freedom tests"
-
-text {* Tactics useful for dealing with the generated verification conditions: *}
-
-method_setup conjI_tac = {*
-  Scan.succeed (K (SIMPLE_METHOD' (conjI_Tac (K all_tac)))) *}
-  "verification condition generator for interference freedom tests"
-
-ML {*
-fun disjE_Tac tac i st = st |>
-       ( (EVERY [etac disjE i,
-          disjE_Tac tac (i+1),
-          tac i]) ORELSE (tac i) )
-*}
-
-method_setup disjE_tac = {*
-  Scan.succeed (K (SIMPLE_METHOD' (disjE_Tac (K all_tac)))) *}
-  "verification condition generator for interference freedom tests"
-
-end
--- a/src/HOL/HoareParallel/OG_Tran.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,309 +0,0 @@
-
-header {* \section{Operational Semantics} *}
-
-theory OG_Tran imports OG_Com begin
-
-types
-  'a ann_com_op = "('a ann_com) option"
-  'a ann_triple_op = "('a ann_com_op \<times> 'a assn)"
-  
-consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
-primrec "com (c, q) = c"
-
-consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
-primrec "post (c, q) = q"
-
-constdefs
-  All_None :: "'a ann_triple_op list \<Rightarrow> bool"
-  "All_None Ts \<equiv> \<forall>(c, q) \<in> set Ts. c = None"
-
-subsection {* The Transition Relation *}
-
-inductive_set
-  ann_transition :: "(('a ann_com_op \<times> 'a) \<times> ('a ann_com_op \<times> 'a)) set"        
-  and transition :: "(('a com \<times> 'a) \<times> ('a com \<times> 'a)) set"
-  and ann_transition' :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
-    ("_ -1\<rightarrow> _"[81,81] 100)
-  and transition' :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
-    ("_ -P1\<rightarrow> _"[81,81] 100)
-  and transitions :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
-    ("_ -P*\<rightarrow> _"[81,81] 100)
-where
-  "con_0 -1\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition"
-| "con_0 -P1\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition"
-| "con_0 -P*\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition\<^sup>*"
-
-| AnnBasic:  "(Some (AnnBasic r f), s) -1\<rightarrow> (None, f s)"
-
-| AnnSeq1: "(Some c0, s) -1\<rightarrow> (None, t) \<Longrightarrow> 
-               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some c1, t)"
-| AnnSeq2: "(Some c0, s) -1\<rightarrow> (Some c2, t) \<Longrightarrow> 
-               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some (AnnSeq c2 c1), t)"
-
-| AnnCond1T: "s \<in> b  \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c1, s)"
-| AnnCond1F: "s \<notin> b \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c2, s)"
-
-| AnnCond2T: "s \<in> b  \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (Some c, s)"
-| AnnCond2F: "s \<notin> b \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (None, s)"
-
-| AnnWhileF: "s \<notin> b \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> (None, s)"
-| AnnWhileT: "s \<in> b  \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> 
-                         (Some (AnnSeq c (AnnWhile i b i c)), s)"
-
-| AnnAwait: "\<lbrakk> s \<in> b; atom_com c; (c, s) -P*\<rightarrow> (Parallel [], t) \<rbrakk> \<Longrightarrow>
-	           (Some (AnnAwait r b c), s) -1\<rightarrow> (None, t)" 
-
-| Parallel: "\<lbrakk> i<length Ts; Ts!i = (Some c, q); (Some c, s) -1\<rightarrow> (r, t) \<rbrakk>
-              \<Longrightarrow> (Parallel Ts, s) -P1\<rightarrow> (Parallel (Ts [i:=(r, q)]), t)"
-
-| Basic:  "(Basic f, s) -P1\<rightarrow> (Parallel [], f s)"
-
-| Seq1:   "All_None Ts \<Longrightarrow> (Seq (Parallel Ts) c, s) -P1\<rightarrow> (c, s)"
-| Seq2:   "(c0, s) -P1\<rightarrow> (c2, t) \<Longrightarrow> (Seq c0 c1, s) -P1\<rightarrow> (Seq c2 c1, t)"
-
-| CondT: "s \<in> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c1, s)"
-| CondF: "s \<notin> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c2, s)"
-
-| WhileF: "s \<notin> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Parallel [], s)"
-| WhileT: "s \<in> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Seq c (While b i c), s)"
-
-monos "rtrancl_mono"
-
-text {* The corresponding syntax translations are: *}
-
-abbreviation
-  ann_transition_n :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a) 
-                           \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)  where
-  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition ^^ n"
-
-abbreviation
-  ann_transitions :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
-                           ("_ -*\<rightarrow> _"[81,81] 100)  where
-  "con_0 -*\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition\<^sup>*"
-
-abbreviation
-  transition_n :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  
-                          ("_ -P_\<rightarrow> _"[81,81,81] 100)  where
-  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition ^^ n"
-
-subsection {* Definition of Semantics *}
-
-constdefs
-  ann_sem :: "'a ann_com \<Rightarrow> 'a \<Rightarrow> 'a set"
-  "ann_sem c \<equiv> \<lambda>s. {t. (Some c, s) -*\<rightarrow> (None, t)}"
-
-  ann_SEM :: "'a ann_com \<Rightarrow> 'a set \<Rightarrow> 'a set"
-  "ann_SEM c S \<equiv> \<Union>ann_sem c ` S"  
-
-  sem :: "'a com \<Rightarrow> 'a \<Rightarrow> 'a set"
-  "sem c \<equiv> \<lambda>s. {t. \<exists>Ts. (c, s) -P*\<rightarrow> (Parallel Ts, t) \<and> All_None Ts}"
-
-  SEM :: "'a com \<Rightarrow> 'a set \<Rightarrow> 'a set"
-  "SEM c S \<equiv> \<Union>sem c ` S "
-
-syntax "_Omega" :: "'a com"    ("\<Omega>" 63)
-translations  "\<Omega>" \<rightleftharpoons> "While CONST UNIV CONST UNIV (Basic id)"
-
-consts fwhile :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> nat \<Rightarrow> 'a com"
-primrec 
-   "fwhile b c 0 = \<Omega>"
-   "fwhile b c (Suc n) = Cond b (Seq c (fwhile b c n)) (Basic id)"
-
-subsubsection {* Proofs *}
-
-declare ann_transition_transition.intros [intro]
-inductive_cases transition_cases: 
-    "(Parallel T,s) -P1\<rightarrow> t"  
-    "(Basic f, s) -P1\<rightarrow> t"
-    "(Seq c1 c2, s) -P1\<rightarrow> t" 
-    "(Cond b c1 c2, s) -P1\<rightarrow> t"
-    "(While b i c, s) -P1\<rightarrow> t"
-
-lemma Parallel_empty_lemma [rule_format (no_asm)]: 
-  "(Parallel [],s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=[] \<and> n=0 \<and> s=t"
-apply(induct n)
- apply(simp (no_asm))
-apply clarify
-apply(drule rel_pow_Suc_D2)
-apply(force elim:transition_cases)
-done
-
-lemma Parallel_AllNone_lemma [rule_format (no_asm)]: 
- "All_None Ss \<longrightarrow> (Parallel Ss,s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=Ss \<and> n=0 \<and> s=t"
-apply(induct "n")
- apply(simp (no_asm))
-apply clarify
-apply(drule rel_pow_Suc_D2)
-apply clarify
-apply(erule transition_cases,simp_all)
-apply(force dest:nth_mem simp add:All_None_def)
-done
-
-lemma Parallel_AllNone: "All_None Ts \<Longrightarrow> (SEM (Parallel Ts) X) = X"
-apply (unfold SEM_def sem_def)
-apply auto
-apply(drule rtrancl_imp_UN_rel_pow)
-apply clarify
-apply(drule Parallel_AllNone_lemma)
-apply auto
-done
-
-lemma Parallel_empty: "Ts=[] \<Longrightarrow> (SEM (Parallel Ts) X) = X"
-apply(rule Parallel_AllNone)
-apply(simp add:All_None_def)
-done
-
-text {* Set of lemmas from Apt and Olderog "Verification of sequential
-and concurrent programs", page 63. *}
-
-lemma L3_5i: "X\<subseteq>Y \<Longrightarrow> SEM c X \<subseteq> SEM c Y" 
-apply (unfold SEM_def)
-apply force
-done
-
-lemma L3_5ii_lemma1: 
- "\<lbrakk> (c1, s1) -P*\<rightarrow> (Parallel Ts, s2); All_None Ts;  
-  (c2, s2) -P*\<rightarrow> (Parallel Ss, s3); All_None Ss \<rbrakk> 
- \<Longrightarrow> (Seq c1 c2, s1) -P*\<rightarrow> (Parallel Ss, s3)"
-apply(erule converse_rtrancl_induct2)
-apply(force intro:converse_rtrancl_into_rtrancl)+
-done
-
-lemma L3_5ii_lemma2 [rule_format (no_asm)]: 
- "\<forall>c1 c2 s t. (Seq c1 c2, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow>  
-  (All_None Ts) \<longrightarrow> (\<exists>y m Rs. (c1,s) -P*\<rightarrow> (Parallel Rs, y) \<and> 
-  (All_None Rs) \<and> (c2, y) -Pm\<rightarrow> (Parallel Ts, t) \<and>  m \<le> n)"
-apply(induct "n")
- apply(force)
-apply(safe dest!: rel_pow_Suc_D2)
-apply(erule transition_cases,simp_all)
- apply (fast intro!: le_SucI)
-apply (fast intro!: le_SucI elim!: rel_pow_imp_rtrancl converse_rtrancl_into_rtrancl)
-done
-
-lemma L3_5ii_lemma3: 
- "\<lbrakk>(Seq c1 c2,s) -P*\<rightarrow> (Parallel Ts,t); All_None Ts\<rbrakk> \<Longrightarrow> 
-    (\<exists>y Rs. (c1,s) -P*\<rightarrow> (Parallel Rs,y) \<and> All_None Rs 
-   \<and> (c2,y) -P*\<rightarrow> (Parallel Ts,t))"
-apply(drule rtrancl_imp_UN_rel_pow)
-apply(fast dest: L3_5ii_lemma2 rel_pow_imp_rtrancl)
-done
-
-lemma L3_5ii: "SEM (Seq c1 c2) X = SEM c2 (SEM c1 X)"
-apply (unfold SEM_def sem_def)
-apply auto
- apply(fast dest: L3_5ii_lemma3)
-apply(fast elim: L3_5ii_lemma1)
-done
-
-lemma L3_5iii: "SEM (Seq (Seq c1 c2) c3) X = SEM (Seq c1 (Seq c2 c3)) X"
-apply (simp (no_asm) add: L3_5ii)
-done
-
-lemma L3_5iv:
- "SEM (Cond b c1 c2) X = (SEM c1 (X \<inter> b)) Un (SEM c2 (X \<inter> (-b)))"
-apply (unfold SEM_def sem_def)
-apply auto
-apply(erule converse_rtranclE)
- prefer 2
- apply (erule transition_cases,simp_all)
-  apply(fast intro: converse_rtrancl_into_rtrancl elim: transition_cases)+
-done
-
-
-lemma  L3_5v_lemma1[rule_format]: 
- "(S,s) -Pn\<rightarrow> (T,t) \<longrightarrow> S=\<Omega> \<longrightarrow> (\<not>(\<exists>Rs. T=(Parallel Rs) \<and> All_None Rs))"
-apply (unfold UNIV_def)
-apply(rule nat_less_induct)
-apply safe
-apply(erule rel_pow_E2)
- apply simp_all
-apply(erule transition_cases)
- apply simp_all
-apply(erule rel_pow_E2)
- apply(simp add: Id_def)
-apply(erule transition_cases,simp_all)
-apply clarify
-apply(erule transition_cases,simp_all)
-apply(erule rel_pow_E2,simp)
-apply clarify
-apply(erule transition_cases)
- apply simp+
-    apply clarify
-    apply(erule transition_cases)
-apply simp_all
-done
-
-lemma L3_5v_lemma2: "\<lbrakk>(\<Omega>, s) -P*\<rightarrow> (Parallel Ts, t); All_None Ts \<rbrakk> \<Longrightarrow> False"
-apply(fast dest: rtrancl_imp_UN_rel_pow L3_5v_lemma1)
-done
-
-lemma L3_5v_lemma3: "SEM (\<Omega>) S = {}"
-apply (unfold SEM_def sem_def)
-apply(fast dest: L3_5v_lemma2)
-done
-
-lemma L3_5v_lemma4 [rule_format]: 
- "\<forall>s. (While b i c, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>  
-  (\<exists>k. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t))"
-apply(rule nat_less_induct)
-apply safe
-apply(erule rel_pow_E2)
- apply safe
-apply(erule transition_cases,simp_all)
- apply (rule_tac x = "1" in exI)
- apply(force dest: Parallel_empty_lemma intro: converse_rtrancl_into_rtrancl simp add: Id_def)
-apply safe
-apply(drule L3_5ii_lemma2)
- apply safe
-apply(drule le_imp_less_Suc)
-apply (erule allE , erule impE,assumption)
-apply (erule allE , erule impE, assumption)
-apply safe
-apply (rule_tac x = "k+1" in exI)
-apply(simp (no_asm))
-apply(rule converse_rtrancl_into_rtrancl)
- apply fast
-apply(fast elim: L3_5ii_lemma1)
-done
-
-lemma L3_5v_lemma5 [rule_format]: 
- "\<forall>s. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>  
-  (While b i c, s) -P*\<rightarrow> (Parallel Ts,t)"
-apply(induct "k")
- apply(force dest: L3_5v_lemma2)
-apply safe
-apply(erule converse_rtranclE)
- apply simp_all
-apply(erule transition_cases,simp_all)
- apply(rule converse_rtrancl_into_rtrancl)
-  apply(fast)
- apply(fast elim!: L3_5ii_lemma1 dest: L3_5ii_lemma3)
-apply(drule rtrancl_imp_UN_rel_pow)
-apply clarify
-apply(erule rel_pow_E2)
- apply simp_all
-apply(erule transition_cases,simp_all)
-apply(fast dest: Parallel_empty_lemma)
-done
-
-lemma L3_5v: "SEM (While b i c) = (\<lambda>x. (\<Union>k. SEM (fwhile b c k) x))"
-apply(rule ext)
-apply (simp add: SEM_def sem_def)
-apply safe
- apply(drule rtrancl_imp_UN_rel_pow,simp)
- apply clarify
- apply(fast dest:L3_5v_lemma4)
-apply(fast intro: L3_5v_lemma5)
-done
-
-section {* Validity of Correctness Formulas *}
-
-constdefs 
-  com_validity :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>= _// _//_)" [90,55,90] 50)
-  "\<parallel>= p c q \<equiv> SEM c p \<subseteq> q"
-
-  ann_com_validity :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"   ("\<Turnstile> _ _" [60,90] 45)
-  "\<Turnstile> c q \<equiv> ann_SEM c (pre c) \<subseteq> q"
-
-end
\ No newline at end of file
--- a/src/HOL/HoareParallel/Quote_Antiquote.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-
-header {* \section{Concrete Syntax} *}
-
-theory Quote_Antiquote imports Main begin
-
-syntax
-  "_quote"     :: "'b \<Rightarrow> ('a \<Rightarrow> 'b)"                ("(\<guillemotleft>_\<guillemotright>)" [0] 1000)
-  "_antiquote" :: "('a \<Rightarrow> 'b) \<Rightarrow> 'b"                ("\<acute>_" [1000] 1000)
-  "_Assert"    :: "'a \<Rightarrow> 'a set"                    ("(.{_}.)" [0] 1000)
-
-syntax (xsymbols)
-  "_Assert"    :: "'a \<Rightarrow> 'a set"            ("(\<lbrace>_\<rbrace>)" [0] 1000)
-
-translations
-  ".{b}." \<rightharpoonup> "Collect \<guillemotleft>b\<guillemotright>"
-
-parse_translation {*
-  let
-    fun quote_tr [t] = Syntax.quote_tr "_antiquote" t
-      | quote_tr ts = raise TERM ("quote_tr", ts);
-  in [("_quote", quote_tr)] end
-*}
-
-end
\ No newline at end of file
--- a/src/HOL/HoareParallel/RG_Com.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,25 +0,0 @@
-
-header {* \chapter{The Rely-Guarantee Method} 
-
-\section {Abstract Syntax}
-*}
-
-theory RG_Com imports Main begin
-
-text {* Semantics of assertions and boolean expressions (bexp) as sets
-of states.  Syntax of commands @{text com} and parallel commands
-@{text par_com}. *}
-
-types
-  'a bexp = "'a set"
-
-datatype 'a com = 
-    Basic "'a \<Rightarrow>'a"
-  | Seq "'a com" "'a com"
-  | Cond "'a bexp" "'a com" "'a com"         
-  | While "'a bexp" "'a com"       
-  | Await "'a bexp" "'a com"                 
-
-types 'a par_com = "(('a com) option) list"
-
-end
\ No newline at end of file
--- a/src/HOL/HoareParallel/RG_Examples.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,359 +0,0 @@
-header {* \section{Examples} *}
-
-theory RG_Examples
-imports RG_Syntax
-begin
-
-lemmas definitions [simp]= stable_def Pre_def Rely_def Guar_def Post_def Com_def 
-
-subsection {* Set Elements of an Array to Zero *}
-
-lemma le_less_trans2: "\<lbrakk>(j::nat)<k; i\<le> j\<rbrakk> \<Longrightarrow> i<k"
-by simp
-
-lemma add_le_less_mono: "\<lbrakk> (a::nat) < c; b\<le>d \<rbrakk> \<Longrightarrow> a + b < c + d"
-by simp
-
-record Example1 =
-  A :: "nat list"
-
-lemma Example1: 
- "\<turnstile> COBEGIN
-      SCHEME [0 \<le> i < n]
-     (\<acute>A := \<acute>A [i := 0], 
-     \<lbrace> n < length \<acute>A \<rbrace>, 
-     \<lbrace> length \<ordmasculine>A = length \<ordfeminine>A \<and> \<ordmasculine>A ! i = \<ordfeminine>A ! i \<rbrace>, 
-     \<lbrace> length \<ordmasculine>A = length \<ordfeminine>A \<and> (\<forall>j<n. i \<noteq> j \<longrightarrow> \<ordmasculine>A ! j = \<ordfeminine>A ! j) \<rbrace>, 
-     \<lbrace> \<acute>A ! i = 0 \<rbrace>) 
-    COEND
- SAT [\<lbrace> n < length \<acute>A \<rbrace>, \<lbrace> \<ordmasculine>A = \<ordfeminine>A \<rbrace>, \<lbrace> True \<rbrace>, \<lbrace> \<forall>i < n. \<acute>A ! i = 0 \<rbrace>]"
-apply(rule Parallel)
-apply (auto intro!: Basic) 
-done
-
-lemma Example1_parameterized: 
-"k < t \<Longrightarrow>
-  \<turnstile> COBEGIN 
-    SCHEME [k*n\<le>i<(Suc k)*n] (\<acute>A:=\<acute>A[i:=0], 
-   \<lbrace>t*n < length \<acute>A\<rbrace>, 
-   \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> \<ordmasculine>A!i = \<ordfeminine>A!i\<rbrace>, 
-   \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> (\<forall>j<length \<ordmasculine>A . i\<noteq>j \<longrightarrow> \<ordmasculine>A!j = \<ordfeminine>A!j)\<rbrace>, 
-   \<lbrace>\<acute>A!i=0\<rbrace>) 
-   COEND  
- SAT [\<lbrace>t*n < length \<acute>A\<rbrace>, 
-      \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> (\<forall>i<n. \<ordmasculine>A!(k*n+i)=\<ordfeminine>A!(k*n+i))\<rbrace>, 
-      \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> 
-      (\<forall>i<length \<ordmasculine>A . (i<k*n \<longrightarrow> \<ordmasculine>A!i = \<ordfeminine>A!i) \<and> ((Suc k)*n \<le> i\<longrightarrow> \<ordmasculine>A!i = \<ordfeminine>A!i))\<rbrace>, 
-      \<lbrace>\<forall>i<n. \<acute>A!(k*n+i) = 0\<rbrace>]"
-apply(rule Parallel)
-    apply auto
-  apply(erule_tac x="k*n +i" in allE)
-  apply(subgoal_tac "k*n+i <length (A b)")
-   apply force
-  apply(erule le_less_trans2) 
-  apply(case_tac t,simp+)
-  apply (simp add:add_commute)
-  apply(simp add: add_le_mono)
-apply(rule Basic)
-   apply simp
-   apply clarify
-   apply (subgoal_tac "k*n+i< length (A x)")
-    apply simp
-   apply(erule le_less_trans2)
-   apply(case_tac t,simp+)
-   apply (simp add:add_commute)
-   apply(rule add_le_mono, auto)
-done
-
-
-subsection {* Increment a Variable in Parallel *}
-
-subsubsection {* Two components *}
-
-record Example2 =
-  x  :: nat
-  c_0 :: nat
-  c_1 :: nat
-
-lemma Example2: 
- "\<turnstile>  COBEGIN
-    (\<langle> \<acute>x:=\<acute>x+1;; \<acute>c_0:=\<acute>c_0 + 1 \<rangle>, 
-     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1  \<and> \<acute>c_0=0\<rbrace>, 
-     \<lbrace>\<ordmasculine>c_0 = \<ordfeminine>c_0 \<and> 
-        (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
-        \<longrightarrow> \<ordfeminine>x = \<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,  
-     \<lbrace>\<ordmasculine>c_1 = \<ordfeminine>c_1 \<and> 
-         (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
-         \<longrightarrow> \<ordfeminine>x =\<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,
-     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_0=1 \<rbrace>)
-  \<parallel>
-      (\<langle> \<acute>x:=\<acute>x+1;; \<acute>c_1:=\<acute>c_1+1 \<rangle>, 
-     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_1=0 \<rbrace>, 
-     \<lbrace>\<ordmasculine>c_1 = \<ordfeminine>c_1 \<and> 
-        (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
-        \<longrightarrow> \<ordfeminine>x = \<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,  
-     \<lbrace>\<ordmasculine>c_0 = \<ordfeminine>c_0 \<and> 
-         (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
-        \<longrightarrow> \<ordfeminine>x =\<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,
-     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_1=1\<rbrace>)
- COEND
- SAT [\<lbrace>\<acute>x=0 \<and> \<acute>c_0=0 \<and> \<acute>c_1=0\<rbrace>, 
-      \<lbrace>\<ordmasculine>x=\<ordfeminine>x \<and>  \<ordmasculine>c_0= \<ordfeminine>c_0 \<and> \<ordmasculine>c_1=\<ordfeminine>c_1\<rbrace>,
-      \<lbrace>True\<rbrace>,
-      \<lbrace>\<acute>x=2\<rbrace>]"
-apply(rule Parallel)
-   apply simp_all
-   apply clarify
-   apply(case_tac i)
-    apply simp
-    apply(rule conjI)
-     apply clarify
-     apply simp
-    apply clarify
-    apply simp
-    apply(case_tac j,simp)
-    apply simp
-   apply simp
-   apply(rule conjI)
-    apply clarify
-    apply simp
-   apply clarify
-   apply simp
-   apply(subgoal_tac "j=0")
-    apply (rotate_tac -1)
-    apply (simp (asm_lr))
-   apply arith
-  apply clarify
-  apply(case_tac i,simp,simp)
- apply clarify   
- apply simp
- apply(erule_tac x=0 in all_dupE)
- apply(erule_tac x=1 in allE,simp)
-apply clarify
-apply(case_tac i,simp)
- apply(rule Await)
-  apply simp_all
- apply(clarify)
- apply(rule Seq)
-  prefer 2
-  apply(rule Basic)
-   apply simp_all
-  apply(rule subset_refl)
- apply(rule Basic)
- apply simp_all
- apply clarify
- apply simp
-apply(rule Await)
- apply simp_all
-apply(clarify)
-apply(rule Seq)
- prefer 2
- apply(rule Basic)
-  apply simp_all
- apply(rule subset_refl)
-apply(auto intro!: Basic)
-done
-
-subsubsection {* Parameterized *}
-
-lemma Example2_lemma2_aux: "j<n \<Longrightarrow> 
- (\<Sum>i=0..<n. (b i::nat)) =
- (\<Sum>i=0..<j. b i) + b j + (\<Sum>i=0..<n-(Suc j) . b (Suc j + i))"
-apply(induct n)
- apply simp_all
-apply(simp add:less_Suc_eq)
- apply(auto)
-apply(subgoal_tac "n - j = Suc(n- Suc j)")
-  apply simp
-apply arith
-done
-
-lemma Example2_lemma2_aux2: 
-  "j\<le> s \<Longrightarrow> (\<Sum>i::nat=0..<j. (b (s:=t)) i) = (\<Sum>i=0..<j. b i)"
-apply(induct j)
- apply (simp_all cong:setsum_cong)
-done
-
-lemma Example2_lemma2: 
- "\<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i::nat=0..<n. b i)=(\<Sum>i=0..<n. (b (j := Suc 0)) i)"
-apply(frule_tac b="(b (j:=(Suc 0)))" in Example2_lemma2_aux)
-apply(erule_tac  t="setsum (b(j := (Suc 0))) {0..<n}" in ssubst)
-apply(frule_tac b=b in Example2_lemma2_aux)
-apply(erule_tac  t="setsum b {0..<n}" in ssubst)
-apply(subgoal_tac "Suc (setsum b {0..<j} + b j + (\<Sum>i=0..<n - Suc j. b (Suc j + i)))=(setsum b {0..<j} + Suc (b j) + (\<Sum>i=0..<n - Suc j. b (Suc j + i)))")
-apply(rotate_tac -1)
-apply(erule ssubst)
-apply(subgoal_tac "j\<le>j")
- apply(drule_tac b="b" and t="(Suc 0)" in Example2_lemma2_aux2)
-apply(rotate_tac -1)
-apply(erule ssubst)
-apply simp_all
-done
-
-lemma Example2_lemma2_Suc0: "\<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow>
- Suc (\<Sum>i::nat=0..< n. b i)=(\<Sum>i=0..< n. (b (j:=Suc 0)) i)"
-by(simp add:Example2_lemma2)
-
-record Example2_parameterized =   
-  C :: "nat \<Rightarrow> nat"
-  y  :: nat
-
-lemma Example2_parameterized: "0<n \<Longrightarrow> 
-  \<turnstile> COBEGIN SCHEME  [0\<le>i<n]
-     (\<langle> \<acute>y:=\<acute>y+1;; \<acute>C:=\<acute>C (i:=1) \<rangle>, 
-     \<lbrace>\<acute>y=(\<Sum>i=0..<n. \<acute>C i) \<and> \<acute>C i=0\<rbrace>, 
-     \<lbrace>\<ordmasculine>C i = \<ordfeminine>C i \<and> 
-      (\<ordmasculine>y=(\<Sum>i=0..<n. \<ordmasculine>C i) \<longrightarrow> \<ordfeminine>y =(\<Sum>i=0..<n. \<ordfeminine>C i))\<rbrace>,  
-     \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>C j = \<ordfeminine>C j) \<and> 
-       (\<ordmasculine>y=(\<Sum>i=0..<n. \<ordmasculine>C i) \<longrightarrow> \<ordfeminine>y =(\<Sum>i=0..<n. \<ordfeminine>C i))\<rbrace>,
-     \<lbrace>\<acute>y=(\<Sum>i=0..<n. \<acute>C i) \<and> \<acute>C i=1\<rbrace>) 
-    COEND
- SAT [\<lbrace>\<acute>y=0 \<and> (\<Sum>i=0..<n. \<acute>C i)=0 \<rbrace>, \<lbrace>\<ordmasculine>C=\<ordfeminine>C \<and> \<ordmasculine>y=\<ordfeminine>y\<rbrace>, \<lbrace>True\<rbrace>, \<lbrace>\<acute>y=n\<rbrace>]"
-apply(rule Parallel)
-apply force
-apply force
-apply(force)
-apply clarify
-apply simp
-apply(simp cong:setsum_ivl_cong)
-apply clarify
-apply simp
-apply(rule Await)
-apply simp_all
-apply clarify
-apply(rule Seq)
-prefer 2
-apply(rule Basic)
-apply(rule subset_refl)
-apply simp+
-apply(rule Basic)
-apply simp
-apply clarify
-apply simp
-apply(simp add:Example2_lemma2_Suc0 cong:if_cong)
-apply simp+
-done
-
-subsection {* Find Least Element *}
-
-text {* A previous lemma: *}
-
-lemma mod_aux :"\<lbrakk>i < (n::nat); a mod n = i;  j < a + n; j mod n = i; a < j\<rbrakk> \<Longrightarrow> False"
-apply(subgoal_tac "a=a div n*n + a mod n" )
- prefer 2 apply (simp (no_asm_use))
-apply(subgoal_tac "j=j div n*n + j mod n")
- prefer 2 apply (simp (no_asm_use))
-apply simp
-apply(subgoal_tac "a div n*n < j div n*n")
-prefer 2 apply arith
-apply(subgoal_tac "j div n*n < (a div n + 1)*n")
-prefer 2 apply simp
-apply (simp only:mult_less_cancel2)
-apply arith
-done
-
-record Example3 =
-  X :: "nat \<Rightarrow> nat"
-  Y :: "nat \<Rightarrow> nat"
-
-lemma Example3: "m mod n=0 \<Longrightarrow> 
- \<turnstile> COBEGIN 
- SCHEME [0\<le>i<n]
- (WHILE (\<forall>j<n. \<acute>X i < \<acute>Y j)  DO 
-   IF P(B!(\<acute>X i)) THEN \<acute>Y:=\<acute>Y (i:=\<acute>X i) 
-   ELSE \<acute>X:= \<acute>X (i:=(\<acute>X i)+ n) FI 
-  OD,
- \<lbrace>(\<acute>X i) mod n=i \<and> (\<forall>j<\<acute>X i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y i<m \<longrightarrow> P(B!(\<acute>Y i)) \<and> \<acute>Y i\<le> m+i)\<rbrace>,
- \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordfeminine>Y j \<le> \<ordmasculine>Y j) \<and> \<ordmasculine>X i = \<ordfeminine>X i \<and> 
-   \<ordmasculine>Y i = \<ordfeminine>Y i\<rbrace>,
- \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>X j = \<ordfeminine>X j \<and> \<ordmasculine>Y j = \<ordfeminine>Y j) \<and>   
-   \<ordfeminine>Y i \<le> \<ordmasculine>Y i\<rbrace>,
- \<lbrace>(\<acute>X i) mod n=i \<and> (\<forall>j<\<acute>X i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y i<m \<longrightarrow> P(B!(\<acute>Y i)) \<and> \<acute>Y i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y j \<le> \<acute>X i) \<rbrace>) 
- COEND
- SAT [\<lbrace> \<forall>i<n. \<acute>X i=i \<and> \<acute>Y i=m+i \<rbrace>,\<lbrace>\<ordmasculine>X=\<ordfeminine>X \<and> \<ordmasculine>Y=\<ordfeminine>Y\<rbrace>,\<lbrace>True\<rbrace>,
-  \<lbrace>\<forall>i<n. (\<acute>X i) mod n=i \<and> (\<forall>j<\<acute>X i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> 
-    (\<acute>Y i<m \<longrightarrow> P(B!(\<acute>Y i)) \<and> \<acute>Y i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y j \<le> \<acute>X i)\<rbrace>]"
-apply(rule Parallel)
---{*5 subgoals left *}
-apply force+
-apply clarify
-apply simp
-apply(rule While)
-    apply force
-   apply force
-  apply force
- apply(rule_tac pre'="\<lbrace> \<acute>X i mod n = i \<and> (\<forall>j. j<\<acute>X i \<longrightarrow> j mod n = i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y i < n * q \<longrightarrow> P (B!(\<acute>Y i))) \<and> \<acute>X i<\<acute>Y i\<rbrace>" in Conseq)
-     apply force
-    apply(rule subset_refl)+
- apply(rule Cond)
-    apply force
-   apply(rule Basic)
-      apply force
-     apply fastsimp
-    apply force
-   apply force
-  apply(rule Basic)
-     apply simp
-     apply clarify
-     apply simp
-     apply (case_tac "X x (j mod n) \<le> j")
-     apply (drule le_imp_less_or_eq)
-     apply (erule disjE)
-     apply (drule_tac j=j and n=n and i="j mod n" and a="X x (j mod n)" in mod_aux)
-     apply auto
-done
-
-text {* Same but with a list as auxiliary variable: *}
-
-record Example3_list =
-  X :: "nat list"
-  Y :: "nat list"
-
-lemma Example3_list: "m mod n=0 \<Longrightarrow> \<turnstile> (COBEGIN SCHEME [0\<le>i<n]
- (WHILE (\<forall>j<n. \<acute>X!i < \<acute>Y!j)  DO 
-     IF P(B!(\<acute>X!i)) THEN \<acute>Y:=\<acute>Y[i:=\<acute>X!i] ELSE \<acute>X:= \<acute>X[i:=(\<acute>X!i)+ n] FI 
-  OD,
- \<lbrace>n<length \<acute>X \<and> n<length \<acute>Y \<and> (\<acute>X!i) mod n=i \<and> (\<forall>j<\<acute>X!i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y!i<m \<longrightarrow> P(B!(\<acute>Y!i)) \<and> \<acute>Y!i\<le> m+i)\<rbrace>,
- \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordfeminine>Y!j \<le> \<ordmasculine>Y!j) \<and> \<ordmasculine>X!i = \<ordfeminine>X!i \<and> 
-   \<ordmasculine>Y!i = \<ordfeminine>Y!i \<and> length \<ordmasculine>X = length \<ordfeminine>X \<and> length \<ordmasculine>Y = length \<ordfeminine>Y\<rbrace>,
- \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>X!j = \<ordfeminine>X!j \<and> \<ordmasculine>Y!j = \<ordfeminine>Y!j) \<and>   
-   \<ordfeminine>Y!i \<le> \<ordmasculine>Y!i \<and> length \<ordmasculine>X = length \<ordfeminine>X \<and> length \<ordmasculine>Y = length \<ordfeminine>Y\<rbrace>,
- \<lbrace>(\<acute>X!i) mod n=i \<and> (\<forall>j<\<acute>X!i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y!i<m \<longrightarrow> P(B!(\<acute>Y!i)) \<and> \<acute>Y!i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y!j \<le> \<acute>X!i) \<rbrace>) COEND)
- SAT [\<lbrace>n<length \<acute>X \<and> n<length \<acute>Y \<and> (\<forall>i<n. \<acute>X!i=i \<and> \<acute>Y!i=m+i) \<rbrace>,
-      \<lbrace>\<ordmasculine>X=\<ordfeminine>X \<and> \<ordmasculine>Y=\<ordfeminine>Y\<rbrace>,
-      \<lbrace>True\<rbrace>,
-      \<lbrace>\<forall>i<n. (\<acute>X!i) mod n=i \<and> (\<forall>j<\<acute>X!i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> 
-        (\<acute>Y!i<m \<longrightarrow> P(B!(\<acute>Y!i)) \<and> \<acute>Y!i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y!j \<le> \<acute>X!i)\<rbrace>]"
-apply(rule Parallel)
---{* 5 subgoals left *}
-apply force+
-apply clarify
-apply simp
-apply(rule While)
-    apply force
-   apply force
-  apply force
- apply(rule_tac pre'="\<lbrace>n<length \<acute>X \<and> n<length \<acute>Y \<and> \<acute>X ! i mod n = i \<and> (\<forall>j. j < \<acute>X ! i \<longrightarrow> j mod n = i \<longrightarrow> \<not> P (B ! j)) \<and> (\<acute>Y ! i < n * q \<longrightarrow> P (B ! (\<acute>Y ! i))) \<and> \<acute>X!i<\<acute>Y!i\<rbrace>" in Conseq)
-     apply force
-    apply(rule subset_refl)+
- apply(rule Cond)
-    apply force
-   apply(rule Basic)
-      apply force
-     apply force
-    apply force
-   apply force
-  apply(rule Basic)
-     apply simp
-     apply clarify
-     apply simp
-     apply(rule allI)
-     apply(rule impI)+
-     apply(case_tac "X x ! i\<le> j")
-      apply(drule le_imp_less_or_eq)
-      apply(erule disjE)
-       apply(drule_tac j=j and n=n and i=i and a="X x ! i" in mod_aux)
-     apply auto
-done
-
-end
--- a/src/HOL/HoareParallel/RG_Hoare.thy	Tue Sep 29 22:15:54 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1375 +0,0 @@
-header {* \section{The Proof System} *}
-
-theory RG_Hoare imports RG_Tran begin
-
-subsection {* Proof System for Component Programs *}
-
-declare Un_subset_iff [iff del]
-declare Cons_eq_map_conv[iff]
-
-constdefs
-  stable :: "'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> bool"  
-  "stable \<equiv> \<lambda>f g. (\<forall>x y. x \<in> f \<longrightarrow> (x, y) \<in> g \<longrightarrow> y \<in> f)" 
-
-inductive
-  rghoare :: "['a com, 'a set, ('a \<times> 'a) set, ('a \<times> 'a) set, 'a set] \<Rightarrow> bool"  
-    ("\<turnstile> _ sat [_, _, _, _]" [60,0,0,0,0] 45)
-where
-  Basic: "\<lbrakk> pre \<subseteq> {s. f s \<in> post}; {(s,t). s \<in> pre \<and> (t=f s \<or> t=s)} \<subseteq> guar; 
-            stable pre rely; stable post rely \<rbrakk> 
-           \<Longrightarrow> \<turnstile> Basic f sat [pre, rely, guar, post]"
-
-| Seq: "\<lbrakk> \<turnstile> P sat [pre, rely, guar, mid]; \<turnstile> Q sat [mid, rely, guar, post] \<rbrakk> 
-           \<Longrightarrow> \<turnstile> Seq P Q sat [pre, rely, guar, post]"
-
-| Cond: "\<lbrakk> stable pre rely; \<turnstile> P1 sat [pre \<inter> b, rely, guar, post];
-           \<turnstile> P2 sat [pre \<inter> -b, rely, guar, post]; \<forall>s. (s,s)\<in>guar \<rbrakk>
-          \<Longrightarrow> \<turnstile> Cond b P1 P2 sat [pre, rely, guar, post]"
-
-| While: "\<lbrakk> stable pre rely; (pre \<inter> -b) \<subseteq> post; stable post rely;
-            \<turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s,s)\<in>guar \<rbrakk>
-          \<Longrightarrow> \<turnstile> While b P sat [pre, rely, guar, post]"
-
-| Await: "\<lbrakk> stable pre rely; stable post rely; 
-            \<forall>V. \<turnstile> P sat [pre \<inter> b \<inter> {V}, {(s, t). s = t}, 
-                UNIV, {s. (V, s) \<in> guar} \<inter> post] \<rbrakk>
-           \<Longrightarrow> \<turnstile> Await b P sat [pre, rely, guar, post]"
-  
-| Conseq: "\<lbrakk> pre \<subseteq> pre'; rely \<subseteq> rely'; guar' \<subseteq> guar; post' \<subseteq> post;
-             \<turnstile> P sat [pre', rely', guar', post'] \<rbrakk>
-            \<Longrightarrow> \<turnstile> P sat [pre, rely, guar, post]"
-
-constdefs 
-  Pre :: "'a rgformula \<Rightarrow> 'a set"
-  "Pre x \<equiv> fst(snd x)"
-  Post :: "'a rgformula \<Rightarrow> 'a set"
-  "Post x \<equiv> snd(snd(snd(snd x)))"
-  Rely :: "'a rgformula \<Rightarrow> ('a \<times> 'a) set"
-  "Rely x \<equiv> fst(snd(snd x))"
-  Guar :: "'a rgformula \<Rightarrow> ('a \<times> 'a) set"
-  "Guar x \<equiv> fst(snd(snd(snd x)))"
-  Com :: "'a rgformula \<Rightarrow> 'a com"
-  "Com x \<equiv> fst x"
-
-subsection {* Proof System for Parallel Programs *}
-
-types 'a par_rgformula = "('a rgformula) list \<times> 'a set \<times> ('a \<times> 'a) set \<times> ('a \<times> 'a) set \<times> 'a set"
-
-inductive
-  par_rghoare :: "('a rgformula) list \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set \<Rightarrow> bool"
-    ("\<turnstile> _ SAT [_, _, _, _]" [60,0,0,0,0] 45)
-where
-  Parallel: 
-  "\<lbrakk> \<forall>i<length xs. rely \<union> (\<Union>j\<in>{j. j<length xs \<and> j\<noteq>i}. Guar(xs!j)) \<subseteq> Rely(xs!i);
-    (\<Union>j\<in>{j. j<length xs}. Guar(xs!j)) \<subseteq> guar;
-     pre \<subseteq> (\<Inter>i\<in>{i. i<length xs}. Pre(xs!i)); 
-    (\<Inter>i\<in>{i. i<length xs}. Post(xs!i)) \<subseteq> post;
-    \<forall>i<length xs. \<turnstile> Com(xs!i) sat [Pre(xs!i),Rely(xs!i),Guar(xs!i),Post(xs!i)] \<rbrakk>
-   \<Longrightarrow>  \<turnstile> xs SAT [pre, rely, guar, post]"
-
-section {* Soundness*}
-
-subsubsection {* Some previous lemmas *}
-
-lemma tl_of_assum_in_assum: 
-  "(P, s) # (P, t) # xs \<in> assum (pre, rely) \<Longrightarrow> stable pre rely 
-  \<Longrightarrow> (P, t) # xs \<in> assum (pre, rely)"
-apply(simp add:assum_def)
-apply clarify
-apply(rule conjI)
- apply(erule_tac x=0 in allE)
- apply(simp (no_asm_use)only:stable_def)
- apply(erule allE,erule allE,erule impE,assumption,erule mp)
- apply(simp add:Env)
-apply clarify
-apply(erule_tac x="Suc i" in allE)
-apply simp
-done
-
-lemma etran_in_comm: 
-  "(P, t) # xs \<in> comm(guar, post) \<Longrightarrow> (P, s) # (P, t) # xs \<in> comm(guar, post)"
-apply(simp add:comm_def)
-apply clarify
-apply(case_tac i,simp+)
-done
-
-lemma ctran_in_comm: 
-  "\<lbrakk>(s, s) \<in> guar; (Q, s) # xs \<in> comm(guar, post)\<rbrakk> 
-  \<Longrightarrow> (P, s) # (Q, s) # xs \<in> comm(guar, post)"
-apply(simp add:comm_def)
-apply clarify
-apply(case_tac i,simp+)
-done
-
-lemma takecptn_is_cptn [rule_format, elim!]: 
-  "\<forall>j. c \<in> cptn \<longrightarrow> take (Suc j) c \<in> cptn"
-apply(induct "c")
- apply(force elim: cptn.cases)
-apply clarify
-apply(case_tac j) 
- apply simp
- apply(rule CptnOne)
-apply simp
-apply(force intro:cptn.intros elim:cptn.cases)
-done
-
-lemma dropcptn_is_cptn [rule_format,elim!]: 
-  "\<forall>j<length c. c \<in> cptn \<longrightarrow> drop j c \<in> cptn"
-apply(induct "c")
- apply(force elim: cptn.cases)
-apply clarify
-apply(case_tac j,simp+) 
-apply(erule cptn.cases)
-  apply simp
- apply force
-apply force
-done
-
-lemma takepar_cptn_is_par_cptn [rule_format,elim]: 
-  "\<forall>j. c \<in> par_cptn \<longrightarrow> take (Suc j) c \<in> par_cptn"
-apply(induct "c")
- apply(force elim: cptn.cases)
-apply clarify
-apply(case_tac j,simp) 
- apply(rule ParCptnOne)
-apply(force intro:par_cptn.intros elim:par_cptn.cases)
-done
-
-lemma droppar_cptn_is_par_cptn [rule_format]:
-  "\<forall>j<length c. c \<in> par_cptn \<longrightarrow> drop j c \<in> par_cptn"
-apply(induct "c")
- apply(force elim: par_cptn.cases)
-apply clarify
-apply(case_tac j,simp+) 
-apply(erule par_cptn.cases)
-  apply simp
- apply force
-apply force
-done
-
-lemma tl_of_cptn_is_cptn: "\<lbrakk>x # xs \<in> cptn; xs \<noteq> []\<rbrakk> \<Longrightarrow> xs  \<in> cptn"
-apply(subgoal_tac "1 < length (x # xs)") 
- apply(drule dropcptn_is_cptn,simp+)
-done
-
-lemma not_ctran_None [rule_format]: 
-  "\<forall>s. (None, s)#xs \<in> cptn \<longrightarrow> (\<forall>i<length xs. ((None, s)#xs)!i -e\<rightarrow> xs!i)"
-apply(induct xs,simp+)
-apply clarify
-apply(erule cptn.cases,simp)
- apply simp
- apply(case_tac i,simp)
-  apply(rule Env)
- apply simp
-apply(force elim:ctran.cases)
-done
-
-lemma cptn_not_empty [simp]:"[] \<notin> cptn"
-apply(force elim:cptn.cases)
-done
-
-lemma etran_or_ctran [rule_format]: 
-  "\<forall>m i. x\<in>cptn \<longrightarrow> m \<le> length x 
-   \<longrightarrow> (\<forall>i. Suc i < m \<longrightarrow> \<not> x!i -c\<rightarrow> x!Suc i) \<longrightarrow> Suc i < m 
-   \<longrightarrow> x!i -e\<rightarrow> x!Suc i"
-apply(induct x,simp)
-apply clarify
-apply(erule cptn.cases,simp)
- apply(case_tac i,simp)
-  apply(rule Env)
- apply simp
- apply(erule_tac x="m - 1" in allE)
- apply(case_tac m,simp,simp)
- apply(subgoal_tac "(\<forall>i. Suc i < nata \<longrightarrow> (((P, t) # xs) ! i, xs ! i) \<notin> ctran)")
-  apply force
- apply clarify
- apply(erule_tac x="Suc ia" in allE,simp)
-apply(erule_tac x="0" and P="\<lambda>j. ?H j \<longrightarrow> (?J j) \<notin> ctran" in allE,simp)
-done
-
-lemma etran_or_ctran2 [rule_format]: 
-  "\<forall>i. Suc i<length x \<longrightarrow> x\<in>cptn \<longrightarrow> (x!i -c\<rightarrow> x!Suc i \<longrightarrow> \<not> x!i -e\<rightarrow> x!Suc i)
-  \<or> (x!i -e\<rightarrow> x!Suc i \<longrightarrow> \<not> x!i -c\<rightarrow> x!Suc i)"
-apply(induct x)
- apply simp
-apply clarify
-apply(erule cptn.cases,simp)
- apply(case_tac i,simp+)
-apply(case_tac i,simp)
- apply(force elim:etran.cases)
-apply simp
-done
-