Merged.
authorballarin
Thu Oct 01 07:40:25 2009 +0200 (2009-10-01)
changeset 328059b535493ac8d
parent 32804 ca430e6aee1c
parent 32783 e43d761a742d
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
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/Admin/E/eproof	Thu Oct 01 07:40:25 2009 +0200
     1.3 @@ -0,0 +1,93 @@
     1.4 +#!/usr/bin/perl -w
     1.5 +#
     1.6 +# eproof - run E and translate its output into TSTP format
     1.7 +#
     1.8 +# Author: Sascha Boehme, TU Muenchen
     1.9 +#
    1.10 +# This script is a port of a Bash script with the same name coming with
    1.11 +# E 1.0-004 (written by Stephan Schulz).
    1.12 +#
    1.13 +
    1.14 +
    1.15 +use File::Basename qw/ dirname /;
    1.16 +use File::Temp qw/ tempfile /;
    1.17 +use English;
    1.18 +
    1.19 +
    1.20 +# E executables
    1.21 +
    1.22 +my $edir = dirname($0);
    1.23 +my $eprover = "$edir/eprover";
    1.24 +my $epclextract = "$edir/epclextract";
    1.25 +
    1.26 +
    1.27 +# build E command from given commandline arguments
    1.28 +
    1.29 +my $format = "";
    1.30 +my $timelimit = 2000000000;   # effectively unlimited
    1.31 +
    1.32 +my $eprover_cmd = "'$eprover'";
    1.33 +foreach (@ARGV) {
    1.34 +  if (m/--cpu-limit=([0-9]+)/) {
    1.35 +    $timelimit = $1;
    1.36 +  }
    1.37 +
    1.38 +  if (m/--tstp-out/) {
    1.39 +    $format = $_;
    1.40 +  }
    1.41 +  else {
    1.42 +    $eprover_cmd = "$eprover_cmd '$_'";
    1.43 +  }
    1.44 +}
    1.45 +$eprover_cmd = "$eprover_cmd -l4 -R -o- --pcl-terms-compressed --pcl-compact";
    1.46 +
    1.47 +
    1.48 +# run E, redirecting output into a temporary file
    1.49 +
    1.50 +my ($fh, $filename) = tempfile(UNLINK => 1);
    1.51 +my $r = system "$eprover_cmd > '$filename'";
    1.52 +exit ($r >> 8) if $r != 0;
    1.53 +
    1.54 +
    1.55 +# analyze E output
    1.56 +
    1.57 +my @lines = <$fh>;
    1.58 +my $content = join "", @lines[-60 .. -1];
    1.59 +  # Note: Like the original eproof, we only look at the last 60 lines.
    1.60 +
    1.61 +if ($content =~ m/Total time\s*:\s*([0-9]+\.[0-9]+)/) {
    1.62 +  $timelimit = int($timelimit - $1 - 1);
    1.63 +
    1.64 +  if ($content =~ m/No proof found!/) {
    1.65 +    print "# Problem is satisfiable (or invalid), " .
    1.66 +      "generating saturation derivation\n";
    1.67 +  }
    1.68 +  elsif ($content =~ m/Proof found!/) {
    1.69 +    print "# Problem is unsatisfiable (or provable), " .
    1.70 +      "constructing proof object\n";
    1.71 +  }
    1.72 +  elsif ($content =~ m/Watchlist is empty!/) {
    1.73 +    print "# All watchlist clauses generated, constructing derivation\n";
    1.74 +  }
    1.75 +  else {
    1.76 +    print "# Cannot determine problem status\n";
    1.77 +    exit $r;
    1.78 +  }
    1.79 +}
    1.80 +else {
    1.81 +  print "# Cannot determine problem status within resource limit\n";
    1.82 +  exit $r;
    1.83 +}
    1.84 +
    1.85 +
    1.86 +# translate E output
    1.87 +
    1.88 +foreach (@lines) {
    1.89 +  print if (m/# SZS status/ or m/"# Failure"/);
    1.90 +}
    1.91 +$r = system ("exec bash -c \"ulimit -S -t $timelimit; " .
    1.92 +  "'$epclextract' $format -f --competition-framing '$filename'\"");
    1.93 +  # Note: Setting the user time is not supported on Cygwin, i.e., ulimit fails
    1.94 +  # and prints and error message. How could we then limit the execution time?
    1.95 +exit ($r >> 8);
    1.96 +
     2.1 --- a/Admin/isatest/annomaly.ML	Tue Sep 29 22:15:54 2009 +0200
     2.2 +++ b/Admin/isatest/annomaly.ML	Thu Oct 01 07:40:25 2009 +0200
     2.3 @@ -20,7 +20,7 @@
     2.4    val isabelleHome =
     2.5        case OS.Process.getEnv "ISABELLE_HOME"
     2.6         of  NONE => OS.FileSys.getDir ()
     2.7 -	 | SOME home => mkAbsolute home
     2.8 +         | SOME home => mkAbsolute home
     2.9  
    2.10    fun noparent [] = []
    2.11      | noparent (n :: ns) =
    2.12 @@ -33,12 +33,12 @@
    2.13  
    2.14    fun rewrite defPrefix name =
    2.15        let val abs = mkAbsolute name
    2.16 -	  val rel = OS.Path.mkRelative { path = abs, relativeTo = isabelleHome }
    2.17 -	  val exists = (OS.FileSys.access(abs, nil)
    2.18 -			handle OS.SysErr _ => false)
    2.19 +          val rel = OS.Path.mkRelative { path = abs, relativeTo = isabelleHome }
    2.20 +          val exists = (OS.FileSys.access(abs, nil)
    2.21 +                        handle OS.SysErr _ => false)
    2.22        in  if exists andalso rel <> ""
    2.23 -	  then isabellePath (toArcs rel)
    2.24 -	  else defPrefix @ noparent (toArcs name)
    2.25 +          then isabellePath (toArcs rel)
    2.26 +          else defPrefix @ noparent (toArcs name)
    2.27        end handle OS.Path.Path => defPrefix @ noparent (toArcs name)
    2.28  
    2.29  in
    2.30 @@ -49,10 +49,10 @@
    2.31          (* should we have different files for different line numbers? *
    2.32          val arcs = if line <= 1 then arcs
    2.33                     else arcs @ [ "l." ^ Int.toString line ]
    2.34 -	*)
    2.35 -	val arcs = if t = "structure Isabelle =\nstruct\nend;"
    2.36 -		      andalso name = "ML"
    2.37 -		   then ["empty_Isabelle", "empty" ] else arcs
    2.38 +        *)
    2.39 +        val arcs = if t = "structure Isabelle =\nstruct\nend;"
    2.40 +                      andalso name = "ML"
    2.41 +                   then ["empty_Isabelle", "empty" ] else arcs
    2.42          val _    = AnnoMaLy.nameNextStream arcs
    2.43      in  smlnj_use_text tune str_of_pos name_space (line, name) p v t  end;
    2.44  
     3.1 --- a/Admin/isatest/isatest-makeall	Tue Sep 29 22:15:54 2009 +0200
     3.2 +++ b/Admin/isatest/isatest-makeall	Thu Oct 01 07:40:25 2009 +0200
     3.3 @@ -10,6 +10,8 @@
     3.4  # max time until test is aborted (in sec)
     3.5  MAXTIME=28800
     3.6  
     3.7 +PUBLISH_TEST=/home/isabelle-repository/repos/testtool/publish_test.py
     3.8 +
     3.9  ## diagnostics
    3.10  
    3.11  PRG="$(basename "$0")"
    3.12 @@ -80,7 +82,7 @@
    3.13          NICE=""
    3.14          ;;
    3.15  
    3.16 -    macbroy21)
    3.17 +    macbroy22)
    3.18          MFLAGS="-k"
    3.19          NICE=""
    3.20          ;;
    3.21 @@ -120,6 +122,8 @@
    3.22    TOOL="$ISABELLE_TOOL makeall $MFLAGS all"
    3.23  fi
    3.24  
    3.25 +IDENT=$(cat "$DISTPREFIX/ISABELLE_IDENT")
    3.26 +
    3.27  # main test loop
    3.28  
    3.29  log "starting [$@]"
    3.30 @@ -159,10 +163,16 @@
    3.31      then
    3.32          # test log and cleanup
    3.33          echo ------------------- test successful --- `date` --- $HOSTNAME >> $TESTLOG 2>&1
    3.34 +        if [ -x $PUBLISH_TEST ]; then
    3.35 +            $PUBLISH_TEST -r $IDENT -s "SUCCESS" -a log $TESTLOG
    3.36 +        fi
    3.37          gzip -f $TESTLOG
    3.38      else
    3.39          # test log
    3.40          echo ------------------- test FAILED --- `date` --- $HOSTNAME >> $TESTLOG 2>&1
    3.41 +        if [ -x $PUBLISH_TEST ]; then
    3.42 +             $PUBLISH_TEST -r $IDENT -s "FAIL" -a log $TESTLOG
    3.43 +        fi
    3.44  
    3.45          # error log
    3.46          echo "Test for platform ${SHORT} failed. Log file attached." >> $ERRORLOG
     4.1 --- a/Admin/isatest/isatest-makedist	Tue Sep 29 22:15:54 2009 +0200
     4.2 +++ b/Admin/isatest/isatest-makedist	Thu Oct 01 07:40:25 2009 +0200
     4.3 @@ -94,17 +94,17 @@
     4.4  $SSH sunbroy2 "$MAKEALL $HOME/settings/sun-poly"
     4.5  # give test some time to copy settings and start
     4.6  sleep 15
     4.7 -$SSH macbroy21 "$MAKEALL $HOME/settings/at-poly"
     4.8 +$SSH macbroy22 "$MAKEALL $HOME/settings/at-poly"
     4.9  sleep 15
    4.10  $SSH macbroy20 "$MAKEALL $HOME/settings/at-poly-5.1-para-e"
    4.11  sleep 15
    4.12  #$SSH macbroy24 "$MAKEALL -l HOL proofterms $HOME/settings/at-sml-dev-p"
    4.13  #sleep 15
    4.14 -$SSH macbroy22 "$MAKEALL $HOME/settings/at64-poly-5.1-para"
    4.15 +$SSH macbroy21 "$MAKEALL $HOME/settings/at64-poly-5.1-para"
    4.16  sleep 15
    4.17 -$SSH macbroy23 -l HOL images "$MAKEALL $HOME/settings/at-sml-dev-e"
    4.18 +$SSH macbroy23 "$MAKEALL -l HOL images $HOME/settings/at-sml-dev-e"
    4.19  sleep 15
    4.20 -$SSH atbroy101 "$MAKEALL $HOME/settings/at64-poly"
    4.21 +$SSH atbroy99 "$MAKEALL $HOME/settings/at64-poly"
    4.22  sleep 15
    4.23  $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"
    4.24  sleep 15
     5.1 --- a/Admin/isatest/isatest-stats	Tue Sep 29 22:15:54 2009 +0200
     5.2 +++ b/Admin/isatest/isatest-stats	Thu Oct 01 07:40:25 2009 +0200
     5.3 @@ -6,7 +6,7 @@
     5.4  
     5.5  THIS=$(cd "$(dirname "$0")"; pwd -P)
     5.6  
     5.7 -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"
     5.8 +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"
     5.9  
    5.10  ISABELLE_SESSIONS="\
    5.11    HOL-Plain \
    5.12 @@ -24,9 +24,9 @@
    5.13    HOL-MetisExamples \
    5.14    HOL-MicroJava \
    5.15    HOL-NSA \
    5.16 -  HOL-NewNumberTheory \
    5.17    HOL-Nominal-Examples \
    5.18 -  HOL-NumberTheory \
    5.19 +  HOL-Number_Theory \
    5.20 +  HOL-Old_Number_Theory \
    5.21    HOL-SET-Protocol \
    5.22    HOL-UNITY \
    5.23    HOL-Word \
     6.1 --- a/Admin/user-aliases	Tue Sep 29 22:15:54 2009 +0200
     6.2 +++ b/Admin/user-aliases	Thu Oct 01 07:40:25 2009 +0200
     6.3 @@ -4,3 +4,5 @@
     6.4  nipkow@lapbroy100.local nipkow
     6.5  chaieb@chaieb-laptop chaieb
     6.6  immler@in.tum.de immler
     6.7 +tsewell@rubicon.NSW.bigpond.net.au tsewell
     6.8 +tsewell@nicta.com.au tsewell
     7.1 --- a/CONTRIBUTORS	Tue Sep 29 22:15:54 2009 +0200
     7.2 +++ b/CONTRIBUTORS	Thu Oct 01 07:40:25 2009 +0200
     7.3 @@ -7,6 +7,18 @@
     7.4  Contributions to this Isabelle version
     7.5  --------------------------------------
     7.6  
     7.7 +* September 2009: Thomas Sewell, NICTA
     7.8 +  More efficient HOL/record implementation
     7.9 +
    7.10 +* September 2009: Sascha Boehme, TUM
    7.11 +  SMT method using external SMT solvers
    7.12 +
    7.13 +* September 2009: Florian Haftmann, TUM
    7.14 +  Refinement of Sets and Lattices
    7.15 +
    7.16 +* July 2009: Jeremy Avigad and Amine Chaieb
    7.17 +  New number theory
    7.18 +
    7.19  * July 2009: Philipp Meyer, TUM
    7.20    HOL/Library/Sum_of_Squares: functionality to call a remote csdp prover
    7.21  
     8.1 --- a/NEWS	Tue Sep 29 22:15:54 2009 +0200
     8.2 +++ b/NEWS	Thu Oct 01 07:40:25 2009 +0200
     8.3 @@ -18,51 +18,31 @@
     8.4  
     8.5  *** HOL ***
     8.6  
     8.7 -* New proof method "sos" (sum of squares) for nonlinear real arithmetic
     8.8 -(originally due to John Harison). It requires Library/Sum_Of_Squares.
     8.9 -It is not a complete decision procedure but works well in practice
    8.10 -on quantifier-free real arithmetic with +, -, *, ^, =, <= and <,
    8.11 -i.e. boolean combinations of equalities and inequalities between
    8.12 -polynomials. It makes use of external semidefinite programming solvers.
    8.13 -For more information and examples see Library/Sum_Of_Squares.
    8.14 -
    8.15 -* Set.UNIV and Set.empty are mere abbreviations for top and bot.  INCOMPATIBILITY.
    8.16 -
    8.17 -* More convenient names for set intersection and union.  INCOMPATIBILITY:
    8.18 -
    8.19 -    Set.Int ~>  Set.inter
    8.20 -    Set.Un ~>   Set.union
    8.21 -
    8.22 -* Code generator attributes follow the usual underscore convention:
    8.23 -    code_unfold     replaces    code unfold
    8.24 -    code_post       replaces    code post
    8.25 -    etc.
    8.26 -  INCOMPATIBILITY.
    8.27 -
    8.28 -* New quickcheck implementation using new code generator.
    8.29 -
    8.30 -* New class "boolean_algebra".
    8.31 -
    8.32 -* Refinements to lattices classes:
    8.33 -  - added boolean_algebra type class
    8.34 -  - less default intro/elim rules in locale variant, more default
    8.35 -    intro/elim rules in class variant: more uniformity
    8.36 -  - lemma ge_sup_conv renamed to le_sup_iff, in accordance with le_inf_iff
    8.37 -  - dropped lemma alias inf_ACI for inf_aci (same for sup_ACI and sup_aci)
    8.38 -  - renamed ACI to inf_sup_aci
    8.39 -  - class "complete_lattice" moved to separate theory "complete_lattice";
    8.40 -    corresponding constants renamed:
    8.41 -    
    8.42 -    Set.Inf ~>      Complete_Lattice.Inf
    8.43 -    Set.Sup ~>      Complete_Lattice.Sup
    8.44 -    Set.INFI ~>     Complete_Lattice.INFI
    8.45 -    Set.SUPR ~>     Complete_Lattice.SUPR
    8.46 -    Set.Inter ~>    Complete_Lattice.Inter
    8.47 -    Set.Union ~>    Complete_Lattice.Union
    8.48 -    Set.INTER ~>    Complete_Lattice.INTER
    8.49 -    Set.UNION ~>    Complete_Lattice.UNION
    8.50 -
    8.51 -  INCOMPATIBILITY.
    8.52 +* Most rules produced by inductive and datatype package
    8.53 +have mandatory prefixes.
    8.54 +INCOMPATIBILITY.
    8.55 +
    8.56 +* New proof method "smt" for a combination of first-order logic
    8.57 +with equality, linear and nonlinear (natural/integer/real)
    8.58 +arithmetic, and fixed-size bitvectors; there is also basic
    8.59 +support for higher-order features (esp. lambda abstractions).
    8.60 +It is an incomplete decision procedure based on external SMT
    8.61 +solvers using the oracle mechanism.
    8.62 +
    8.63 +* Reorganization of number theory:
    8.64 +  * former session NumberTheory now named Old_Number_Theory
    8.65 +  * new session Number_Theory by Jeremy Avigad; if possible, prefer this.
    8.66 +  * moved legacy theories Legacy_GCD and Primes from Library/ to Old_Number_Theory/;
    8.67 +  * moved theory Pocklington from Library/ to Old_Number_Theory/;
    8.68 +  * removed various references to Old_Number_Theory from HOL distribution.
    8.69 +INCOMPATIBILITY.
    8.70 +
    8.71 +* Theory GCD now has functions Gcd/GCD and Lcm/LCM for the gcd and lcm
    8.72 +of finite and infinite sets. It is shown that they form a complete
    8.73 +lattice.
    8.74 +
    8.75 +* Split off prime number ingredients from theory GCD
    8.76 +to theory Number_Theory/Primes;
    8.77  
    8.78  * Class semiring_div requires superclass no_zero_divisors and proof of
    8.79  div_mult_mult1; theorems div_mult_mult1, div_mult_mult2,
    8.80 @@ -72,20 +52,83 @@
    8.81  zdiv_zmult_zmult2.  div_mult_mult1 is now [simp] by default.
    8.82  INCOMPATIBILITY.
    8.83  
    8.84 +* New testing tool "Mirabelle" for automated (proof) tools. Applies
    8.85 +several tools and tactics like sledgehammer, metis, or quickcheck, to
    8.86 +every proof step in a theory. To be used in batch mode via the
    8.87 +"mirabelle" utility.
    8.88 +
    8.89 +* New proof method "sos" (sum of squares) for nonlinear real
    8.90 +arithmetic (originally due to John Harison). It requires
    8.91 +Library/Sum_Of_Squares.  It is not a complete decision procedure but
    8.92 +works well in practice on quantifier-free real arithmetic with +, -,
    8.93 +*, ^, =, <= and <, i.e. boolean combinations of equalities and
    8.94 +inequalities between polynomials. It makes use of external
    8.95 +semidefinite programming solvers.  For more information and examples
    8.96 +see src/HOL/Library/Sum_Of_Squares.
    8.97 +
    8.98 +* Code generator attributes follow the usual underscore convention:
    8.99 +    code_unfold     replaces    code unfold
   8.100 +    code_post       replaces    code post
   8.101 +    etc.
   8.102 +  INCOMPATIBILITY.
   8.103 +
   8.104 +* Refinements to lattice classes and sets:
   8.105 +  - less default intro/elim rules in locale variant, more default
   8.106 +    intro/elim rules in class variant: more uniformity
   8.107 +  - lemma ge_sup_conv renamed to le_sup_iff, in accordance with le_inf_iff
   8.108 +  - dropped lemma alias inf_ACI for inf_aci (same for sup_ACI and sup_aci)
   8.109 +  - renamed ACI to inf_sup_aci
   8.110 +  - new class "boolean_algebra"
   8.111 +  - class "complete_lattice" moved to separate theory "complete_lattice";
   8.112 +    corresponding constants (and abbreviations) renamed and with authentic syntax:
   8.113 +    Set.Inf ~>      Complete_Lattice.Inf
   8.114 +    Set.Sup ~>      Complete_Lattice.Sup
   8.115 +    Set.INFI ~>     Complete_Lattice.INFI
   8.116 +    Set.SUPR ~>     Complete_Lattice.SUPR
   8.117 +    Set.Inter ~>    Complete_Lattice.Inter
   8.118 +    Set.Union ~>    Complete_Lattice.Union
   8.119 +    Set.INTER ~>    Complete_Lattice.INTER
   8.120 +    Set.UNION ~>    Complete_Lattice.UNION
   8.121 +  - more convenient names for set intersection and union:
   8.122 +    Set.Int ~>      Set.inter
   8.123 +    Set.Un ~>       Set.union
   8.124 +  - authentic syntax for
   8.125 +    Set.Pow
   8.126 +    Set.image
   8.127 +  - mere abbreviations:
   8.128 +    Set.empty               (for bot)
   8.129 +    Set.UNIV                (for top)
   8.130 +    Set.inter               (for inf)
   8.131 +    Set.union               (for sup)
   8.132 +    Complete_Lattice.Inter  (for Inf)
   8.133 +    Complete_Lattice.Union  (for Sup)
   8.134 +    Complete_Lattice.INTER  (for INFI)
   8.135 +    Complete_Lattice.UNION  (for SUPR)
   8.136 +  - object-logic definitions as far as appropriate
   8.137 +
   8.138 +INCOMPATIBILITY.  Care is required when theorems Int_subset_iff or
   8.139 +Un_subset_iff are explicitly deleted as default simp rules;  then
   8.140 +also their lattice counterparts le_inf_iff and le_sup_iff have to be
   8.141 +deleted to achieve the desired effect.
   8.142 +
   8.143 +* Rules inf_absorb1, inf_absorb2, sup_absorb1, sup_absorb2 are no
   8.144 +simp rules by default any longer.  The same applies to
   8.145 +min_max.inf_absorb1 etc.!  INCOMPATIBILITY.
   8.146 +
   8.147 +* sup_Int_eq and sup_Un_eq are no default pred_set_conv rules any longer.
   8.148 +INCOMPATIBILITY.
   8.149 +
   8.150  * Power operations on relations and functions are now one dedicate
   8.151 -constant compow with infix syntax "^^".  Power operations on
   8.152 +constant "compow" with infix syntax "^^".  Power operation on
   8.153  multiplicative monoids retains syntax "^" and is now defined generic
   8.154  in class power.  INCOMPATIBILITY.
   8.155  
   8.156 -* Relation composition "R O S" now has a "more standard" argument order,
   8.157 -i.e., "R O S = {(x,z). EX y. (x,y) : R & (y,z) : S }".
   8.158 +* Relation composition "R O S" now has a "more standard" argument
   8.159 +order, i.e., "R O S = {(x,z). EX y. (x,y) : R & (y,z) : S }".
   8.160  INCOMPATIBILITY: Rewrite propositions with "S O R" --> "R O S". Proofs
   8.161 -may occationally break, since the O_assoc rule was not rewritten like this.
   8.162 -Fix using O_assoc[symmetric].
   8.163 -The same applies to the curried version "R OO S".
   8.164 -
   8.165 -* GCD now has functions Gcd/GCD and Lcm/LCM for the gcd and lcm of finite and
   8.166 -infinite sets. It is shown that they form a complete lattice.
   8.167 +may occationally break, since the O_assoc rule was not rewritten like
   8.168 +this.  Fix using O_assoc[symmetric].  The same applies to the curried
   8.169 +version "R OO S".
   8.170  
   8.171  * ML antiquotation @{code_datatype} inserts definition of a datatype
   8.172  generated by the code generator; see Predicate.thy for an example.
   8.173 @@ -93,41 +136,36 @@
   8.174  * New method "linarith" invokes existing linear arithmetic decision
   8.175  procedure only.
   8.176  
   8.177 -* Implementation of quickcheck using generic code generator; default
   8.178 -generators are provided for all suitable HOL types, records and
   8.179 -datatypes.
   8.180 -
   8.181 -* Constants Set.Pow and Set.image now with authentic syntax;
   8.182 -object-logic definitions Set.Pow_def and Set.image_def.
   8.183 -INCOMPATIBILITY.
   8.184 +* New implementation of quickcheck uses generic code generator;
   8.185 +default generators are provided for all suitable HOL types, records
   8.186 +and datatypes.
   8.187  
   8.188  * Renamed theorems:
   8.189  Suc_eq_add_numeral_1 -> Suc_eq_plus1
   8.190  Suc_eq_add_numeral_1_left -> Suc_eq_plus1_left
   8.191  Suc_plus1 -> Suc_eq_plus1
   8.192  
   8.193 +* Moved theorems:
   8.194 +Wellfounded.in_inv_image -> Relation.in_inv_image
   8.195 +
   8.196  * New sledgehammer option "Full Types" in Proof General settings menu.
   8.197  Causes full type information to be output to the ATPs.  This slows
   8.198  ATPs down considerably but eliminates a source of unsound "proofs"
   8.199  that fail later.
   8.200  
   8.201 +* New method metisFT: A version of metis that uses full type information
   8.202 +in order to avoid failures of proof reconstruction.
   8.203 +
   8.204  * Discontinued ancient tradition to suffix certain ML module names
   8.205  with "_package", e.g.:
   8.206  
   8.207      DatatypePackage ~> Datatype
   8.208      InductivePackage ~> Inductive
   8.209  
   8.210 -    etc.
   8.211 -
   8.212  INCOMPATIBILITY.
   8.213  
   8.214 -* NewNumberTheory: Jeremy Avigad's new version of part of
   8.215 -NumberTheory.  If possible, use NewNumberTheory, not NumberTheory.
   8.216 -
   8.217 -* Simplified interfaces of datatype module.  INCOMPATIBILITY.
   8.218 -
   8.219 -* Abbreviation "arbitrary" of "undefined" has disappeared; use
   8.220 -"undefined" directly.  INCOMPATIBILITY.
   8.221 +* Discontinued abbreviation "arbitrary" of constant
   8.222 +"undefined". INCOMPATIBILITY, use "undefined" directly.
   8.223  
   8.224  * New evaluator "approximate" approximates an real valued term using
   8.225  the same method as the approximation method.
   8.226 @@ -148,13 +186,30 @@
   8.227  
   8.228  *** ML ***
   8.229  
   8.230 +* Structure Synchronized (cf. src/Pure/Concurrent/synchronized.ML)
   8.231 +provides a high-level programming interface to synchronized state
   8.232 +variables with atomic update.  This works via pure function
   8.233 +application within a critical section -- its runtime should be as
   8.234 +short as possible; beware of deadlocks if critical code is nested,
   8.235 +either directly or indirectly via other synchronized variables!
   8.236 +
   8.237 +* Structure Unsynchronized (cf. src/Pure/ML-Systems/unsynchronized.ML)
   8.238 +wraps raw ML references, explicitly indicating their non-thread-safe
   8.239 +behaviour.  The Isar toplevel keeps this structure open, to
   8.240 +accommodate Proof General as well as quick and dirty interactive
   8.241 +experiments with references.
   8.242 +
   8.243  * PARALLEL_CHOICE and PARALLEL_GOALS provide basic support for
   8.244  parallel tactical reasoning.
   8.245  
   8.246 -* Tactical FOCUS is similar to SUBPROOF, but allows the body tactic to
   8.247 -introduce new subgoals and schematic variables.  FOCUS_PARAMS is
   8.248 -similar, but focuses on the parameter prefix only, leaving subgoal
   8.249 -premises unchanged.
   8.250 +* Tacticals Subgoal.FOCUS, Subgoal.FOCUS_PREMS, Subgoal.FOCUS_PARAMS
   8.251 +are similar to SUBPROOF, but are slightly more flexible: only the
   8.252 +specified parts of the subgoal are imported into the context, and the
   8.253 +body tactic may introduce new subgoals and schematic variables.
   8.254 +
   8.255 +* Old tactical METAHYPS, which does not observe the proof context, has
   8.256 +been renamed to Old_Goals.METAHYPS and awaits deletion.  Use SUBPROOF
   8.257 +or Subgoal.FOCUS etc.
   8.258  
   8.259  * Renamed functor TableFun to Table, and GraphFun to Graph.  (Since
   8.260  functors have their own ML name space there is no point to mark them
   8.261 @@ -175,6 +230,10 @@
   8.262  or even Display.pretty_thm_without_context as last resort.
   8.263  INCOMPATIBILITY.
   8.264  
   8.265 +* Discontinued Display.pretty_ctyp/cterm etc.  INCOMPATIBILITY, use
   8.266 +Syntax.pretty_typ/term directly, preferably with proper context
   8.267 +instead of global theory.
   8.268 +
   8.269  
   8.270  *** System ***
   8.271  
     9.1 --- a/bin/isabelle	Tue Sep 29 22:15:54 2009 +0200
     9.2 +++ b/bin/isabelle	Thu Oct 01 07:40:25 2009 +0200
     9.3 @@ -17,7 +17,7 @@
     9.4  ISABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)"
     9.5  source "$ISABELLE_HOME/lib/scripts/getsettings" || exit 2
     9.6  
     9.7 -ORIG_IFS="$IFS"; IFS=":"; declare -a TOOLS=($ISABELLE_TOOLS); IFS="$ORIG_IFS"
     9.8 +splitarray ":" "$ISABELLE_TOOLS"; TOOLS=("${SPLITARRAY[@]}")
     9.9  
    9.10  
    9.11  ## diagnostics
    10.1 --- a/bin/isabelle-process	Tue Sep 29 22:15:54 2009 +0200
    10.2 +++ b/bin/isabelle-process	Thu Oct 01 07:40:25 2009 +0200
    10.3 @@ -160,7 +160,7 @@
    10.4      INFILE=""
    10.5      ISA_PATH=""
    10.6  
    10.7 -    ORIG_IFS="$IFS"; IFS=":"; declare -a PATHS=($ISABELLE_PATH); IFS="$ORIG_IFS"
    10.8 +    splitarray ":" "$ISABELLE_PATH"; PATHS=("${SPLITARRAY[@]}")
    10.9      for DIR in "${PATHS[@]}"
   10.10      do
   10.11        DIR="$DIR/$ML_IDENTIFIER"
    11.1 --- a/doc-src/manual.bib	Tue Sep 29 22:15:54 2009 +0200
    11.2 +++ b/doc-src/manual.bib	Thu Oct 01 07:40:25 2009 +0200
    11.3 @@ -484,7 +484,7 @@
    11.4    booktitle     = {Types for Proofs and Programs, TYPES 2008},
    11.5    publisher     = {Springer},
    11.6    series        = {LNCS},
    11.7 -  volume        = {????},
    11.8 +  volume        = {5497},
    11.9    year          = {2009}
   11.10  }
   11.11  
    12.1 --- a/doc-src/rail.ML	Tue Sep 29 22:15:54 2009 +0200
    12.2 +++ b/doc-src/rail.ML	Thu Oct 01 07:40:25 2009 +0200
    12.3 @@ -99,7 +99,7 @@
    12.4        |> (if markup = "" then I else enclose ("\\" ^ markup ^ "{") "}")
    12.5        |> (if ! ThyOutput.quotes then quote else I)
    12.6        |> (if ! ThyOutput.display then enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
    12.7 -	  else hyper o enclose "\\mbox{\\isa{" "}}")), style)
    12.8 +          else hyper o enclose "\\mbox{\\isa{" "}}")), style)
    12.9    else ("Bad " ^ kind ^ " " ^ name, false)
   12.10    end;
   12.11  end;
   12.12 @@ -147,8 +147,8 @@
   12.13    ) >> (Identifier o enclose "\\isa{" "}" o Output.output o implode) ||
   12.14    scan_link >> (decode_link ctxt) >>
   12.15      (fn (txt, style) =>
   12.16 -	if style then Special_Identifier(txt)
   12.17 -	else Identifier(txt))
   12.18 +        if style then Special_Identifier(txt)
   12.19 +        else Identifier(txt))
   12.20  end;
   12.21  
   12.22  fun scan_anot ctxt =
   12.23 @@ -169,12 +169,12 @@
   12.24      val text_sq =
   12.25        Scan.repeat (
   12.26          Scan.one (fn s =>
   12.27 -	  s <> "\n" andalso
   12.28 -	  s <> "\t" andalso
   12.29 -	  s <> "'" andalso
   12.30 -	  s <> "\\" andalso
   12.31 -	  Symbol.is_regular s) ||
   12.32 -	($$ "\\" |-- $$ "'")
   12.33 +          s <> "\n" andalso
   12.34 +          s <> "\t" andalso
   12.35 +          s <> "'" andalso
   12.36 +          s <> "\\" andalso
   12.37 +          Symbol.is_regular s) ||
   12.38 +        ($$ "\\" |-- $$ "'")
   12.39        ) >> implode
   12.40    fun quoted scan = $$ "'" |-- scan --| $$ "'";
   12.41    in
   12.42 @@ -305,9 +305,9 @@
   12.43    parse_body2 -- ($$$ "*" |-- !!! "body4e expected" (parse_body4e)) >>
   12.44      (fn (body1, body2) =>
   12.45        if is_empty body2 then
   12.46 -	add_body(PLUS, new_empty_body, rev_body body1)
   12.47 +        add_body(PLUS, new_empty_body, rev_body body1)
   12.48        else
   12.49 -	add_body(BAR, new_empty_body, add_body (PLUS, body1, rev_body body2)) ) ||
   12.50 +        add_body(BAR, new_empty_body, add_body (PLUS, body1, rev_body body2)) ) ||
   12.51    parse_body2 -- ($$$ "+" |-- !!! "body4e expected" (parse_body4e)) >>
   12.52      (fn (body1, body2) => new_body (PLUS, body1, rev_body body2) ) ||
   12.53    parse_body2e
   12.54 @@ -365,36 +365,36 @@
   12.55  fun position_body (body as Body(kind, text, annot, id, bodies), ystart) =
   12.56    let fun max (x,y) = if x > y then x else y
   12.57      fun set_body_position (Body(kind, text, annot, id, bodies), ystart, ynext) =
   12.58 -	  Body_Pos(kind, text, annot, id, bodies, ystart, ynext)
   12.59 +          Body_Pos(kind, text, annot, id, bodies, ystart, ynext)
   12.60      fun pos_bodies_cat ([],_,ynext,liste) = (liste, ynext)
   12.61        | pos_bodies_cat (x::xs, ystart, ynext, liste) =
   12.62 -	  if is_kind_of CR x then
   12.63 -	      (case set_body_position(x, ystart, ynext+1) of
   12.64 -		body as Body_Pos(_,_,_,_,_,_,ynext1) =>
   12.65 -		  pos_bodies_cat(xs, ynext1, max(ynext,ynext1), liste@[body])
   12.66 -	      )
   12.67 -	  else
   12.68 -	      (case position_body(x, ystart) of
   12.69 -		body as Body_Pos(_,_,_,_,_,_,ynext1) =>
   12.70 -		  pos_bodies_cat(xs, ystart, max(ynext,ynext1), liste@[body])
   12.71 -	      )
   12.72 +          if is_kind_of CR x then
   12.73 +              (case set_body_position(x, ystart, ynext+1) of
   12.74 +                body as Body_Pos(_,_,_,_,_,_,ynext1) =>
   12.75 +                  pos_bodies_cat(xs, ynext1, max(ynext,ynext1), liste@[body])
   12.76 +              )
   12.77 +          else
   12.78 +              (case position_body(x, ystart) of
   12.79 +                body as Body_Pos(_,_,_,_,_,_,ynext1) =>
   12.80 +                  pos_bodies_cat(xs, ystart, max(ynext,ynext1), liste@[body])
   12.81 +              )
   12.82      fun pos_bodies_bar_plus ([],_,ynext,liste) = (liste, ynext)
   12.83        | pos_bodies_bar_plus (x::xs, ystart, ynext, liste) =
   12.84 -	  (case position_body(x, ystart) of
   12.85 -	    body as Body_Pos(_,_,_,_,_,_,ynext1) =>
   12.86 -	      pos_bodies_bar_plus(xs, ynext1, max(ynext,ynext1), liste@[body])
   12.87 -	  )
   12.88 +          (case position_body(x, ystart) of
   12.89 +            body as Body_Pos(_,_,_,_,_,_,ynext1) =>
   12.90 +              pos_bodies_bar_plus(xs, ynext1, max(ynext,ynext1), liste@[body])
   12.91 +          )
   12.92    in
   12.93    (case kind of
   12.94      CAT => (case pos_bodies_cat(bodies,ystart,ystart+1,[]) of
   12.95 -	      (bodiesPos, ynext) =>
   12.96 -		Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
   12.97 +              (bodiesPos, ynext) =>
   12.98 +                Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
   12.99    | BAR => (case pos_bodies_bar_plus(bodies,ystart,ystart+1,[]) of
  12.100 -	      (bodiesPos, ynext) =>
  12.101 -		Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
  12.102 +              (bodiesPos, ynext) =>
  12.103 +                Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
  12.104    | PLUS => (case pos_bodies_bar_plus(bodies,ystart,ystart+1,[]) of
  12.105 -	      (bodiesPos, ynext) =>
  12.106 -		Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
  12.107 +              (bodiesPos, ynext) =>
  12.108 +                Body_Pos(kind, text, annot, id, bodiesPos, ystart, ynext))
  12.109    | CR => set_body_position(body, ystart, ystart+3)
  12.110    | EMPTY => set_body_position(body, ystart, ystart+1)
  12.111    | ANNOTE => set_body_position(body, ystart, ystart+1)
  12.112 @@ -406,15 +406,15 @@
  12.113  fun format_body (Body_Pos(EMPTY,_,_,_,_,_,_), _) = ""
  12.114    | format_body (Body_Pos(CAT,_,_,_,bodies,_,_), cent) =
  12.115      let fun format_bodies([]) = ""
  12.116 -	  | format_bodies(x::xs) = format_body (x, "") ^ format_bodies(xs)
  12.117 +          | format_bodies(x::xs) = format_body (x, "") ^ format_bodies(xs)
  12.118      in
  12.119        format_bodies(bodies)
  12.120      end
  12.121    | format_body (Body_Pos(BAR,_,_,_,bodies,_,_),cent) =
  12.122      let fun format_bodies([]) = "\\rail@endbar\n"
  12.123 -	  | format_bodies(x::xs) =
  12.124 -	      "\\rail@nextbar{" ^ string_of_int(getystart(x)) ^"}\n" ^
  12.125 -	      format_body(x, "") ^ format_bodies(xs)
  12.126 +          | format_bodies(x::xs) =
  12.127 +              "\\rail@nextbar{" ^ string_of_int(getystart(x)) ^"}\n" ^
  12.128 +              format_body(x, "") ^ format_bodies(xs)
  12.129      in
  12.130        "\\rail@bar\n" ^ format_body(hd(bodies), "") ^ format_bodies(tl(bodies))
  12.131      end
    13.1 --- a/etc/components	Tue Sep 29 22:15:54 2009 +0200
    13.2 +++ b/etc/components	Thu Oct 01 07:40:25 2009 +0200
    13.3 @@ -11,6 +11,8 @@
    13.4  src/LCF
    13.5  src/Sequents
    13.6  #misc components
    13.7 +src/Tools/Code
    13.8  src/HOL/Tools/ATP_Manager
    13.9 +src/HOL/Mirabelle
   13.10  src/HOL/Library/Sum_Of_Squares
   13.11 -
   13.12 +src/HOL/SMT
    14.1 --- a/etc/settings	Tue Sep 29 22:15:54 2009 +0200
    14.2 +++ b/etc/settings	Thu Oct 01 07:40:25 2009 +0200
    14.3 @@ -173,7 +173,7 @@
    14.4  
    14.5  # The pdf file viewer
    14.6  if [ $(uname -s) = Darwin ]; then
    14.7 -  PDF_VIEWER=open
    14.8 +  PDF_VIEWER="open -W -n"
    14.9  else
   14.10    PDF_VIEWER=xpdf
   14.11  fi
   14.12 @@ -207,22 +207,6 @@
   14.13  
   14.14  
   14.15  ###
   14.16 -### jEdit
   14.17 -###
   14.18 -
   14.19 -JEDIT_HOME=$(choosefrom \
   14.20 -  "$ISABELLE_HOME/contrib/jedit" \
   14.21 -  "$ISABELLE_HOME/../jedit" \
   14.22 -  "/usr/local/jedit" \
   14.23 -  "/usr/share/jedit" \
   14.24 -  "/opt/jedit" \
   14.25 -  "")
   14.26 -
   14.27 -JEDIT_JAVA_OPTIONS=""
   14.28 -#JEDIT_JAVA_OPTIONS="-server -Xms128m -Xmx512m"
   14.29 -JEDIT_OPTIONS="-reuseview -noserver -nobackground"
   14.30 -
   14.31 -###
   14.32  ### External reasoning tools
   14.33  ###
   14.34  
    15.1 --- a/lib/Tools/codegen	Tue Sep 29 22:15:54 2009 +0200
    15.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.3 @@ -1,40 +0,0 @@
    15.4 -#!/usr/bin/env bash
    15.5 -#
    15.6 -# Author: Florian Haftmann, TUM
    15.7 -#
    15.8 -# DESCRIPTION: issue code generation from shell
    15.9 -
   15.10 -
   15.11 -## diagnostics
   15.12 -
   15.13 -PRG="$(basename "$0")"
   15.14 -
   15.15 -function usage()
   15.16 -{
   15.17 -  echo
   15.18 -  echo "Usage: isabelle $PRG IMAGE THY CMD"
   15.19 -  echo
   15.20 -  echo "  Issues code generation using image IMAGE,"
   15.21 -  echo "  theory THY,"
   15.22 -  echo "  with Isar command 'export_code CMD'"
   15.23 -  echo
   15.24 -  exit 1
   15.25 -}
   15.26 -
   15.27 -
   15.28 -## process command line
   15.29 -
   15.30 -[ "$#" -lt 2 -o "$1" = "-?" ] && usage
   15.31 -
   15.32 -IMAGE="$1"; shift
   15.33 -THY="$1"; shift
   15.34 -CMD="$1"
   15.35 -
   15.36 -
   15.37 -## main
   15.38 -
   15.39 -CODE_CMD=$(echo $CMD | perl -pe 's/\\/\\\\/g; s/"/\\\"/g')
   15.40 -CTXT_CMD="ML_Context.eval_in (SOME (ProofContext.init (theory \"HOL\"))) false Position.none \"Code_Target.shell_command thyname cmd\";"
   15.41 -FULL_CMD="val thyname = \"$THY\"; val cmd = \"$CODE_CMD\"; $CTXT_CMD"
   15.42 -
   15.43 -"$ISABELLE" -q -e "$FULL_CMD" "$IMAGE" || exit 1
    16.1 --- a/lib/Tools/doc	Tue Sep 29 22:15:54 2009 +0200
    16.2 +++ b/lib/Tools/doc	Thu Oct 01 07:40:25 2009 +0200
    16.3 @@ -34,7 +34,7 @@
    16.4  
    16.5  ## main
    16.6  
    16.7 -ORIG_IFS="$IFS"; IFS=":"; declare -a DOCS=($ISABELLE_DOCS); IFS="$ORIG_IFS"
    16.8 +splitarray ":" "$ISABELLE_DOCS"; DOCS=("${SPLITARRAY[@]}")
    16.9  
   16.10  if [ -z "$DOC" ]; then
   16.11    for DIR in "${DOCS[@]}"
    17.1 --- a/lib/Tools/document	Tue Sep 29 22:15:54 2009 +0200
    17.2 +++ b/lib/Tools/document	Thu Oct 01 07:40:25 2009 +0200
    17.3 @@ -53,7 +53,7 @@
    17.4        OUTFORMAT="$OPTARG"
    17.5        ;;
    17.6      t)
    17.7 -      ORIG_IFS="$IFS"; IFS=","; TAGS=($OPTARG); IFS="$ORIG_IFS"
    17.8 +      splitarray "," "$OPTARG"; TAGS=("${SPLITARRAY[@]}")
    17.9        ;;
   17.10      \?)
   17.11        usage
    18.1 --- a/lib/Tools/findlogics	Tue Sep 29 22:15:54 2009 +0200
    18.2 +++ b/lib/Tools/findlogics	Thu Oct 01 07:40:25 2009 +0200
    18.3 @@ -25,7 +25,7 @@
    18.4  declare -a LOGICS=()
    18.5  declare -a ISABELLE_PATHS=()
    18.6  
    18.7 -ORIG_IFS="$IFS"; IFS=":"; ISABELLE_PATHS=($ISABELLE_PATH); IFS=$ORIG_IFS
    18.8 +splitarray ":" "$ISABELLE_PATH"; ISABELLE_PATHS=("${SPLITARRAY[@]}")
    18.9  
   18.10  for DIR in "${ISABELLE_PATHS[@]}"
   18.11  do
   18.12 @@ -34,7 +34,7 @@
   18.13    do
   18.14      if [ -f "$FILE" ]; then
   18.15        NAME=$(basename "$FILE")
   18.16 -      LOGICS+=("$NAME")
   18.17 +      LOGICS["${#LOGICS[@]}"]="$NAME"
   18.18      fi
   18.19    done
   18.20  done
    19.1 --- a/lib/Tools/jedit	Tue Sep 29 22:15:54 2009 +0200
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,24 +0,0 @@
    19.4 -#!/usr/bin/env bash
    19.5 -#
    19.6 -# Author: Makarius
    19.7 -#
    19.8 -# DESCRIPTION: Isabelle/jEdit interface wrapper
    19.9 -
   19.10 -
   19.11 -## diagnostics
   19.12 -
   19.13 -function fail()
   19.14 -{
   19.15 -  echo "$1" >&2
   19.16 -  exit 2
   19.17 -}
   19.18 -
   19.19 -
   19.20 -## main
   19.21 -
   19.22 -[ -z "$JEDIT_HOME" ] && fail "Missing Isabelle/jEdit installation (JEDIT_HOME)"
   19.23 -
   19.24 -INTERFACE="$JEDIT_HOME/interface"
   19.25 -[ ! -x "$INTERFACE" ] && fail "Bad interface script: \"$INTERFACE\""
   19.26 -
   19.27 -exec "$INTERFACE" "$@"
    20.1 --- a/lib/Tools/makeall	Tue Sep 29 22:15:54 2009 +0200
    20.2 +++ b/lib/Tools/makeall	Thu Oct 01 07:40:25 2009 +0200
    20.3 @@ -34,7 +34,7 @@
    20.4  echo "Started at $(date) ($ML_IDENTIFIER on $(hostname))"
    20.5  . "$ISABELLE_HOME/lib/scripts/timestart.bash"
    20.6  
    20.7 -ORIG_IFS="$IFS"; IFS=":"; declare -a COMPONENTS=($ISABELLE_COMPONENTS); IFS="$ORIG_IFS"
    20.8 +splitarray ":" "$ISABELLE_COMPONENTS"; COMPONENTS=("${SPLITARRAY[@]}")
    20.9  
   20.10  for DIR in "${COMPONENTS[@]}"
   20.11  do
    21.1 --- a/lib/Tools/usedir	Tue Sep 29 22:15:54 2009 +0200
    21.2 +++ b/lib/Tools/usedir	Thu Oct 01 07:40:25 2009 +0200
    21.3 @@ -262,7 +262,7 @@
    21.4  else
    21.5    { echo "$ITEM FAILED";
    21.6      echo "(see also $LOG)";
    21.7 -    echo; tail "$LOG"; echo; } >&2
    21.8 +    echo; tail -n 20 "$LOG"; echo; } >&2
    21.9  fi
   21.10  
   21.11  exit "$RC"
    22.1 --- a/lib/scripts/getsettings	Tue Sep 29 22:15:54 2009 +0200
    22.2 +++ b/lib/scripts/getsettings	Thu Oct 01 07:40:25 2009 +0200
    22.3 @@ -68,6 +68,17 @@
    22.4    done
    22.5  }
    22.6  
    22.7 +#arrays
    22.8 +function splitarray ()
    22.9 +{
   22.10 +  SPLITARRAY=()
   22.11 +  local IFS="$1"; shift
   22.12 +  for X in $*
   22.13 +  do
   22.14 +    SPLITARRAY["${#SPLITARRAY[@]}"]="$X"
   22.15 +  done
   22.16 +}
   22.17 +
   22.18  #nested components
   22.19  ISABELLE_COMPONENTS=""
   22.20  function init_component ()
    23.1 --- a/lib/scripts/mirabelle	Tue Sep 29 22:15:54 2009 +0200
    23.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.3 @@ -1,129 +0,0 @@
    23.4 -#!/usr/bin/perl -w
    23.5 -
    23.6 -use strict;
    23.7 -use File::Basename;
    23.8 -
    23.9 -# Taken from http://www.skywayradio.com/tech/perl/trim_blanks.html
   23.10 -sub trim {
   23.11 -    my @out = @_;
   23.12 -    for (@out) {
   23.13 -        s/^\s+//;
   23.14 -        s/\s+$//;
   23.15 -    }
   23.16 -    return wantarray ? @out : $out[0];
   23.17 -}
   23.18 -
   23.19 -sub quote {
   23.20 -    my $str = pop;
   23.21 -    return "\"" . $str . "\"";
   23.22 -}
   23.23 -
   23.24 -sub print_usage_and_quit {
   23.25 -    print STDERR "Usage: mirabelle actions file1.thy...\n" .
   23.26 -                 "  actions: action1:...:actionN\n" .
   23.27 -                 "  action: name or name[key1=value1,...,keyM=valueM]\n";
   23.28 -    exit 1;
   23.29 -}
   23.30 -
   23.31 -my $num_args = $#ARGV + 1;
   23.32 -if ($num_args < 2) {
   23.33 -    print_usage_and_quit();
   23.34 -}
   23.35 -
   23.36 -my @action_names;
   23.37 -my @action_settings;
   23.38 -
   23.39 -foreach (split(/:/, $ARGV[0])) {
   23.40 -    my %settings;
   23.41 -
   23.42 -    $_ =~ /([^[]*)(?:\[(.*)\])?/;
   23.43 -    my ($name, $settings_str) = ($1, $2 || "");
   23.44 -    my @setting_strs = split(/,/, $settings_str);
   23.45 -    foreach (@setting_strs) {
   23.46 -        $_ =~ /(.*)=(.*)/;
   23.47 -	    my $key = $1;
   23.48 -	    my $value = $2;
   23.49 -	    $settings{trim($key)} = trim($value);
   23.50 -    }
   23.51 -
   23.52 -    push @action_names, trim($name);
   23.53 -    push @action_settings, \%settings;
   23.54 -}
   23.55 -
   23.56 -my $output_path = "/tmp/mirabelle"; # FIXME: generate path
   23.57 -my $mirabellesetup_thy_name = $output_path . "/MirabelleSetup";
   23.58 -my $mirabellesetup_file = $mirabellesetup_thy_name . ".thy";
   23.59 -my $mirabelle_log_file = $output_path . "/mirabelle.log";
   23.60 -
   23.61 -mkdir $output_path, 0755;
   23.62 -
   23.63 -open(FILE, ">$mirabellesetup_file")
   23.64 -    || die "Could not create file '$mirabellesetup_file'";
   23.65 -
   23.66 -my $invoke_lines;
   23.67 -
   23.68 -for my $i (0 .. $#action_names) { 
   23.69 -    my $settings_str = "";
   23.70 -    my $settings = $action_settings[$i];
   23.71 -    my $key;
   23.72 -    my $value;
   23.73 -
   23.74 -    while (($key, $value) = each(%$settings)) {
   23.75 -        $settings_str .= "(" . quote ($key) . ", " . quote ($value) . "), ";
   23.76 -    }
   23.77 -    $settings_str =~ s/, $//;
   23.78 -
   23.79 -    $invoke_lines .= "setup {* Mirabelle.invoke \"$action_names[$i]\" ";
   23.80 -    $invoke_lines .= "[$settings_str] *}\n"
   23.81 -}
   23.82 -
   23.83 -print FILE <<EOF;
   23.84 -theory MirabelleSetup
   23.85 -imports Mirabelle
   23.86 -begin
   23.87 -
   23.88 -setup {* Mirabelle.set_logfile "$mirabelle_log_file" *}
   23.89 -
   23.90 -$invoke_lines
   23.91 -
   23.92 -end
   23.93 -EOF
   23.94 -
   23.95 -my $root_text = "";
   23.96 -my @new_thy_files;
   23.97 -
   23.98 -for my $i (1 .. $num_args - 1) {
   23.99 -    my $old_thy_file = $ARGV[$i];
  23.100 -    my ($base, $dir, $ext) = fileparse($old_thy_file, "\.thy");
  23.101 -    my $new_thy_name = $base . "Mirabelle";
  23.102 -    my $new_thy_file = $dir . $new_thy_name . $ext;
  23.103 -
  23.104 -    open(OLD_FILE, "<$old_thy_file")
  23.105 -        || die "Cannot open file $old_thy_file";
  23.106 -    my @lines = <OLD_FILE>;
  23.107 -    close(OLD_FILE);
  23.108 -
  23.109 -    my $thy_text = join("", @lines);
  23.110 -    my $old_len = length($thy_text);
  23.111 -    $thy_text =~ s/\btheory\b[^\n]*\s*\bimports\s/theory $new_thy_name\nimports "$mirabellesetup_thy_name" /gm;
  23.112 -    die "No 'imports' found" if length($thy_text) == $old_len;
  23.113 -
  23.114 -    open(NEW_FILE, ">$new_thy_file");
  23.115 -    print NEW_FILE $thy_text;
  23.116 -    close(NEW_FILE);
  23.117 -
  23.118 -    $root_text .= "use_thy \"" . $dir . $new_thy_name . "\";\n";
  23.119 -
  23.120 -    push @new_thy_files, $new_thy_file;
  23.121 -}
  23.122 -
  23.123 -my $root_file = "ROOT_mirabelle.ML";
  23.124 -open(ROOT_FILE, ">$root_file") || die "Cannot open file $root_file";
  23.125 -print ROOT_FILE $root_text;
  23.126 -close(ROOT_FILE);
  23.127 -
  23.128 -system "isabelle-process -e 'use \"ROOT_mirabelle.ML\";' -f -q HOL";
  23.129 -
  23.130 -# unlink $mirabellesetup_file;
  23.131 -unlink $root_file;
  23.132 -unlink @new_thy_files;
    24.1 --- a/src/CCL/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
    24.2 +++ b/src/CCL/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
    24.3 @@ -3,12 +3,11 @@
    24.4      Copyright   1993  University of Cambridge
    24.5  
    24.6  Classical Computational Logic based on First-Order Logic.
    24.7 +
    24.8 +A computational logic for an untyped functional language with
    24.9 +evaluation to weak head-normal form.
   24.10  *)
   24.11  
   24.12 -set eta_contract;
   24.13 -
   24.14 -(* CCL - a computational logic for an untyped functional language *)
   24.15 -(*                       with evaluation to weak head-normal form *)
   24.16 +Unsynchronized.set eta_contract;
   24.17  
   24.18  use_thys ["Wfd", "Fix"];
   24.19 -
    25.1 --- a/src/FOL/fologic.ML	Tue Sep 29 22:15:54 2009 +0200
    25.2 +++ b/src/FOL/fologic.ML	Thu Oct 01 07:40:25 2009 +0200
    25.3 @@ -6,28 +6,28 @@
    25.4  
    25.5  signature FOLOGIC =
    25.6  sig
    25.7 -  val oT		: typ
    25.8 -  val mk_Trueprop	: term -> term
    25.9 -  val dest_Trueprop	: term -> term
   25.10 -  val not		: term
   25.11 -  val conj		: term
   25.12 -  val disj		: term
   25.13 -  val imp		: term
   25.14 -  val iff		: term
   25.15 -  val mk_conj		: term * term -> term
   25.16 -  val mk_disj		: term * term -> term
   25.17 -  val mk_imp		: term * term -> term
   25.18 -  val dest_imp	       	: term -> term*term
   25.19 -  val dest_conj         : term -> term list
   25.20 -  val mk_iff		: term * term -> term
   25.21 -  val dest_iff	       	: term -> term*term
   25.22 -  val all_const		: typ -> term
   25.23 -  val mk_all		: term * term -> term
   25.24 -  val exists_const	: typ -> term
   25.25 -  val mk_exists		: term * term -> term
   25.26 -  val eq_const		: typ -> term
   25.27 -  val mk_eq		: term * term -> term
   25.28 -  val dest_eq 		: term -> term*term
   25.29 +  val oT: typ
   25.30 +  val mk_Trueprop: term -> term
   25.31 +  val dest_Trueprop: term -> term
   25.32 +  val not: term
   25.33 +  val conj: term
   25.34 +  val disj: term
   25.35 +  val imp: term
   25.36 +  val iff: term
   25.37 +  val mk_conj: term * term -> term
   25.38 +  val mk_disj: term * term -> term
   25.39 +  val mk_imp: term * term -> term
   25.40 +  val dest_imp: term -> term * term
   25.41 +  val dest_conj: term -> term list
   25.42 +  val mk_iff: term * term -> term
   25.43 +  val dest_iff: term -> term * term
   25.44 +  val all_const: typ -> term
   25.45 +  val mk_all: term * term -> term
   25.46 +  val exists_const: typ -> term
   25.47 +  val mk_exists: term * term -> term
   25.48 +  val eq_const: typ -> term
   25.49 +  val mk_eq: term * term -> term
   25.50 +  val dest_eq: term -> term * term
   25.51    val mk_binop: string -> term * term -> term
   25.52    val mk_binrel: string -> term * term -> term
   25.53    val dest_bin: string -> typ -> term -> term * term
   25.54 @@ -46,7 +46,8 @@
   25.55  fun dest_Trueprop (Const ("Trueprop", _) $ P) = P
   25.56    | dest_Trueprop t = raise TERM ("dest_Trueprop", [t]);
   25.57  
   25.58 -(** Logical constants **)
   25.59 +
   25.60 +(* Logical constants *)
   25.61  
   25.62  val not = Const ("Not", oT --> oT);
   25.63  val conj = Const("op &", [oT,oT]--->oT);
   25.64 @@ -80,6 +81,7 @@
   25.65  fun exists_const T = Const ("Ex", [T --> oT] ---> oT);
   25.66  fun mk_exists (Free(x,T),P) = exists_const T $ (absfree (x,T,P));
   25.67  
   25.68 +
   25.69  (* binary oprations and relations *)
   25.70  
   25.71  fun mk_binop c (t, u) =
   25.72 @@ -97,5 +99,4 @@
   25.73        else raise TERM ("dest_bin " ^ c, [tm])
   25.74    | dest_bin c _ tm = raise TERM ("dest_bin " ^ c, [tm]);
   25.75  
   25.76 -
   25.77  end;
    26.1 --- a/src/FOL/intprover.ML	Tue Sep 29 22:15:54 2009 +0200
    26.2 +++ b/src/FOL/intprover.ML	Thu Oct 01 07:40:25 2009 +0200
    26.3 @@ -79,8 +79,7 @@
    26.4  (*One safe or unsafe step. *)
    26.5  fun step_tac i = FIRST [safe_tac, inst_step_tac i, biresolve_tac haz_brls i];
    26.6  
    26.7 -fun step_dup_tac i = FIRST [safe_tac, inst_step_tac i, 
    26.8 -			    biresolve_tac haz_dup_brls i];
    26.9 +fun step_dup_tac i = FIRST [safe_tac, inst_step_tac i, biresolve_tac haz_dup_brls i];
   26.10  
   26.11  (*Dumb but fast*)
   26.12  val fast_tac = SELECT_GOAL (DEPTH_SOLVE (step_tac 1));
    27.1 --- a/src/FOLP/IFOLP.thy	Tue Sep 29 22:15:54 2009 +0200
    27.2 +++ b/src/FOLP/IFOLP.thy	Thu Oct 01 07:40:25 2009 +0200
    27.3 @@ -69,7 +69,7 @@
    27.4  ML {*
    27.5  
    27.6  (*show_proofs:=true displays the proof terms -- they are ENORMOUS*)
    27.7 -val show_proofs = ref false;
    27.8 +val show_proofs = Unsynchronized.ref false;
    27.9  
   27.10  fun proof_tr [p,P] = Const (@{const_name Proof}, dummyT) $ P $ p;
   27.11  
    28.1 --- a/src/FOLP/hypsubst.ML	Tue Sep 29 22:15:54 2009 +0200
    28.2 +++ b/src/FOLP/hypsubst.ML	Thu Oct 01 07:40:25 2009 +0200
    28.3 @@ -27,7 +27,7 @@
    28.4    val inspect_pair        : bool -> term * term -> thm
    28.5    end;
    28.6  
    28.7 -functor HypsubstFun(Data: HYPSUBST_DATA): HYPSUBST = 
    28.8 +functor HypsubstFun(Data: HYPSUBST_DATA): HYPSUBST =
    28.9  struct
   28.10  
   28.11  local open Data in
   28.12 @@ -43,13 +43,13 @@
   28.13      but how could we check for this?*)
   28.14  fun inspect_pair bnd (t,u) =
   28.15    case (Envir.eta_contract t, Envir.eta_contract u) of
   28.16 -       (Bound i, _) => if loose(i,u) then raise Match 
   28.17 +       (Bound i, _) => if loose(i,u) then raise Match
   28.18                         else sym         (*eliminates t*)
   28.19 -     | (_, Bound i) => if loose(i,t) then raise Match 
   28.20 +     | (_, Bound i) => if loose(i,t) then raise Match
   28.21                         else asm_rl      (*eliminates u*)
   28.22 -     | (Free _, _) => if bnd orelse Logic.occs(t,u) then raise Match 
   28.23 +     | (Free _, _) => if bnd orelse Logic.occs(t,u) then raise Match
   28.24                        else sym          (*eliminates t*)
   28.25 -     | (_, Free _) => if bnd orelse Logic.occs(u,t) then raise Match 
   28.26 +     | (_, Free _) => if bnd orelse Logic.occs(u,t) then raise Match
   28.27                        else asm_rl       (*eliminates u*)
   28.28       | _ => raise Match;
   28.29  
   28.30 @@ -58,7 +58,7 @@
   28.31     the rule asm_rl (resp. sym). *)
   28.32  fun eq_var bnd =
   28.33    let fun eq_var_aux k (Const("all",_) $ Abs(_,_,t)) = eq_var_aux k t
   28.34 -        | eq_var_aux k (Const("==>",_) $ A $ B) = 
   28.35 +        | eq_var_aux k (Const("==>",_) $ A $ B) =
   28.36                ((k, inspect_pair bnd (dest_eq A))
   28.37                        (*Exception Match comes from inspect_pair or dest_eq*)
   28.38                 handle Match => eq_var_aux (k+1) B)
   28.39 @@ -70,13 +70,13 @@
   28.40  fun gen_hyp_subst_tac bnd = SUBGOAL(fn (Bi,i) =>
   28.41        let val n = length(Logic.strip_assums_hyp Bi) - 1
   28.42            val (k,symopt) = eq_var bnd Bi
   28.43 -      in 
   28.44 +      in
   28.45           DETERM
   28.46             (EVERY [REPEAT_DETERM_N k (etac rev_mp i),
   28.47 -		   etac revcut_rl i,
   28.48 -		   REPEAT_DETERM_N (n-k) (etac rev_mp i),
   28.49 -		   etac (symopt RS subst) i,
   28.50 -		   REPEAT_DETERM_N n (rtac imp_intr i)])
   28.51 +                   etac revcut_rl i,
   28.52 +                   REPEAT_DETERM_N (n-k) (etac rev_mp i),
   28.53 +                   etac (symopt RS subst) i,
   28.54 +                   REPEAT_DETERM_N n (rtac imp_intr i)])
   28.55        end
   28.56        handle THM _ => no_tac | EQ_VAR => no_tac);
   28.57  
    29.1 --- a/src/FOLP/simp.ML	Tue Sep 29 22:15:54 2009 +0200
    29.2 +++ b/src/FOLP/simp.ML	Thu Oct 01 07:40:25 2009 +0200
    29.3 @@ -49,10 +49,10 @@
    29.4  (* temporarily disabled:
    29.5    val extract_free_congs        : unit -> thm list
    29.6  *)
    29.7 -  val tracing   : bool ref
    29.8 +  val tracing   : bool Unsynchronized.ref
    29.9  end;
   29.10  
   29.11 -functor SimpFun (Simp_data: SIMP_DATA) : SIMP = 
   29.12 +functor SimpFun (Simp_data: SIMP_DATA) : SIMP =
   29.13  struct
   29.14  
   29.15  local open Simp_data in
   29.16 @@ -74,12 +74,12 @@
   29.17    Similar to match_from_nat_tac, but the net does not contain numbers;
   29.18    rewrite rules are not ordered.*)
   29.19  fun net_tac net =
   29.20 -  SUBGOAL(fn (prem,i) => 
   29.21 +  SUBGOAL(fn (prem,i) =>
   29.22            resolve_tac (Net.unify_term net (Logic.strip_assums_concl prem)) i);
   29.23  
   29.24  (*match subgoal i against possible theorems indexed by lhs in the net*)
   29.25  fun lhs_net_tac net =
   29.26 -  SUBGOAL(fn (prem,i) => 
   29.27 +  SUBGOAL(fn (prem,i) =>
   29.28            biresolve_tac (Net.unify_term net
   29.29                         (lhs_of (Logic.strip_assums_concl prem))) i);
   29.30  
   29.31 @@ -110,7 +110,7 @@
   29.32  
   29.33  (*Get the norm constants from norm_thms*)
   29.34  val norms =
   29.35 -  let fun norm thm = 
   29.36 +  let fun norm thm =
   29.37        case lhs_of(concl_of thm) of
   29.38            Const(n,_)$_ => n
   29.39          | _ => error "No constant in lhs of a norm_thm"
   29.40 @@ -144,7 +144,7 @@
   29.41  (**** Adding "NORM" tags ****)
   29.42  
   29.43  (*get name of the constant from conclusion of a congruence rule*)
   29.44 -fun cong_const cong = 
   29.45 +fun cong_const cong =
   29.46      case head_of (lhs_of (concl_of cong)) of
   29.47          Const(c,_) => c
   29.48        | _ => ""                 (*a placeholder distinct from const names*);
   29.49 @@ -156,9 +156,9 @@
   29.50  fun add_hidden_vars ccs =
   29.51    let fun add_hvars tm hvars = case tm of
   29.52                Abs(_,_,body) => OldTerm.add_term_vars(body,hvars)
   29.53 -            | _$_ => let val (f,args) = strip_comb tm 
   29.54 +            | _$_ => let val (f,args) = strip_comb tm
   29.55                       in case f of
   29.56 -                            Const(c,T) => 
   29.57 +                            Const(c,T) =>
   29.58                                  if member (op =) ccs c
   29.59                                  then fold_rev add_hvars args hvars
   29.60                                  else OldTerm.add_term_vars (tm, hvars)
   29.61 @@ -202,13 +202,13 @@
   29.62      val hvs = map (#1 o dest_Var) hvars
   29.63      val refl1_tac = refl_tac 1
   29.64      fun norm_step_tac st = st |>
   29.65 -	 (case head_of(rhs_of_eq 1 st) of
   29.66 -	    Var(ixn,_) => if ixn mem hvs then refl1_tac
   29.67 -			  else resolve_tac normI_thms 1 ORELSE refl1_tac
   29.68 -	  | Const _ => resolve_tac normI_thms 1 ORELSE
   29.69 -		       resolve_tac congs 1 ORELSE refl1_tac
   29.70 -	  | Free _ => resolve_tac congs 1 ORELSE refl1_tac
   29.71 -	  | _ => refl1_tac)
   29.72 +         (case head_of(rhs_of_eq 1 st) of
   29.73 +            Var(ixn,_) => if ixn mem hvs then refl1_tac
   29.74 +                          else resolve_tac normI_thms 1 ORELSE refl1_tac
   29.75 +          | Const _ => resolve_tac normI_thms 1 ORELSE
   29.76 +                       resolve_tac congs 1 ORELSE refl1_tac
   29.77 +          | Free _ => resolve_tac congs 1 ORELSE refl1_tac
   29.78 +          | _ => refl1_tac)
   29.79      val add_norm_tac = DEPTH_FIRST (has_fewer_prems nops) norm_step_tac
   29.80      val SOME(thm'',_) = Seq.pull(add_norm_tac thm')
   29.81  in thm'' end;
   29.82 @@ -246,9 +246,9 @@
   29.83  (** Insertion of congruences and rewrites **)
   29.84  
   29.85  (*insert a thm in a thm net*)
   29.86 -fun insert_thm_warn th net = 
   29.87 +fun insert_thm_warn th net =
   29.88    Net.insert_term Thm.eq_thm_prop (concl_of th, th) net
   29.89 -  handle Net.INSERT => 
   29.90 +  handle Net.INSERT =>
   29.91      (writeln ("Duplicate rewrite or congruence rule:\n" ^
   29.92          Display.string_of_thm_without_context th); net);
   29.93  
   29.94 @@ -272,9 +272,9 @@
   29.95  (** Deletion of congruences and rewrites **)
   29.96  
   29.97  (*delete a thm from a thm net*)
   29.98 -fun delete_thm_warn th net = 
   29.99 +fun delete_thm_warn th net =
  29.100    Net.delete_term Thm.eq_thm_prop (concl_of th, th) net
  29.101 -  handle Net.DELETE => 
  29.102 +  handle Net.DELETE =>
  29.103      (writeln ("No such rewrite or congruence rule:\n" ^
  29.104          Display.string_of_thm_without_context th); net);
  29.105  
  29.106 @@ -337,17 +337,17 @@
  29.107      in find_if(tm,0) end;
  29.108  
  29.109  fun IF1_TAC cong_tac i =
  29.110 -    let fun seq_try (ifth::ifths,ifc::ifcs) thm = 
  29.111 +    let fun seq_try (ifth::ifths,ifc::ifcs) thm =
  29.112                  (COND (if_rewritable ifc i) (DETERM(rtac ifth i))
  29.113                          (seq_try(ifths,ifcs))) thm
  29.114                | seq_try([],_) thm = no_tac thm
  29.115          and try_rew thm = (seq_try(case_rews,case_consts) ORELSE one_subt) thm
  29.116          and one_subt thm =
  29.117                  let val test = has_fewer_prems (nprems_of thm + 1)
  29.118 -                    fun loop thm = 
  29.119 -			COND test no_tac
  29.120 +                    fun loop thm =
  29.121 +                        COND test no_tac
  29.122                            ((try_rew THEN DEPTH_FIRST test (refl_tac i))
  29.123 -			   ORELSE (refl_tac i THEN loop)) thm
  29.124 +                           ORELSE (refl_tac i THEN loop)) thm
  29.125                  in (cong_tac THEN loop) thm end
  29.126      in COND (may_match(case_consts,i)) try_rew no_tac end;
  29.127  
  29.128 @@ -366,7 +366,7 @@
  29.129  
  29.130  (** Tracing **)
  29.131  
  29.132 -val tracing = ref false;
  29.133 +val tracing = Unsynchronized.ref false;
  29.134  
  29.135  (*Replace parameters by Free variables in P*)
  29.136  fun variants_abs ([],P) = P
  29.137 @@ -381,12 +381,12 @@
  29.138  
  29.139  (*print lhs of conclusion of subgoal i*)
  29.140  fun pr_goal_lhs i st =
  29.141 -    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st) 
  29.142 +    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st)
  29.143               (lhs_of (prepare_goal i st)));
  29.144  
  29.145  (*print conclusion of subgoal i*)
  29.146  fun pr_goal_concl i st =
  29.147 -    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st) (prepare_goal i st)) 
  29.148 +    writeln (Syntax.string_of_term_global (Thm.theory_of_thm st) (prepare_goal i st))
  29.149  
  29.150  (*print subgoals i to j (inclusive)*)
  29.151  fun pr_goals (i,j) st =
  29.152 @@ -439,7 +439,7 @@
  29.153          then writeln (cat_lines
  29.154            ("Adding rewrites:" :: map Display.string_of_thm_without_context new_rws))
  29.155          else ();
  29.156 -        (ss,thm,anet',anet::ats,cs) 
  29.157 +        (ss,thm,anet',anet::ats,cs)
  29.158      end;
  29.159  
  29.160  fun rew(seq,thm,ss,anet,ats,cs, more) = case Seq.pull seq of
  29.161 @@ -492,7 +492,7 @@
  29.162  
  29.163  fun EXEC_TAC(ss,fl) (SS{auto_tac,cong_net,simp_net,...}) =
  29.164  let val cong_tac = net_tac cong_net
  29.165 -in fn i => 
  29.166 +in fn i =>
  29.167      (fn thm =>
  29.168       if i <= 0 orelse nprems_of thm < i then Seq.empty
  29.169       else Seq.single(execute(ss,fl,auto_tac,cong_tac,simp_net,i,thm)))
    30.1 --- a/src/HOL/Algebra/Divisibility.thy	Tue Sep 29 22:15:54 2009 +0200
    30.2 +++ b/src/HOL/Algebra/Divisibility.thy	Thu Oct 01 07:40:25 2009 +0200
    30.3 @@ -2656,25 +2656,7 @@
    30.4    shows "(x \<in> carrier G \<and> x gcdof a b) =
    30.5           greatest (division_rel G) x (Lower (division_rel G) {a, b})"
    30.6  unfolding isgcd_def greatest_def Lower_def elem_def
    30.7 -proof (simp, safe)
    30.8 -  fix xa
    30.9 -  assume r1[rule_format]: "\<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> xa divides x"
   30.10 -  assume r2[rule_format]: "\<forall>y\<in>carrier G. y divides a \<and> y divides b \<longrightarrow> y divides x"
   30.11 -
   30.12 -  assume "xa \<in> carrier G"  "x divides a"  "x divides b"
   30.13 -  with carr
   30.14 -  show "xa divides x"
   30.15 -      by (fast intro: r1 r2)
   30.16 -next
   30.17 -  fix a' y
   30.18 -  assume r1[rule_format]:
   30.19 -         "\<forall>xa\<in>{l. \<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> l divides x} \<inter> carrier G.
   30.20 -           xa divides x"
   30.21 -  assume "y \<in> carrier G"  "y divides a"  "y divides b"
   30.22 -  with carr
   30.23 -       show "y divides x"
   30.24 -       by (fast intro: r1)
   30.25 -qed (simp, simp)
   30.26 +by auto
   30.27  
   30.28  lemma lcmof_leastUpper:
   30.29    fixes G (structure)
   30.30 @@ -2682,25 +2664,7 @@
   30.31    shows "(x \<in> carrier G \<and> x lcmof a b) =
   30.32           least (division_rel G) x (Upper (division_rel G) {a, b})"
   30.33  unfolding islcm_def least_def Upper_def elem_def
   30.34 -proof (simp, safe)
   30.35 -  fix xa
   30.36 -  assume r1[rule_format]: "\<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> x divides xa"
   30.37 -  assume r2[rule_format]: "\<forall>y\<in>carrier G. a divides y \<and> b divides y \<longrightarrow> x divides y"
   30.38 -
   30.39 -  assume "xa \<in> carrier G"  "a divides x"  "b divides x"
   30.40 -  with carr
   30.41 -  show "x divides xa"
   30.42 -      by (fast intro: r1 r2)
   30.43 -next
   30.44 -  fix a' y
   30.45 -  assume r1[rule_format]:
   30.46 -         "\<forall>xa\<in>{l. \<forall>x. (x = a \<or> x = b) \<and> x \<in> carrier G \<longrightarrow> x divides l} \<inter> carrier G.
   30.47 -           x divides xa"
   30.48 -  assume "y \<in> carrier G"  "a divides y"  "b divides y"
   30.49 -  with carr
   30.50 -       show "x divides y"
   30.51 -       by (fast intro: r1)
   30.52 -qed (simp, simp)
   30.53 +by auto
   30.54  
   30.55  lemma somegcd_meet:
   30.56    fixes G (structure)
    31.1 --- a/src/HOL/Algebra/Exponent.thy	Tue Sep 29 22:15:54 2009 +0200
    31.2 +++ b/src/HOL/Algebra/Exponent.thy	Thu Oct 01 07:40:25 2009 +0200
    31.3 @@ -1,16 +1,13 @@
    31.4  (*  Title:      HOL/Algebra/Exponent.thy
    31.5 -    ID:         $Id$
    31.6      Author:     Florian Kammueller, with new proofs by L C Paulson
    31.7  
    31.8      exponent p s   yields the greatest power of p that divides s.
    31.9  *)
   31.10  
   31.11  theory Exponent
   31.12 -imports Main Primes Binomial
   31.13 +imports Main "~~/src/HOL/Old_Number_Theory/Primes" Binomial
   31.14  begin
   31.15  
   31.16 -hide (open) const GCD.gcd GCD.coprime GCD.prime
   31.17 -
   31.18  section {*Sylow's Theorem*}
   31.19  
   31.20  subsection {*The Combinatorial Argument Underlying the First Sylow Theorem*}
    32.1 --- a/src/HOL/Algebra/FiniteProduct.thy	Tue Sep 29 22:15:54 2009 +0200
    32.2 +++ b/src/HOL/Algebra/FiniteProduct.thy	Thu Oct 01 07:40:25 2009 +0200
    32.3 @@ -212,7 +212,7 @@
    32.4    apply (induct set: finite)
    32.5     apply simp
    32.6    apply (simp add: foldD_insert foldD_commute Int_insert_left insert_absorb
    32.7 -    Int_mono2 Un_subset_iff)
    32.8 +    Int_mono2)
    32.9    done
   32.10  
   32.11  lemma (in LCD) foldD_nest_Un_disjoint:
   32.12 @@ -274,14 +274,14 @@
   32.13    apply (simp add: AC insert_absorb Int_insert_left
   32.14      LCD.foldD_insert [OF LCD.intro [of D]]
   32.15      LCD.foldD_closed [OF LCD.intro [of D]]
   32.16 -    Int_mono2 Un_subset_iff)
   32.17 +    Int_mono2)
   32.18    done
   32.19  
   32.20  lemma (in ACeD) foldD_Un_disjoint:
   32.21    "[| finite A; finite B; A Int B = {}; A \<subseteq> D; B \<subseteq> D |] ==>
   32.22      foldD D f e (A Un B) = foldD D f e A \<cdot> foldD D f e B"
   32.23    by (simp add: foldD_Un_Int
   32.24 -    left_commute LCD.foldD_closed [OF LCD.intro [of D]] Un_subset_iff)
   32.25 +    left_commute LCD.foldD_closed [OF LCD.intro [of D]])
   32.26  
   32.27  
   32.28  subsubsection {* Products over Finite Sets *}
   32.29 @@ -377,7 +377,7 @@
   32.30    from insert have A: "g \<in> A -> carrier G" by fast
   32.31    from insert A a show ?case
   32.32      by (simp add: m_ac Int_insert_left insert_absorb finprod_closed
   32.33 -          Int_mono2 Un_subset_iff) 
   32.34 +          Int_mono2) 
   32.35  qed
   32.36  
   32.37  lemma finprod_Un_disjoint:
    33.1 --- a/src/HOL/Algebra/IntRing.thy	Tue Sep 29 22:15:54 2009 +0200
    33.2 +++ b/src/HOL/Algebra/IntRing.thy	Thu Oct 01 07:40:25 2009 +0200
    33.3 @@ -4,7 +4,7 @@
    33.4  *)
    33.5  
    33.6  theory IntRing
    33.7 -imports QuotRing Lattice Int Primes
    33.8 +imports QuotRing Lattice Int "~~/src/HOL/Old_Number_Theory/Primes"
    33.9  begin
   33.10  
   33.11  
    34.1 --- a/src/HOL/Algebra/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
    34.2 +++ b/src/HOL/Algebra/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
    34.3 @@ -5,7 +5,7 @@
    34.4  *)
    34.5  
    34.6  (* Preliminaries from set and number theory *)
    34.7 -no_document use_thys ["FuncSet", "Primes", "Binomial", "Permutation"];
    34.8 +no_document use_thys ["FuncSet", "~~/src/HOL/Old_Number_Theory/Primes", "Binomial", "Permutation"];
    34.9  
   34.10  
   34.11  (*** New development, based on explicit structures ***)
    35.1 --- a/src/HOL/Algebra/UnivPoly.thy	Tue Sep 29 22:15:54 2009 +0200
    35.2 +++ b/src/HOL/Algebra/UnivPoly.thy	Thu Oct 01 07:40:25 2009 +0200
    35.3 @@ -592,15 +592,14 @@
    35.4          proof (cases "n = k")
    35.5            case True
    35.6            then have "\<zero> = (\<Oplus>i \<in> {..<n} \<union> {n}. ?s i)"
    35.7 -            by (simp cong: R.finsum_cong add: ivl_disj_int_singleton Pi_def)
    35.8 +            by (simp cong: R.finsum_cong add: Pi_def)
    35.9            also from True have "... = (\<Oplus>i \<in> {..k}. ?s i)"
   35.10              by (simp only: ivl_disj_un_singleton)
   35.11            finally show ?thesis .
   35.12          next
   35.13            case False with n_le_k have n_less_k: "n < k" by arith
   35.14            with neq have "\<zero> = (\<Oplus>i \<in> {..<n} \<union> {n}. ?s i)"
   35.15 -            by (simp add: R.finsum_Un_disjoint f1 f2
   35.16 -              ivl_disj_int_singleton Pi_def del: Un_insert_right)
   35.17 +            by (simp add: R.finsum_Un_disjoint f1 f2 Pi_def del: Un_insert_right)
   35.18            also have "... = (\<Oplus>i \<in> {..n}. ?s i)"
   35.19              by (simp only: ivl_disj_un_singleton)
   35.20            also from n_less_k neq have "... = (\<Oplus>i \<in> {..n} \<union> {n<..k}. ?s i)"
   35.21 @@ -817,15 +816,9 @@
   35.22  text {* Degree and polynomial operations *}
   35.23  
   35.24  lemma deg_add [simp]:
   35.25 -  assumes R: "p \<in> carrier P" "q \<in> carrier P"
   35.26 -  shows "deg R (p \<oplus>\<^bsub>P\<^esub> q) <= max (deg R p) (deg R q)"
   35.27 -proof (cases "deg R p <= deg R q")
   35.28 -  case True show ?thesis
   35.29 -    by (rule deg_aboveI) (simp_all add: True R deg_aboveD)
   35.30 -next
   35.31 -  case False show ?thesis
   35.32 -    by (rule deg_aboveI) (simp_all add: False R deg_aboveD)
   35.33 -qed
   35.34 +  "p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow>
   35.35 +  deg R (p \<oplus>\<^bsub>P\<^esub> q) <= max (deg R p) (deg R q)"
   35.36 +by(rule deg_aboveI)(simp_all add: deg_aboveD)
   35.37  
   35.38  lemma deg_monom_le:
   35.39    "a \<in> carrier R ==> deg R (monom P a n) <= n"
   35.40 @@ -945,8 +938,7 @@
   35.41      also have "...= (\<Oplus>i \<in> {deg R p} \<union> {deg R p <.. deg R p + deg R q}. ?s i)"
   35.42        by (simp only: ivl_disj_un_singleton)
   35.43      also have "... = coeff P p (deg R p) \<otimes> coeff P q (deg R q)"
   35.44 -      by (simp cong: R.finsum_cong
   35.45 -	add: ivl_disj_int_singleton deg_aboveD R Pi_def)
   35.46 +      by (simp cong: R.finsum_cong add: deg_aboveD R Pi_def)
   35.47      finally have "(\<Oplus>i \<in> {.. deg R p + deg R q}. ?s i)
   35.48        = coeff P p (deg R p) \<otimes> coeff P q (deg R q)" .
   35.49      with nz show "(\<Oplus>i \<in> {.. deg R p + deg R q}. ?s i) ~= \<zero>"
   35.50 @@ -989,8 +981,7 @@
   35.51      have "... = coeff P (\<Oplus>\<^bsub>P\<^esub> i \<in> {..<k} \<union> {k}. ?s i) k"
   35.52        by (simp only: ivl_disj_un_singleton)
   35.53      also have "... = coeff P p k"
   35.54 -      by (simp cong: R.finsum_cong
   35.55 -	add: ivl_disj_int_singleton coeff_finsum deg_aboveD R RR Pi_def)
   35.56 +      by (simp cong: R.finsum_cong add: coeff_finsum deg_aboveD R RR Pi_def)
   35.57      finally show ?thesis .
   35.58    next
   35.59      case False
   35.60 @@ -998,8 +989,7 @@
   35.61            coeff P (\<Oplus>\<^bsub>P\<^esub> i \<in> {..<deg R p} \<union> {deg R p}. ?s i) k"
   35.62        by (simp only: ivl_disj_un_singleton)
   35.63      also from False have "... = coeff P p k"
   35.64 -      by (simp cong: R.finsum_cong
   35.65 -	add: ivl_disj_int_singleton coeff_finsum deg_aboveD R Pi_def)
   35.66 +      by (simp cong: R.finsum_cong add: coeff_finsum deg_aboveD R Pi_def)
   35.67      finally show ?thesis .
   35.68    qed
   35.69  qed (simp_all add: R Pi_def)
    36.1 --- a/src/HOL/Algebra/abstract/Ring2.thy	Tue Sep 29 22:15:54 2009 +0200
    36.2 +++ b/src/HOL/Algebra/abstract/Ring2.thy	Thu Oct 01 07:40:25 2009 +0200
    36.3 @@ -241,7 +241,7 @@
    36.4  proof (induct n)
    36.5    case 0 show ?case by simp
    36.6  next
    36.7 -  case Suc thus ?case by (simp add: add_assoc) 
    36.8 +  case Suc thus ?case by (simp add: add_assoc)
    36.9  qed
   36.10  
   36.11  lemma natsum_cong [cong]:
   36.12 @@ -269,21 +269,21 @@
   36.13  
   36.14  ML {*
   36.15    local
   36.16 -    val lhss = 
   36.17 +    val lhss =
   36.18          ["t + u::'a::ring",
   36.19 -	 "t - u::'a::ring",
   36.20 -	 "t * u::'a::ring",
   36.21 -	 "- t::'a::ring"];
   36.22 -    fun proc ss t = 
   36.23 +         "t - u::'a::ring",
   36.24 +         "t * u::'a::ring",
   36.25 +         "- t::'a::ring"];
   36.26 +    fun proc ss t =
   36.27        let val rew = Goal.prove (Simplifier.the_context ss) [] []
   36.28              (HOLogic.mk_Trueprop
   36.29                (HOLogic.mk_eq (t, Var (("x", Term.maxidx_of_term t + 1), fastype_of t))))
   36.30                  (fn _ => simp_tac (Simplifier.inherit_context ss ring_ss) 1)
   36.31              |> mk_meta_eq;
   36.32            val (t', u) = Logic.dest_equals (Thm.prop_of rew);
   36.33 -      in if t' aconv u 
   36.34 +      in if t' aconv u
   36.35          then NONE
   36.36 -        else SOME rew 
   36.37 +        else SOME rew
   36.38      end;
   36.39    in
   36.40      val ring_simproc = Simplifier.simproc @{theory} "ring" lhss (K proc);
   36.41 @@ -305,7 +305,7 @@
   36.42  declare one_not_zero [simp]
   36.43  
   36.44  lemma zero_not_one [simp]:
   36.45 -  "0 ~= (1::'a::domain)" 
   36.46 +  "0 ~= (1::'a::domain)"
   36.47  by (rule not_sym) simp
   36.48  
   36.49  lemma integral_iff: (* not by default a simp rule! *)
   36.50 @@ -322,7 +322,7 @@
   36.51  *)
   36.52  (*
   36.53  lemma bug: "(b::'a::ring) - (b - a) = a" by simp
   36.54 -   simproc for rings cannot prove "(a::'a::ring) - (a - b) = b" 
   36.55 +   simproc for rings cannot prove "(a::'a::ring) - (a - b) = b"
   36.56  *)
   36.57  lemma m_lcancel:
   36.58    assumes prem: "(a::'a::domain) ~= 0" shows conc: "(a * b = a * c) = (b = c)"
   36.59 @@ -330,8 +330,8 @@
   36.60    assume eq: "a * b = a * c"
   36.61    then have "a * (b - c) = 0" by simp
   36.62    then have "a = 0 | (b - c) = 0" by (simp only: integral_iff)
   36.63 -  with prem have "b - c = 0" by auto 
   36.64 -  then have "b = b - (b - c)" by simp 
   36.65 +  with prem have "b - c = 0" by auto
   36.66 +  then have "b = b - (b - c)" by simp
   36.67    also have "b - (b - c) = c" by simp
   36.68    finally show "b = c" .
   36.69  next
   36.70 @@ -386,7 +386,7 @@
   36.71  qed
   36.72  
   36.73  
   36.74 -lemma unit_mult: 
   36.75 +lemma unit_mult:
   36.76    "!!a::'a::ring. [| a dvd 1; b dvd 1 |] ==> a * b dvd 1"
   36.77    apply (unfold dvd_def)
   36.78    apply clarify
    37.1 --- a/src/HOL/Algebra/poly/UnivPoly2.thy	Tue Sep 29 22:15:54 2009 +0200
    37.2 +++ b/src/HOL/Algebra/poly/UnivPoly2.thy	Thu Oct 01 07:40:25 2009 +0200
    37.3 @@ -563,11 +563,7 @@
    37.4  
    37.5  lemma deg_add [simp]:
    37.6    "deg ((p::'a::ring up) + q) <= max (deg p) (deg q)"
    37.7 -proof (cases "deg p <= deg q")
    37.8 -  case True show ?thesis by (rule deg_aboveI) (simp add: True deg_aboveD) 
    37.9 -next
   37.10 -  case False show ?thesis by (rule deg_aboveI) (simp add: False deg_aboveD)
   37.11 -qed
   37.12 +by (rule deg_aboveI) (simp add: deg_aboveD)
   37.13  
   37.14  lemma deg_monom_ring:
   37.15    "deg (monom a n::'a::ring up) <= n"
   37.16 @@ -678,8 +674,7 @@
   37.17      also have "... = setsum ?s ({deg p} Un {deg p <.. deg p + deg q})"
   37.18        by (simp only: ivl_disj_un_singleton)
   37.19      also have "... = coeff p (deg p) * coeff q (deg q)" 
   37.20 -      by (simp add: setsum_Un_disjoint ivl_disj_int_singleton 
   37.21 -        setsum_0 deg_aboveD)
   37.22 +      by (simp add: setsum_Un_disjoint setsum_0 deg_aboveD)
   37.23      finally have "setsum ?s {.. deg p + deg q} 
   37.24        = coeff p (deg p) * coeff q (deg q)" .
   37.25      with nz show "setsum ?s {.. deg p + deg q} ~= 0"
   37.26 @@ -723,8 +718,7 @@
   37.27      have "... = coeff (setsum ?s ({..<k} Un {k})) k"
   37.28        by (simp only: ivl_disj_un_singleton)
   37.29      also have "... = coeff p k"
   37.30 -      by (simp add: setsum_Un_disjoint ivl_disj_int_singleton 
   37.31 -        setsum_0 coeff_natsum deg_aboveD)
   37.32 +      by (simp add: setsum_Un_disjoint setsum_0 coeff_natsum deg_aboveD)
   37.33      finally show ?thesis .
   37.34    next
   37.35      case False
   37.36 @@ -732,8 +726,7 @@
   37.37            coeff (setsum ?s ({..<deg p} Un {deg p})) k"
   37.38        by (simp only: ivl_disj_un_singleton)
   37.39      also from False have "... = coeff p k"
   37.40 -      by (simp add: setsum_Un_disjoint ivl_disj_int_singleton 
   37.41 -        setsum_0 coeff_natsum deg_aboveD)
   37.42 +      by (simp add: setsum_Un_disjoint setsum_0 coeff_natsum deg_aboveD)
   37.43      finally show ?thesis .
   37.44    qed
   37.45  qed
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/HOL/Auth/All_Symmetric.thy	Thu Oct 01 07:40:25 2009 +0200
    38.3 @@ -0,0 +1,12 @@
    38.4 +theory All_Symmetric
    38.5 +imports Message
    38.6 +begin
    38.7 +
    38.8 +text {* All keys are symmetric *}
    38.9 +
   38.10 +defs all_symmetric_def: "all_symmetric \<equiv> True"
   38.11 +
   38.12 +lemma isSym_keys: "K \<in> symKeys"
   38.13 +  by (simp add: symKeys_def all_symmetric_def invKey_symmetric) 
   38.14 +
   38.15 +end
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/HOL/Auth/Auth_Public.thy	Thu Oct 01 07:40:25 2009 +0200
    39.3 @@ -0,0 +1,15 @@
    39.4 +(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    39.5 +    Copyright   1996  University of Cambridge
    39.6 +*)
    39.7 +
    39.8 +header {* Conventional protocols: rely on conventional Message, Event and Public -- Public-key protocols *}
    39.9 +
   39.10 +theory Auth_Public
   39.11 +imports
   39.12 +  "NS_Public_Bad"
   39.13 +  "NS_Public"
   39.14 +  "TLS"
   39.15 +  "CertifiedEmail"
   39.16 +begin
   39.17 +
   39.18 +end
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/HOL/Auth/Auth_Shared.thy	Thu Oct 01 07:40:25 2009 +0200
    40.3 @@ -0,0 +1,27 @@
    40.4 +(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    40.5 +    Copyright   1996  University of Cambridge
    40.6 +*)
    40.7 +
    40.8 +header {* Conventional protocols: rely on conventional Message, Event and Public -- Shared-key protocols *}
    40.9 +
   40.10 +theory Auth_Shared
   40.11 +imports
   40.12 +  "NS_Shared"
   40.13 +  "Kerberos_BAN"
   40.14 +  "Kerberos_BAN_Gets"
   40.15 +  "KerberosIV"
   40.16 +  "KerberosIV_Gets"
   40.17 +  "KerberosV"
   40.18 +  "OtwayRees"
   40.19 +  "OtwayRees_AN"
   40.20 +  "OtwayRees_Bad"
   40.21 +  "OtwayReesBella"
   40.22 +  "WooLam"
   40.23 +  "Recur"
   40.24 +  "Yahalom"
   40.25 +  "Yahalom2"
   40.26 +  "Yahalom_Bad"
   40.27 +  "ZhouGollmann"
   40.28 +begin
   40.29 +
   40.30 +end
    41.1 --- a/src/HOL/Auth/Event.thy	Tue Sep 29 22:15:54 2009 +0200
    41.2 +++ b/src/HOL/Auth/Event.thy	Thu Oct 01 07:40:25 2009 +0200
    41.3 @@ -139,9 +139,11 @@
    41.4  
    41.5  text{*Elimination rules: derive contradictions from old Says events containing
    41.6    items known to be fresh*}
    41.7 +lemmas Says_imp_parts_knows_Spy = 
    41.8 +       Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
    41.9 +
   41.10  lemmas knows_Spy_partsEs =
   41.11 -     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
   41.12 -     parts.Body [THEN revcut_rl, standard]
   41.13 +     Says_imp_parts_knows_Spy parts.Body [THEN revcut_rl, standard]
   41.14  
   41.15  lemmas Says_imp_analz_Spy = Says_imp_knows_Spy [THEN analz.Inj]
   41.16  
    42.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.2 +++ b/src/HOL/Auth/Guard/Auth_Guard_Public.thy	Thu Oct 01 07:40:25 2009 +0200
    42.3 @@ -0,0 +1,15 @@
    42.4 +(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    42.5 +    Copyright   1996  University of Cambridge
    42.6 +*)
    42.7 +
    42.8 +header {* Blanqui's "guard" concept: protocol-independent secrecy *}
    42.9 +
   42.10 +theory Auth_Guard_Public
   42.11 +imports
   42.12 +  "P1"
   42.13 +  "P2"
   42.14 +  "Guard_NS_Public"
   42.15 +  "Proto"
   42.16 +begin
   42.17 +
   42.18 +end
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/HOL/Auth/Guard/Auth_Guard_Shared.thy	Thu Oct 01 07:40:25 2009 +0200
    43.3 @@ -0,0 +1,13 @@
    43.4 +(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    43.5 +    Copyright   1996  University of Cambridge
    43.6 +*)
    43.7 +
    43.8 +header {* Blanqui's "guard" concept: protocol-independent secrecy *}
    43.9 +
   43.10 +theory Auth_Guard_Shared
   43.11 +imports
   43.12 +  "Guard_OtwayRees"
   43.13 +  "Guard_Yahalom"
   43.14 +begin
   43.15 +
   43.16 +end
    44.1 --- a/src/HOL/Auth/Guard/Extensions.thy	Tue Sep 29 22:15:54 2009 +0200
    44.2 +++ b/src/HOL/Auth/Guard/Extensions.thy	Thu Oct 01 07:40:25 2009 +0200
    44.3 @@ -11,7 +11,9 @@
    44.4  
    44.5  header {*Extensions to Standard Theories*}
    44.6  
    44.7 -theory Extensions imports "../Event" begin
    44.8 +theory Extensions
    44.9 +imports "../Event"
   44.10 +begin
   44.11  
   44.12  subsection{*Extensions to Theory @{text Set}*}
   44.13  
   44.14 @@ -173,7 +175,7 @@
   44.15  subsubsection{*lemmas on analz*}
   44.16  
   44.17  lemma analz_UnI1 [intro]: "X:analz G ==> X:analz (G Un H)"
   44.18 -by (subgoal_tac "G <= G Un H", auto dest: analz_mono)
   44.19 +  by (subgoal_tac "G <= G Un H") (blast dest: analz_mono)+
   44.20  
   44.21  lemma analz_sub: "[| X:analz G; G <= H |] ==> X:analz H"
   44.22  by (auto dest: analz_mono)
    45.1 --- a/src/HOL/Auth/KerberosIV.thy	Tue Sep 29 22:15:54 2009 +0200
    45.2 +++ b/src/HOL/Auth/KerberosIV.thy	Thu Oct 01 07:40:25 2009 +0200
    45.3 @@ -899,7 +899,6 @@
    45.4  apply (frule_tac [7] Says_ticket_parts)
    45.5  apply (simp_all (no_asm_simp))
    45.6  apply blast
    45.7 -atp_minimize [atp=spass] Crypt_imp_invKey_keysFor invKey_K new_keys_not_used
    45.8  apply (metis Crypt_imp_invKey_keysFor invKey_K new_keys_not_used)
    45.9  apply (clarify)
   45.10  apply (frule Says_Tgs_message_form, assumption)
   45.11 @@ -1316,7 +1315,6 @@
   45.12  txt{*K4*}
   45.13  apply blast
   45.14  txt{*Level 8: K5*}
   45.15 -atp_minimize [atp=e] Tgs_not_bad authKeysI less_SucI mem_def nat_add_commute servK_notin_authKeysD spies_partsEs(1)
   45.16  apply (blast dest: servK_notin_authKeysD Says_Kas_message_form intro: less_SucI)
   45.17  txt{*Oops1*}
   45.18  apply (blast dest!: unique_authKeys intro: less_SucI)
    46.1 --- a/src/HOL/Auth/KerberosV.thy	Tue Sep 29 22:15:54 2009 +0200
    46.2 +++ b/src/HOL/Auth/KerberosV.thy	Thu Oct 01 07:40:25 2009 +0200
    46.3 @@ -697,9 +697,7 @@
    46.4  txt{*K4*}
    46.5  apply (force dest!: Crypt_imp_keysFor, clarify)
    46.6  txt{*K6*}
    46.7 -apply (drule  Says_imp_spies [THEN parts.Inj, THEN parts.Fst])
    46.8 -apply (drule  Says_imp_spies [THEN parts.Inj, THEN parts.Snd])
    46.9 -apply (blast dest!: unique_CryptKey)
   46.10 +apply (metis Says_imp_spies Says_ticket_parts analz.Fst analz.Inj analz_conj_parts unique_CryptKey)
   46.11  done
   46.12  
   46.13  text{*Needs a unicity theorem, hence moved here*}
   46.14 @@ -841,13 +839,10 @@
   46.15  apply (erule kerbV.induct, analz_mono_contra)
   46.16  apply (frule_tac [7] Says_ticket_parts)
   46.17  apply (frule_tac [5] Says_ticket_parts, simp_all, blast)
   46.18 -txt{*K4 splits into distinct subcases*}
   46.19 -apply auto
   46.20 -txt{*servK can't have been enclosed in two certificates*}
   46.21 - prefer 2 apply (blast dest: unique_CryptKey)
   46.22 -txt{*servK is fresh and so could not have been used, by
   46.23 -   @{text new_keys_not_used}*}
   46.24 -apply (force dest!: Crypt_imp_invKey_keysFor simp add: AKcryptSK_def)
   46.25 +txt{*K4*}
   46.26 +apply (metis Auth_fresh_not_AKcryptSK Crypt_imp_invKey_keysFor Says_ticket_analz
   46.27 +         analz.Fst invKey_K new_keys_not_analzd parts.Fst Says_imp_parts_knows_Spy
   46.28 +         unique_CryptKey)
   46.29  done
   46.30  
   46.31  text{*Long term keys are not issued as servKeys*}
   46.32 @@ -981,9 +976,7 @@
   46.33  txt{*K4*}
   46.34  apply (blast dest!: authK_not_AKcryptSK)
   46.35  txt{*Oops1*}
   46.36 -apply clarify
   46.37 -apply simp
   46.38 -apply (blast dest!: AKcryptSK_analz_insert)
   46.39 +apply (metis AKcryptSK_analz_insert insert_Key_singleton)
   46.40  done
   46.41  
   46.42  text{* First simplification law for analz: no session keys encrypt
   46.43 @@ -1039,8 +1032,8 @@
   46.44          \<in> set evs;  authK \<in> symKeys;
   46.45           Key authK \<in> analz (spies evs); evs \<in> kerbV \<rbrakk>
   46.46        \<Longrightarrow> Key servK \<in> analz (spies evs)"
   46.47 -apply (force dest: Says_imp_spies [THEN analz.Inj, THEN analz.Fst, THEN analz.Decrypt, THEN analz.Fst])
   46.48 -done
   46.49 +  by (metis Says_imp_analz_Spy analz.Fst analz_Decrypt')
   46.50 +
   46.51  
   46.52  text{*lemma @{text servK_notin_authKeysD} not needed in version V*}
   46.53  
   46.54 @@ -1112,16 +1105,16 @@
   46.55  apply (frule_tac [5] Says_ticket_analz)
   46.56  apply (safe del: impI conjI impCE)
   46.57  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)
   46.58 -txt{*Fake*}
   46.59 -apply spy_analz
   46.60 -txt{*K2*}
   46.61 -apply (blast intro: parts_insertI less_SucI)
   46.62 -txt{*K4*}
   46.63 -apply (blast dest: authTicket_authentic Confidentiality_Kas)
   46.64 -txt{*Oops1*}
   46.65 +    txt{*Fake*}
   46.66 +    apply spy_analz
   46.67 +   txt{*K2*}
   46.68 +   apply (blast intro: parts_insertI less_SucI)
   46.69 +  txt{*K4*}
   46.70 +  apply (blast dest: authTicket_authentic Confidentiality_Kas)
   46.71 + txt{*Oops1*}
   46.72   apply (blast dest: Says_Kas_message_form Says_Tgs_message_form intro: less_SucI)
   46.73  txt{*Oops2*}
   46.74 -  apply (blast dest: Says_imp_spies [THEN parts.Inj] Key_unique_SesKey intro: less_SucI)
   46.75 +apply (metis Suc_le_eq linorder_linear linorder_not_le msg.simps(2) unique_servKeys)
   46.76  done
   46.77  
   46.78  
   46.79 @@ -1270,17 +1263,7 @@
   46.80           Key authK \<notin> analz (spies evs); Key servK \<notin> analz (spies evs);
   46.81           A \<notin> bad;  B \<notin> bad; evs \<in> kerbV \<rbrakk>
   46.82        \<Longrightarrow> Says B A (Crypt servK (Number T3)) \<in> set evs"
   46.83 -apply (frule authK_authentic)
   46.84 -apply assumption+
   46.85 -apply (frule servK_authentic)
   46.86 -prefer 2 apply (blast dest: authK_authentic Says_Kas_message_form)
   46.87 -apply assumption+
   46.88 -apply clarify
   46.89 -apply (blast dest: K4_imp_K2 Key_unique_SesKey intro!: Says_K6)
   46.90 -(*Single command proof: much slower!
   46.91 -apply (blast dest: authK_authentic servK_authentic Says_Kas_message_form Key_unique_SesKey K4_imp_K2 intro!: Says_K6)
   46.92 -*)
   46.93 -done
   46.94 +  by (metis authK_authentic Oops_range_spies1 Says_K6 servK_authentic u_K4_imp_K2 unique_authKeys)
   46.95  
   46.96  lemma A_authenticates_B_r:
   46.97       "\<lbrakk> Crypt servK (Number T3) \<in> parts (spies evs);
   46.98 @@ -1301,8 +1284,7 @@
   46.99  apply (erule_tac [9] exE)
  46.100  apply (frule_tac [9] K4_imp_K2)
  46.101  apply assumption+
  46.102 -apply (blast dest: Key_unique_SesKey intro!: Says_K6 dest: Confidentiality_Tgs
  46.103 -)
  46.104 +apply (blast dest: Key_unique_SesKey intro!: Says_K6 dest: Confidentiality_Tgs)
  46.105  done
  46.106  
  46.107  
  46.108 @@ -1478,7 +1460,7 @@
  46.109  ...expands as follows - including extra exE because of new form of lemmas*)
  46.110  apply (frule K3_imp_K2, assumption, assumption, erule exE, erule exE)
  46.111  apply (case_tac "Key authK \<in> analz (spies evs5)")
  46.112 -apply (drule Says_imp_knows_Spy [THEN analz.Inj, THEN analz.Fst, THEN analz_Decrypt', THEN analz.Fst], assumption, assumption, simp)
  46.113 + apply (metis Says_imp_analz_Spy analz.Fst analz_Decrypt')
  46.114  apply (frule K3_imp_K2, assumption, assumption, erule exE, erule exE)
  46.115  apply (drule Says_imp_knows_Spy [THEN parts.Inj, THEN parts.Fst])
  46.116  apply (frule servK_authentic_ter, blast, assumption+)
    47.1 --- a/src/HOL/Auth/Kerberos_BAN.thy	Tue Sep 29 22:15:54 2009 +0200
    47.2 +++ b/src/HOL/Auth/Kerberos_BAN.thy	Thu Oct 01 07:40:25 2009 +0200
    47.3 @@ -288,15 +288,8 @@
    47.4                    on evs)"
    47.5  apply (unfold before_def)
    47.6  apply (erule rev_mp)
    47.7 -apply (erule bankerberos.induct, simp_all)
    47.8 -txt{*We need this simplification only for Message 2*}
    47.9 -apply (simp (no_asm) add: takeWhile_tail)
   47.10 -apply auto
   47.11 -txt{*Two subcases of Message 2. Subcase: used before*}
   47.12 -apply (blast dest: used_evs_rev [THEN equalityD2, THEN contra_subsetD] 
   47.13 -                   used_takeWhile_used)
   47.14 -txt{*subcase: CT before*}
   47.15 -apply (fastsimp dest!: set_evs_rev [THEN equalityD2, THEN contra_subsetD, THEN takeWhile_void])
   47.16 +apply (erule bankerberos.induct, simp_all add: takeWhile_tail)
   47.17 +apply (metis length_rev set_rev takeWhile_void used_evs_rev)
   47.18  done
   47.19  
   47.20  
   47.21 @@ -492,6 +485,7 @@
   47.22  txt{*BK3*}
   47.23  apply (blast dest: Kab_authentic unique_session_keys)
   47.24  done
   47.25 +
   47.26  lemma lemma_B [rule_format]:
   47.27       "\<lbrakk> B \<notin> bad;  evs \<in> bankerberos \<rbrakk>
   47.28        \<Longrightarrow> Key K \<notin> analz (spies evs) \<longrightarrow>
   47.29 @@ -585,9 +579,8 @@
   47.30  txt{*BK2*}
   47.31  apply (blast intro: parts_insertI less_SucI)
   47.32  txt{*BK3*}
   47.33 -apply (case_tac "Aa \<in> bad")
   47.34 - prefer 2 apply (blast dest: Kab_authentic unique_session_keys)
   47.35 -apply (blast dest: Says_imp_spies [THEN analz.Inj] Crypt_Spy_analz_bad elim!: MPair_analz intro: less_SucI)
   47.36 +apply (metis Crypt_Spy_analz_bad Kab_authentic Says_imp_analz_Spy 
   47.37 +          Says_imp_parts_knows_Spy analz.Snd less_SucI unique_session_keys)
   47.38  txt{*Oops: PROOF FAILS if unsafe intro below*}
   47.39  apply (blast dest: unique_session_keys intro!: less_SucI)
   47.40  done
    48.1 --- a/src/HOL/Auth/NS_Shared.thy	Tue Sep 29 22:15:54 2009 +0200
    48.2 +++ b/src/HOL/Auth/NS_Shared.thy	Thu Oct 01 07:40:25 2009 +0200
    48.3 @@ -273,11 +273,11 @@
    48.4  apply (simp_all add: analz_insert_eq analz_insert_freshK pushes split_ifs, spy_analz)
    48.5  txt{*NS2*}
    48.6  apply blast
    48.7 -txt{*NS3, Server sub-case*}
    48.8 +txt{*NS3*}
    48.9  apply (blast dest!: Crypt_Spy_analz_bad A_trusts_NS2
   48.10  	     dest:  Says_imp_knows_Spy analz.Inj unique_session_keys)
   48.11 -txt{*NS3, Spy sub-case; also Oops*}
   48.12 -apply (blast dest: unique_session_keys)+
   48.13 +txt{*Oops*}
   48.14 +apply (blast dest: unique_session_keys)
   48.15  done
   48.16  
   48.17  
   48.18 @@ -318,9 +318,7 @@
   48.19      @{term "Crypt K (Nonce NB) \<in> parts (spies evs2)"} *} 
   48.20  apply (force dest!: Crypt_imp_keysFor)
   48.21  txt{*NS4*}
   48.22 -apply (blast dest: B_trusts_NS3
   48.23 -	           Says_imp_knows_Spy [THEN analz.Inj]
   48.24 -                   Crypt_Spy_analz_bad unique_session_keys)
   48.25 +apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
   48.26  done
   48.27  
   48.28  text{*This version no longer assumes that K is secure*}
   48.29 @@ -349,9 +347,7 @@
   48.30  txt{*NS2*}
   48.31  apply (blast dest!: new_keys_not_used Crypt_imp_keysFor)
   48.32  txt{*NS4*}
   48.33 -apply (blast dest: B_trusts_NS3
   48.34 -	     dest: Says_imp_knows_Spy [THEN analz.Inj]
   48.35 -                   unique_session_keys Crypt_Spy_analz_bad)
   48.36 +apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
   48.37  done
   48.38  
   48.39  
   48.40 @@ -475,18 +471,15 @@
   48.41  apply (erule rev_mp)
   48.42  apply (erule rev_mp)
   48.43  apply (erule ns_shared.induct, analz_mono_contra)
   48.44 -apply (frule_tac [5] Says_S_message_form)
   48.45  apply (simp_all)
   48.46  txt{*Fake*}
   48.47  apply blast
   48.48  txt{*NS2*}
   48.49  apply (force dest!: Crypt_imp_keysFor)
   48.50 -txt{*NS3, much quicker having installed @{term Says_S_message_form} before simplication*}
   48.51 -apply fastsimp
   48.52 +txt{*NS3*}
   48.53 +apply (metis NS3_msg_in_parts_spies parts_cut_eq)
   48.54  txt{*NS5, the most important case, can be solved by unicity*}
   48.55 -apply (case_tac "Aa \<in> bad")
   48.56 -apply (force dest!: Says_imp_spies [THEN analz.Inj, THEN analz.Decrypt, THEN analz.Snd, THEN analz.Snd, THEN analz.Fst])
   48.57 -apply (blast dest: A_trusts_NS2 unique_session_keys)
   48.58 +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)
   48.59  done
   48.60  
   48.61  lemma A_Issues_B:
    49.1 --- a/src/HOL/Auth/Public.thy	Tue Sep 29 22:15:54 2009 +0200
    49.2 +++ b/src/HOL/Auth/Public.thy	Thu Oct 01 07:40:25 2009 +0200
    49.3 @@ -1,5 +1,4 @@
    49.4  (*  Title:      HOL/Auth/Public
    49.5 -    ID:         $Id$
    49.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    49.7      Copyright   1996  University of Cambridge
    49.8  
    49.9 @@ -8,7 +7,9 @@
   49.10  Private and public keys; initial states of agents
   49.11  *)
   49.12  
   49.13 -theory Public imports Event begin
   49.14 +theory Public
   49.15 +imports Event
   49.16 +begin
   49.17  
   49.18  lemma invKey_K: "K \<in> symKeys ==> invKey K = K"
   49.19  by (simp add: symKeys_def)
    50.1 --- a/src/HOL/Auth/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
    50.2 +++ b/src/HOL/Auth/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
    50.3 @@ -1,51 +1,2 @@
    50.4 -(*  Title:      HOL/Auth/ROOT.ML
    50.5 -    ID:         $Id$
    50.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    50.7 -    Copyright   1996  University of Cambridge
    50.8  
    50.9 -Root file for protocol proofs.
   50.10 -*)
   50.11 -
   50.12 -use_thys [
   50.13 -
   50.14 -(* Conventional protocols: rely on 
   50.15 -   conventional Message, Event and Public *)
   50.16 -
   50.17 -(*Shared-key protocols*)
   50.18 -  "NS_Shared",
   50.19 -  "Kerberos_BAN",
   50.20 -  "Kerberos_BAN_Gets",
   50.21 -  "KerberosIV",
   50.22 -  "KerberosIV_Gets",
   50.23 -  "KerberosV",
   50.24 -  "OtwayRees",
   50.25 -  "OtwayRees_AN",
   50.26 -  "OtwayRees_Bad",
   50.27 -  "OtwayReesBella",
   50.28 -  "WooLam",
   50.29 -  "Recur",
   50.30 -  "Yahalom",
   50.31 -  "Yahalom2",
   50.32 -  "Yahalom_Bad",
   50.33 -  "ZhouGollmann",
   50.34 -
   50.35 -(*Public-key protocols*)
   50.36 -  "NS_Public_Bad",
   50.37 -  "NS_Public",
   50.38 -  "TLS",
   50.39 -  "CertifiedEmail",
   50.40 -
   50.41 -(*Smartcard protocols: rely on conventional Message and on new
   50.42 -  EventSC and Smartcard *)
   50.43 -
   50.44 -  "Smartcard/ShoupRubin",
   50.45 -  "Smartcard/ShoupRubinBella",
   50.46 -
   50.47 -(*Blanqui's "guard" concept: protocol-independent secrecy*)
   50.48 -  "Guard/P1",
   50.49 -  "Guard/P2",
   50.50 -  "Guard/Guard_NS_Public",
   50.51 -  "Guard/Guard_OtwayRees",
   50.52 -  "Guard/Guard_Yahalom",
   50.53 -  "Guard/Proto"
   50.54 -];
   50.55 +use_thys ["Auth_Shared", "Auth_Public", "Smartcard/Auth_Smartcard", "Guard/Auth_Guard_Shared", "Guard/Auth_Guard_Public"];
    51.1 --- a/src/HOL/Auth/Recur.thy	Tue Sep 29 22:15:54 2009 +0200
    51.2 +++ b/src/HOL/Auth/Recur.thy	Thu Oct 01 07:40:25 2009 +0200
    51.3 @@ -419,15 +419,10 @@
    51.4  apply spy_analz
    51.5  txt{*RA2*}
    51.6  apply blast 
    51.7 -txt{*RA3 remains*}
    51.8 +txt{*RA3*}
    51.9  apply (simp add: parts_insert_spies)
   51.10 -txt{*Now we split into two cases.  A single blast could do it, but it would take
   51.11 -  a CPU minute.*}
   51.12 -apply (safe del: impCE)
   51.13 -txt{*RA3, case 1: use lemma previously proved by induction*}
   51.14 -apply (blast elim: rev_notE [OF _ respond_Spy_not_see_session_key])
   51.15 -txt{*RA3, case 2: K is an old key*}
   51.16 -apply (blast dest: resp_analz_insert dest: Key_in_parts_respond)
   51.17 +apply (metis Key_in_parts_respond parts.Body parts.Fst resp_analz_insert 
   51.18 +             respond_Spy_not_see_session_key usedI)
   51.19  txt{*RA4*}
   51.20  apply blast 
   51.21  done
    52.1 --- a/src/HOL/Auth/Shared.thy	Tue Sep 29 22:15:54 2009 +0200
    52.2 +++ b/src/HOL/Auth/Shared.thy	Thu Oct 01 07:40:25 2009 +0200
    52.3 @@ -1,5 +1,4 @@
    52.4  (*  Title:      HOL/Auth/Shared
    52.5 -    ID:         $Id$
    52.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    52.7      Copyright   1996  University of Cambridge
    52.8  
    52.9 @@ -8,7 +7,9 @@
   52.10  Shared, long-term keys; initial states of agents
   52.11  *)
   52.12  
   52.13 -theory Shared imports Event begin
   52.14 +theory Shared
   52.15 +imports Event All_Symmetric
   52.16 +begin
   52.17  
   52.18  consts
   52.19    shrK    :: "agent => key"  (*symmetric keys*);
   52.20 @@ -20,13 +21,6 @@
   52.21     apply (simp add: inj_on_def split: agent.split) 
   52.22     done
   52.23  
   52.24 -text{*All keys are symmetric*}
   52.25 -
   52.26 -defs  all_symmetric_def: "all_symmetric == True"
   52.27 -
   52.28 -lemma isSym_keys: "K \<in> symKeys"	
   52.29 -by (simp add: symKeys_def all_symmetric_def invKey_symmetric) 
   52.30 -
   52.31  text{*Server knows all long-term keys; other agents know only their own*}
   52.32  primrec
   52.33    initState_Server:  "initState Server     = Key ` range shrK"
    53.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    53.2 +++ b/src/HOL/Auth/Smartcard/Auth_Smartcard.thy	Thu Oct 01 07:40:25 2009 +0200
    53.3 @@ -0,0 +1,13 @@
    53.4 +(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    53.5 +    Copyright   1996  University of Cambridge
    53.6 +*)
    53.7 +
    53.8 +header {* Smartcard protocols: rely on conventional Message and on new EventSC and Smartcard *}
    53.9 +
   53.10 +theory Auth_Smartcard
   53.11 +imports
   53.12 +  "ShoupRubin"
   53.13 +  "ShoupRubinBella"
   53.14 +begin
   53.15 +
   53.16 +end
    54.1 --- a/src/HOL/Auth/Smartcard/Smartcard.thy	Tue Sep 29 22:15:54 2009 +0200
    54.2 +++ b/src/HOL/Auth/Smartcard/Smartcard.thy	Thu Oct 01 07:40:25 2009 +0200
    54.3 @@ -1,10 +1,11 @@
    54.4 -(*  ID:         $Id$
    54.5 -    Author:     Giampaolo Bella, Catania University
    54.6 +(* Author:     Giampaolo Bella, Catania University
    54.7  *)
    54.8  
    54.9  header{*Theory of smartcards*}
   54.10  
   54.11 -theory Smartcard imports EventSC begin
   54.12 +theory Smartcard
   54.13 +imports EventSC All_Symmetric
   54.14 +begin
   54.15  
   54.16  text{*  
   54.17  As smartcards handle long-term (symmetric) keys, this theoy extends and 
   54.18 @@ -42,14 +43,6 @@
   54.19    shrK_disj_pin [iff]:  "shrK P \<noteq> pin Q"
   54.20    crdK_disj_pin [iff]:   "crdK C \<noteq> pin P"
   54.21  
   54.22 -
   54.23 -text{*All keys are symmetric*}
   54.24 -defs  all_symmetric_def: "all_symmetric == True"
   54.25 -
   54.26 -lemma isSym_keys: "K \<in> symKeys"	
   54.27 -by (simp add: symKeys_def all_symmetric_def invKey_symmetric) 
   54.28 -
   54.29 -
   54.30  constdefs
   54.31    legalUse :: "card => bool" ("legalUse (_)")
   54.32    "legalUse C == C \<notin> stolen"
    55.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    55.2 +++ b/src/HOL/Bali/Bali.thy	Thu Oct 01 07:40:25 2009 +0200
    55.3 @@ -0,0 +1,11 @@
    55.4 +(*  Author:     David von Oheimb
    55.5 +    Copyright   1999 Technische Universitaet Muenchen
    55.6 +*)
    55.7 +
    55.8 +header {* The Hoare logic for Bali. *}
    55.9 +
   55.10 +theory Bali
   55.11 +imports AxExample AxSound AxCompl Trans
   55.12 +begin
   55.13 +
   55.14 +end
    56.1 --- a/src/HOL/Bali/DeclConcepts.thy	Tue Sep 29 22:15:54 2009 +0200
    56.2 +++ b/src/HOL/Bali/DeclConcepts.thy	Thu Oct 01 07:40:25 2009 +0200
    56.3 @@ -154,21 +154,14 @@
    56.4  
    56.5  instance decl_ext_type :: ("has_static") has_static ..
    56.6  
    56.7 -defs (overloaded)
    56.8 -decl_is_static_def: 
    56.9 - "is_static (m::('a::has_static) decl_scheme) \<equiv> is_static (Decl.decl.more m)" 
   56.10 -
   56.11  instance member_ext_type :: ("type") has_static ..
   56.12  
   56.13  defs (overloaded)
   56.14  static_field_type_is_static_def: 
   56.15 - "is_static (m::('b::type) member_ext_type) \<equiv> static_sel m"
   56.16 + "is_static (m::('b member_scheme)) \<equiv> static m"
   56.17  
   56.18  lemma member_is_static_simp: "is_static (m::'a member_scheme) = static m"
   56.19 -apply (cases m)
   56.20 -apply (simp add: static_field_type_is_static_def 
   56.21 -                 decl_is_static_def Decl.member.dest_convs)
   56.22 -done
   56.23 +by (simp add: static_field_type_is_static_def)
   56.24  
   56.25  instance * :: ("type","has_static") has_static ..
   56.26  
   56.27 @@ -402,30 +395,16 @@
   56.28  
   56.29  instance decl_ext_type :: ("has_resTy") has_resTy ..
   56.30  
   56.31 -defs (overloaded)
   56.32 -decl_resTy_def: 
   56.33 - "resTy (m::('a::has_resTy) decl_scheme) \<equiv> resTy (Decl.decl.more m)" 
   56.34 -
   56.35  instance member_ext_type :: ("has_resTy") has_resTy ..
   56.36  
   56.37 -defs (overloaded)
   56.38 -member_ext_type_resTy_def: 
   56.39 - "resTy (m::('b::has_resTy) member_ext_type) 
   56.40 -  \<equiv> resTy (member.more_sel m)" 
   56.41 -
   56.42  instance mhead_ext_type :: ("type") has_resTy ..
   56.43  
   56.44  defs (overloaded)
   56.45  mhead_ext_type_resTy_def: 
   56.46 - "resTy (m::('b mhead_ext_type)) 
   56.47 -  \<equiv> resT_sel m" 
   56.48 + "resTy (m::('b mhead_scheme)) \<equiv> resT m"
   56.49  
   56.50  lemma mhead_resTy_simp: "resTy (m::'a mhead_scheme) = resT m"
   56.51 -apply (cases m)
   56.52 -apply (simp add: decl_resTy_def member_ext_type_resTy_def 
   56.53 -                 mhead_ext_type_resTy_def 
   56.54 -                 member.dest_convs mhead.dest_convs)
   56.55 -done
   56.56 +by (simp add: mhead_ext_type_resTy_def)
   56.57  
   56.58  lemma resTy_mhead [simp]:"resTy (mhead m) = resTy m"
   56.59  by (simp add: mhead_def mhead_resTy_simp)
    57.1 --- a/src/HOL/Bali/DefiniteAssignmentCorrect.thy	Tue Sep 29 22:15:54 2009 +0200
    57.2 +++ b/src/HOL/Bali/DefiniteAssignmentCorrect.thy	Thu Oct 01 07:40:25 2009 +0200
    57.3 @@ -1747,7 +1747,7 @@
    57.4        have "assigns (In1l e2) \<subseteq> dom (locals (store s2))"
    57.5  	by (simp add: need_second_arg_def)
    57.6        with s2
    57.7 -      show ?thesis using False by (simp add: Un_subset_iff)
    57.8 +      show ?thesis using False by simp
    57.9      qed
   57.10    next
   57.11      case Super thus ?case by simp
    58.1 --- a/src/HOL/Bali/Example.thy	Tue Sep 29 22:15:54 2009 +0200
    58.2 +++ b/src/HOL/Bali/Example.thy	Thu Oct 01 07:40:25 2009 +0200
    58.3 @@ -1167,7 +1167,6 @@
    58.4  apply    (simp,rule assigned.select_convs)
    58.5  apply   (simp)
    58.6  apply  simp
    58.7 -apply  blast
    58.8  apply simp
    58.9  apply (simp add: intersect_ts_def)
   58.10  done
    59.1 --- a/src/HOL/Bali/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
    59.2 +++ b/src/HOL/Bali/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
    59.3 @@ -1,9 +1,2 @@
    59.4 -(*  Title:      HOL/Bali/ROOT.ML
    59.5 -    ID:         $Id$
    59.6 -    Author:     David von Oheimb
    59.7 -    Copyright   1999 Technische Universitaet Muenchen
    59.8  
    59.9 -The Hoare logic for Bali.
   59.10 -*)
   59.11 -
   59.12 -use_thys ["AxExample", "AxSound", "AxCompl", "Trans"];
   59.13 +use_thy "Bali"
    60.1 --- a/src/HOL/Bali/TypeSafe.thy	Tue Sep 29 22:15:54 2009 +0200
    60.2 +++ b/src/HOL/Bali/TypeSafe.thy	Thu Oct 01 07:40:25 2009 +0200
    60.3 @@ -2953,7 +2953,7 @@
    60.4  	  by simp
    60.5  	from da_e1 s0_s1 True obtain E1' where
    60.6  	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s1)))\<guillemotright>In1l e1\<guillemotright> E1'"
    60.7 -	  by - (rule da_weakenE, auto iff del: Un_subset_iff)
    60.8 +	  by - (rule da_weakenE, auto iff del: Un_subset_iff le_sup_iff)
    60.9  	with conf_s1 wt_e1
   60.10  	obtain 
   60.11  	  "s2\<Colon>\<preceq>(G, L)"
   60.12 @@ -2972,7 +2972,7 @@
   60.13  	  by simp
   60.14  	from da_e2 s0_s1 False obtain E2' where
   60.15  	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s1)))\<guillemotright>In1l e2\<guillemotright> E2'"
   60.16 -	  by - (rule da_weakenE, auto iff del: Un_subset_iff)
   60.17 +	  by - (rule da_weakenE, auto iff del: Un_subset_iff le_sup_iff)
   60.18  	with conf_s1 wt_e2
   60.19  	obtain 
   60.20  	  "s2\<Colon>\<preceq>(G, L)"
    61.1 --- a/src/HOL/Code_Eval.thy	Tue Sep 29 22:15:54 2009 +0200
    61.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    61.3 @@ -1,271 +0,0 @@
    61.4 -(*  Title:      HOL/Code_Eval.thy
    61.5 -    Author:     Florian Haftmann, TU Muenchen
    61.6 -*)
    61.7 -
    61.8 -header {* Term evaluation using the generic code generator *}
    61.9 -
   61.10 -theory Code_Eval
   61.11 -imports Plain Typerep Code_Numeral
   61.12 -begin
   61.13 -
   61.14 -subsection {* Term representation *}
   61.15 -
   61.16 -subsubsection {* Terms and class @{text term_of} *}
   61.17 -
   61.18 -datatype "term" = dummy_term
   61.19 -
   61.20 -definition Const :: "String.literal \<Rightarrow> typerep \<Rightarrow> term" where
   61.21 -  "Const _ _ = dummy_term"
   61.22 -
   61.23 -definition App :: "term \<Rightarrow> term \<Rightarrow> term" where
   61.24 -  "App _ _ = dummy_term"
   61.25 -
   61.26 -code_datatype Const App
   61.27 -
   61.28 -class term_of = typerep +
   61.29 -  fixes term_of :: "'a \<Rightarrow> term"
   61.30 -
   61.31 -lemma term_of_anything: "term_of x \<equiv> t"
   61.32 -  by (rule eq_reflection) (cases "term_of x", cases t, simp)
   61.33 -
   61.34 -definition valapp :: "('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)
   61.35 -  \<Rightarrow> 'a \<times> (unit \<Rightarrow> term) \<Rightarrow> 'b \<times> (unit \<Rightarrow> term)" where
   61.36 -  "valapp f x = (fst f (fst x), \<lambda>u. App (snd f ()) (snd x ()))"
   61.37 -
   61.38 -lemma valapp_code [code, code_unfold]:
   61.39 -  "valapp (f, tf) (x, tx) = (f x, \<lambda>u. App (tf ()) (tx ()))"
   61.40 -  by (simp only: valapp_def fst_conv snd_conv)
   61.41 -
   61.42 -
   61.43 -subsubsection {* @{text term_of} instances *}
   61.44 -
   61.45 -instantiation "fun" :: (typerep, typerep) term_of
   61.46 -begin
   61.47 -
   61.48 -definition
   61.49 -  "term_of (f \<Colon> 'a \<Rightarrow> 'b) = Const (STR ''dummy_pattern'') (Typerep.Typerep (STR ''fun'')
   61.50 -     [Typerep.typerep TYPE('a), Typerep.typerep TYPE('b)])"
   61.51 -
   61.52 -instance ..
   61.53 -
   61.54 -end
   61.55 -
   61.56 -setup {*
   61.57 -let
   61.58 -  fun add_term_of tyco raw_vs thy =
   61.59 -    let
   61.60 -      val vs = map (fn (v, _) => (v, @{sort typerep})) raw_vs;
   61.61 -      val ty = Type (tyco, map TFree vs);
   61.62 -      val lhs = Const (@{const_name term_of}, ty --> @{typ term})
   61.63 -        $ Free ("x", ty);
   61.64 -      val rhs = @{term "undefined \<Colon> term"};
   61.65 -      val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
   61.66 -      fun triv_name_of t = (fst o dest_Free o fst o strip_comb o fst
   61.67 -        o HOLogic.dest_eq o HOLogic.dest_Trueprop) t ^ "_triv";
   61.68 -    in
   61.69 -      thy
   61.70 -      |> TheoryTarget.instantiation ([tyco], vs, @{sort term_of})
   61.71 -      |> `(fn lthy => Syntax.check_term lthy eq)
   61.72 -      |-> (fn eq => Specification.definition (NONE, ((Binding.name (triv_name_of eq), []), eq)))
   61.73 -      |> snd
   61.74 -      |> Class.prove_instantiation_exit (K (Class.intro_classes_tac []))
   61.75 -    end;
   61.76 -  fun ensure_term_of (tyco, (raw_vs, _)) thy =
   61.77 -    let
   61.78 -      val need_inst = not (can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of})
   61.79 -        andalso can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort typerep};
   61.80 -    in if need_inst then add_term_of tyco raw_vs thy else thy end;
   61.81 -in
   61.82 -  Code.type_interpretation ensure_term_of
   61.83 -end
   61.84 -*}
   61.85 -
   61.86 -setup {*
   61.87 -let
   61.88 -  fun mk_term_of_eq thy ty vs tyco (c, tys) =
   61.89 -    let
   61.90 -      val t = list_comb (Const (c, tys ---> ty),
   61.91 -        map Free (Name.names Name.context "a" tys));
   61.92 -      val (arg, rhs) = pairself (Thm.cterm_of thy o map_types Logic.unvarifyT o Logic.varify)
   61.93 -        (t, (map_aterms (fn t as Free (v, ty) => HOLogic.mk_term_of ty t | t => t) o HOLogic.reflect_term) t)
   61.94 -      val cty = Thm.ctyp_of thy ty;
   61.95 -    in
   61.96 -      @{thm term_of_anything}
   61.97 -      |> Drule.instantiate' [SOME cty] [SOME arg, SOME rhs]
   61.98 -      |> Thm.varifyT
   61.99 -    end;
  61.100 -  fun add_term_of_code tyco raw_vs raw_cs thy =
  61.101 -    let
  61.102 -      val algebra = Sign.classes_of thy;
  61.103 -      val vs = map (fn (v, sort) =>
  61.104 -        (v, curry (Sorts.inter_sort algebra) @{sort typerep} sort)) raw_vs;
  61.105 -      val ty = Type (tyco, map TFree vs);
  61.106 -      val cs = (map o apsnd o map o map_atyps)
  61.107 -        (fn TFree (v, _) => TFree (v, (the o AList.lookup (op =) vs) v)) raw_cs;
  61.108 -      val const = AxClass.param_of_inst thy (@{const_name term_of}, tyco);
  61.109 -      val eqs = map (mk_term_of_eq thy ty vs tyco) cs;
  61.110 -   in
  61.111 -      thy
  61.112 -      |> Code.del_eqns const
  61.113 -      |> fold Code.add_eqn eqs
  61.114 -    end;
  61.115 -  fun ensure_term_of_code (tyco, (raw_vs, cs)) thy =
  61.116 -    let
  61.117 -      val has_inst = can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of};
  61.118 -    in if has_inst then add_term_of_code tyco raw_vs cs thy else thy end;
  61.119 -in
  61.120 -  Code.type_interpretation ensure_term_of_code
  61.121 -end
  61.122 -*}
  61.123 -
  61.124 -
  61.125 -subsubsection {* Code generator setup *}
  61.126 -
  61.127 -lemmas [code del] = term.recs term.cases term.size
  61.128 -lemma [code, code del]: "eq_class.eq (t1\<Colon>term) t2 \<longleftrightarrow> eq_class.eq t1 t2" ..
  61.129 -
  61.130 -lemma [code, code del]: "(term_of \<Colon> typerep \<Rightarrow> term) = term_of" ..
  61.131 -lemma [code, code del]: "(term_of \<Colon> term \<Rightarrow> term) = term_of" ..
  61.132 -lemma [code, code del]: "(term_of \<Colon> String.literal \<Rightarrow> term) = term_of" ..
  61.133 -lemma [code, code del]:
  61.134 -  "(Code_Eval.term_of \<Colon> 'a::{type, term_of} Predicate.pred \<Rightarrow> Code_Eval.term) = Code_Eval.term_of" ..
  61.135 -lemma [code, code del]:
  61.136 -  "(Code_Eval.term_of \<Colon> 'a::{type, term_of} Predicate.seq \<Rightarrow> Code_Eval.term) = Code_Eval.term_of" ..
  61.137 -
  61.138 -lemma term_of_char [unfolded typerep_fun_def typerep_char_def typerep_nibble_def, code]: "Code_Eval.term_of c =
  61.139 -    (let (n, m) = nibble_pair_of_char c
  61.140 -  in Code_Eval.App (Code_Eval.App (Code_Eval.Const (STR ''String.char.Char'') (TYPEREP(nibble \<Rightarrow> nibble \<Rightarrow> char)))
  61.141 -    (Code_Eval.term_of n)) (Code_Eval.term_of m))"
  61.142 -  by (subst term_of_anything) rule 
  61.143 -
  61.144 -code_type "term"
  61.145 -  (Eval "Term.term")
  61.146 -
  61.147 -code_const Const and App
  61.148 -  (Eval "Term.Const/ ((_), (_))" and "Term.$/ ((_), (_))")
  61.149 -
  61.150 -code_const "term_of \<Colon> String.literal \<Rightarrow> term"
  61.151 -  (Eval "HOLogic.mk'_message'_string")
  61.152 -
  61.153 -code_reserved Eval HOLogic
  61.154 -
  61.155 -
  61.156 -subsubsection {* Syntax *}
  61.157 -
  61.158 -definition termify :: "'a \<Rightarrow> term" where
  61.159 -  [code del]: "termify x = dummy_term"
  61.160 -
  61.161 -abbreviation valtermify :: "'a \<Rightarrow> 'a \<times> (unit \<Rightarrow> term)" where
  61.162 -  "valtermify x \<equiv> (x, \<lambda>u. termify x)"
  61.163 -
  61.164 -setup {*
  61.165 -let
  61.166 -  fun map_default f xs =
  61.167 -    let val ys = map f xs
  61.168 -    in if exists is_some ys
  61.169 -      then SOME (map2 the_default xs ys)
  61.170 -      else NONE
  61.171 -    end;
  61.172 -  fun subst_termify_app (Const (@{const_name termify}, T), [t]) =
  61.173 -        if not (Term.has_abs t)
  61.174 -        then if fold_aterms (fn Const _ => I | _ => K false) t true
  61.175 -          then SOME (HOLogic.reflect_term t)
  61.176 -          else error "Cannot termify expression containing variables"
  61.177 -        else error "Cannot termify expression containing abstraction"
  61.178 -    | subst_termify_app (t, ts) = case map_default subst_termify ts
  61.179 -       of SOME ts' => SOME (list_comb (t, ts'))
  61.180 -        | NONE => NONE
  61.181 -  and subst_termify (Abs (v, T, t)) = (case subst_termify t
  61.182 -       of SOME t' => SOME (Abs (v, T, t'))
  61.183 -        | NONE => NONE)
  61.184 -    | subst_termify t = subst_termify_app (strip_comb t) 
  61.185 -  fun check_termify ts ctxt = map_default subst_termify ts
  61.186 -    |> Option.map (rpair ctxt)
  61.187 -in
  61.188 -  Context.theory_map (Syntax.add_term_check 0 "termify" check_termify)
  61.189 -end;
  61.190 -*}
  61.191 -
  61.192 -locale term_syntax
  61.193 -begin
  61.194 -
  61.195 -notation App (infixl "<\<cdot>>" 70)
  61.196 -  and valapp (infixl "{\<cdot>}" 70)
  61.197 -
  61.198 -end
  61.199 -
  61.200 -interpretation term_syntax .
  61.201 -
  61.202 -no_notation App (infixl "<\<cdot>>" 70)
  61.203 -  and valapp (infixl "{\<cdot>}" 70)
  61.204 -
  61.205 -
  61.206 -subsection {* Numeric types *}
  61.207 -
  61.208 -definition term_of_num :: "'a\<Colon>{semiring_div} \<Rightarrow> 'a\<Colon>{semiring_div} \<Rightarrow> term" where
  61.209 -  "term_of_num two = (\<lambda>_. dummy_term)"
  61.210 -
  61.211 -lemma (in term_syntax) term_of_num_code [code]:
  61.212 -  "term_of_num two k = (if k = 0 then termify Int.Pls
  61.213 -    else (if k mod two = 0
  61.214 -      then termify Int.Bit0 <\<cdot>> term_of_num two (k div two)
  61.215 -      else termify Int.Bit1 <\<cdot>> term_of_num two (k div two)))"
  61.216 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_def Let_def)
  61.217 -
  61.218 -lemma (in term_syntax) term_of_nat_code [code]:
  61.219 -  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num (2::nat) n"
  61.220 -  by (simp only: term_of_anything)
  61.221 -
  61.222 -lemma (in term_syntax) term_of_int_code [code]:
  61.223 -  "term_of (k::int) = (if k = 0 then termify (0 :: int)
  61.224 -    else if k > 0 then termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) k
  61.225 -      else termify (uminus :: int \<Rightarrow> int) <\<cdot>> (termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) (- k)))"
  61.226 -  by (simp only: term_of_anything)
  61.227 -
  61.228 -lemma (in term_syntax) term_of_code_numeral_code [code]:
  61.229 -  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num (2::code_numeral) k"
  61.230 -  by (simp only: term_of_anything)
  61.231 -
  61.232 -subsection {* Obfuscate *}
  61.233 -
  61.234 -print_translation {*
  61.235 -let
  61.236 -  val term = Const ("<TERM>", dummyT);
  61.237 -  fun tr1' [_, _] = term;
  61.238 -  fun tr2' [] = term;
  61.239 -in
  61.240 -  [(@{const_syntax Const}, tr1'),
  61.241 -    (@{const_syntax App}, tr1'),
  61.242 -    (@{const_syntax dummy_term}, tr2')]
  61.243 -end
  61.244 -*}
  61.245 -
  61.246 -hide const dummy_term App valapp
  61.247 -hide (open) const Const termify valtermify term_of term_of_num
  61.248 -
  61.249 -
  61.250 -subsection {* Evaluation setup *}
  61.251 -
  61.252 -ML {*
  61.253 -signature EVAL =
  61.254 -sig
  61.255 -  val eval_ref: (unit -> term) option ref
  61.256 -  val eval_term: theory -> term -> term
  61.257 -end;
  61.258 -
  61.259 -structure Eval : EVAL =
  61.260 -struct
  61.261 -
  61.262 -val eval_ref = ref (NONE : (unit -> term) option);
  61.263 -
  61.264 -fun eval_term thy t =
  61.265 -  Code_ML.eval NONE ("Eval.eval_ref", eval_ref) I thy (HOLogic.mk_term_of (fastype_of t) t) [];
  61.266 -
  61.267 -end;
  61.268 -*}
  61.269 -
  61.270 -setup {*
  61.271 -  Value.add_evaluator ("code", Eval.eval_term o ProofContext.theory_of)
  61.272 -*}
  61.273 -
  61.274 -end
    62.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    62.2 +++ b/src/HOL/Code_Evaluation.thy	Thu Oct 01 07:40:25 2009 +0200
    62.3 @@ -0,0 +1,271 @@
    62.4 +(*  Title:      HOL/Code_Evaluation.thy
    62.5 +    Author:     Florian Haftmann, TU Muenchen
    62.6 +*)
    62.7 +
    62.8 +header {* Term evaluation using the generic code generator *}
    62.9 +
   62.10 +theory Code_Evaluation
   62.11 +imports Plain Typerep Code_Numeral
   62.12 +begin
   62.13 +
   62.14 +subsection {* Term representation *}
   62.15 +
   62.16 +subsubsection {* Terms and class @{text term_of} *}
   62.17 +
   62.18 +datatype "term" = dummy_term
   62.19 +
   62.20 +definition Const :: "String.literal \<Rightarrow> typerep \<Rightarrow> term" where
   62.21 +  "Const _ _ = dummy_term"
   62.22 +
   62.23 +definition App :: "term \<Rightarrow> term \<Rightarrow> term" where
   62.24 +  "App _ _ = dummy_term"
   62.25 +
   62.26 +code_datatype Const App
   62.27 +
   62.28 +class term_of = typerep +
   62.29 +  fixes term_of :: "'a \<Rightarrow> term"
   62.30 +
   62.31 +lemma term_of_anything: "term_of x \<equiv> t"
   62.32 +  by (rule eq_reflection) (cases "term_of x", cases t, simp)
   62.33 +
   62.34 +definition valapp :: "('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)
   62.35 +  \<Rightarrow> 'a \<times> (unit \<Rightarrow> term) \<Rightarrow> 'b \<times> (unit \<Rightarrow> term)" where
   62.36 +  "valapp f x = (fst f (fst x), \<lambda>u. App (snd f ()) (snd x ()))"
   62.37 +
   62.38 +lemma valapp_code [code, code_unfold]:
   62.39 +  "valapp (f, tf) (x, tx) = (f x, \<lambda>u. App (tf ()) (tx ()))"
   62.40 +  by (simp only: valapp_def fst_conv snd_conv)
   62.41 +
   62.42 +
   62.43 +subsubsection {* @{text term_of} instances *}
   62.44 +
   62.45 +instantiation "fun" :: (typerep, typerep) term_of
   62.46 +begin
   62.47 +
   62.48 +definition
   62.49 +  "term_of (f \<Colon> 'a \<Rightarrow> 'b) = Const (STR ''dummy_pattern'') (Typerep.Typerep (STR ''fun'')
   62.50 +     [Typerep.typerep TYPE('a), Typerep.typerep TYPE('b)])"
   62.51 +
   62.52 +instance ..
   62.53 +
   62.54 +end
   62.55 +
   62.56 +setup {*
   62.57 +let
   62.58 +  fun add_term_of tyco raw_vs thy =
   62.59 +    let
   62.60 +      val vs = map (fn (v, _) => (v, @{sort typerep})) raw_vs;
   62.61 +      val ty = Type (tyco, map TFree vs);
   62.62 +      val lhs = Const (@{const_name term_of}, ty --> @{typ term})
   62.63 +        $ Free ("x", ty);
   62.64 +      val rhs = @{term "undefined \<Colon> term"};
   62.65 +      val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
   62.66 +      fun triv_name_of t = (fst o dest_Free o fst o strip_comb o fst
   62.67 +        o HOLogic.dest_eq o HOLogic.dest_Trueprop) t ^ "_triv";
   62.68 +    in
   62.69 +      thy
   62.70 +      |> TheoryTarget.instantiation ([tyco], vs, @{sort term_of})
   62.71 +      |> `(fn lthy => Syntax.check_term lthy eq)
   62.72 +      |-> (fn eq => Specification.definition (NONE, ((Binding.name (triv_name_of eq), []), eq)))
   62.73 +      |> snd
   62.74 +      |> Class.prove_instantiation_exit (K (Class.intro_classes_tac []))
   62.75 +    end;
   62.76 +  fun ensure_term_of (tyco, (raw_vs, _)) thy =
   62.77 +    let
   62.78 +      val need_inst = not (can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of})
   62.79 +        andalso can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort typerep};
   62.80 +    in if need_inst then add_term_of tyco raw_vs thy else thy end;
   62.81 +in
   62.82 +  Code.type_interpretation ensure_term_of
   62.83 +end
   62.84 +*}
   62.85 +
   62.86 +setup {*
   62.87 +let
   62.88 +  fun mk_term_of_eq thy ty vs tyco (c, tys) =
   62.89 +    let
   62.90 +      val t = list_comb (Const (c, tys ---> ty),
   62.91 +        map Free (Name.names Name.context "a" tys));
   62.92 +      val (arg, rhs) = pairself (Thm.cterm_of thy o map_types Logic.unvarifyT o Logic.varify)
   62.93 +        (t, (map_aterms (fn t as Free (v, ty) => HOLogic.mk_term_of ty t | t => t) o HOLogic.reflect_term) t)
   62.94 +      val cty = Thm.ctyp_of thy ty;
   62.95 +    in
   62.96 +      @{thm term_of_anything}
   62.97 +      |> Drule.instantiate' [SOME cty] [SOME arg, SOME rhs]
   62.98 +      |> Thm.varifyT
   62.99 +    end;
  62.100 +  fun add_term_of_code tyco raw_vs raw_cs thy =
  62.101 +    let
  62.102 +      val algebra = Sign.classes_of thy;
  62.103 +      val vs = map (fn (v, sort) =>
  62.104 +        (v, curry (Sorts.inter_sort algebra) @{sort typerep} sort)) raw_vs;
  62.105 +      val ty = Type (tyco, map TFree vs);
  62.106 +      val cs = (map o apsnd o map o map_atyps)
  62.107 +        (fn TFree (v, _) => TFree (v, (the o AList.lookup (op =) vs) v)) raw_cs;
  62.108 +      val const = AxClass.param_of_inst thy (@{const_name term_of}, tyco);
  62.109 +      val eqs = map (mk_term_of_eq thy ty vs tyco) cs;
  62.110 +   in
  62.111 +      thy
  62.112 +      |> Code.del_eqns const
  62.113 +      |> fold Code.add_eqn eqs
  62.114 +    end;
  62.115 +  fun ensure_term_of_code (tyco, (raw_vs, cs)) thy =
  62.116 +    let
  62.117 +      val has_inst = can (Sorts.mg_domain (Sign.classes_of thy) tyco) @{sort term_of};
  62.118 +    in if has_inst then add_term_of_code tyco raw_vs cs thy else thy end;
  62.119 +in
  62.120 +  Code.type_interpretation ensure_term_of_code
  62.121 +end
  62.122 +*}
  62.123 +
  62.124 +
  62.125 +subsubsection {* Code generator setup *}
  62.126 +
  62.127 +lemmas [code del] = term.recs term.cases term.size
  62.128 +lemma [code, code del]: "eq_class.eq (t1\<Colon>term) t2 \<longleftrightarrow> eq_class.eq t1 t2" ..
  62.129 +
  62.130 +lemma [code, code del]: "(term_of \<Colon> typerep \<Rightarrow> term) = term_of" ..
  62.131 +lemma [code, code del]: "(term_of \<Colon> term \<Rightarrow> term) = term_of" ..
  62.132 +lemma [code, code del]: "(term_of \<Colon> String.literal \<Rightarrow> term) = term_of" ..
  62.133 +lemma [code, code del]:
  62.134 +  "(Code_Evaluation.term_of \<Colon> 'a::{type, term_of} Predicate.pred \<Rightarrow> Code_Evaluation.term) = Code_Evaluation.term_of" ..
  62.135 +lemma [code, code del]:
  62.136 +  "(Code_Evaluation.term_of \<Colon> 'a::{type, term_of} Predicate.seq \<Rightarrow> Code_Evaluation.term) = Code_Evaluation.term_of" ..
  62.137 +
  62.138 +lemma term_of_char [unfolded typerep_fun_def typerep_char_def typerep_nibble_def, code]: "Code_Evaluation.term_of c =
  62.139 +    (let (n, m) = nibble_pair_of_char c
  62.140 +  in Code_Evaluation.App (Code_Evaluation.App (Code_Evaluation.Const (STR ''String.char.Char'') (TYPEREP(nibble \<Rightarrow> nibble \<Rightarrow> char)))
  62.141 +    (Code_Evaluation.term_of n)) (Code_Evaluation.term_of m))"
  62.142 +  by (subst term_of_anything) rule 
  62.143 +
  62.144 +code_type "term"
  62.145 +  (Eval "Term.term")
  62.146 +
  62.147 +code_const Const and App
  62.148 +  (Eval "Term.Const/ ((_), (_))" and "Term.$/ ((_), (_))")
  62.149 +
  62.150 +code_const "term_of \<Colon> String.literal \<Rightarrow> term"
  62.151 +  (Eval "HOLogic.mk'_message'_string")
  62.152 +
  62.153 +code_reserved Eval HOLogic
  62.154 +
  62.155 +
  62.156 +subsubsection {* Syntax *}
  62.157 +
  62.158 +definition termify :: "'a \<Rightarrow> term" where
  62.159 +  [code del]: "termify x = dummy_term"
  62.160 +
  62.161 +abbreviation valtermify :: "'a \<Rightarrow> 'a \<times> (unit \<Rightarrow> term)" where
  62.162 +  "valtermify x \<equiv> (x, \<lambda>u. termify x)"
  62.163 +
  62.164 +setup {*
  62.165 +let
  62.166 +  fun map_default f xs =
  62.167 +    let val ys = map f xs
  62.168 +    in if exists is_some ys
  62.169 +      then SOME (map2 the_default xs ys)
  62.170 +      else NONE
  62.171 +    end;
  62.172 +  fun subst_termify_app (Const (@{const_name termify}, T), [t]) =
  62.173 +        if not (Term.has_abs t)
  62.174 +        then if fold_aterms (fn Const _ => I | _ => K false) t true
  62.175 +          then SOME (HOLogic.reflect_term t)
  62.176 +          else error "Cannot termify expression containing variables"
  62.177 +        else error "Cannot termify expression containing abstraction"
  62.178 +    | subst_termify_app (t, ts) = case map_default subst_termify ts
  62.179 +       of SOME ts' => SOME (list_comb (t, ts'))
  62.180 +        | NONE => NONE
  62.181 +  and subst_termify (Abs (v, T, t)) = (case subst_termify t
  62.182 +       of SOME t' => SOME (Abs (v, T, t'))
  62.183 +        | NONE => NONE)
  62.184 +    | subst_termify t = subst_termify_app (strip_comb t) 
  62.185 +  fun check_termify ts ctxt = map_default subst_termify ts
  62.186 +    |> Option.map (rpair ctxt)
  62.187 +in
  62.188 +  Context.theory_map (Syntax.add_term_check 0 "termify" check_termify)
  62.189 +end;
  62.190 +*}
  62.191 +
  62.192 +locale term_syntax
  62.193 +begin
  62.194 +
  62.195 +notation App (infixl "<\<cdot>>" 70)
  62.196 +  and valapp (infixl "{\<cdot>}" 70)
  62.197 +
  62.198 +end
  62.199 +
  62.200 +interpretation term_syntax .
  62.201 +
  62.202 +no_notation App (infixl "<\<cdot>>" 70)
  62.203 +  and valapp (infixl "{\<cdot>}" 70)
  62.204 +
  62.205 +
  62.206 +subsection {* Numeric types *}
  62.207 +
  62.208 +definition term_of_num :: "'a\<Colon>{semiring_div} \<Rightarrow> 'a\<Colon>{semiring_div} \<Rightarrow> term" where
  62.209 +  "term_of_num two = (\<lambda>_. dummy_term)"
  62.210 +
  62.211 +lemma (in term_syntax) term_of_num_code [code]:
  62.212 +  "term_of_num two k = (if k = 0 then termify Int.Pls
  62.213 +    else (if k mod two = 0
  62.214 +      then termify Int.Bit0 <\<cdot>> term_of_num two (k div two)
  62.215 +      else termify Int.Bit1 <\<cdot>> term_of_num two (k div two)))"
  62.216 +  by (auto simp add: term_of_anything Const_def App_def term_of_num_def Let_def)
  62.217 +
  62.218 +lemma (in term_syntax) term_of_nat_code [code]:
  62.219 +  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num (2::nat) n"
  62.220 +  by (simp only: term_of_anything)
  62.221 +
  62.222 +lemma (in term_syntax) term_of_int_code [code]:
  62.223 +  "term_of (k::int) = (if k = 0 then termify (0 :: int)
  62.224 +    else if k > 0 then termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) k
  62.225 +      else termify (uminus :: int \<Rightarrow> int) <\<cdot>> (termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) (- k)))"
  62.226 +  by (simp only: term_of_anything)
  62.227 +
  62.228 +lemma (in term_syntax) term_of_code_numeral_code [code]:
  62.229 +  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num (2::code_numeral) k"
  62.230 +  by (simp only: term_of_anything)
  62.231 +
  62.232 +subsection {* Obfuscate *}
  62.233 +
  62.234 +print_translation {*
  62.235 +let
  62.236 +  val term = Const ("<TERM>", dummyT);
  62.237 +  fun tr1' [_, _] = term;
  62.238 +  fun tr2' [] = term;
  62.239 +in
  62.240 +  [(@{const_syntax Const}, tr1'),
  62.241 +    (@{const_syntax App}, tr1'),
  62.242 +    (@{const_syntax dummy_term}, tr2')]
  62.243 +end
  62.244 +*}
  62.245 +
  62.246 +hide const dummy_term App valapp
  62.247 +hide (open) const Const termify valtermify term_of term_of_num
  62.248 +
  62.249 +
  62.250 +subsection {* Evaluation setup *}
  62.251 +
  62.252 +ML {*
  62.253 +signature EVAL =
  62.254 +sig
  62.255 +  val eval_ref: (unit -> term) option Unsynchronized.ref
  62.256 +  val eval_term: theory -> term -> term
  62.257 +end;
  62.258 +
  62.259 +structure Eval : EVAL =
  62.260 +struct
  62.261 +
  62.262 +val eval_ref = Unsynchronized.ref (NONE : (unit -> term) option);
  62.263 +
  62.264 +fun eval_term thy t =
  62.265 +  Code_ML.eval NONE ("Eval.eval_ref", eval_ref) I thy (HOLogic.mk_term_of (fastype_of t) t) [];
  62.266 +
  62.267 +end;
  62.268 +*}
  62.269 +
  62.270 +setup {*
  62.271 +  Value.add_evaluator ("code", Eval.eval_term o ProofContext.theory_of)
  62.272 +*}
  62.273 +
  62.274 +end
    63.1 --- a/src/HOL/Complete_Lattice.thy	Tue Sep 29 22:15:54 2009 +0200
    63.2 +++ b/src/HOL/Complete_Lattice.thy	Thu Oct 01 07:40:25 2009 +0200
    63.3 @@ -10,7 +10,9 @@
    63.4    less_eq  (infix "\<sqsubseteq>" 50) and
    63.5    less (infix "\<sqsubset>" 50) and
    63.6    inf  (infixl "\<sqinter>" 70) and
    63.7 -  sup  (infixl "\<squnion>" 65)
    63.8 +  sup  (infixl "\<squnion>" 65) and
    63.9 +  top ("\<top>") and
   63.10 +  bot ("\<bottom>")
   63.11  
   63.12  
   63.13  subsection {* Abstract complete lattices *}
   63.14 @@ -24,6 +26,15 @@
   63.15       and Sup_least: "(\<And>x. x \<in> A \<Longrightarrow> x \<sqsubseteq> z) \<Longrightarrow> \<Squnion>A \<sqsubseteq> z"
   63.16  begin
   63.17  
   63.18 +term complete_lattice
   63.19 +
   63.20 +lemma dual_complete_lattice:
   63.21 +  "complete_lattice (op \<ge>) (op >) (op \<squnion>) (op \<sqinter>) \<top> \<bottom> Sup Inf"
   63.22 +  by (auto intro!: complete_lattice.intro dual_lattice
   63.23 +    bot.intro top.intro dual_preorder, unfold_locales)
   63.24 +      (fact bot_least top_greatest
   63.25 +        Sup_upper Sup_least Inf_lower Inf_greatest)+
   63.26 +
   63.27  lemma Inf_Sup: "\<Sqinter>A = \<Squnion>{b. \<forall>a \<in> A. b \<le> a}"
   63.28    by (auto intro: antisym Inf_lower Inf_greatest Sup_upper Sup_least)
   63.29  
   63.30 @@ -76,11 +87,11 @@
   63.31  
   63.32  lemma sup_bot [simp]:
   63.33    "x \<squnion> bot = x"
   63.34 -  using bot_least [of x] by (simp add: le_iff_sup sup_commute)
   63.35 +  using bot_least [of x] by (simp add: sup_commute sup_absorb2)
   63.36  
   63.37  lemma inf_top [simp]:
   63.38    "x \<sqinter> top = x"
   63.39 -  using top_greatest [of x] by (simp add: le_iff_inf inf_commute)
   63.40 +  using top_greatest [of x] by (simp add: inf_commute inf_absorb2)
   63.41  
   63.42  definition SUPR :: "'b set \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a" where
   63.43    "SUPR A f = \<Squnion> (f ` A)"
   63.44 @@ -203,8 +214,8 @@
   63.45  
   63.46  subsection {* Union *}
   63.47  
   63.48 -definition Union :: "'a set set \<Rightarrow> 'a set" where
   63.49 -  Sup_set_eq [symmetric]: "Union S = \<Squnion>S"
   63.50 +abbreviation Union :: "'a set set \<Rightarrow> 'a set" where
   63.51 +  "Union S \<equiv> \<Squnion>S"
   63.52  
   63.53  notation (xsymbols)
   63.54    Union  ("\<Union>_" [90] 90)
   63.55 @@ -216,7 +227,7 @@
   63.56    have "(\<exists>Q\<in>{P. \<exists>B\<in>A. P \<longleftrightarrow> x \<in> B}. Q) \<longleftrightarrow> (\<exists>B\<in>A. x \<in> B)"
   63.57      by auto
   63.58    then show "x \<in> \<Union>A \<longleftrightarrow> x \<in> {x. \<exists>B\<in>A. x \<in> B}"
   63.59 -    by (simp add: Sup_set_eq [symmetric] Sup_fun_def Sup_bool_def) (simp add: mem_def)
   63.60 +    by (simp add: Sup_fun_def Sup_bool_def) (simp add: mem_def)
   63.61  qed
   63.62  
   63.63  lemma Union_iff [simp, noatp]:
   63.64 @@ -278,8 +289,8 @@
   63.65  
   63.66  subsection {* Unions of families *}
   63.67  
   63.68 -definition UNION :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
   63.69 -  SUPR_set_eq [symmetric]: "UNION S f = (SUP x:S. f x)"
   63.70 +abbreviation UNION :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
   63.71 +  "UNION \<equiv> SUPR"
   63.72  
   63.73  syntax
   63.74    "@UNION1"     :: "pttrns => 'b set => 'b set"           ("(3UN _./ _)" [0, 10] 10)
   63.75 @@ -314,7 +325,7 @@
   63.76  
   63.77  lemma UNION_eq_Union_image:
   63.78    "(\<Union>x\<in>A. B x) = \<Union>(B`A)"
   63.79 -  by (simp add: SUPR_def SUPR_set_eq [symmetric] Sup_set_eq)
   63.80 +  by (fact SUPR_def)
   63.81  
   63.82  lemma Union_def:
   63.83    "\<Union>S = (\<Union>x\<in>S. x)"
   63.84 @@ -351,7 +362,7 @@
   63.85    by blast
   63.86  
   63.87  lemma UN_upper: "a \<in> A ==> B a \<subseteq> (\<Union>x\<in>A. B x)"
   63.88 -  by blast
   63.89 +  by (fact le_SUPI)
   63.90  
   63.91  lemma UN_least: "(!!x. x \<in> A ==> B x \<subseteq> C) ==> (\<Union>x\<in>A. B x) \<subseteq> C"
   63.92    by (iprover intro: subsetI elim: UN_E dest: subsetD)
   63.93 @@ -439,8 +450,8 @@
   63.94  
   63.95  subsection {* Inter *}
   63.96  
   63.97 -definition Inter :: "'a set set \<Rightarrow> 'a set" where
   63.98 -  Inf_set_eq [symmetric]: "Inter S = \<Sqinter>S"
   63.99 +abbreviation Inter :: "'a set set \<Rightarrow> 'a set" where
  63.100 +  "Inter S \<equiv> \<Sqinter>S"
  63.101    
  63.102  notation (xsymbols)
  63.103    Inter  ("\<Inter>_" [90] 90)
  63.104 @@ -452,7 +463,7 @@
  63.105    have "(\<forall>Q\<in>{P. \<exists>B\<in>A. P \<longleftrightarrow> x \<in> B}. Q) \<longleftrightarrow> (\<forall>B\<in>A. x \<in> B)"
  63.106      by auto
  63.107    then show "x \<in> \<Inter>A \<longleftrightarrow> x \<in> {x. \<forall>B \<in> A. x \<in> B}"
  63.108 -    by (simp add: Inf_fun_def Inf_bool_def Inf_set_eq [symmetric]) (simp add: mem_def)
  63.109 +    by (simp add: Inf_fun_def Inf_bool_def) (simp add: mem_def)
  63.110  qed
  63.111  
  63.112  lemma Inter_iff [simp,noatp]: "(A : Inter C) = (ALL X:C. A:X)"
  63.113 @@ -514,8 +525,8 @@
  63.114  
  63.115  subsection {* Intersections of families *}
  63.116  
  63.117 -definition INTER :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
  63.118 -  INFI_set_eq [symmetric]: "INTER S f = (INF x:S. f x)"
  63.119 +abbreviation INTER :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> 'b set" where
  63.120 +  "INTER \<equiv> INFI"
  63.121  
  63.122  syntax
  63.123    "@INTER1"     :: "pttrns => 'b set => 'b set"           ("(3INT _./ _)" [0, 10] 10)
  63.124 @@ -541,7 +552,7 @@
  63.125  
  63.126  lemma INTER_eq_Inter_image:
  63.127    "(\<Inter>x\<in>A. B x) = \<Inter>(B`A)"
  63.128 -  by (simp add: INFI_def INFI_set_eq [symmetric] Inf_set_eq)
  63.129 +  by (fact INFI_def)
  63.130    
  63.131  lemma Inter_def:
  63.132    "\<Inter>S = (\<Inter>x\<in>S. x)"
  63.133 @@ -579,10 +590,10 @@
  63.134    by blast
  63.135  
  63.136  lemma INT_lower: "a \<in> A ==> (\<Inter>x\<in>A. B x) \<subseteq> B a"
  63.137 -  by blast
  63.138 +  by (fact INF_leI)
  63.139  
  63.140  lemma INT_greatest: "(!!x. x \<in> A ==> C \<subseteq> B x) ==> C \<subseteq> (\<Inter>x\<in>A. B x)"
  63.141 -  by (iprover intro: INT_I subsetI dest: subsetD)
  63.142 +  by (fact le_INFI)
  63.143  
  63.144  lemma INT_empty [simp]: "(\<Inter>x\<in>{}. B x) = UNIV"
  63.145    by blast
  63.146 @@ -784,7 +795,9 @@
  63.147    inf  (infixl "\<sqinter>" 70) and
  63.148    sup  (infixl "\<squnion>" 65) and
  63.149    Inf  ("\<Sqinter>_" [900] 900) and
  63.150 -  Sup  ("\<Squnion>_" [900] 900)
  63.151 +  Sup  ("\<Squnion>_" [900] 900) and
  63.152 +  top ("\<top>") and
  63.153 +  bot ("\<bottom>")
  63.154  
  63.155  lemmas mem_simps =
  63.156    insert_iff empty_iff Un_iff Int_iff Compl_iff Diff_iff
    64.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Tue Sep 29 22:15:54 2009 +0200
    64.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Thu Oct 01 07:40:25 2009 +0200
    64.3 @@ -1904,7 +1904,7 @@
    64.4  	show "0 < real x * 2/3" using * by auto
    64.5  	show "real ?max + 1 \<le> real x * 2/3" using * up
    64.6  	  by (cases "0 < real x * real (lapprox_posrat prec 2 3) - 1",
    64.7 -	      auto simp add: real_of_float_max max_def)
    64.8 +	      auto simp add: real_of_float_max min_max.sup_absorb1)
    64.9        qed
   64.10        finally have "real (?lb_horner (Float 1 -1)) + real (?lb_horner ?max)
   64.11  	\<le> ln (real x)"
   64.12 @@ -3246,12 +3246,13 @@
   64.13          = map (` (variable_of_bound o prop_of)) prems
   64.14  
   64.15        fun add_deps (name, bnds)
   64.16 -        = Graph.add_deps_acyclic
   64.17 -            (name, remove (op =) name (Term.add_free_names (prop_of bnds) []))
   64.18 +        = Graph.add_deps_acyclic (name,
   64.19 +            remove (op =) name (Term.add_free_names (prop_of bnds) []))
   64.20 +
   64.21        val order = Graph.empty
   64.22                    |> fold Graph.new_node variable_bounds
   64.23                    |> fold add_deps variable_bounds
   64.24 -                  |> Graph.topological_order |> rev
   64.25 +                  |> Graph.strong_conn |> map the_single |> rev
   64.26                    |> map_filter (AList.lookup (op =) variable_bounds)
   64.27  
   64.28        fun prepend_prem th tac
   64.29 @@ -3338,7 +3339,7 @@
   64.30                        etac @{thm meta_eqE},
   64.31                        rtac @{thm impI}] i)
   64.32        THEN Subgoal.FOCUS (fn {prems, ...} => reorder_bounds_tac prems i) @{context} i
   64.33 -      THEN TRY (filter_prems_tac (K false) i)
   64.34 +      THEN DETERM (TRY (filter_prems_tac (K false) i))
   64.35        THEN DETERM (Reflection.genreify_tac ctxt form_equations NONE i)
   64.36        THEN rewrite_interpret_form_tac ctxt prec splitting taylor i
   64.37        THEN gen_eval_tac eval_oracle ctxt i))
   64.38 @@ -3350,7 +3351,7 @@
   64.39  
   64.40    fun mk_approx' prec t = (@{const "approx'"}
   64.41                           $ HOLogic.mk_number @{typ nat} prec
   64.42 -                         $ t $ @{term "[] :: (float * float) list"})
   64.43 +                         $ t $ @{term "[] :: (float * float) option list"})
   64.44  
   64.45    fun dest_result (Const (@{const_name "Some"}, _) $
   64.46                     ((Const (@{const_name "Pair"}, _)) $
    65.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Tue Sep 29 22:15:54 2009 +0200
    65.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Thu Oct 01 07:40:25 2009 +0200
    65.3 @@ -512,7 +512,7 @@
    65.4    assumes g0: "numgcd t = 0"
    65.5    shows "Inum bs t = 0"
    65.6    using g0[simplified numgcd_def] 
    65.7 -  by (induct t rule: numgcdh.induct, auto simp add: natabs0 max_def maxcoeff_pos)
    65.8 +  by (induct t rule: numgcdh.induct, auto simp add: natabs0 maxcoeff_pos min_max.sup_absorb2)
    65.9  
   65.10  lemma numgcdh_pos: assumes gp: "g \<ge> 0" shows "numgcdh t g \<ge> 0"
   65.11    using gp
    66.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Tue Sep 29 22:15:54 2009 +0200
    66.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Thu Oct 01 07:40:25 2009 +0200
    66.3 @@ -4,7 +4,7 @@
    66.4  
    66.5  signature COOPER_TAC =
    66.6  sig
    66.7 -  val trace: bool ref
    66.8 +  val trace: bool Unsynchronized.ref
    66.9    val linz_tac: Proof.context -> bool -> int -> tactic
   66.10    val setup: theory -> theory
   66.11  end
   66.12 @@ -12,7 +12,7 @@
   66.13  structure Cooper_Tac: COOPER_TAC =
   66.14  struct
   66.15  
   66.16 -val trace = ref false;
   66.17 +val trace = Unsynchronized.ref false;
   66.18  fun trace_msg s = if !trace then tracing s else ();
   66.19  
   66.20  val cooper_ss = @{simpset};
    67.1 --- a/src/HOL/Decision_Procs/ex/Approximation_Ex.thy	Tue Sep 29 22:15:54 2009 +0200
    67.2 +++ b/src/HOL/Decision_Procs/ex/Approximation_Ex.thy	Thu Oct 01 07:40:25 2009 +0200
    67.3 @@ -72,7 +72,9 @@
    67.4    shows "g / v * tan (35 * d) \<in> { 3 * d .. 3.1 * d }"
    67.5    using assms by (approximation 80)
    67.6  
    67.7 -lemma "\<phi> \<in> { 0 .. 1 :: real } \<longrightarrow> \<phi> ^ 2 \<le> \<phi>"
    67.8 -  by (approximation 30 splitting: \<phi>=1 taylor: \<phi> = 3)
    67.9 +lemma "x \<in> { 0 .. 1 :: real } \<longrightarrow> x ^ 2 \<le> x"
   67.10 +  by (approximation 30 splitting: x=1 taylor: x = 3)
   67.11 +
   67.12 +value [approximate] "10"
   67.13  
   67.14  end
    68.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML	Tue Sep 29 22:15:54 2009 +0200
    68.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Thu Oct 01 07:40:25 2009 +0200
    68.3 @@ -4,7 +4,7 @@
    68.4  
    68.5  signature FERRACK_TAC =
    68.6  sig
    68.7 -  val trace: bool ref
    68.8 +  val trace: bool Unsynchronized.ref
    68.9    val linr_tac: Proof.context -> bool -> int -> tactic
   68.10    val setup: theory -> theory
   68.11  end
   68.12 @@ -12,7 +12,7 @@
   68.13  structure Ferrack_Tac =
   68.14  struct
   68.15  
   68.16 -val trace = ref false;
   68.17 +val trace = Unsynchronized.ref false;
   68.18  fun trace_msg s = if !trace then tracing s else ();
   68.19  
   68.20  val ferrack_ss = let val ths = [@{thm real_of_int_inject}, @{thm real_of_int_less_iff}, 
    69.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Tue Sep 29 22:15:54 2009 +0200
    69.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Thu Oct 01 07:40:25 2009 +0200
    69.3 @@ -4,7 +4,7 @@
    69.4  
    69.5  signature MIR_TAC =
    69.6  sig
    69.7 -  val trace: bool ref
    69.8 +  val trace: bool Unsynchronized.ref
    69.9    val mir_tac: Proof.context -> bool -> int -> tactic
   69.10    val setup: theory -> theory
   69.11  end
   69.12 @@ -12,7 +12,7 @@
   69.13  structure Mir_Tac =
   69.14  struct
   69.15  
   69.16 -val trace = ref false;
   69.17 +val trace = Unsynchronized.ref false;
   69.18  fun trace_msg s = if !trace then tracing s else ();
   69.19  
   69.20  val mir_ss = 
    70.1 --- a/src/HOL/Extraction/Euclid.thy	Tue Sep 29 22:15:54 2009 +0200
    70.2 +++ b/src/HOL/Extraction/Euclid.thy	Thu Oct 01 07:40:25 2009 +0200
    70.3 @@ -1,5 +1,4 @@
    70.4  (*  Title:      HOL/Extraction/Euclid.thy
    70.5 -    ID:         $Id$
    70.6      Author:     Markus Wenzel, TU Muenchen
    70.7                  Freek Wiedijk, Radboud University Nijmegen
    70.8                  Stefan Berghofer, TU Muenchen
    70.9 @@ -8,7 +7,7 @@
   70.10  header {* Euclid's theorem *}
   70.11  
   70.12  theory Euclid
   70.13 -imports "~~/src/HOL/NumberTheory/Factorization" Util Efficient_Nat
   70.14 +imports "~~/src/HOL/Old_Number_Theory/Factorization" Util Efficient_Nat
   70.15  begin
   70.16  
   70.17  text {*
    71.1 --- a/src/HOL/Extraction/ROOT.ML	Tue Sep 29 22:15:54 2009 +0200
    71.2 +++ b/src/HOL/Extraction/ROOT.ML	Thu Oct 01 07:40:25 2009 +0200
    71.3 @@ -1,5 +1,4 @@
    71.4  (*  Title:      HOL/Extraction/ROOT.ML
    71.5 -    ID:         $Id$
    71.6  
    71.7  Examples for program extraction in Higher-Order Logic.
    71.8  *)
    71.9 @@ -8,5 +7,5 @@
   71.10    warning "HOL proof terms required for running extraction examples"
   71.11  else
   71.12    (Proofterm.proofs := 2;
   71.13 -   no_document use_thys ["Efficient_Nat", "~~/src/HOL/NumberTheory/Factorization"];
   71.14 +   no_document use_thys ["Efficient_Nat", "~~/src/HOL/Old_Number_Theory/Factorization"];
   71.15     use_thys ["Greatest_Common_Divisor", "Warshall", "Higman", "Pigeonhole", "Euclid"]);
    72.1 --- a/src/HOL/Fact.thy	Tue Sep 29 22:15:54 2009 +0200
    72.2 +++ b/src/HOL/Fact.thy	Thu Oct 01 07:40:25 2009 +0200
    72.3 @@ -8,7 +8,7 @@
    72.4  header{*Factorial Function*}
    72.5  
    72.6  theory Fact
    72.7 -imports NatTransfer
    72.8 +imports Nat_Transfer
    72.9  begin
   72.10  
   72.11  class fact =
    73.1 --- a/src/HOL/Finite_Set.thy	Tue Sep 29 22:15:54 2009 +0200
    73.2 +++ b/src/HOL/Finite_Set.thy	Thu Oct 01 07:40:25 2009 +0200
    73.3 @@ -1565,9 +1565,7 @@
    73.4    apply (rule finite_subset)
    73.5    prefer 2
    73.6    apply assumption
    73.7 -  apply auto
    73.8 -  apply (rule setsum_cong)
    73.9 -  apply auto
   73.10 +  apply (auto simp add: sup_absorb2)
   73.11  done
   73.12  
   73.13  lemma setsum_right_distrib: 
   73.14 @@ -2615,6 +2613,23 @@
   73.15    finally show ?case .
   73.16  qed
   73.17  
   73.18 +lemma fold1_eq_fold_idem:
   73.19 +  assumes "finite A"
   73.20 +  shows "fold1 times (insert a A) = fold times a A"
   73.21 +proof (cases "a \<in> A")
   73.22 +  case False
   73.23 +  with assms show ?thesis by (simp add: fold1_eq_fold)
   73.24 +next
   73.25 +  interpret fun_left_comm_idem times by (fact fun_left_comm_idem)
   73.26 +  case True then obtain b B
   73.27 +    where A: "A = insert a B" and "a \<notin> B" by (rule set_insert)
   73.28 +  with assms have "finite B" by auto
   73.29 +  then have "fold times a (insert a B) = fold times (a * a) B"
   73.30 +    using `a \<notin> B` by (rule fold_insert2)
   73.31 +  then show ?thesis
   73.32 +    using `a \<notin> B` `finite B` by (simp add: fold1_eq_fold A)
   73.33 +qed
   73.34 +
   73.35  end
   73.36  
   73.37  
   73.38 @@ -2966,11 +2981,11 @@
   73.39  
   73.40  lemma dual_max:
   73.41    "ord.max (op \<ge>) = min"
   73.42 -  by (auto simp add: ord.max_def_raw min_def_raw expand_fun_eq)
   73.43 +  by (auto simp add: ord.max_def_raw min_def expand_fun_eq)
   73.44  
   73.45  lemma dual_min:
   73.46    "ord.min (op \<ge>) = max"
   73.47 -  by (auto simp add: ord.min_def_raw max_def_raw expand_fun_eq)
   73.48 +  by (auto simp add: ord.min_def_raw max_def expand_fun_eq)
   73.49  
   73.50  lemma strict_below_fold1_iff:
   73.51    assumes "finite A" and "A \<noteq> {}"
    74.1 --- a/src/HOL/Fun.thy	Tue Sep 29 22:15:54 2009 +0200
    74.2 +++ b/src/HOL/Fun.thy	Thu Oct 01 07:40:25 2009 +0200
    74.3 @@ -7,6 +7,7 @@
    74.4  
    74.5  theory Fun
    74.6  imports Complete_Lattice
    74.7 +uses ("Tools/transfer.ML")
    74.8  begin
    74.9  
   74.10  text{*As a simplification rule, it replaces all function equalities by
   74.11 @@ -568,6 +569,16 @@
   74.12  *}
   74.13  
   74.14  
   74.15 +subsection {* Generic transfer procedure *}
   74.16 +
   74.17 +definition TransferMorphism:: "('b \<Rightarrow> 'a) \<Rightarrow> 'b set \<Rightarrow> bool"
   74.18 +  where "TransferMorphism a B \<longleftrightarrow> True"
   74.19 +
   74.20 +use "Tools/transfer.ML"
   74.21 +
   74.22 +setup Transfer.setup
   74.23 +
   74.24 +
   74.25  subsection {* Code generator setup *}
   74.26  
   74.27  types_code
   74.28 @@ -578,7 +589,7 @@
   74.29  attach (test) {*
   74.30  fun gen_fun_type aF aT bG bT i =
   74.31    let
   74.32 -    val tab = ref [];
   74.33 +    val tab = Unsynchronized.ref [];
   74.34      fun mk_upd (x, (_, y)) t = Const ("Fun.fun_upd",
   74.35        (aT --> bT) --> aT --> bT --> aT --> bT) $ t $ aF x $ y ()
   74.36    in
    75.1 --- a/src/HOL/GCD.thy	Tue Sep 29 22:15:54 2009 +0200
    75.2 +++ b/src/HOL/GCD.thy	Thu Oct 01 07:40:25 2009 +0200
    75.3 @@ -1,11 +1,9 @@
    75.4 -(*  Title:      GCD.thy
    75.5 -    Authors:    Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb,
    75.6 +(*  Authors:    Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb,
    75.7                  Thomas M. Rasmussen, Jeremy Avigad, Tobias Nipkow
    75.8  
    75.9  
   75.10 -This file deals with the functions gcd and lcm, and properties of
   75.11 -primes. Definitions and lemmas are proved uniformly for the natural
   75.12 -numbers and integers.
   75.13 +This file deals with the functions gcd and lcm.  Definitions and
   75.14 +lemmas are proved uniformly for the natural numbers and integers.
   75.15  
   75.16  This file combines and revises a number of prior developments.
   75.17  
   75.18 @@ -52,11 +50,6 @@
   75.19  
   75.20  end
   75.21  
   75.22 -class prime = one +
   75.23 -
   75.24 -fixes
   75.25 -  prime :: "'a \<Rightarrow> bool"
   75.26 -
   75.27  
   75.28  (* definitions for the natural numbers *)
   75.29  
   75.30 @@ -80,20 +73,6 @@
   75.31  end
   75.32  
   75.33  
   75.34 -instantiation nat :: prime
   75.35 -
   75.36 -begin
   75.37 -
   75.38 -definition
   75.39 -  prime_nat :: "nat \<Rightarrow> bool"
   75.40 -where
   75.41 -  [code del]: "prime_nat p = (1 < p \<and> (\<forall>m. m dvd p --> m = 1 \<or> m = p))"
   75.42 -
   75.43 -instance proof qed
   75.44 -
   75.45 -end
   75.46 -
   75.47 -
   75.48  (* definitions for the integers *)
   75.49  
   75.50  instantiation int :: gcd
   75.51 @@ -115,28 +94,13 @@
   75.52  end
   75.53  
   75.54  
   75.55 -instantiation int :: prime
   75.56 -
   75.57 -begin
   75.58 -
   75.59 -definition
   75.60 -  prime_int :: "int \<Rightarrow> bool"
   75.61 -where
   75.62 -  [code del]: "prime_int p = prime (nat p)"
   75.63 -
   75.64 -instance proof qed
   75.65 -
   75.66 -end
   75.67 -
   75.68 -
   75.69  subsection {* Set up Transfer *}
   75.70  
   75.71  
   75.72  lemma transfer_nat_int_gcd:
   75.73    "(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> gcd (nat x) (nat y) = nat (gcd x y)"
   75.74    "(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> lcm (nat x) (nat y) = nat (lcm x y)"
   75.75 -  "(x::int) >= 0 \<Longrightarrow> prime (nat x) = prime x"
   75.76 -  unfolding gcd_int_def lcm_int_def prime_int_def
   75.77 +  unfolding gcd_int_def lcm_int_def
   75.78    by auto
   75.79  
   75.80  lemma transfer_nat_int_gcd_closures:
   75.81 @@ -150,8 +114,7 @@
   75.82  lemma transfer_int_nat_gcd:
   75.83    "gcd (int x) (int y) = int (gcd x y)"
   75.84    "lcm (int x) (int y) = int (lcm x y)"
   75.85 -  "prime (int x) = prime x"
   75.86 -  by (unfold gcd_int_def lcm_int_def prime_int_def, auto)
   75.87 +  by (unfold gcd_int_def lcm_int_def, auto)
   75.88  
   75.89  lemma transfer_int_nat_gcd_closures:
   75.90    "is_nat x \<Longrightarrow> is_nat y \<Longrightarrow> gcd x y >= 0"
   75.91 @@ -1003,20 +966,6 @@
   75.92    apply (auto simp add: gcd_mult_cancel_int)
   75.93  done
   75.94  
   75.95 -lemma prime_odd_nat: "prime (p::nat) \<Longrightarrow> p > 2 \<Longrightarrow> odd p"
   75.96 -  unfolding prime_nat_def
   75.97 -  apply (subst even_mult_two_ex)
   75.98 -  apply clarify
   75.99 -  apply (drule_tac x = 2 in spec)
  75.100 -  apply auto
  75.101 -done
  75.102 -
  75.103 -lemma prime_odd_int: "prime (p::int) \<Longrightarrow> p > 2 \<Longrightarrow> odd p"
  75.104 -  unfolding prime_int_def
  75.105 -  apply (frule prime_odd_nat)
  75.106 -  apply (auto simp add: even_nat_def)
  75.107 -done
  75.108 -
  75.109  lemma coprime_common_divisor_nat: "coprime (a::nat) b \<Longrightarrow> x dvd a \<Longrightarrow>
  75.110      x dvd b \<Longrightarrow> x = 1"
  75.111    apply (subgoal_tac "x dvd gcd a b")
  75.112 @@ -1753,329 +1702,4 @@
  75.113    show ?thesis by(simp add: Gcd_def fold_set gcd_commute_int)
  75.114  qed
  75.115  
  75.116 -
  75.117 -subsection {* Primes *}
  75.118 -
  75.119 -(* FIXME Is there a better way to handle these, rather than making them elim rules? *)
  75.120 -
  75.121 -lemma prime_ge_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= 0"
  75.122 -  by (unfold prime_nat_def, auto)
  75.123 -
  75.124 -lemma prime_gt_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p > 0"
  75.125 -  by (unfold prime_nat_def, auto)
  75.126 -
  75.127 -lemma prime_ge_1_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= 1"
  75.128 -  by (unfold prime_nat_def, auto)
  75.129 -
  75.130 -lemma prime_gt_1_nat [elim]: "prime (p::nat) \<Longrightarrow> p > 1"
  75.131 -  by (unfold prime_nat_def, auto)
  75.132 -
  75.133 -lemma prime_ge_Suc_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= Suc 0"
  75.134 -  by (unfold prime_nat_def, auto)
  75.135 -
  75.136 -lemma prime_gt_Suc_0_nat [elim]: "prime (p::nat) \<Longrightarrow> p > Suc 0"
  75.137 -  by (unfold prime_nat_def, auto)
  75.138 -
  75.139 -lemma prime_ge_2_nat [elim]: "prime (p::nat) \<Longrightarrow> p >= 2"
  75.140 -  by (unfold prime_nat_def, auto)
  75.141 -
  75.142 -lemma prime_ge_0_int [elim]: "prime (p::int) \<Longrightarrow> p >= 0"
  75.143 -  by (unfold prime_int_def prime_nat_def) auto
  75.144 -
  75.145 -lemma prime_gt_0_int [elim]: "prime (p::int) \<Longrightarrow> p > 0"
  75.146 -  by (unfold prime_int_def prime_nat_def, auto)
  75.147 -
  75.148 -lemma prime_ge_1_int [elim]: "prime (p::int) \<Longrightarrow> p >= 1"
  75.149 -  by (unfold prime_int_def prime_nat_def, auto)
  75.150 -
  75.151 -lemma prime_gt_1_int [elim]: "prime (p::int) \<Longrightarrow> p > 1"
  75.152 -  by (unfold prime_int_def prime_nat_def, auto)
  75.153 -
  75.154 -lemma prime_ge_2_int [elim]: "prime (p::int) \<Longrightarrow> p >= 2"
  75.155 -  by (unfold prime_int_def prime_nat_def, auto)
  75.156 -
  75.157 -
  75.158 -lemma prime_int_altdef: "prime (p::int) = (1 < p \<and> (\<forall>m \<ge> 0. m dvd p \<longrightarrow>
  75.159 -    m = 1 \<or> m = p))"
  75.160 -  using prime_nat_def [transferred]
  75.161 -    apply (case_tac "p >= 0")
  75.162 -    by (blast, auto simp add: prime_ge_0_int)
  75.163 -
  75.164 -lemma prime_imp_coprime_nat: "prime (p::nat) \<Longrightarrow> \<not> p dvd n \<Longrightarrow> coprime p n"
  75.165 -  apply (unfold prime_nat_def)
  75.166 -  apply (metis gcd_dvd1_nat gcd_dvd2_nat)
  75.167 -  done
  75.168 -
  75.169 -lemma prime_imp_coprime_int: "prime (p::int) \<Longrightarrow> \<not> p dvd n \<Longrightarrow> coprime p n"
  75.170 -  apply (unfold prime_int_altdef)
  75.171 -  apply (metis gcd_dvd1_int gcd_dvd2_int gcd_ge_0_int)
  75.172 -  done
  75.173 -
  75.174 -lemma prime_dvd_mult_nat: "prime (p::nat) \<Longrightarrow> p dvd m * n \<Longrightarrow> p dvd m \<or> p dvd n"
  75.175 -  by (blast intro: coprime_dvd_mult_nat prime_imp_coprime_nat)
  75.176 -
  75.177 -lemma prime_dvd_mult_int: "prime (p::int) \<Longrightarrow> p dvd m * n \<Longrightarrow> p dvd m \<or> p dvd n"
  75.178 -  by (blast intro: coprime_dvd_mult_int prime_imp_coprime_int)
  75.179 -
  75.180 -lemma prime_dvd_mult_eq_nat [simp]: "prime (p::nat) \<Longrightarrow>
  75.181 -    p dvd m * n = (p dvd m \<or> p dvd n)"
  75.182 -  by (rule iffI, rule prime_dvd_mult_nat, auto)
  75.183 -
  75.184 -lemma prime_dvd_mult_eq_int [simp]: "prime (p::int) \<Longrightarrow>
  75.185 -    p dvd m * n = (p dvd m \<or> p dvd n)"
  75.186 -  by (rule iffI, rule prime_dvd_mult_int, auto)
  75.187 -
  75.188 -lemma not_prime_eq_prod_nat: "(n::nat) > 1 \<Longrightarrow> ~ prime n \<Longrightarrow>
  75.189 -    EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n"
  75.190 -  unfolding prime_nat_def dvd_def apply auto
  75.191 -  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)
  75.192 -
  75.193 -lemma not_prime_eq_prod_int: "(n::int) > 1 \<Longrightarrow> ~ prime n \<Longrightarrow>
  75.194 -    EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n"
  75.195 -  unfolding prime_int_altdef dvd_def
  75.196 -  apply auto
  75.197 -  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)
  75.198 -
  75.199 -lemma prime_dvd_power_nat [rule_format]: "prime (p::nat) -->
  75.200 -    n > 0 --> (p dvd x^n --> p dvd x)"
  75.201 -  by (induct n rule: nat_induct, auto)
  75.202 -
  75.203 -lemma prime_dvd_power_int [rule_format]: "prime (p::int) -->
  75.204 -    n > 0 --> (p dvd x^n --> p dvd x)"
  75.205 -  apply (induct n rule: nat_induct, auto)
  75.206 -  apply (frule prime_ge_0_int)
  75.207 -  apply auto
  75.208 -done
  75.209 -
  75.210 -subsubsection{* Make prime naively executable *}
  75.211 -
  75.212 -lemma zero_not_prime_nat [simp]: "~prime (0::nat)"
  75.213 -  by (simp add: prime_nat_def)
  75.214 -
  75.215 -lemma zero_not_prime_int [simp]: "~prime (0::int)"
  75.216 -  by (simp add: prime_int_def)
  75.217 -
  75.218 -lemma one_not_prime_nat [simp]: "~prime (1::nat)"
  75.219 -  by (simp add: prime_nat_def)
  75.220 -
  75.221 -lemma Suc_0_not_prime_nat [simp]: "~prime (Suc 0)"
  75.222 -  by (simp add: prime_nat_def One_nat_def)
  75.223 -
  75.224 -lemma one_not_prime_int [simp]: "~prime (1::int)"
  75.225 -  by (simp add: prime_int_def)
  75.226 -
  75.227 -lemma prime_nat_code[code]:
  75.228 - "prime(p::nat) = (p > 1 & (ALL n : {1<..<p}. ~(n dvd p)))"
  75.229 -apply(simp add: Ball_def)
  75.230 -apply (metis less_not_refl prime_nat_def dvd_triv_right not_prime_eq_prod_nat)
  75.231 -done
  75.232 -
  75.233 -lemma prime_nat_simp:
  75.234 - "prime(p::nat) = (p > 1 & (list_all (%n. ~ n dvd p) [2..<p]))"
  75.235 -apply(simp only:prime_nat_code list_ball_code greaterThanLessThan_upt)
  75.236 -apply(simp add:nat_number One_nat_def)
  75.237 -done
  75.238 -
  75.239 -lemmas prime_nat_simp_number_of[simp] = prime_nat_simp[of "number_of m", standard]
  75.240 -
  75.241 -lemma prime_int_code[code]:
  75.242 -  "prime(p::int) = (p > 1 & (ALL n : {1<..<p}. ~(n dvd p)))" (is "?L = ?R")
  75.243 -proof
  75.244 -  assume "?L" thus "?R"
  75.245 -    by (clarsimp simp: prime_gt_1_int) (metis int_one_le_iff_zero_less prime_int_altdef zless_le)
  75.246 -next
  75.247 -    assume "?R" thus "?L" by (clarsimp simp:Ball_def) (metis dvdI not_prime_eq_prod_int)
  75.248 -qed
  75.249 -
  75.250 -lemma prime_int_simp:
  75.251 -  "prime(p::int) = (p > 1 & (list_all (%n. ~ n dvd p) [2..p - 1]))"
  75.252 -apply(simp only:prime_int_code list_ball_code greaterThanLessThan_upto)
  75.253 -apply simp
  75.254 -done
  75.255 -
  75.256 -lemmas prime_int_simp_number_of[simp] = prime_int_simp[of "number_of m", standard]
  75.257 -
  75.258 -declare successor_int_def[simp]
  75.259 -
  75.260 -lemma two_is_prime_nat [simp]: "prime (2::nat)"
  75.261 -by simp
  75.262 -
  75.263 -lemma two_is_prime_int [simp]: "prime (2::int)"
  75.264 -by simp
  75.265 -
  75.266 -text{* A bit of regression testing: *}
  75.267 -
  75.268 -lemma "prime(97::nat)"
  75.269 -by simp
  75.270 -
  75.271 -lemma "prime(97::int)"
  75.272 -by simp
  75.273 -
  75.274 -lemma "prime(997::nat)"
  75.275 -by eval
  75.276 -
  75.277 -lemma "prime(997::int)"
  75.278 -by eval
  75.279 -
  75.280 -
  75.281 -lemma prime_imp_power_coprime_nat: "prime (p::nat) \<Longrightarrow> ~ p dvd a \<Longrightarrow> coprime a (p^m)"
  75.282 -  apply (rule coprime_exp_nat)
  75.283 -  apply (subst gcd_commute_nat)
  75.284 -  apply (erule (1) prime_imp_coprime_nat)
  75.285 -done
  75.286 -
  75.287 -lemma prime_imp_power_coprime_int: "prime (p::int) \<Longrightarrow> ~ p dvd a \<Longrightarrow> coprime a (p^m)"
  75.288 -  apply (rule coprime_exp_int)
  75.289 -  apply (subst gcd_commute_int)
  75.290 -  apply (erule (1) prime_imp_coprime_int)
  75.291 -done
  75.292 -
  75.293 -lemma primes_coprime_nat: "prime (p::nat) \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
  75.294 -  apply (rule prime_imp_coprime_nat, assumption)
  75.295 -  apply (unfold prime_nat_def, auto)
  75.296 -done
  75.297 -
  75.298 -lemma primes_coprime_int: "prime (p::int) \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
  75.299 -  apply (rule prime_imp_coprime_int, assumption)
  75.300 -  apply (unfold prime_int_altdef, clarify)
  75.301 -  apply (drule_tac x = q in spec)
  75.302 -  apply (drule_tac x = p in spec)
  75.303 -  apply auto
  75.304 -done
  75.305 -
  75.306 -lemma primes_imp_powers_coprime_nat: "prime (p::nat) \<Longrightarrow> prime q \<Longrightarrow> p ~= q \<Longrightarrow> coprime (p^m) (q^n)"
  75.307 -  by (rule coprime_exp2_nat, rule primes_coprime_nat)
  75.308 -
  75.309 -lemma primes_imp_powers_coprime_int: "prime (p::int) \<Longrightarrow> prime q \<Longrightarrow> p ~= q \<Longrightarrow> coprime (p^m) (q^n)"
  75.310 -  by (rule coprime_exp2_int, rule primes_coprime_int)
  75.311 -
  75.312 -lemma prime_factor_nat: "n \<noteq> (1::nat) \<Longrightarrow> \<exists> p. prime p \<and> p dvd n"
  75.313 -  apply (induct n rule: nat_less_induct)
  75.314 -  apply (case_tac "n = 0")
  75.315 -  using two_is_prime_nat apply blast
  75.316 -  apply (case_tac "prime n")
  75.317 -  apply blast
  75.318 -  apply (subgoal_tac "n > 1")
  75.319 -  apply (frule (1) not_prime_eq_prod_nat)
  75.320 -  apply (auto intro: dvd_mult dvd_mult2)
  75.321 -done
  75.322 -
  75.323 -(* An Isar version:
  75.324 -
  75.325 -lemma prime_factor_b_nat:
  75.326 -  fixes n :: nat
  75.327 -  assumes "n \<noteq> 1"
  75.328 -  shows "\<exists>p. prime p \<and> p dvd n"
  75.329 -
  75.330 -using `n ~= 1`
  75.331 -proof (induct n rule: less_induct_nat)
  75.332 -  fix n :: nat
  75.333 -  assume "n ~= 1" and
  75.334 -    ih: "\<forall>m<n. m \<noteq> 1 \<longrightarrow> (\<exists>p. prime p \<and> p dvd m)"
  75.335 -  thus "\<exists>p. prime p \<and> p dvd n"
  75.336 -  proof -
  75.337 -  {
  75.338 -    assume "n = 0"
  75.339 -    moreover note two_is_prime_nat
  75.340 -    ultimately have ?thesis
  75.341 -      by (auto simp del: two_is_prime_nat)
  75.342 -  }
  75.343 -  moreover
  75.344 -  {
  75.345 -    assume "prime n"
  75.346 -    hence ?thesis by auto
  75.347 -  }
  75.348 -  moreover
  75.349 -  {
  75.350 -    assume "n ~= 0" and "~ prime n"
  75.351 -    with `n ~= 1` have "n > 1" by auto
  75.352 -    with `~ prime n` and not_prime_eq_prod_nat obtain m k where
  75.353 -      "n = m * k" and "1 < m" and "m < n" by blast
  75.354 -    with ih obtain p where "prime p" and "p dvd m" by blast
  75.355 -    with `n = m * k` have ?thesis by auto
  75.356 -  }
  75.357 -  ultimately show ?thesis by blast
  75.358 -  qed
  75.359 -qed
  75.360 -
  75.361 -*)
  75.362 -
  75.363 -text {* One property of coprimality is easier to prove via prime factors. *}
  75.364 -
  75.365 -lemma prime_divprod_pow_nat:
  75.366 -  assumes p: "prime (p::nat)" and ab: "coprime a b" and pab: "p^n dvd a * b"
  75.367 -  shows "p^n dvd a \<or> p^n dvd b"
  75.368 -proof-
  75.369 -  {assume "n = 0 \<or> a = 1 \<or> b = 1" with pab have ?thesis
  75.370 -      apply (cases "n=0", simp_all)
  75.371 -      apply (cases "a=1", simp_all) done}
  75.372 -  moreover
  75.373 -  {assume n: "n \<noteq> 0" and a: "a\<noteq>1" and b: "b\<noteq>1"
  75.374 -    then obtain m where m: "n = Suc m" by (cases n, auto)
  75.375 -    from n have "p dvd p^n" by (intro dvd_power, auto)
  75.376 -    also note pab
  75.377 -    finally have pab': "p dvd a * b".
  75.378 -    from prime_dvd_mult_nat[OF p pab']
  75.379 -    have "p dvd a \<or> p dvd b" .
  75.380 -    moreover
  75.381 -    {assume pa: "p dvd a"
  75.382 -      have pnba: "p^n dvd b*a" using pab by (simp add: mult_commute)
  75.383 -      from coprime_common_divisor_nat [OF ab, OF pa] p have "\<not> p dvd b" by auto
  75.384 -      with p have "coprime b p"
  75.385 -        by (subst gcd_commute_nat, intro prime_imp_coprime_nat)
  75.386 -      hence pnb: "coprime (p^n) b"
  75.387 -        by (subst gcd_commute_nat, rule coprime_exp_nat)
  75.388 -      from coprime_divprod_nat[OF pnba pnb] have ?thesis by blast }
  75.389 -    moreover
  75.390 -    {assume pb: "p dvd b"
  75.391 -      have pnba: "p^n dvd b*a" using pab by (simp add: mult_commute)
  75.392 -      from coprime_common_divisor_nat [OF ab, of p] pb p have "\<not> p dvd a"
  75.393 -        by auto
  75.394 -      with p have "coprime a p"
  75.395 -        by (subst gcd_commute_nat, intro prime_imp_coprime_nat)
  75.396 -      hence pna: "coprime (p^n) a"
  75.397 -        by (subst gcd_commute_nat, rule coprime_exp_nat)
  75.398 -      from coprime_divprod_nat[OF pab pna] have ?thesis by blast }
  75.399 -    ultimately have ?thesis by blast}
  75.400 -  ultimately show ?thesis by blast
  75.401 -qed
  75.402 -
  75.403 -subsection {* Infinitely many primes *}
  75.404 -
  75.405 -lemma next_prime_bound: "\<exists>(p::nat). prime p \<and> n < p \<and> p <= fact n + 1"
  75.406 -proof-
  75.407 -  have f1: "fact n + 1 \<noteq> 1" using fact_ge_one_nat [of n] by arith 
  75.408 -  from prime_factor_nat [OF f1]
  75.409 -      obtain p where "prime p" and "p dvd fact n + 1" by auto
  75.410 -  hence "p \<le> fact n + 1" 
  75.411 -    by (intro dvd_imp_le, auto)
  75.412 -  {assume "p \<le> n"
  75.413 -    from `prime p` have "p \<ge> 1" 
  75.414 -      by (cases p, simp_all)
  75.415 -    with `p <= n` have "p dvd fact n" 
  75.416 -      by (intro dvd_fact_nat)
  75.417 -    with `p dvd fact n + 1` have "p dvd fact n + 1 - fact n"
  75.418 -      by (rule dvd_diff_nat)
  75.419 -    hence "p dvd 1" by simp
  75.420 -    hence "p <= 1" by auto
  75.421 -    moreover from `prime p` have "p > 1" by auto
  75.422 -    ultimately have False by auto}
  75.423 -  hence "n < p" by arith
  75.424 -  with `prime p` and `p <= fact n + 1` show ?thesis by auto
  75.425 -qed
  75.426 -
  75.427 -lemma bigger_prime: "\<exists>p. prime p \<and> p > (n::nat)" 
  75.428 -using next_prime_bound by auto
  75.429 -
  75.430 -lemma primes_infinite: "\<not> (finite {(p::nat). prime p})"
  75.431 -proof
  75.432 -  assume "finite {(p::nat). prime p}"
  75.433 -  with Max_ge have "(EX b. (ALL x : {(p::nat). prime p}. x <= b))"
  75.434 -    by auto
  75.435 -  then obtain b where "ALL (x::nat). prime x \<longrightarrow> x <= b"
  75.436 -    by auto
  75.437 -  with bigger_prime [of b] show False by auto
  75.438 -qed
  75.439 -
  75.440 -
  75.441  end
    76.1 --- a/src/HOL/HOL.thy	Tue Sep 29 22:15:54 2009 +0200
    76.2 +++ b/src/HOL/HOL.thy	Thu Oct 01 07:40:25 2009 +0200
    76.3 @@ -15,6 +15,7 @@
    76.4    "~~/src/Tools/IsaPlanner/rw_inst.ML"
    76.5    "~~/src/Tools/intuitionistic.ML"
    76.6    "~~/src/Tools/project_rule.ML"
    76.7 +  "~~/src/Tools/cong_tac.ML"
    76.8    "~~/src/Provers/hypsubst.ML"
    76.9    "~~/src/Provers/splitter.ML"
   76.10    "~~/src/Provers/classical.ML"
   76.11 @@ -29,6 +30,7 @@
   76.12    "~~/src/Tools/induct.ML"
   76.13    ("~~/src/Tools/induct_tacs.ML")
   76.14    ("Tools/recfun_codegen.ML")
   76.15 +  "~~/src/Tools/more_conv.ML"
   76.16  begin
   76.17  
   76.18  setup {* Intuitionistic.method_setup @{binding iprover} *}
   76.19 @@ -239,15 +241,15 @@
   76.20    by (rule subst)
   76.21  
   76.22  
   76.23 -subsubsection {*Congruence rules for application*}
   76.24 +subsubsection {* Congruence rules for application *}
   76.25  
   76.26 -(*similar to AP_THM in Gordon's HOL*)
   76.27 +text {* Similar to @{text AP_THM} in Gordon's HOL. *}
   76.28  lemma fun_cong: "(f::'a=>'b) = g ==> f(x)=g(x)"
   76.29  apply (erule subst)
   76.30  apply (rule refl)
   76.31  done
   76.32  
   76.33 -(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
   76.34 +text {* Similar to @{text AP_TERM} in Gordon's HOL and FOL's @{text subst_context}. *}
   76.35  lemma arg_cong: "x=y ==> f(x)=f(y)"
   76.36  apply (erule subst)
   76.37  apply (rule refl)
   76.38 @@ -258,13 +260,15 @@
   76.39  apply (rule refl)
   76.40  done
   76.41  
   76.42 -lemma cong: "[| f = g; (x::'a) = y |] ==> f(x) = g(y)"
   76.43 +lemma cong: "[| f = g; (x::'a) = y |] ==> f x = g y"
   76.44  apply (erule subst)+
   76.45  apply (rule refl)
   76.46  done
   76.47  
   76.48 +ML {* val cong_tac = Cong_Tac.cong_tac @{thm cong} *}
   76.49  
   76.50 -subsubsection {*Equality of booleans -- iff*}
   76.51 +
   76.52 +subsubsection {* Equality of booleans -- iff *}
   76.53  
   76.54  lemma iffI: assumes "P ==> Q" and "Q ==> P" shows "P=Q"
   76.55    by (iprover intro: iff [THEN mp, THEN mp] impI assms)
   76.56 @@ -1465,7 +1469,7 @@
   76.57  subsubsection {* Coherent logic *}
   76.58  
   76.59  ML {*
   76.60 -structure Coherent = CoherentFun
   76.61 +structure Coherent = Coherent
   76.62  (
   76.63    val atomize_elimL = @{thm atomize_elimL}
   76.64    val atomize_exL = @{thm atomize_exL}
   76.65 @@ -1886,7 +1890,7 @@
   76.66  *}
   76.67  
   76.68  setup {*
   76.69 -  Code.add_const_alias @{thm equals_alias_cert}
   76.70 +  Nbe.add_const_alias @{thm equals_alias_cert}
   76.71  *}
   76.72  
   76.73  hide (open) const eq
   76.74 @@ -1966,7 +1970,7 @@
   76.75  structure Eval_Method =
   76.76  struct
   76.77  
   76.78 -val eval_ref : (unit -> bool) option ref = ref NONE;
   76.79 +val eval_ref : (unit -> bool) option Unsynchronized.ref = Unsynchronized.ref NONE;
   76.80  
   76.81  end;
   76.82  *}
   76.83 @@ -2020,6 +2024,29 @@
   76.84  
   76.85  quickcheck_params [size = 5, iterations = 50]
   76.86  
   76.87 +subsection {* Preprocessing for the predicate compiler *}
   76.88 +
   76.89 +ML {*
   76.90 +structure Predicate_Compile_Alternative_Defs = Named_Thms
   76.91 +(
   76.92 +  val name = "code_pred_def"
   76.93 +  val description = "alternative definitions of constants for the Predicate Compiler"
   76.94 +)
   76.95 +*}
   76.96 +
   76.97 +ML {*
   76.98 +structure Predicate_Compile_Inline_Defs = Named_Thms
   76.99 +(
  76.100 +  val name = "code_pred_inline"
  76.101 +  val description = "inlining definitions for the Predicate Compiler"
  76.102 +)
  76.103 +*}
  76.104 +
  76.105 +setup {*
  76.106 +  Predicate_Compile_Alternative_Defs.setup
  76.107 +  #> Predicate_Compile_Inline_Defs.setup
  76.108 +  #> Predicate_Compile_Preproc_Const_Defs.setup
  76.109 +*}
  76.110  
  76.111  subsection {* Nitpick setup *}
  76.112  
    77.1 --- a/src/HOL/HoareParallel/Gar_Coll.thy	Tue Sep 29 22:15:54 2009 +0200
    77.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    77.3 @@ -1,846 +0,0 @@
    77.4 -
    77.5 -header {* \section{The Single Mutator Case} *}
    77.6 -
    77.7 -theory Gar_Coll imports Graph OG_Syntax begin
    77.8 -
    77.9 -declare psubsetE [rule del]
   77.10 -
   77.11 -text {* Declaration of variables: *}
   77.12 -
   77.13 -record gar_coll_state =
   77.14 -  M :: nodes
   77.15 -  E :: edges
   77.16 -  bc :: "nat set"
   77.17 -  obc :: "nat set"
   77.18 -  Ma :: nodes
   77.19 -  ind :: nat 
   77.20 -  k :: nat
   77.21 -  z :: bool
   77.22 -
   77.23 -subsection {* The Mutator *}
   77.24 -
   77.25 -text {* The mutator first redirects an arbitrary edge @{text "R"} from
   77.26 -an arbitrary accessible node towards an arbitrary accessible node
   77.27 -@{text "T"}.  It then colors the new target @{text "T"} black. 
   77.28 -
   77.29 -We declare the arbitrarily selected node and edge as constants:*}
   77.30 -
   77.31 -consts R :: nat  T :: nat
   77.32 -
   77.33 -text {* \noindent The following predicate states, given a list of
   77.34 -nodes @{text "m"} and a list of edges @{text "e"}, the conditions
   77.35 -under which the selected edge @{text "R"} and node @{text "T"} are
   77.36 -valid: *}
   77.37 -
   77.38 -constdefs
   77.39 -  Mut_init :: "gar_coll_state \<Rightarrow> bool"
   77.40 -  "Mut_init \<equiv> \<guillemotleft> T \<in> Reach \<acute>E \<and> R < length \<acute>E \<and> T < length \<acute>M \<guillemotright>"
   77.41 -
   77.42 -text {* \noindent For the mutator we
   77.43 -consider two modules, one for each action.  An auxiliary variable
   77.44 -@{text "\<acute>z"} is set to false if the mutator has already redirected an
   77.45 -edge but has not yet colored the new target.   *}
   77.46 -
   77.47 -constdefs
   77.48 -  Redirect_Edge :: "gar_coll_state ann_com"
   77.49 -  "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>"
   77.50 -
   77.51 -  Color_Target :: "gar_coll_state ann_com"
   77.52 -  "Color_Target \<equiv> .{\<acute>Mut_init \<and> \<not>\<acute>z}. \<langle>\<acute>M:=\<acute>M[T:=Black],, \<acute>z:= (\<not>\<acute>z)\<rangle>"
   77.53 -
   77.54 -  Mutator :: "gar_coll_state ann_com"
   77.55 -  "Mutator \<equiv>
   77.56 -  .{\<acute>Mut_init \<and> \<acute>z}. 
   77.57 -  WHILE True INV .{\<acute>Mut_init \<and> \<acute>z}. 
   77.58 -  DO  Redirect_Edge ;; Color_Target  OD"
   77.59 -
   77.60 -subsubsection {* Correctness of the mutator *}
   77.61 -
   77.62 -lemmas mutator_defs = Mut_init_def Redirect_Edge_def Color_Target_def
   77.63 -
   77.64 -lemma Redirect_Edge: 
   77.65 -  "\<turnstile> Redirect_Edge pre(Color_Target)"
   77.66 -apply (unfold mutator_defs)
   77.67 -apply annhoare
   77.68 -apply(simp_all)
   77.69 -apply(force elim:Graph2)
   77.70 -done
   77.71 -
   77.72 -lemma Color_Target:
   77.73 -  "\<turnstile> Color_Target .{\<acute>Mut_init \<and> \<acute>z}."
   77.74 -apply (unfold mutator_defs)
   77.75 -apply annhoare
   77.76 -apply(simp_all)
   77.77 -done
   77.78 -
   77.79 -lemma Mutator: 
   77.80 - "\<turnstile> Mutator .{False}."
   77.81 -apply(unfold Mutator_def)
   77.82 -apply annhoare
   77.83 -apply(simp_all add:Redirect_Edge Color_Target)
   77.84 -apply(simp add:mutator_defs Redirect_Edge_def)
   77.85 -done
   77.86 -
   77.87 -subsection {* The Collector *}
   77.88 -
   77.89 -text {* \noindent A constant @{text "M_init"} is used to give @{text "\<acute>Ma"} a
   77.90 -suitable first value, defined as a list of nodes where only the @{text
   77.91 -"Roots"} are black. *}
   77.92 -
   77.93 -consts  M_init :: nodes
   77.94 -
   77.95 -constdefs
   77.96 -  Proper_M_init :: "gar_coll_state \<Rightarrow> bool"
   77.97 -  "Proper_M_init \<equiv>  \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
   77.98 - 
   77.99 -  Proper :: "gar_coll_state \<Rightarrow> bool"
  77.100 -  "Proper \<equiv> \<guillemotleft> Proper_Roots \<acute>M \<and> Proper_Edges(\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<guillemotright>"
  77.101 -
  77.102 -  Safe :: "gar_coll_state \<Rightarrow> bool"
  77.103 -  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
  77.104 -
  77.105 -lemmas collector_defs = Proper_M_init_def Proper_def Safe_def
  77.106 -
  77.107 -subsubsection {* Blackening the roots *}
  77.108 -
  77.109 -constdefs
  77.110 -  Blacken_Roots :: " gar_coll_state ann_com"
  77.111 -  "Blacken_Roots \<equiv> 
  77.112 -  .{\<acute>Proper}.
  77.113 -  \<acute>ind:=0;;
  77.114 -  .{\<acute>Proper \<and> \<acute>ind=0}.
  77.115 -  WHILE \<acute>ind<length \<acute>M 
  77.116 -   INV .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M}.
  77.117 -  DO .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
  77.118 -   IF \<acute>ind\<in>Roots THEN 
  77.119 -   .{\<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}. 
  77.120 -    \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
  77.121 -   .{\<acute>Proper \<and> (\<forall>i<\<acute>ind+1. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
  77.122 -    \<acute>ind:=\<acute>ind+1 
  77.123 -  OD"
  77.124 -
  77.125 -lemma Blacken_Roots: 
  77.126 - "\<turnstile> Blacken_Roots .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}."
  77.127 -apply (unfold Blacken_Roots_def)
  77.128 -apply annhoare
  77.129 -apply(simp_all add:collector_defs Graph_defs)
  77.130 -apply safe
  77.131 -apply(simp_all add:nth_list_update)
  77.132 -  apply (erule less_SucE)
  77.133 -   apply simp+
  77.134 - apply force
  77.135 -apply force
  77.136 -done
  77.137 -
  77.138 -subsubsection {* Propagating black *}
  77.139 -
  77.140 -constdefs
  77.141 -  PBInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
  77.142 -  "PBInv \<equiv> \<guillemotleft> \<lambda>ind. \<acute>obc < Blacks \<acute>M \<or> (\<forall>i <ind. \<not>BtoW (\<acute>E!i, \<acute>M) \<or>
  77.143 -   (\<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>"
  77.144 -
  77.145 -constdefs  
  77.146 -  Propagate_Black_aux :: "gar_coll_state ann_com"
  77.147 -  "Propagate_Black_aux \<equiv>
  77.148 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
  77.149 -  \<acute>ind:=0;;
  77.150 -  .{\<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}. 
  77.151 -  WHILE \<acute>ind<length \<acute>E 
  77.152 -   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.153 -         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
  77.154 -  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.155 -       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
  77.156 -   IF \<acute>M!(fst (\<acute>E!\<acute>ind)) = Black THEN 
  77.157 -    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.158 -       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black}.
  77.159 -     \<acute>M:=\<acute>M[snd(\<acute>E!\<acute>ind):=Black];;
  77.160 -    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.161 -       \<and> \<acute>PBInv (\<acute>ind + 1) \<and> \<acute>ind<length \<acute>E}.
  77.162 -     \<acute>ind:=\<acute>ind+1
  77.163 -   FI
  77.164 -  OD"
  77.165 -
  77.166 -lemma Propagate_Black_aux: 
  77.167 -  "\<turnstile>  Propagate_Black_aux
  77.168 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.169 -    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
  77.170 -apply (unfold Propagate_Black_aux_def  PBInv_def collector_defs)
  77.171 -apply annhoare
  77.172 -apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
  77.173 -      apply force
  77.174 -     apply force
  77.175 -    apply force
  77.176 ---{* 4 subgoals left *}
  77.177 -apply clarify
  77.178 -apply(simp add:Proper_Edges_def Proper_Roots_def Graph6 Graph7 Graph8 Graph12)
  77.179 -apply (erule disjE)
  77.180 - apply(rule disjI1)
  77.181 - apply(erule Graph13)
  77.182 - apply force
  77.183 -apply (case_tac "M x ! snd (E x ! ind x)=Black")
  77.184 - apply (simp add: Graph10 BtoW_def)
  77.185 - apply (rule disjI2)
  77.186 - apply clarify
  77.187 - apply (erule less_SucE)
  77.188 -  apply (erule_tac x=i in allE , erule (1) notE impE)
  77.189 -  apply simp
  77.190 -  apply clarify
  77.191 -  apply (drule_tac y = r in le_imp_less_or_eq)
  77.192 -  apply (erule disjE)
  77.193 -   apply (subgoal_tac "Suc (ind x)\<le>r")
  77.194 -    apply fast
  77.195 -   apply arith
  77.196 -  apply fast
  77.197 - apply fast
  77.198 -apply(rule disjI1)
  77.199 -apply(erule subset_psubset_trans)
  77.200 -apply(erule Graph11)
  77.201 -apply fast
  77.202 ---{* 3 subgoals left *}
  77.203 -apply force
  77.204 -apply force
  77.205 ---{* last *}
  77.206 -apply clarify
  77.207 -apply simp
  77.208 -apply(subgoal_tac "ind x = length (E x)")
  77.209 - apply (rotate_tac -1)
  77.210 - apply (simp (asm_lr))
  77.211 - apply(drule Graph1)
  77.212 -   apply simp
  77.213 -  apply clarify  
  77.214 - apply(erule allE, erule impE, assumption)
  77.215 -  apply force
  77.216 - apply force
  77.217 -apply arith
  77.218 -done
  77.219 -
  77.220 -subsubsection {* Refining propagating black *}
  77.221 -
  77.222 -constdefs
  77.223 -  Auxk :: "gar_coll_state \<Rightarrow> bool"
  77.224 -  "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> 
  77.225 -          \<acute>obc<Blacks \<acute>M \<or> (\<not>\<acute>z \<and> \<acute>ind=R \<and> snd(\<acute>E!R)=T  
  77.226 -          \<and> (\<exists>r. \<acute>ind<r \<and> r<length \<acute>E \<and> BtoW(\<acute>E!r, \<acute>M))))\<guillemotright>"
  77.227 -
  77.228 -constdefs  
  77.229 -  Propagate_Black :: " gar_coll_state ann_com"
  77.230 -  "Propagate_Black \<equiv>
  77.231 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
  77.232 -  \<acute>ind:=0;;
  77.233 -  .{\<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}.
  77.234 -  WHILE \<acute>ind<length \<acute>E 
  77.235 -   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.236 -         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
  77.237 -  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.238 -       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
  77.239 -   IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))=Black THEN 
  77.240 -    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.241 -      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black}.
  77.242 -     \<acute>k:=(snd(\<acute>E!\<acute>ind));;
  77.243 -    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.244 -      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black 
  77.245 -      \<and> \<acute>Auxk}.
  77.246 -     \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],, \<acute>ind:=\<acute>ind+1\<rangle>
  77.247 -   ELSE .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.248 -          \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
  77.249 -         \<langle>IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> 
  77.250 -   FI
  77.251 -  OD"
  77.252 -
  77.253 -lemma Propagate_Black: 
  77.254 -  "\<turnstile>  Propagate_Black
  77.255 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.256 -    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
  77.257 -apply (unfold Propagate_Black_def  PBInv_def Auxk_def collector_defs)
  77.258 -apply annhoare
  77.259 -apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
  77.260 -       apply force
  77.261 -      apply force
  77.262 -     apply force
  77.263 ---{* 5 subgoals left *}
  77.264 -apply clarify
  77.265 -apply(simp add:BtoW_def Proper_Edges_def)
  77.266 ---{* 4 subgoals left *}
  77.267 -apply clarify
  77.268 -apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
  77.269 -apply (erule disjE)
  77.270 - apply (rule disjI1)
  77.271 - apply (erule psubset_subset_trans)
  77.272 - apply (erule Graph9)
  77.273 -apply (case_tac "M x!k x=Black")
  77.274 - apply (case_tac "M x ! snd (E x ! ind x)=Black")
  77.275 -  apply (simp add: Graph10 BtoW_def)
  77.276 -  apply (rule disjI2)
  77.277 -  apply clarify
  77.278 -  apply (erule less_SucE)
  77.279 -   apply (erule_tac x=i in allE , erule (1) notE impE)
  77.280 -   apply simp
  77.281 -   apply clarify
  77.282 -   apply (drule_tac y = r in le_imp_less_or_eq)
  77.283 -   apply (erule disjE)
  77.284 -    apply (subgoal_tac "Suc (ind x)\<le>r")
  77.285 -     apply fast
  77.286 -    apply arith
  77.287 -   apply fast
  77.288 -  apply fast
  77.289 - apply (simp add: Graph10 BtoW_def)
  77.290 - apply (erule disjE)
  77.291 -  apply (erule disjI1)
  77.292 - apply clarify
  77.293 - apply (erule less_SucE)
  77.294 -  apply force
  77.295 - apply simp
  77.296 - apply (subgoal_tac "Suc R\<le>r")
  77.297 -  apply fast
  77.298 - apply arith
  77.299 -apply(rule disjI1)
  77.300 -apply(erule subset_psubset_trans)
  77.301 -apply(erule Graph11)
  77.302 -apply fast
  77.303 ---{* 3 subgoals left *}
  77.304 -apply force
  77.305 ---{* 2 subgoals left *}
  77.306 -apply clarify
  77.307 -apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
  77.308 -apply (erule disjE)
  77.309 - apply fast
  77.310 -apply clarify
  77.311 -apply (erule less_SucE)
  77.312 - apply (erule_tac x=i in allE , erule (1) notE impE)
  77.313 - apply simp
  77.314 - apply clarify
  77.315 - apply (drule_tac y = r in le_imp_less_or_eq)
  77.316 - apply (erule disjE)
  77.317 -  apply (subgoal_tac "Suc (ind x)\<le>r")
  77.318 -   apply fast
  77.319 -  apply arith
  77.320 - apply (simp add: BtoW_def)
  77.321 -apply (simp add: BtoW_def)
  77.322 ---{* last *}
  77.323 -apply clarify
  77.324 -apply simp
  77.325 -apply(subgoal_tac "ind x = length (E x)")
  77.326 - apply (rotate_tac -1)
  77.327 - apply (simp (asm_lr))
  77.328 - apply(drule Graph1)
  77.329 -   apply simp
  77.330 -  apply clarify  
  77.331 - apply(erule allE, erule impE, assumption)
  77.332 -  apply force
  77.333 - apply force
  77.334 -apply arith
  77.335 -done
  77.336 -
  77.337 -subsubsection {* Counting black nodes *}
  77.338 -
  77.339 -constdefs
  77.340 -  CountInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
  77.341 -  "CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
  77.342 -
  77.343 -constdefs
  77.344 -  Count :: " gar_coll_state ann_com"
  77.345 -  "Count \<equiv>
  77.346 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.347 -    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.348 -    \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={}}.
  77.349 -  \<acute>ind:=0;;
  77.350 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.351 -    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.352 -   \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={} 
  77.353 -   \<and> \<acute>ind=0}.
  77.354 -   WHILE \<acute>ind<length \<acute>M 
  77.355 -     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.356 -           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.357 -           \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
  77.358 -           \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind\<le>length \<acute>M}.
  77.359 -   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.360 -         \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.361 -         \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind 
  77.362 -         \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}. 
  77.363 -       IF \<acute>M!\<acute>ind=Black 
  77.364 -          THEN .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.365 -                 \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.366 -                 \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
  77.367 -                 \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
  77.368 -          \<acute>bc:=insert \<acute>ind \<acute>bc
  77.369 -       FI;;
  77.370 -      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.371 -        \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.372 -        \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv (\<acute>ind+1)
  77.373 -        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}.
  77.374 -      \<acute>ind:=\<acute>ind+1
  77.375 -   OD"
  77.376 -
  77.377 -lemma Count: 
  77.378 -  "\<turnstile> Count 
  77.379 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.380 -   \<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
  77.381 -   \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}."
  77.382 -apply(unfold Count_def)
  77.383 -apply annhoare
  77.384 -apply(simp_all add:CountInv_def Graph6 Graph7 Graph8 Graph12 Blacks_def collector_defs)
  77.385 -      apply force
  77.386 -     apply force
  77.387 -    apply force
  77.388 -   apply clarify
  77.389 -   apply simp
  77.390 -   apply(fast elim:less_SucE)
  77.391 -  apply clarify
  77.392 -  apply simp
  77.393 -  apply(fast elim:less_SucE)
  77.394 - apply force
  77.395 -apply force
  77.396 -done
  77.397 -
  77.398 -subsubsection {* Appending garbage nodes to the free list *}
  77.399 -
  77.400 -consts Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
  77.401 -
  77.402 -axioms
  77.403 -  Append_to_free0: "length (Append_to_free (i, e)) = length e"
  77.404 -  Append_to_free1: "Proper_Edges (m, e) 
  77.405 -                   \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
  77.406 -  Append_to_free2: "i \<notin> Reach e 
  77.407 -     \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
  77.408 -
  77.409 -constdefs
  77.410 -  AppendInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
  77.411 -  "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>"
  77.412 -
  77.413 -constdefs
  77.414 -  Append :: " gar_coll_state ann_com"
  77.415 -   "Append \<equiv>
  77.416 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
  77.417 -  \<acute>ind:=0;;
  77.418 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
  77.419 -    WHILE \<acute>ind<length \<acute>M 
  77.420 -      INV .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
  77.421 -    DO .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
  77.422 -       IF \<acute>M!\<acute>ind=Black THEN 
  77.423 -          .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
  77.424 -          \<acute>M:=\<acute>M[\<acute>ind:=White] 
  77.425 -       ELSE .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}.
  77.426 -              \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
  77.427 -       FI;;
  77.428 -     .{\<acute>Proper \<and> \<acute>AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
  77.429 -       \<acute>ind:=\<acute>ind+1
  77.430 -    OD"
  77.431 -
  77.432 -lemma Append: 
  77.433 -  "\<turnstile> Append .{\<acute>Proper}."
  77.434 -apply(unfold Append_def AppendInv_def)
  77.435 -apply annhoare
  77.436 -apply(simp_all add:collector_defs Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  77.437 -       apply(force simp:Blacks_def nth_list_update)
  77.438 -      apply force
  77.439 -     apply force
  77.440 -    apply(force simp add:Graph_defs)
  77.441 -   apply force
  77.442 -  apply clarify
  77.443 -  apply simp
  77.444 -  apply(rule conjI)
  77.445 -   apply (erule Append_to_free1)
  77.446 -  apply clarify
  77.447 -  apply (drule_tac n = "i" in Append_to_free2)
  77.448 -  apply force
  77.449 - apply force
  77.450 -apply force
  77.451 -done
  77.452 -
  77.453 -subsubsection {* Correctness of the Collector *}
  77.454 -
  77.455 -constdefs 
  77.456 -  Collector :: " gar_coll_state ann_com"
  77.457 -  "Collector \<equiv>
  77.458 -.{\<acute>Proper}.  
  77.459 - WHILE True INV .{\<acute>Proper}. 
  77.460 - DO  
  77.461 -  Blacken_Roots;; 
  77.462 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}.  
  77.463 -   \<acute>obc:={};; 
  77.464 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}. 
  77.465 -   \<acute>bc:=Roots;; 
  77.466 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
  77.467 -   \<acute>Ma:=M_init;;  
  77.468 -  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>Ma=M_init}. 
  77.469 -   WHILE \<acute>obc\<noteq>\<acute>bc  
  77.470 -     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
  77.471 -           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.472 -           \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}. 
  77.473 -   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
  77.474 -       \<acute>obc:=\<acute>bc;;
  77.475 -       Propagate_Black;; 
  77.476 -      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  77.477 -        \<and> (\<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}. 
  77.478 -       \<acute>Ma:=\<acute>M;;
  77.479 -      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma 
  77.480 -        \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> length \<acute>Ma=length \<acute>M 
  77.481 -        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}.
  77.482 -       \<acute>bc:={};;
  77.483 -       Count 
  77.484 -   OD;; 
  77.485 -  Append  
  77.486 - OD"
  77.487 -
  77.488 -lemma Collector: 
  77.489 -  "\<turnstile> Collector .{False}."
  77.490 -apply(unfold Collector_def)
  77.491 -apply annhoare
  77.492 -apply(simp_all add: Blacken_Roots Propagate_Black Count Append)
  77.493 -apply(simp_all add:Blacken_Roots_def Propagate_Black_def Count_def Append_def collector_defs)
  77.494 -   apply (force simp add: Proper_Roots_def)
  77.495 -  apply force
  77.496 - apply force
  77.497 -apply clarify
  77.498 -apply (erule disjE)
  77.499 -apply(simp add:psubsetI)
  77.500 - apply(force dest:subset_antisym)
  77.501 -done
  77.502 -
  77.503 -subsection {* Interference Freedom *}
  77.504 -
  77.505 -lemmas modules = Redirect_Edge_def Color_Target_def Blacken_Roots_def 
  77.506 -                 Propagate_Black_def Count_def Append_def
  77.507 -lemmas Invariants = PBInv_def Auxk_def CountInv_def AppendInv_def
  77.508 -lemmas abbrev = collector_defs mutator_defs Invariants
  77.509 -
  77.510 -lemma interfree_Blacken_Roots_Redirect_Edge: 
  77.511 - "interfree_aux (Some Blacken_Roots, {}, Some Redirect_Edge)"
  77.512 -apply (unfold modules)
  77.513 -apply interfree_aux
  77.514 -apply safe
  77.515 -apply (simp_all add:Graph6 Graph12 abbrev)
  77.516 -done
  77.517 -
  77.518 -lemma interfree_Redirect_Edge_Blacken_Roots: 
  77.519 -  "interfree_aux (Some Redirect_Edge, {}, Some Blacken_Roots)"
  77.520 -apply (unfold modules)
  77.521 -apply interfree_aux
  77.522 -apply safe
  77.523 -apply(simp add:abbrev)+
  77.524 -done
  77.525 -
  77.526 -lemma interfree_Blacken_Roots_Color_Target: 
  77.527 -  "interfree_aux (Some Blacken_Roots, {}, Some Color_Target)"
  77.528 -apply (unfold modules)
  77.529 -apply interfree_aux
  77.530 -apply safe
  77.531 -apply(simp_all add:Graph7 Graph8 nth_list_update abbrev)
  77.532 -done
  77.533 -
  77.534 -lemma interfree_Color_Target_Blacken_Roots: 
  77.535 -  "interfree_aux (Some Color_Target, {}, Some Blacken_Roots)"
  77.536 -apply (unfold modules )
  77.537 -apply interfree_aux
  77.538 -apply safe
  77.539 -apply(simp add:abbrev)+
  77.540 -done
  77.541 -
  77.542 -lemma interfree_Propagate_Black_Redirect_Edge: 
  77.543 -  "interfree_aux (Some Propagate_Black, {}, Some Redirect_Edge)"
  77.544 -apply (unfold modules )
  77.545 -apply interfree_aux
  77.546 ---{* 11 subgoals left *}
  77.547 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.548 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.549 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.550 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.551 -apply(erule conjE)+
  77.552 -apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
  77.553 - apply(erule Graph4) 
  77.554 -   apply(simp)+
  77.555 -  apply (simp add:BtoW_def)
  77.556 - apply (simp add:BtoW_def)
  77.557 -apply(rule conjI)
  77.558 - apply (force simp add:BtoW_def)
  77.559 -apply(erule Graph4)
  77.560 -   apply simp+
  77.561 ---{* 7 subgoals left *}
  77.562 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.563 -apply(erule conjE)+
  77.564 -apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
  77.565 - apply(erule Graph4) 
  77.566 -   apply(simp)+
  77.567 -  apply (simp add:BtoW_def)
  77.568 - apply (simp add:BtoW_def)
  77.569 -apply(rule conjI)
  77.570 - apply (force simp add:BtoW_def)
  77.571 -apply(erule Graph4)
  77.572 -   apply simp+
  77.573 ---{* 6 subgoals left *}
  77.574 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.575 -apply(erule conjE)+
  77.576 -apply(rule conjI)
  77.577 - apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
  77.578 -  apply(erule Graph4) 
  77.579 -    apply(simp)+
  77.580 -   apply (simp add:BtoW_def)
  77.581 -  apply (simp add:BtoW_def)
  77.582 - apply(rule conjI)
  77.583 -  apply (force simp add:BtoW_def)
  77.584 - apply(erule Graph4)
  77.585 -    apply simp+
  77.586 -apply(simp add:BtoW_def nth_list_update) 
  77.587 -apply force
  77.588 ---{* 5 subgoals left *}
  77.589 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.590 ---{* 4 subgoals left *}
  77.591 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.592 -apply(rule conjI)
  77.593 - apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
  77.594 -  apply(erule Graph4) 
  77.595 -    apply(simp)+
  77.596 -   apply (simp add:BtoW_def)
  77.597 -  apply (simp add:BtoW_def)
  77.598 - apply(rule conjI)
  77.599 -  apply (force simp add:BtoW_def)
  77.600 - apply(erule Graph4)
  77.601 -    apply simp+
  77.602 -apply(rule conjI)
  77.603 - apply(simp add:nth_list_update)
  77.604 - apply force
  77.605 -apply(rule impI, rule impI, erule disjE, erule disjI1, case_tac "R = (ind x)" ,case_tac "M x ! T = Black")
  77.606 -  apply(force simp add:BtoW_def)
  77.607 - apply(case_tac "M x !snd (E x ! ind x)=Black")
  77.608 -  apply(rule disjI2)
  77.609 -  apply simp
  77.610 -  apply (erule Graph5)
  77.611 -  apply simp+
  77.612 - apply(force simp add:BtoW_def)
  77.613 -apply(force simp add:BtoW_def)
  77.614 ---{* 3 subgoals left *}
  77.615 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.616 ---{* 2 subgoals left *}
  77.617 -apply(clarify, simp add:abbrev Graph6 Graph12)
  77.618 -apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
  77.619 - apply clarify
  77.620 - apply(erule Graph4) 
  77.621 -   apply(simp)+
  77.622 -  apply (simp add:BtoW_def)
  77.623 - apply (simp add:BtoW_def)
  77.624 -apply(rule conjI)
  77.625 - apply (force simp add:BtoW_def)
  77.626 -apply(erule Graph4)
  77.627 -   apply simp+
  77.628 -done
  77.629 -
  77.630 -lemma interfree_Redirect_Edge_Propagate_Black: 
  77.631 -  "interfree_aux (Some Redirect_Edge, {}, Some Propagate_Black)"
  77.632 -apply (unfold modules )
  77.633 -apply interfree_aux
  77.634 -apply(clarify, simp add:abbrev)+
  77.635 -done
  77.636 -
  77.637 -lemma interfree_Propagate_Black_Color_Target: 
  77.638 -  "interfree_aux (Some Propagate_Black, {}, Some Color_Target)"
  77.639 -apply (unfold modules )
  77.640 -apply interfree_aux
  77.641 ---{* 11 subgoals left *}
  77.642 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)+
  77.643 -apply(erule conjE)+
  77.644 -apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
  77.645 -      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
  77.646 -      erule allE, erule impE, assumption, erule impE, assumption, 
  77.647 -      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
  77.648 ---{* 7 subgoals left *}
  77.649 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.650 -apply(erule conjE)+
  77.651 -apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
  77.652 -      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
  77.653 -      erule allE, erule impE, assumption, erule impE, assumption, 
  77.654 -      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
  77.655 ---{* 6 subgoals left *}
  77.656 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.657 -apply clarify
  77.658 -apply (rule conjI)
  77.659 - apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
  77.660 -      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
  77.661 -      erule allE, erule impE, assumption, erule impE, assumption, 
  77.662 -      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
  77.663 -apply(simp add:nth_list_update)
  77.664 ---{* 5 subgoals left *}
  77.665 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.666 ---{* 4 subgoals left *}
  77.667 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.668 -apply (rule conjI)
  77.669 - apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
  77.670 -      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
  77.671 -      erule allE, erule impE, assumption, erule impE, assumption, 
  77.672 -      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
  77.673 -apply(rule conjI)
  77.674 -apply(simp add:nth_list_update)
  77.675 -apply(rule impI,rule impI, case_tac "M x!T=Black",rotate_tac -1, force simp add: BtoW_def Graph10, 
  77.676 -      erule subset_psubset_trans, erule Graph11, force)
  77.677 ---{* 3 subgoals left *}
  77.678 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.679 ---{* 2 subgoals left *}
  77.680 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.681 -apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
  77.682 -      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
  77.683 -      erule allE, erule impE, assumption, erule impE, assumption, 
  77.684 -      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
  77.685 ---{* 3 subgoals left *}
  77.686 -apply(simp add:abbrev)
  77.687 -done
  77.688 -
  77.689 -lemma interfree_Color_Target_Propagate_Black: 
  77.690 -  "interfree_aux (Some Color_Target, {}, Some Propagate_Black)"
  77.691 -apply (unfold modules )
  77.692 -apply interfree_aux
  77.693 -apply(clarify, simp add:abbrev)+
  77.694 -done
  77.695 -
  77.696 -lemma interfree_Count_Redirect_Edge: 
  77.697 -  "interfree_aux (Some Count, {}, Some Redirect_Edge)"
  77.698 -apply (unfold modules)
  77.699 -apply interfree_aux
  77.700 ---{* 9 subgoals left *}
  77.701 -apply(simp_all add:abbrev Graph6 Graph12)
  77.702 ---{* 6 subgoals left *}
  77.703 -apply(clarify, simp add:abbrev Graph6 Graph12,
  77.704 -      erule disjE,erule disjI1,rule disjI2,rule subset_trans, erule Graph3,force,force)+
  77.705 -done
  77.706 -
  77.707 -lemma interfree_Redirect_Edge_Count: 
  77.708 -  "interfree_aux (Some Redirect_Edge, {}, Some Count)"
  77.709 -apply (unfold modules )
  77.710 -apply interfree_aux
  77.711 -apply(clarify,simp add:abbrev)+
  77.712 -apply(simp add:abbrev)
  77.713 -done
  77.714 -
  77.715 -lemma interfree_Count_Color_Target: 
  77.716 -  "interfree_aux (Some Count, {}, Some Color_Target)"
  77.717 -apply (unfold modules )
  77.718 -apply interfree_aux
  77.719 ---{* 9 subgoals left *}
  77.720 -apply(simp_all add:abbrev Graph7 Graph8 Graph12)
  77.721 ---{* 6 subgoals left *}
  77.722 -apply(clarify,simp add:abbrev Graph7 Graph8 Graph12,
  77.723 -      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)+
  77.724 ---{* 2 subgoals left *}
  77.725 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
  77.726 -apply(rule conjI)
  77.727 - apply(erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9) 
  77.728 -apply(simp add:nth_list_update)
  77.729 ---{* 1 subgoal left *}
  77.730 -apply(clarify, simp add:abbrev Graph7 Graph8 Graph12,
  77.731 -      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)
  77.732 -done
  77.733 -
  77.734 -lemma interfree_Color_Target_Count: 
  77.735 -  "interfree_aux (Some Color_Target, {}, Some Count)"
  77.736 -apply (unfold modules )
  77.737 -apply interfree_aux
  77.738 -apply(clarify, simp add:abbrev)+
  77.739 -apply(simp add:abbrev)
  77.740 -done
  77.741 -
  77.742 -lemma interfree_Append_Redirect_Edge: 
  77.743 -  "interfree_aux (Some Append, {}, Some Redirect_Edge)"
  77.744 -apply (unfold modules )
  77.745 -apply interfree_aux
  77.746 -apply( simp_all add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12)
  77.747 -apply(clarify, simp add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12, force dest:Graph3)+
  77.748 -done
  77.749 -
  77.750 -lemma interfree_Redirect_Edge_Append: 
  77.751 -  "interfree_aux (Some Redirect_Edge, {}, Some Append)"
  77.752 -apply (unfold modules )
  77.753 -apply interfree_aux
  77.754 -apply(clarify, simp add:abbrev Append_to_free0)+
  77.755 -apply (force simp add: Append_to_free2)
  77.756 -apply(clarify, simp add:abbrev Append_to_free0)+
  77.757 -done
  77.758 -
  77.759 -lemma interfree_Append_Color_Target: 
  77.760 -  "interfree_aux (Some Append, {}, Some Color_Target)"
  77.761 -apply (unfold modules )
  77.762 -apply interfree_aux
  77.763 -apply(clarify, simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)+
  77.764 -apply(simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)
  77.765 -done
  77.766 -
  77.767 -lemma interfree_Color_Target_Append: 
  77.768 -  "interfree_aux (Some Color_Target, {}, Some Append)"
  77.769 -apply (unfold modules )
  77.770 -apply interfree_aux
  77.771 -apply(clarify, simp add:abbrev Append_to_free0)+
  77.772 -apply (force simp add: Append_to_free2)
  77.773 -apply(clarify,simp add:abbrev Append_to_free0)+
  77.774 -done
  77.775 -
  77.776 -lemmas collector_mutator_interfree = 
  77.777 - interfree_Blacken_Roots_Redirect_Edge interfree_Blacken_Roots_Color_Target 
  77.778 - interfree_Propagate_Black_Redirect_Edge interfree_Propagate_Black_Color_Target  
  77.779 - interfree_Count_Redirect_Edge interfree_Count_Color_Target 
  77.780 - interfree_Append_Redirect_Edge interfree_Append_Color_Target 
  77.781 - interfree_Redirect_Edge_Blacken_Roots interfree_Color_Target_Blacken_Roots 
  77.782 - interfree_Redirect_Edge_Propagate_Black interfree_Color_Target_Propagate_Black  
  77.783 - interfree_Redirect_Edge_Count interfree_Color_Target_Count 
  77.784 - interfree_Redirect_Edge_Append interfree_Color_Target_Append
  77.785 -
  77.786 -subsubsection {* Interference freedom Collector-Mutator *}
  77.787 -
  77.788 -lemma interfree_Collector_Mutator:
  77.789 - "interfree_aux (Some Collector, {}, Some Mutator)"
  77.790 -apply(unfold Collector_def Mutator_def)
  77.791 -apply interfree_aux
  77.792 -apply(simp_all add:collector_mutator_interfree)
  77.793 -apply(unfold modules collector_defs mutator_defs)
  77.794 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
  77.795 ---{* 32 subgoals left *}
  77.796 -apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  77.797 ---{* 20 subgoals left *}
  77.798 -apply(tactic{* TRYALL (clarify_tac @{claset}) *})
  77.799 -apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  77.800 -apply(tactic {* TRYALL (etac disjE) *})
  77.801 -apply simp_all
  77.802 -apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac subset_trans,etac @{thm Graph3},force_tac @{clasimpset}, assume_tac]) *})
  77.803 -apply(tactic {* TRYALL(EVERY'[rtac disjI2,etac subset_trans,rtac @{thm Graph9},force_tac @{clasimpset}]) *})
  77.804 -apply(tactic {* TRYALL(EVERY'[rtac disjI1,etac @{thm psubset_subset_trans},rtac @{thm Graph9},force_tac @{clasimpset}]) *})
  77.805 -done
  77.806 -
  77.807 -subsubsection {* Interference freedom Mutator-Collector *}
  77.808 -
  77.809 -lemma interfree_Mutator_Collector:
  77.810 - "interfree_aux (Some Mutator, {}, Some Collector)"
  77.811 -apply(unfold Collector_def Mutator_def)
  77.812 -apply interfree_aux
  77.813 -apply(simp_all add:collector_mutator_interfree)
  77.814 -apply(unfold modules collector_defs mutator_defs)
  77.815 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
  77.816 ---{* 64 subgoals left *}
  77.817 -apply(simp_all add:nth_list_update Invariants Append_to_free0)+
  77.818 -apply(tactic{* TRYALL (clarify_tac @{claset}) *})
  77.819 ---{* 4 subgoals left *}
  77.820 -apply force
  77.821 -apply(simp add:Append_to_free2)
  77.822 -apply force
  77.823 -apply(simp add:Append_to_free2)
  77.824 -done
  77.825 -
  77.826 -subsubsection {* The Garbage Collection algorithm *}
  77.827 -
  77.828 -text {* In total there are 289 verification conditions.  *}
  77.829 -
  77.830 -lemma Gar_Coll: 
  77.831 -  "\<parallel>- .{\<acute>Proper \<and> \<acute>Mut_init \<and> \<acute>z}.  
  77.832 -  COBEGIN  
  77.833 -   Collector
  77.834 -  .{False}.
  77.835 - \<parallel>  
  77.836 -   Mutator
  77.837 -  .{False}. 
  77.838 - COEND 
  77.839 -  .{False}."
  77.840 -apply oghoare
  77.841 -apply(force simp add: Mutator_def Collector_def modules)
  77.842 -apply(rule Collector)
  77.843 -apply(rule Mutator)
  77.844 -apply(simp add:interfree_Collector_Mutator)
  77.845 -apply(simp add:interfree_Mutator_Collector)
  77.846 -apply force
  77.847 -done
  77.848 -
  77.849 -end
    78.1 --- a/src/HOL/HoareParallel/Graph.thy	Tue Sep 29 22:15:54 2009 +0200
    78.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    78.3 @@ -1,411 +0,0 @@
    78.4 -header {* \chapter{Case Study: Single and Multi-Mutator Garbage Collection Algorithms}
    78.5 -
    78.6 -\section {Formalization of the Memory} *}
    78.7 -
    78.8 -theory Graph imports Main begin
    78.9 -
   78.10 -datatype node = Black | White
   78.11 -
   78.12 -types 
   78.13 -  nodes = "node list"
   78.14 -  edge  = "nat \<times> nat"
   78.15 -  edges = "edge list"
   78.16 -
   78.17 -consts Roots :: "nat set"
   78.18 -
   78.19 -constdefs
   78.20 -  Proper_Roots :: "nodes \<Rightarrow> bool"
   78.21 -  "Proper_Roots M \<equiv> Roots\<noteq>{} \<and> Roots \<subseteq> {i. i<length M}"
   78.22 -
   78.23 -  Proper_Edges :: "(nodes \<times> edges) \<Rightarrow> bool"
   78.24 -  "Proper_Edges \<equiv> (\<lambda>(M,E). \<forall>i<length E. fst(E!i)<length M \<and> snd(E!i)<length M)"
   78.25 -
   78.26 -  BtoW :: "(edge \<times> nodes) \<Rightarrow> bool"
   78.27 -  "BtoW \<equiv> (\<lambda>(e,M). (M!fst e)=Black \<and> (M!snd e)\<noteq>Black)"
   78.28 -
   78.29 -  Blacks :: "nodes \<Rightarrow> nat set"
   78.30 -  "Blacks M \<equiv> {i. i<length M \<and> M!i=Black}"
   78.31 -
   78.32 -  Reach :: "edges \<Rightarrow> nat set"
   78.33 -  "Reach E \<equiv> {x. (\<exists>path. 1<length path \<and> path!(length path - 1)\<in>Roots \<and> x=path!0
   78.34 -              \<and> (\<forall>i<length path - 1. (\<exists>j<length E. E!j=(path!(i+1), path!i))))
   78.35 -	      \<or> x\<in>Roots}"
   78.36 -
   78.37 -text{* Reach: the set of reachable nodes is the set of Roots together with the
   78.38 -nodes reachable from some Root by a path represented by a list of
   78.39 -  nodes (at least two since we traverse at least one edge), where two
   78.40 -consecutive nodes correspond to an edge in E. *}
   78.41 -
   78.42 -subsection {* Proofs about Graphs *}
   78.43 -
   78.44 -lemmas Graph_defs= Blacks_def Proper_Roots_def Proper_Edges_def BtoW_def
   78.45 -declare Graph_defs [simp]
   78.46 -
   78.47 -subsubsection{* Graph 1 *}
   78.48 -
   78.49 -lemma Graph1_aux [rule_format]: 
   78.50 -  "\<lbrakk> Roots\<subseteq>Blacks M; \<forall>i<length E. \<not>BtoW(E!i,M)\<rbrakk>
   78.51 -  \<Longrightarrow> 1< length path \<longrightarrow> (path!(length path - 1))\<in>Roots \<longrightarrow>  
   78.52 -  (\<forall>i<length path - 1. (\<exists>j. j < length E \<and> E!j=(path!(Suc i), path!i))) 
   78.53 -  \<longrightarrow> M!(path!0) = Black"
   78.54 -apply(induct_tac "path")
   78.55 - apply force
   78.56 -apply clarify
   78.57 -apply simp
   78.58 -apply(case_tac "list")
   78.59 - apply force
   78.60 -apply simp
   78.61 -apply(rotate_tac -2)
   78.62 -apply(erule_tac x = "0" in all_dupE)
   78.63 -apply simp
   78.64 -apply clarify
   78.65 -apply(erule allE , erule (1) notE impE)
   78.66 -apply simp
   78.67 -apply(erule mp)
   78.68 -apply(case_tac "lista")
   78.69 - apply force
   78.70 -apply simp
   78.71 -apply(erule mp)
   78.72 -apply clarify
   78.73 -apply(erule_tac x = "Suc i" in allE)
   78.74 -apply force
   78.75 -done
   78.76 -
   78.77 -lemma Graph1: 
   78.78 -  "\<lbrakk>Roots\<subseteq>Blacks M; Proper_Edges(M, E); \<forall>i<length E. \<not>BtoW(E!i,M) \<rbrakk> 
   78.79 -  \<Longrightarrow> Reach E\<subseteq>Blacks M"
   78.80 -apply (unfold Reach_def)
   78.81 -apply simp
   78.82 -apply clarify
   78.83 -apply(erule disjE)
   78.84 - apply clarify
   78.85 - apply(rule conjI)
   78.86 -  apply(subgoal_tac "0< length path - Suc 0")
   78.87 -   apply(erule allE , erule (1) notE impE)
   78.88 -   apply force
   78.89 -  apply simp
   78.90 - apply(rule Graph1_aux)
   78.91 -apply auto
   78.92 -done
   78.93 -
   78.94 -subsubsection{* Graph 2 *}
   78.95 -
   78.96 -lemma Ex_first_occurrence [rule_format]: 
   78.97 -  "P (n::nat) \<longrightarrow> (\<exists>m. P m \<and> (\<forall>i. i<m \<longrightarrow> \<not> P i))";
   78.98 -apply(rule nat_less_induct)
   78.99 -apply clarify
  78.100 -apply(case_tac "\<forall>m. m<n \<longrightarrow> \<not> P m")
  78.101 -apply auto
  78.102 -done
  78.103 -
  78.104 -lemma Compl_lemma: "(n::nat)\<le>l \<Longrightarrow> (\<exists>m. m\<le>l \<and> n=l - m)"
  78.105 -apply(rule_tac x = "l - n" in exI)
  78.106 -apply arith
  78.107 -done
  78.108 -
  78.109 -lemma Ex_last_occurrence: 
  78.110 -  "\<lbrakk>P (n::nat); n\<le>l\<rbrakk> \<Longrightarrow> (\<exists>m. P (l - m) \<and> (\<forall>i. i<m \<longrightarrow> \<not>P (l - i)))"
  78.111 -apply(drule Compl_lemma)
  78.112 -apply clarify
  78.113 -apply(erule Ex_first_occurrence)
  78.114 -done
  78.115 -
  78.116 -lemma Graph2: 
  78.117 -  "\<lbrakk>T \<in> Reach E; R<length E\<rbrakk> \<Longrightarrow> T \<in> Reach (E[R:=(fst(E!R), T)])"
  78.118 -apply (unfold Reach_def)
  78.119 -apply clarify
  78.120 -apply simp
  78.121 -apply(case_tac "\<forall>z<length path. fst(E!R)\<noteq>path!z")
  78.122 - apply(rule_tac x = "path" in exI)
  78.123 - apply simp
  78.124 - apply clarify
  78.125 - apply(erule allE , erule (1) notE impE)
  78.126 - apply clarify
  78.127 - apply(rule_tac x = "j" in exI)
  78.128 - apply(case_tac "j=R")
  78.129 -  apply(erule_tac x = "Suc i" in allE)
  78.130 -  apply simp
  78.131 - apply (force simp add:nth_list_update)
  78.132 -apply simp
  78.133 -apply(erule exE)
  78.134 -apply(subgoal_tac "z \<le> length path - Suc 0")
  78.135 - prefer 2 apply arith
  78.136 -apply(drule_tac P = "\<lambda>m. m<length path \<and> fst(E!R)=path!m" in Ex_last_occurrence)
  78.137 - apply assumption
  78.138 -apply clarify
  78.139 -apply simp
  78.140 -apply(rule_tac x = "(path!0)#(drop (length path - Suc m) path)" in exI)
  78.141 -apply simp
  78.142 -apply(case_tac "length path - (length path - Suc m)")
  78.143 - apply arith
  78.144 -apply simp
  78.145 -apply(subgoal_tac "(length path - Suc m) + nat \<le> length path")
  78.146 - prefer 2 apply arith
  78.147 -apply(drule nth_drop)
  78.148 -apply simp
  78.149 -apply(subgoal_tac "length path - Suc m + nat = length path - Suc 0")
  78.150 - prefer 2 apply arith 
  78.151 -apply simp
  78.152 -apply clarify
  78.153 -apply(case_tac "i")
  78.154 - apply(force simp add: nth_list_update)
  78.155 -apply simp
  78.156 -apply(subgoal_tac "(length path - Suc m) + nata \<le> length path")
  78.157 - prefer 2 apply arith
  78.158 -apply(subgoal_tac "(length path - Suc m) + (Suc nata) \<le> length path")
  78.159 - prefer 2 apply arith
  78.160 -apply simp
  78.161 -apply(erule_tac x = "length path - Suc m + nata" in allE)
  78.162 -apply simp
  78.163 -apply clarify
  78.164 -apply(rule_tac x = "j" in exI)
  78.165 -apply(case_tac "R=j")
  78.166 - prefer 2 apply force
  78.167 -apply simp
  78.168 -apply(drule_tac t = "path ! (length path - Suc m)" in sym)
  78.169 -apply simp
  78.170 -apply(case_tac " length path - Suc 0 < m")
  78.171 - apply(subgoal_tac "(length path - Suc m)=0")
  78.172 -  prefer 2 apply arith
  78.173 - apply(simp del: diff_is_0_eq)
  78.174 - apply(subgoal_tac "Suc nata\<le>nat")
  78.175 - prefer 2 apply arith
  78.176 - apply(drule_tac n = "Suc nata" in Compl_lemma)
  78.177 - apply clarify
  78.178 - using [[linarith_split_limit = 0]]
  78.179 - apply force
  78.180 - using [[linarith_split_limit = 9]]
  78.181 -apply(drule leI)
  78.182 -apply(subgoal_tac "Suc (length path - Suc m + nata)=(length path - Suc 0) - (m - Suc nata)")
  78.183 - apply(erule_tac x = "m - (Suc nata)" in allE)
  78.184 - apply(case_tac "m")
  78.185 -  apply simp
  78.186 - apply simp
  78.187 -apply simp
  78.188 -done
  78.189 -
  78.190 -
  78.191 -subsubsection{* Graph 3 *}
  78.192 -
  78.193 -lemma Graph3: 
  78.194 -  "\<lbrakk> T\<in>Reach E; R<length E \<rbrakk> \<Longrightarrow> Reach(E[R:=(fst(E!R),T)]) \<subseteq> Reach E"
  78.195 -apply (unfold Reach_def)
  78.196 -apply clarify
  78.197 -apply simp
  78.198 -apply(case_tac "\<exists>i<length path - 1. (fst(E!R),T)=(path!(Suc i),path!i)")
  78.199 ---{* the changed edge is part of the path *}
  78.200 - apply(erule exE)
  78.201 - apply(drule_tac P = "\<lambda>i. i<length path - 1 \<and> (fst(E!R),T)=(path!Suc i,path!i)" in Ex_first_occurrence)
  78.202 - apply clarify
  78.203 - apply(erule disjE)
  78.204 ---{* T is NOT a root *}
  78.205 -  apply clarify
  78.206 -  apply(rule_tac x = "(take m path)@patha" in exI)
  78.207 -  apply(subgoal_tac "\<not>(length path\<le>m)")
  78.208 -   prefer 2 apply arith
  78.209 -  apply(simp add: min_def)
  78.210 -  apply(rule conjI)
  78.211 -   apply(subgoal_tac "\<not>(m + length patha - 1 < m)")
  78.212 -    prefer 2 apply arith
  78.213 -   apply(simp add: nth_append min_def)
  78.214 -  apply(rule conjI)
  78.215 -   apply(case_tac "m")
  78.216 -    apply force
  78.217 -   apply(case_tac "path")
  78.218 -    apply force
  78.219 -   apply force
  78.220 -  apply clarify
  78.221 -  apply(case_tac "Suc i\<le>m")
  78.222 -   apply(erule_tac x = "i" in allE)
  78.223 -   apply simp
  78.224 -   apply clarify
  78.225 -   apply(rule_tac x = "j" in exI)
  78.226 -   apply(case_tac "Suc i<m")
  78.227 -    apply(simp add: nth_append)
  78.228 -    apply(case_tac "R=j")
  78.229 -     apply(simp add: nth_list_update)
  78.230 -     apply(case_tac "i=m")
  78.231 -      apply force
  78.232 -     apply(erule_tac x = "i" in allE)
  78.233 -     apply force
  78.234 -    apply(force simp add: nth_list_update)
  78.235 -   apply(simp add: nth_append)
  78.236 -   apply(subgoal_tac "i=m - 1")
  78.237 -    prefer 2 apply arith
  78.238 -   apply(case_tac "R=j")
  78.239 -    apply(erule_tac x = "m - 1" in allE)
  78.240 -    apply(simp add: nth_list_update)
  78.241 -   apply(force simp add: nth_list_update)
  78.242 -  apply(simp add: nth_append min_def)
  78.243 -  apply(rotate_tac -4)
  78.244 -  apply(erule_tac x = "i - m" in allE)
  78.245 -  apply(subgoal_tac "Suc (i - m)=(Suc i - m)" )
  78.246 -    prefer 2 apply arith
  78.247 -   apply simp
  78.248 ---{* T is a root *}
  78.249 - apply(case_tac "m=0")
  78.250 -  apply force
  78.251 - apply(rule_tac x = "take (Suc m) path" in exI)
  78.252 - apply(subgoal_tac "\<not>(length path\<le>Suc m)" )
  78.253 -  prefer 2 apply arith
  78.254 - apply(simp add: min_def)
  78.255 - apply clarify
  78.256 - apply(erule_tac x = "i" in allE)
  78.257 - apply simp
  78.258 - apply clarify
  78.259 - apply(case_tac "R=j")
  78.260 -  apply(force simp add: nth_list_update)
  78.261 - apply(force simp add: nth_list_update)
  78.262 ---{* the changed edge is not part of the path *}
  78.263 -apply(rule_tac x = "path" in exI)
  78.264 -apply simp
  78.265 -apply clarify
  78.266 -apply(erule_tac x = "i" in allE)
  78.267 -apply clarify
  78.268 -apply(case_tac "R=j")
  78.269 - apply(erule_tac x = "i" in allE)
  78.270 - apply simp
  78.271 -apply(force simp add: nth_list_update)
  78.272 -done
  78.273 -
  78.274 -subsubsection{* Graph 4 *}
  78.275 -
  78.276 -lemma Graph4: 
  78.277 -  "\<lbrakk>T \<in> Reach E; Roots\<subseteq>Blacks M; I\<le>length E; T<length M; R<length E; 
  78.278 -  \<forall>i<I. \<not>BtoW(E!i,M); R<I; M!fst(E!R)=Black; M!T\<noteq>Black\<rbrakk> \<Longrightarrow> 
  78.279 -  (\<exists>r. I\<le>r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
  78.280 -apply (unfold Reach_def)
  78.281 -apply simp
  78.282 -apply(erule disjE)
  78.283 - prefer 2 apply force
  78.284 -apply clarify
  78.285 ---{* there exist a black node in the path to T *}
  78.286 -apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
  78.287 - apply(erule exE)
  78.288 - apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
  78.289 - apply clarify
  78.290 - apply(case_tac "ma")
  78.291 -  apply force
  78.292 - apply simp
  78.293 - apply(case_tac "length path")
  78.294 -  apply force
  78.295 - apply simp
  78.296 - apply(erule_tac P = "\<lambda>i. i < nata \<longrightarrow> ?P i" and x = "nat" in allE)
  78.297 - apply simp
  78.298 - apply clarify
  78.299 - apply(erule_tac P = "\<lambda>i. i < Suc nat \<longrightarrow> ?P i" and x = "nat" in allE)
  78.300 - apply simp
  78.301 - apply(case_tac "j<I")
  78.302 -  apply(erule_tac x = "j" in allE)
  78.303 -  apply force
  78.304 - apply(rule_tac x = "j" in exI)
  78.305 - apply(force  simp add: nth_list_update)
  78.306 -apply simp
  78.307 -apply(rotate_tac -1)
  78.308 -apply(erule_tac x = "length path - 1" in allE)
  78.309 -apply(case_tac "length path")
  78.310 - apply force
  78.311 -apply force
  78.312 -done
  78.313 -
  78.314 -subsubsection {* Graph 5 *}
  78.315 -
  78.316 -lemma Graph5: 
  78.317 -  "\<lbrakk> T \<in> Reach E ; Roots \<subseteq> Blacks M; \<forall>i<R. \<not>BtoW(E!i,M); T<length M; 
  78.318 -    R<length E; M!fst(E!R)=Black; M!snd(E!R)=Black; M!T \<noteq> Black\<rbrakk> 
  78.319 -   \<Longrightarrow> (\<exists>r. R<r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
  78.320 -apply (unfold Reach_def)
  78.321 -apply simp
  78.322 -apply(erule disjE)
  78.323 - prefer 2 apply force
  78.324 -apply clarify
  78.325 ---{* there exist a black node in the path to T*}
  78.326 -apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
  78.327 - apply(erule exE)
  78.328 - apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
  78.329 - apply clarify
  78.330 - apply(case_tac "ma")
  78.331 -  apply force
  78.332 - apply simp
  78.333 - apply(case_tac "length path")
  78.334 -  apply force
  78.335 - apply simp
  78.336 - apply(erule_tac P = "\<lambda>i. i < nata \<longrightarrow> ?P i" and x = "nat" in allE)
  78.337 - apply simp
  78.338 - apply clarify
  78.339 - apply(erule_tac P = "\<lambda>i. i < Suc nat \<longrightarrow> ?P i" and x = "nat" in allE)
  78.340 - apply simp
  78.341 - apply(case_tac "j\<le>R")
  78.342 -  apply(drule le_imp_less_or_eq [of _ R])
  78.343 -  apply(erule disjE)
  78.344 -   apply(erule allE , erule (1) notE impE)
  78.345 -   apply force
  78.346 -  apply force
  78.347 - apply(rule_tac x = "j" in exI)
  78.348 - apply(force  simp add: nth_list_update)
  78.349 -apply simp
  78.350 -apply(rotate_tac -1)
  78.351 -apply(erule_tac x = "length path - 1" in allE)
  78.352 -apply(case_tac "length path")
  78.353 - apply force
  78.354 -apply force
  78.355 -done
  78.356 -
  78.357 -subsubsection {* Other lemmas about graphs *}
  78.358 -
  78.359 -lemma Graph6: 
  78.360 - "\<lbrakk>Proper_Edges(M,E); R<length E ; T<length M\<rbrakk> \<Longrightarrow> Proper_Edges(M,E[R:=(fst(E!R),T)])"
  78.361 -apply (unfold Proper_Edges_def)
  78.362 - apply(force  simp add: nth_list_update)
  78.363 -done
  78.364 -
  78.365 -lemma Graph7: 
  78.366 - "\<lbrakk>Proper_Edges(M,E)\<rbrakk> \<Longrightarrow> Proper_Edges(M[T:=a],E)"
  78.367 -apply (unfold Proper_Edges_def)
  78.368 -apply force
  78.369 -done
  78.370 -
  78.371 -lemma Graph8: 
  78.372 - "\<lbrakk>Proper_Roots(M)\<rbrakk> \<Longrightarrow> Proper_Roots(M[T:=a])"
  78.373 -apply (unfold Proper_Roots_def)
  78.374 -apply force
  78.375 -done
  78.376 -
  78.377 -text{* Some specific lemmata for the verification of garbage collection algorithms. *}
  78.378 -
  78.379 -lemma Graph9: "j<length M \<Longrightarrow> Blacks M\<subseteq>Blacks (M[j := Black])"
  78.380 -apply (unfold Blacks_def)
  78.381 - apply(force simp add: nth_list_update)
  78.382 -done
  78.383 -
  78.384 -lemma Graph10 [rule_format (no_asm)]: "\<forall>i. M!i=a \<longrightarrow>M[i:=a]=M"
  78.385 -apply(induct_tac "M")
  78.386 -apply auto
  78.387 -apply(case_tac "i")
  78.388 -apply auto
  78.389 -done
  78.390 -
  78.391 -lemma Graph11 [rule_format (no_asm)]: 
  78.392 -  "\<lbrakk> M!j\<noteq>Black;j<length M\<rbrakk> \<Longrightarrow> Blacks M \<subset> Blacks (M[j := Black])"
  78.393 -apply (unfold Blacks_def)
  78.394 -apply(rule psubsetI)
  78.395 - apply(force simp add: nth_list_update)
  78.396 -apply safe
  78.397 -apply(erule_tac c = "j" in equalityCE)
  78.398 -apply auto
  78.399 -done
  78.400 -
  78.401 -lemma Graph12: "\<lbrakk>a\<subseteq>Blacks M;j<length M\<rbrakk> \<Longrightarrow> a\<subseteq>Blacks (M[j := Black])"
  78.402 -apply (unfold Blacks_def)
  78.403 -apply(force simp add: nth_list_update)
  78.404 -done
  78.405 -
  78.406 -lemma Graph13: "\<lbrakk>a\<subset> Blacks M;j<length M\<rbrakk> \<Longrightarrow> a \<subset> Blacks (M[j := Black])"
  78.407 -apply (unfold Blacks_def)
  78.408 -apply(erule psubset_subset_trans)
  78.409 -apply(force simp add: nth_list_update)
  78.410 -done
  78.411 -
  78.412 -declare Graph_defs [simp del]
  78.413 -
  78.414 -end
    79.1 --- a/src/HOL/HoareParallel/Mul_Gar_Coll.thy	Tue Sep 29 22:15:54 2009 +0200
    79.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    79.3 @@ -1,1283 +0,0 @@
    79.4 -
    79.5 -header {* \section{The Multi-Mutator Case} *}
    79.6 -
    79.7 -theory Mul_Gar_Coll imports Graph OG_Syntax begin
    79.8 -
    79.9 -text {*  The full theory takes aprox. 18 minutes.  *}
   79.10 -
   79.11 -record mut =
   79.12 -  Z :: bool
   79.13 -  R :: nat
   79.14 -  T :: nat
   79.15 -
   79.16 -text {* Declaration of variables: *}
   79.17 -
   79.18 -record mul_gar_coll_state =
   79.19 -  M :: nodes
   79.20 -  E :: edges
   79.21 -  bc :: "nat set"
   79.22 -  obc :: "nat set"
   79.23 -  Ma :: nodes
   79.24 -  ind :: nat 
   79.25 -  k :: nat
   79.26 -  q :: nat
   79.27 -  l :: nat
   79.28 -  Muts :: "mut list"
   79.29 -
   79.30 -subsection {* The Mutators *}
   79.31 -
   79.32 -constdefs 
   79.33 -  Mul_mut_init :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   79.34 -  "Mul_mut_init \<equiv> \<guillemotleft> \<lambda>n. n=length \<acute>Muts \<and> (\<forall>i<n. R (\<acute>Muts!i)<length \<acute>E 
   79.35 -                          \<and> T (\<acute>Muts!i)<length \<acute>M) \<guillemotright>"
   79.36 -
   79.37 -  Mul_Redirect_Edge  :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
   79.38 -  "Mul_Redirect_Edge j n \<equiv>
   79.39 -  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.
   79.40 -  \<langle>IF T(\<acute>Muts!j) \<in> Reach \<acute>E THEN  
   79.41 -  \<acute>E:= \<acute>E[R (\<acute>Muts!j):= (fst (\<acute>E!R(\<acute>Muts!j)), T (\<acute>Muts!j))] FI,, 
   79.42 -  \<acute>Muts:= \<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=False\<rparr>]\<rangle>"
   79.43 -
   79.44 -  Mul_Color_Target :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
   79.45 -  "Mul_Color_Target j n \<equiv>
   79.46 -  .{\<acute>Mul_mut_init n \<and> \<not> Z (\<acute>Muts!j)}. 
   79.47 -  \<langle>\<acute>M:=\<acute>M[T (\<acute>Muts!j):=Black],, \<acute>Muts:=\<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=True\<rparr>]\<rangle>"
   79.48 -
   79.49 -  Mul_Mutator :: "nat \<Rightarrow> nat \<Rightarrow>  mul_gar_coll_state ann_com"
   79.50 -  "Mul_Mutator j n \<equiv>
   79.51 -  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
   79.52 -  WHILE True  
   79.53 -    INV .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
   79.54 -  DO Mul_Redirect_Edge j n ;; 
   79.55 -     Mul_Color_Target j n 
   79.56 -  OD"
   79.57 -
   79.58 -lemmas mul_mutator_defs = Mul_mut_init_def Mul_Redirect_Edge_def Mul_Color_Target_def 
   79.59 -
   79.60 -subsubsection {* Correctness of the proof outline of one mutator *}
   79.61 -
   79.62 -lemma Mul_Redirect_Edge: "0\<le>j \<and> j<n \<Longrightarrow> 
   79.63 -  \<turnstile> Mul_Redirect_Edge j n 
   79.64 -     pre(Mul_Color_Target j n)"
   79.65 -apply (unfold mul_mutator_defs)
   79.66 -apply annhoare
   79.67 -apply(simp_all)
   79.68 -apply clarify
   79.69 -apply(simp add:nth_list_update)
   79.70 -done
   79.71 -
   79.72 -lemma Mul_Color_Target: "0\<le>j \<and> j<n \<Longrightarrow> 
   79.73 -  \<turnstile>  Mul_Color_Target j n  
   79.74 -    .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}."
   79.75 -apply (unfold mul_mutator_defs)
   79.76 -apply annhoare
   79.77 -apply(simp_all)
   79.78 -apply clarify
   79.79 -apply(simp add:nth_list_update)
   79.80 -done
   79.81 -
   79.82 -lemma Mul_Mutator: "0\<le>j \<and> j<n \<Longrightarrow>  
   79.83 - \<turnstile> Mul_Mutator j n .{False}."
   79.84 -apply(unfold Mul_Mutator_def)
   79.85 -apply annhoare
   79.86 -apply(simp_all add:Mul_Redirect_Edge Mul_Color_Target)
   79.87 -apply(simp add:mul_mutator_defs Mul_Redirect_Edge_def)
   79.88 -done
   79.89 -
   79.90 -subsubsection {* Interference freedom between mutators *}
   79.91 -
   79.92 -lemma Mul_interfree_Redirect_Edge_Redirect_Edge: 
   79.93 -  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
   79.94 -  interfree_aux (Some (Mul_Redirect_Edge i n),{}, Some(Mul_Redirect_Edge j n))"
   79.95 -apply (unfold mul_mutator_defs)
   79.96 -apply interfree_aux
   79.97 -apply safe
   79.98 -apply(simp_all add: nth_list_update)
   79.99 -done
  79.100 -
  79.101 -lemma Mul_interfree_Redirect_Edge_Color_Target: 
  79.102 -  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
  79.103 -  interfree_aux (Some(Mul_Redirect_Edge i n),{},Some(Mul_Color_Target j n))"
  79.104 -apply (unfold mul_mutator_defs)
  79.105 -apply interfree_aux
  79.106 -apply safe
  79.107 -apply(simp_all add: nth_list_update)
  79.108 -done
  79.109 -
  79.110 -lemma Mul_interfree_Color_Target_Redirect_Edge: 
  79.111 -  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
  79.112 -  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Redirect_Edge j n))"
  79.113 -apply (unfold mul_mutator_defs)
  79.114 -apply interfree_aux
  79.115 -apply safe
  79.116 -apply(simp_all add:nth_list_update)
  79.117 -done
  79.118 -
  79.119 -lemma Mul_interfree_Color_Target_Color_Target: 
  79.120 -  " \<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
  79.121 -  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Color_Target j n))"
  79.122 -apply (unfold mul_mutator_defs)
  79.123 -apply interfree_aux
  79.124 -apply safe
  79.125 -apply(simp_all add: nth_list_update)
  79.126 -done
  79.127 -
  79.128 -lemmas mul_mutator_interfree = 
  79.129 -  Mul_interfree_Redirect_Edge_Redirect_Edge Mul_interfree_Redirect_Edge_Color_Target
  79.130 -  Mul_interfree_Color_Target_Redirect_Edge Mul_interfree_Color_Target_Color_Target
  79.131 -
  79.132 -lemma Mul_interfree_Mutator_Mutator: "\<lbrakk>i < n; j < n; i \<noteq> j\<rbrakk> \<Longrightarrow> 
  79.133 -  interfree_aux (Some (Mul_Mutator i n), {}, Some (Mul_Mutator j n))"
  79.134 -apply(unfold Mul_Mutator_def)
  79.135 -apply(interfree_aux)
  79.136 -apply(simp_all add:mul_mutator_interfree)
  79.137 -apply(simp_all add: mul_mutator_defs)
  79.138 -apply(tactic {* TRYALL (interfree_aux_tac) *})
  79.139 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
  79.140 -apply (simp_all add:nth_list_update)
  79.141 -done
  79.142 -
  79.143 -subsubsection {* Modular Parameterized Mutators *}
  79.144 -
  79.145 -lemma Mul_Parameterized_Mutators: "0<n \<Longrightarrow>
  79.146 - \<parallel>- .{\<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.
  79.147 - COBEGIN
  79.148 - SCHEME  [0\<le> j< n]
  79.149 -  Mul_Mutator j n
  79.150 - .{False}.
  79.151 - COEND
  79.152 - .{False}."
  79.153 -apply oghoare
  79.154 -apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
  79.155 -apply(erule Mul_Mutator)
  79.156 -apply(simp add:Mul_interfree_Mutator_Mutator)
  79.157 -apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
  79.158 -done
  79.159 -
  79.160 -subsection {* The Collector *}
  79.161 -
  79.162 -constdefs
  79.163 -  Queue :: "mul_gar_coll_state \<Rightarrow> nat"
  79.164 - "Queue \<equiv> \<guillemotleft> length (filter (\<lambda>i. \<not> Z i \<and> \<acute>M!(T i) \<noteq> Black) \<acute>Muts) \<guillemotright>"
  79.165 -
  79.166 -consts  M_init :: nodes
  79.167 -
  79.168 -constdefs
  79.169 -  Proper_M_init :: "mul_gar_coll_state \<Rightarrow> bool"
  79.170 -  "Proper_M_init \<equiv> \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
  79.171 -
  79.172 -  Mul_Proper :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
  79.173 -  "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>"
  79.174 -
  79.175 -  Safe :: "mul_gar_coll_state \<Rightarrow> bool"
  79.176 -  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
  79.177 -
  79.178 -lemmas mul_collector_defs = Proper_M_init_def Mul_Proper_def Safe_def
  79.179 -
  79.180 -subsubsection {* Blackening Roots *}
  79.181 -
  79.182 -constdefs
  79.183 -  Mul_Blacken_Roots :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
  79.184 -  "Mul_Blacken_Roots n \<equiv>
  79.185 -  .{\<acute>Mul_Proper n}.
  79.186 -  \<acute>ind:=0;;
  79.187 -  .{\<acute>Mul_Proper n \<and> \<acute>ind=0}.
  79.188 -  WHILE \<acute>ind<length \<acute>M 
  79.189 -    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}.
  79.190 -  DO .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
  79.191 -       IF \<acute>ind\<in>Roots THEN 
  79.192 -     .{\<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}. 
  79.193 -       \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
  79.194 -     .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind+1. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
  79.195 -       \<acute>ind:=\<acute>ind+1 
  79.196 -  OD"
  79.197 -
  79.198 -lemma Mul_Blacken_Roots: 
  79.199 -  "\<turnstile> Mul_Blacken_Roots n  
  79.200 -  .{\<acute>Mul_Proper n \<and> Roots \<subseteq> Blacks \<acute>M}."
  79.201 -apply (unfold Mul_Blacken_Roots_def)
  79.202 -apply annhoare
  79.203 -apply(simp_all add:mul_collector_defs Graph_defs)
  79.204 -apply safe
  79.205 -apply(simp_all add:nth_list_update)
  79.206 -  apply (erule less_SucE)
  79.207 -   apply simp+
  79.208 - apply force
  79.209 -apply force
  79.210 -done
  79.211 -
  79.212 -subsubsection {* Propagating Black *} 
  79.213 -
  79.214 -constdefs
  79.215 -  Mul_PBInv :: "mul_gar_coll_state \<Rightarrow> bool"
  79.216 -  "Mul_PBInv \<equiv>  \<guillemotleft>\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
  79.217 -                 \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M)) \<and> \<acute>l\<le>\<acute>Queue\<guillemotright>"
  79.218 -
  79.219 -  Mul_Auxk :: "mul_gar_coll_state \<Rightarrow> bool"
  79.220 -  "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>"
  79.221 -
  79.222 -constdefs
  79.223 -  Mul_Propagate_Black :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
  79.224 -  "Mul_Propagate_Black n \<equiv>
  79.225 - .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.226 -  \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)}. 
  79.227 - \<acute>ind:=0;;
  79.228 - .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.229 -   \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> Blacks \<acute>M\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.230 -   \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) \<and> \<acute>ind=0}. 
  79.231 - WHILE \<acute>ind<length \<acute>E 
  79.232 -  INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.233 -        \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.234 -        \<and> \<acute>Mul_PBInv \<and> \<acute>ind\<le>length \<acute>E}.
  79.235 - DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.236 -     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.237 -     \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
  79.238 -   IF \<acute>M!(fst (\<acute>E!\<acute>ind))=Black THEN 
  79.239 -   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.240 -     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.241 -     \<and> \<acute>Mul_PBInv \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black \<and> \<acute>ind<length \<acute>E}.
  79.242 -    \<acute>k:=snd(\<acute>E!\<acute>ind);;
  79.243 -   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.244 -     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.245 -     \<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)) 
  79.246 -        \<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 
  79.247 -     \<and> \<acute>ind<length \<acute>E}.
  79.248 -   \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],,\<acute>ind:=\<acute>ind+1\<rangle>
  79.249 -   ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.250 -         \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.251 -         \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
  79.252 -	 \<langle>IF \<acute>M!(fst (\<acute>E!\<acute>ind))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> FI
  79.253 - OD"
  79.254 -
  79.255 -lemma Mul_Propagate_Black: 
  79.256 -  "\<turnstile> Mul_Propagate_Black n  
  79.257 -   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.258 -     \<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))}."
  79.259 -apply(unfold Mul_Propagate_Black_def)
  79.260 -apply annhoare
  79.261 -apply(simp_all add:Mul_PBInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
  79.262 ---{* 8 subgoals left *}
  79.263 -apply force
  79.264 -apply force
  79.265 -apply force
  79.266 -apply(force simp add:BtoW_def Graph_defs)
  79.267 ---{* 4 subgoals left *}
  79.268 -apply clarify
  79.269 -apply(simp add: mul_collector_defs Graph12 Graph6 Graph7 Graph8)
  79.270 -apply(disjE_tac)
  79.271 - apply(simp_all add:Graph12 Graph13)
  79.272 - apply(case_tac "M x! k x=Black")
  79.273 -  apply(simp add: Graph10)
  79.274 - apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
  79.275 -apply(case_tac "M x! k x=Black")
  79.276 - apply(simp add: Graph10 BtoW_def)
  79.277 - apply(rule disjI2, clarify, erule less_SucE, force)
  79.278 - apply(case_tac "M x!snd(E x! ind x)=Black")
  79.279 -  apply(force)
  79.280 - apply(force)
  79.281 -apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
  79.282 ---{* 3 subgoals left *}
  79.283 -apply force
  79.284 ---{* 2 subgoals left *}
  79.285 -apply clarify
  79.286 -apply(conjI_tac)
  79.287 -apply(disjE_tac)
  79.288 - apply (simp_all)
  79.289 -apply clarify
  79.290 -apply(erule less_SucE)
  79.291 - apply force
  79.292 -apply (simp add:BtoW_def)
  79.293 ---{* 1 subgoal left *}
  79.294 -apply clarify
  79.295 -apply simp
  79.296 -apply(disjE_tac)
  79.297 -apply (simp_all)
  79.298 -apply(rule disjI1 , rule Graph1)
  79.299 - apply simp_all
  79.300 -done
  79.301 -
  79.302 -subsubsection {* Counting Black Nodes *}
  79.303 -
  79.304 -constdefs
  79.305 -  Mul_CountInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
  79.306 - "Mul_CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
  79.307 -
  79.308 -  Mul_Count :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
  79.309 -  "Mul_Count n \<equiv> 
  79.310 -  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.311 -    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.312 -    \<and> length \<acute>Ma=length \<acute>M 
  79.313 -    \<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) ) 
  79.314 -    \<and> \<acute>q<n+1 \<and> \<acute>bc={}}.
  79.315 -  \<acute>ind:=0;;
  79.316 -  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.317 -    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.318 -    \<and> length \<acute>Ma=length \<acute>M 
  79.319 -    \<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) ) 
  79.320 -    \<and> \<acute>q<n+1 \<and> \<acute>bc={} \<and> \<acute>ind=0}.
  79.321 -  WHILE \<acute>ind<length \<acute>M 
  79.322 -     INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.323 -          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
  79.324 -          \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
  79.325 -          \<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))
  79.326 -	  \<and> \<acute>q<n+1 \<and> \<acute>ind\<le>length \<acute>M}.
  79.327 -  DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.328 -       \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.329 -       \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
  79.330 -       \<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))
  79.331 -       \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}. 
  79.332 -     IF \<acute>M!\<acute>ind=Black 
  79.333 -     THEN .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.334 -            \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
  79.335 -            \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
  79.336 -            \<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))
  79.337 -            \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
  79.338 -          \<acute>bc:=insert \<acute>ind \<acute>bc
  79.339 -     FI;;
  79.340 -  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.341 -    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.342 -    \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv (\<acute>ind+1) 
  79.343 -    \<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))
  79.344 -    \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}.
  79.345 -  \<acute>ind:=\<acute>ind+1
  79.346 -  OD"
  79.347 - 
  79.348 -lemma Mul_Count: 
  79.349 -  "\<turnstile> Mul_Count n  
  79.350 -  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.351 -    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.352 -    \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
  79.353 -    \<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)) 
  79.354 -    \<and> \<acute>q<n+1}."
  79.355 -apply (unfold Mul_Count_def)
  79.356 -apply annhoare
  79.357 -apply(simp_all add:Mul_CountInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
  79.358 ---{* 7 subgoals left *}
  79.359 -apply force
  79.360 -apply force
  79.361 -apply force
  79.362 ---{* 4 subgoals left *}
  79.363 -apply clarify
  79.364 -apply(conjI_tac)
  79.365 -apply(disjE_tac)
  79.366 - apply simp_all
  79.367 -apply(simp add:Blacks_def)
  79.368 -apply clarify
  79.369 -apply(erule less_SucE)
  79.370 - back
  79.371 - apply force
  79.372 -apply force
  79.373 ---{* 3 subgoals left *}
  79.374 -apply clarify
  79.375 -apply(conjI_tac)
  79.376 -apply(disjE_tac)
  79.377 - apply simp_all
  79.378 -apply clarify
  79.379 -apply(erule less_SucE)
  79.380 - back
  79.381 - apply force
  79.382 -apply simp
  79.383 -apply(rotate_tac -1)
  79.384 -apply (force simp add:Blacks_def)
  79.385 ---{* 2 subgoals left *}
  79.386 -apply force
  79.387 ---{* 1 subgoal left *}
  79.388 -apply clarify
  79.389 -apply(drule_tac x = "ind x" in le_imp_less_or_eq)
  79.390 -apply (simp_all add:Blacks_def)
  79.391 -done
  79.392 -
  79.393 -subsubsection {* Appending garbage nodes to the free list *}
  79.394 -
  79.395 -consts  Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
  79.396 -
  79.397 -axioms
  79.398 -  Append_to_free0: "length (Append_to_free (i, e)) = length e"
  79.399 -  Append_to_free1: "Proper_Edges (m, e) 
  79.400 -                    \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
  79.401 -  Append_to_free2: "i \<notin> Reach e 
  79.402 -           \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
  79.403 -
  79.404 -constdefs
  79.405 -  Mul_AppendInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
  79.406 -  "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>"
  79.407 -
  79.408 -  Mul_Append :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
  79.409 -  "Mul_Append n \<equiv> 
  79.410 -  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
  79.411 -  \<acute>ind:=0;;
  79.412 -  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
  79.413 -  WHILE \<acute>ind<length \<acute>M 
  79.414 -    INV .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
  79.415 -  DO .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
  79.416 -      IF \<acute>M!\<acute>ind=Black THEN 
  79.417 -     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
  79.418 -      \<acute>M:=\<acute>M[\<acute>ind:=White] 
  79.419 -      ELSE 
  79.420 -     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}. 
  79.421 -      \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
  79.422 -      FI;;
  79.423 -  .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
  79.424 -   \<acute>ind:=\<acute>ind+1
  79.425 -  OD"
  79.426 -
  79.427 -lemma Mul_Append: 
  79.428 -  "\<turnstile> Mul_Append n  
  79.429 -     .{\<acute>Mul_Proper n}."
  79.430 -apply(unfold Mul_Append_def)
  79.431 -apply annhoare
  79.432 -apply(simp_all add: mul_collector_defs Mul_AppendInv_def 
  79.433 -      Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  79.434 -apply(force simp add:Blacks_def)
  79.435 -apply(force simp add:Blacks_def)
  79.436 -apply(force simp add:Blacks_def)
  79.437 -apply(force simp add:Graph_defs)
  79.438 -apply force
  79.439 -apply(force simp add:Append_to_free1 Append_to_free2)
  79.440 -apply force
  79.441 -apply force
  79.442 -done
  79.443 -
  79.444 -subsubsection {* Collector *}
  79.445 -
  79.446 -constdefs 
  79.447 -  Mul_Collector :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
  79.448 -  "Mul_Collector n \<equiv>
  79.449 -.{\<acute>Mul_Proper n}.  
  79.450 -WHILE True INV .{\<acute>Mul_Proper n}. 
  79.451 -DO  
  79.452 -Mul_Blacken_Roots n ;; 
  79.453 -.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M}.  
  79.454 - \<acute>obc:={};; 
  79.455 -.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}.  
  79.456 - \<acute>bc:=Roots;; 
  79.457 -.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
  79.458 - \<acute>l:=0;; 
  79.459 -.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>l=0}. 
  79.460 - WHILE \<acute>l<n+1  
  79.461 -   INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and>  
  79.462 -         (\<acute>Safe \<or> (\<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M) \<and> \<acute>l<n+1)}. 
  79.463 - DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.464 -      \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M)}.
  79.465 -    \<acute>obc:=\<acute>bc;;
  79.466 -    Mul_Propagate_Black n;; 
  79.467 -    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.468 -      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.469 -      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
  79.470 -      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))}. 
  79.471 -    \<acute>bc:={};;
  79.472 -    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.473 -      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.474 -      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
  79.475 -      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) \<and> \<acute>bc={}}. 
  79.476 -       \<langle> \<acute>Ma:=\<acute>M,, \<acute>q:=\<acute>Queue \<rangle>;;
  79.477 -    Mul_Count n;; 
  79.478 -    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.479 -      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.480 -      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
  79.481 -      \<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)) 
  79.482 -      \<and> \<acute>q<n+1}. 
  79.483 -    IF \<acute>obc=\<acute>bc THEN
  79.484 -    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.485 -      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.486 -      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
  79.487 -      \<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)) 
  79.488 -      \<and> \<acute>q<n+1 \<and> \<acute>obc=\<acute>bc}.  
  79.489 -    \<acute>l:=\<acute>l+1  
  79.490 -    ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
  79.491 -          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
  79.492 -          \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
  79.493 -          \<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)) 
  79.494 -          \<and> \<acute>q<n+1 \<and> \<acute>obc\<noteq>\<acute>bc}.  
  79.495 -        \<acute>l:=0 FI 
  79.496 - OD;; 
  79.497 - Mul_Append n  
  79.498 -OD"
  79.499 -
  79.500 -lemmas mul_modules = Mul_Redirect_Edge_def Mul_Color_Target_def 
  79.501 - Mul_Blacken_Roots_def Mul_Propagate_Black_def 
  79.502 - Mul_Count_def Mul_Append_def
  79.503 -
  79.504 -lemma Mul_Collector:
  79.505 -  "\<turnstile> Mul_Collector n 
  79.506 -  .{False}."
  79.507 -apply(unfold Mul_Collector_def)
  79.508 -apply annhoare
  79.509 -apply(simp_all only:pre.simps Mul_Blacken_Roots 
  79.510 -       Mul_Propagate_Black Mul_Count Mul_Append)
  79.511 -apply(simp_all add:mul_modules)
  79.512 -apply(simp_all add:mul_collector_defs Queue_def)
  79.513 -apply force
  79.514 -apply force
  79.515 -apply force
  79.516 -apply (force simp add: less_Suc_eq_le)
  79.517 -apply force
  79.518 -apply (force dest:subset_antisym)
  79.519 -apply force
  79.520 -apply force
  79.521 -apply force
  79.522 -done
  79.523 -
  79.524 -subsection {* Interference Freedom *}
  79.525 -
  79.526 -lemma le_length_filter_update[rule_format]: 
  79.527 - "\<forall>i. (\<not>P (list!i) \<or> P j) \<and> i<length list 
  79.528 - \<longrightarrow> length(filter P list) \<le> length(filter P (list[i:=j]))"
  79.529 -apply(induct_tac "list")
  79.530 - apply(simp)
  79.531 -apply(clarify)
  79.532 -apply(case_tac i)
  79.533 - apply(simp)
  79.534 -apply(simp)
  79.535 -done
  79.536 -
  79.537 -lemma less_length_filter_update [rule_format]: 
  79.538 - "\<forall>i. P j \<and> \<not>(P (list!i)) \<and> i<length list 
  79.539 - \<longrightarrow> length(filter P list) < length(filter P (list[i:=j]))"
  79.540 -apply(induct_tac "list")
  79.541 - apply(simp)
  79.542 -apply(clarify)
  79.543 -apply(case_tac i)
  79.544 - apply(simp)
  79.545 -apply(simp)
  79.546 -done
  79.547 -
  79.548 -lemma Mul_interfree_Blacken_Roots_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk> \<Longrightarrow>  
  79.549 -  interfree_aux (Some(Mul_Blacken_Roots n),{},Some(Mul_Redirect_Edge j n))"
  79.550 -apply (unfold mul_modules)
  79.551 -apply interfree_aux
  79.552 -apply safe
  79.553 -apply(simp_all add:Graph6 Graph9 Graph12 nth_list_update mul_mutator_defs mul_collector_defs)
  79.554 -done
  79.555 -
  79.556 -lemma Mul_interfree_Redirect_Edge_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow> 
  79.557 -  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Blacken_Roots n))"
  79.558 -apply (unfold mul_modules)
  79.559 -apply interfree_aux
  79.560 -apply safe
  79.561 -apply(simp_all add:mul_mutator_defs nth_list_update)
  79.562 -done
  79.563 -
  79.564 -lemma Mul_interfree_Blacken_Roots_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.565 -  interfree_aux (Some(Mul_Blacken_Roots n),{},Some (Mul_Color_Target j n ))"
  79.566 -apply (unfold mul_modules)
  79.567 -apply interfree_aux
  79.568 -apply safe
  79.569 -apply(simp_all add:mul_mutator_defs mul_collector_defs nth_list_update Graph7 Graph8 Graph9 Graph12)
  79.570 -done
  79.571 -
  79.572 -lemma Mul_interfree_Color_Target_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.573 -  interfree_aux (Some(Mul_Color_Target j n ),{},Some (Mul_Blacken_Roots n ))"
  79.574 -apply (unfold mul_modules)
  79.575 -apply interfree_aux
  79.576 -apply safe
  79.577 -apply(simp_all add:mul_mutator_defs nth_list_update)
  79.578 -done
  79.579 -
  79.580 -lemma Mul_interfree_Propagate_Black_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.581 -  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Redirect_Edge j n ))"
  79.582 -apply (unfold mul_modules)
  79.583 -apply interfree_aux
  79.584 -apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_PBInv_def nth_list_update Graph6)
  79.585 ---{* 7 subgoals left *}
  79.586 -apply clarify
  79.587 -apply(disjE_tac)
  79.588 -  apply(simp_all add:Graph6)
  79.589 - apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.590 -apply(rule conjI)
  79.591 - apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.592 -apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.593 ---{* 6 subgoals left *}
  79.594 -apply clarify
  79.595 -apply(disjE_tac)
  79.596 -  apply(simp_all add:Graph6)
  79.597 - apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.598 -apply(rule conjI)
  79.599 - apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.600 -apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.601 ---{* 5 subgoals left *}
  79.602 -apply clarify
  79.603 -apply(disjE_tac)
  79.604 -  apply(simp_all add:Graph6)
  79.605 - apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.606 -apply(rule conjI)
  79.607 - 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)
  79.608 -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)
  79.609 -apply(erule conjE)
  79.610 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.611 - apply(rule conjI)
  79.612 -  apply(rule impI,(rule disjI2)+,rule conjI)
  79.613 -   apply clarify
  79.614 -   apply(case_tac "R (Muts x! j)=i")
  79.615 -    apply (force simp add: nth_list_update BtoW_def)
  79.616 -   apply (force simp add: nth_list_update)
  79.617 -  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.618 - apply(rule impI,(rule disjI2)+, erule le_trans)
  79.619 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.620 -apply(rule conjI)
  79.621 - apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.622 - apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.623 -apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.624 -apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.625 ---{* 4 subgoals left *}
  79.626 -apply clarify
  79.627 -apply(disjE_tac)
  79.628 -  apply(simp_all add:Graph6)
  79.629 - apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.630 -apply(rule conjI)
  79.631 - 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)
  79.632 -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)
  79.633 -apply(erule conjE)
  79.634 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.635 - apply(rule conjI)
  79.636 -  apply(rule impI,(rule disjI2)+,rule conjI)
  79.637 -   apply clarify
  79.638 -   apply(case_tac "R (Muts x! j)=i")
  79.639 -    apply (force simp add: nth_list_update BtoW_def)
  79.640 -   apply (force simp add: nth_list_update)
  79.641 -  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.642 - apply(rule impI,(rule disjI2)+, erule le_trans)
  79.643 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.644 -apply(rule conjI)
  79.645 - apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.646 - apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.647 -apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.648 -apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.649 ---{* 3 subgoals left *}
  79.650 -apply clarify
  79.651 -apply(disjE_tac)
  79.652 -  apply(simp_all add:Graph6)
  79.653 -  apply (rule impI)
  79.654 -   apply(rule conjI)
  79.655 -    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.656 -   apply(case_tac "R (Muts x ! j)= ind x")
  79.657 -    apply(simp add:nth_list_update)
  79.658 -   apply(simp add:nth_list_update)
  79.659 -  apply(case_tac "R (Muts x ! j)= ind x")
  79.660 -   apply(simp add:nth_list_update)
  79.661 -  apply(simp add:nth_list_update)
  79.662 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.663 -  apply(rule conjI)
  79.664 -   apply(rule impI)
  79.665 -   apply(rule conjI)
  79.666 -    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.667 -    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.668 -   apply(case_tac "R (Muts x ! j)= ind x")
  79.669 -    apply(simp add:nth_list_update)
  79.670 -   apply(simp add:nth_list_update)
  79.671 -  apply(rule impI)
  79.672 -  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.673 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.674 - apply(rule conjI)
  79.675 -  apply(rule impI)
  79.676 -   apply(rule conjI)
  79.677 -    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.678 -    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.679 -   apply(case_tac "R (Muts x ! j)= ind x")
  79.680 -    apply(simp add:nth_list_update)
  79.681 -   apply(simp add:nth_list_update)
  79.682 -  apply(rule impI)
  79.683 -  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.684 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.685 - apply(erule conjE)
  79.686 - apply(rule conjI)
  79.687 -  apply(case_tac "M x!(T (Muts x!j))=Black")
  79.688 -   apply(rule impI,rule conjI,(rule disjI2)+,rule conjI)
  79.689 -    apply clarify
  79.690 -    apply(case_tac "R (Muts x! j)=i")
  79.691 -     apply (force simp add: nth_list_update BtoW_def)
  79.692 -    apply (force simp add: nth_list_update)
  79.693 -   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.694 -  apply(case_tac "R (Muts x ! j)= ind x")
  79.695 -   apply(simp add:nth_list_update)
  79.696 -  apply(simp add:nth_list_update)
  79.697 - apply(rule impI,rule conjI)
  79.698 -  apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.699 -  apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.700 - apply(case_tac "R (Muts x! j)=ind x")
  79.701 -  apply (force simp add: nth_list_update)
  79.702 - apply (force simp add: nth_list_update)
  79.703 -apply(rule impI, (rule disjI2)+, erule le_trans)
  79.704 -apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.705 ---{* 2 subgoals left *}
  79.706 -apply clarify
  79.707 -apply(rule conjI)
  79.708 - apply(disjE_tac)
  79.709 -  apply(simp_all add:Mul_Auxk_def Graph6)
  79.710 -  apply (rule impI)
  79.711 -   apply(rule conjI)
  79.712 -    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.713 -   apply(case_tac "R (Muts x ! j)= ind x")
  79.714 -    apply(simp add:nth_list_update)
  79.715 -   apply(simp add:nth_list_update)
  79.716 -  apply(case_tac "R (Muts x ! j)= ind x")
  79.717 -   apply(simp add:nth_list_update)
  79.718 -  apply(simp add:nth_list_update)
  79.719 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.720 -  apply(rule impI)
  79.721 -  apply(rule conjI)
  79.722 -   apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.723 -   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.724 -  apply(case_tac "R (Muts x ! j)= ind x")
  79.725 -   apply(simp add:nth_list_update)
  79.726 -  apply(simp add:nth_list_update)
  79.727 - apply(rule impI)
  79.728 - apply(rule conjI)
  79.729 -  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.730 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.731 - apply(case_tac "R (Muts x ! j)= ind x")
  79.732 -  apply(simp add:nth_list_update)
  79.733 - apply(simp add:nth_list_update)
  79.734 -apply(rule impI)
  79.735 -apply(rule conjI)
  79.736 - apply(erule conjE)+
  79.737 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.738 -  apply((rule disjI2)+,rule conjI)
  79.739 -   apply clarify
  79.740 -   apply(case_tac "R (Muts x! j)=i")
  79.741 -    apply (force simp add: nth_list_update BtoW_def)
  79.742 -   apply (force simp add: nth_list_update)
  79.743 -  apply(rule conjI)
  79.744 -   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.745 -  apply(rule impI)
  79.746 -  apply(case_tac "R (Muts x ! j)= ind x")
  79.747 -   apply(simp add:nth_list_update BtoW_def)
  79.748 -  apply (simp  add:nth_list_update)
  79.749 -  apply(rule impI)
  79.750 -  apply simp
  79.751 -  apply(disjE_tac)
  79.752 -   apply(rule disjI1, erule less_le_trans)
  79.753 -   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.754 -  apply force
  79.755 - apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.756 - apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.757 - apply(case_tac "R (Muts x ! j)= ind x")
  79.758 -  apply(simp add:nth_list_update)
  79.759 - apply(simp add:nth_list_update)
  79.760 -apply(disjE_tac) 
  79.761 -apply simp_all
  79.762 -apply(conjI_tac)
  79.763 - apply(rule impI)
  79.764 - apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.765 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.766 -apply(erule conjE)+
  79.767 -apply(rule impI,(rule disjI2)+,rule conjI)
  79.768 - apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.769 -apply(rule impI)+
  79.770 -apply simp
  79.771 -apply(disjE_tac)
  79.772 - apply(rule disjI1, erule less_le_trans)
  79.773 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.774 -apply force
  79.775 ---{* 1 subgoal left *} 
  79.776 -apply clarify
  79.777 -apply(disjE_tac)
  79.778 -  apply(simp_all add:Graph6)
  79.779 - apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.780 -apply(rule conjI)
  79.781 - 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)
  79.782 -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)
  79.783 -apply(erule conjE)
  79.784 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.785 - apply(rule conjI)
  79.786 -  apply(rule impI,(rule disjI2)+,rule conjI)
  79.787 -   apply clarify
  79.788 -   apply(case_tac "R (Muts x! j)=i")
  79.789 -    apply (force simp add: nth_list_update BtoW_def)
  79.790 -   apply (force simp add: nth_list_update)
  79.791 -  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.792 - apply(rule impI,(rule disjI2)+, erule le_trans)
  79.793 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  79.794 -apply(rule conjI)
  79.795 - apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.796 - apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.797 -apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  79.798 -apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
  79.799 -done
  79.800 -
  79.801 -lemma Mul_interfree_Redirect_Edge_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.802 -  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Propagate_Black n))"
  79.803 -apply (unfold mul_modules)
  79.804 -apply interfree_aux
  79.805 -apply safe
  79.806 -apply(simp_all add:mul_mutator_defs nth_list_update)
  79.807 -done
  79.808 -
  79.809 -lemma Mul_interfree_Propagate_Black_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.810 -  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Color_Target j n ))"
  79.811 -apply (unfold mul_modules)
  79.812 -apply interfree_aux
  79.813 -apply(simp_all add: mul_collector_defs mul_mutator_defs)
  79.814 ---{* 7 subgoals left *}
  79.815 -apply clarify
  79.816 -apply (simp add:Graph7 Graph8 Graph12)
  79.817 -apply(disjE_tac)
  79.818 -  apply(simp add:Graph7 Graph8 Graph12)
  79.819 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.820 -  apply(rule disjI2,rule disjI1, erule le_trans)
  79.821 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.822 - apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
  79.823 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  79.824 ---{* 6 subgoals left *}
  79.825 -apply clarify
  79.826 -apply (simp add:Graph7 Graph8 Graph12)
  79.827 -apply(disjE_tac)
  79.828 -  apply(simp add:Graph7 Graph8 Graph12)
  79.829 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.830 -  apply(rule disjI2,rule disjI1, erule le_trans)
  79.831 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.832 - apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
  79.833 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  79.834 ---{* 5 subgoals left *}
  79.835 -apply clarify
  79.836 -apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
  79.837 -apply(disjE_tac)
  79.838 -   apply(simp add:Graph7 Graph8 Graph12) 
  79.839 -  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
  79.840 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.841 -  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.842 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.843 - apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
  79.844 -apply(erule conjE)
  79.845 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.846 - apply((rule disjI2)+)
  79.847 - apply (rule conjI)
  79.848 -  apply(simp add:Graph10)
  79.849 - apply(erule le_trans)
  79.850 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.851 -apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
  79.852 ---{* 4 subgoals left *}
  79.853 -apply clarify
  79.854 -apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
  79.855 -apply(disjE_tac)
  79.856 -   apply(simp add:Graph7 Graph8 Graph12)
  79.857 -  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
  79.858 - apply(case_tac "M x!(T (Muts x!j))=Black")
  79.859 -  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  79.860 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.861 - apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
  79.862 -apply(erule conjE)
  79.863 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.864 - apply((rule disjI2)+)
  79.865 - apply (rule conjI)
  79.866 -  apply(simp add:Graph10)
  79.867 - apply(erule le_trans)
  79.868 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.869 -apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
  79.870 ---{* 3 subgoals left *}
  79.871 -apply clarify
  79.872 -apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
  79.873 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.874 - apply(simp add:Graph10)
  79.875 - apply(disjE_tac)
  79.876 -  apply simp_all
  79.877 -  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
  79.878 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.879 - apply(erule conjE)
  79.880 - apply((rule disjI2)+,erule le_trans)
  79.881 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.882 -apply(rule conjI)
  79.883 - apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
  79.884 -apply (force simp add:nth_list_update)
  79.885 ---{* 2 subgoals left *}
  79.886 -apply clarify 
  79.887 -apply(simp add:Mul_Auxk_def Graph7 Graph8 Graph12)
  79.888 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.889 - apply(simp add:Graph10)
  79.890 - apply(disjE_tac)
  79.891 -  apply simp_all
  79.892 -  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
  79.893 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.894 - apply(erule conjE)+
  79.895 - apply((rule disjI2)+,rule conjI, erule le_trans)
  79.896 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.897 - apply((rule impI)+)
  79.898 - apply simp
  79.899 - apply(erule disjE)
  79.900 -  apply(rule disjI1, erule less_le_trans) 
  79.901 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.902 - apply force
  79.903 -apply(rule conjI)
  79.904 - apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
  79.905 -apply (force simp add:nth_list_update)
  79.906 ---{* 1 subgoal left *}
  79.907 -apply clarify
  79.908 -apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
  79.909 -apply(case_tac "M x!(T (Muts x!j))=Black")
  79.910 - apply(simp add:Graph10)
  79.911 - apply(disjE_tac)
  79.912 -  apply simp_all
  79.913 -  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
  79.914 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.915 - apply(erule conjE)
  79.916 - apply((rule disjI2)+,erule le_trans)
  79.917 - apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  79.918 -apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
  79.919 -done
  79.920 -
  79.921 -lemma Mul_interfree_Color_Target_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.922 -  interfree_aux (Some(Mul_Color_Target j n),{},Some(Mul_Propagate_Black n ))"
  79.923 -apply (unfold mul_modules)
  79.924 -apply interfree_aux
  79.925 -apply safe
  79.926 -apply(simp_all add:mul_mutator_defs nth_list_update)
  79.927 -done
  79.928 -
  79.929 -lemma Mul_interfree_Count_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  79.930 -  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Redirect_Edge j n))"
  79.931 -apply (unfold mul_modules)
  79.932 -apply interfree_aux
  79.933 ---{* 9 subgoals left *}
  79.934 -apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def Graph6)
  79.935 -apply clarify
  79.936 -apply disjE_tac
  79.937 -   apply(simp add:Graph6)
  79.938 -  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.939 - apply(simp add:Graph6)
  79.940 -apply clarify
  79.941 -apply disjE_tac
  79.942 - apply(simp add:Graph6)
  79.943 - apply(rule conjI)
  79.944 -  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)
  79.945 - 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)
  79.946 -apply(simp add:Graph6)
  79.947 ---{* 8 subgoals left *}
  79.948 -apply(simp add:mul_mutator_defs nth_list_update)
  79.949 ---{* 7 subgoals left *}
  79.950 -apply(simp add:mul_mutator_defs mul_collector_defs)
  79.951 -apply clarify
  79.952 -apply disjE_tac
  79.953 -   apply(simp add:Graph6)
  79.954 -  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.955 - apply(simp add:Graph6)
  79.956 -apply clarify
  79.957 -apply disjE_tac
  79.958 - apply(simp add:Graph6)
  79.959 - apply(rule conjI)
  79.960 -  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)
  79.961 - 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)
  79.962 -apply(simp add:Graph6)
  79.963 ---{* 6 subgoals left *}
  79.964 -apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
  79.965 -apply clarify
  79.966 -apply disjE_tac
  79.967 -   apply(simp add:Graph6 Queue_def)
  79.968 -  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.969 - apply(simp add:Graph6)
  79.970 -apply clarify
  79.971 -apply disjE_tac
  79.972 - apply(simp add:Graph6)
  79.973 - apply(rule conjI)
  79.974 -  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)
  79.975 - 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)
  79.976 -apply(simp add:Graph6)
  79.977 ---{* 5 subgoals left *}
  79.978 -apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
  79.979 -apply clarify
  79.980 -apply disjE_tac
  79.981 -   apply(simp add:Graph6)
  79.982 -  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.983 - apply(simp add:Graph6)
  79.984 -apply clarify
  79.985 -apply disjE_tac
  79.986 - apply(simp add:Graph6)
  79.987 - apply(rule conjI)
  79.988 -  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)
  79.989 - 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)
  79.990 -apply(simp add:Graph6)
  79.991 ---{* 4 subgoals left *}
  79.992 -apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
  79.993 -apply clarify
  79.994 -apply disjE_tac
  79.995 -   apply(simp add:Graph6)
  79.996 -  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  79.997 - apply(simp add:Graph6)
  79.998 -apply clarify
  79.999 -apply disjE_tac
 79.1000 - apply(simp add:Graph6)
 79.1001 - apply(rule conjI)
 79.1002 -  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)
 79.1003 - 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)
 79.1004 -apply(simp add:Graph6)
 79.1005 ---{* 3 subgoals left *}
 79.1006 -apply(simp add:mul_mutator_defs nth_list_update)
 79.1007 ---{* 2 subgoals left *}
 79.1008 -apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
 79.1009 -apply clarify
 79.1010 -apply disjE_tac
 79.1011 -   apply(simp add:Graph6)
 79.1012 -  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 79.1013 - apply(simp add:Graph6)
 79.1014 -apply clarify
 79.1015 -apply disjE_tac
 79.1016 - apply(simp add:Graph6)
 79.1017 - apply(rule conjI)
 79.1018 -  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)
 79.1019 - 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)
 79.1020 -apply(simp add:Graph6)
 79.1021 ---{* 1 subgoal left *}
 79.1022 -apply(simp add:mul_mutator_defs nth_list_update)
 79.1023 -done
 79.1024 -
 79.1025 -lemma Mul_interfree_Redirect_Edge_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1026 -  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Count n ))"
 79.1027 -apply (unfold mul_modules)
 79.1028 -apply interfree_aux
 79.1029 -apply safe
 79.1030 -apply(simp_all add:mul_mutator_defs nth_list_update)
 79.1031 -done
 79.1032 -
 79.1033 -lemma Mul_interfree_Count_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1034 -  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Color_Target j n))"
 79.1035 -apply (unfold mul_modules)
 79.1036 -apply interfree_aux
 79.1037 -apply(simp_all add:mul_collector_defs mul_mutator_defs Mul_CountInv_def)
 79.1038 ---{* 6 subgoals left *}
 79.1039 -apply clarify
 79.1040 -apply disjE_tac
 79.1041 -  apply (simp add: Graph7 Graph8 Graph12)
 79.1042 - apply (simp add: Graph7 Graph8 Graph12)
 79.1043 -apply clarify
 79.1044 -apply disjE_tac
 79.1045 - apply (simp add: Graph7 Graph8 Graph12)
 79.1046 - apply(case_tac "M x!(T (Muts x!j))=Black")
 79.1047 -  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
 79.1048 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 79.1049 - apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 79.1050 -apply (simp add: Graph7 Graph8 Graph12)
 79.1051 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
 79.1052 ---{* 5 subgoals left *}
 79.1053 -apply clarify
 79.1054 -apply disjE_tac
 79.1055 -  apply (simp add: Graph7 Graph8 Graph12)
 79.1056 - apply (simp add: Graph7 Graph8 Graph12)
 79.1057 -apply clarify
 79.1058 -apply disjE_tac
 79.1059 - apply (simp add: Graph7 Graph8 Graph12)
 79.1060 - apply(case_tac "M x!(T (Muts x!j))=Black")
 79.1061 -  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
 79.1062 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 79.1063 - apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 79.1064 -apply (simp add: Graph7 Graph8 Graph12)
 79.1065 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
 79.1066 ---{* 4 subgoals left *}
 79.1067 -apply clarify
 79.1068 -apply disjE_tac
 79.1069 -  apply (simp add: Graph7 Graph8 Graph12)
 79.1070 - apply (simp add: Graph7 Graph8 Graph12)
 79.1071 -apply clarify
 79.1072 -apply disjE_tac
 79.1073 - apply (simp add: Graph7 Graph8 Graph12)
 79.1074 - apply(case_tac "M x!(T (Muts x!j))=Black")
 79.1075 -  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
 79.1076 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 79.1077 - apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 79.1078 -apply (simp add: Graph7 Graph8 Graph12)
 79.1079 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
 79.1080 ---{* 3 subgoals left *}
 79.1081 -apply clarify
 79.1082 -apply disjE_tac
 79.1083 -  apply (simp add: Graph7 Graph8 Graph12)
 79.1084 - apply (simp add: Graph7 Graph8 Graph12)
 79.1085 -apply clarify
 79.1086 -apply disjE_tac
 79.1087 - apply (simp add: Graph7 Graph8 Graph12)
 79.1088 - apply(case_tac "M x!(T (Muts x!j))=Black")
 79.1089 -  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
 79.1090 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 79.1091 - apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 79.1092 -apply (simp add: Graph7 Graph8 Graph12)
 79.1093 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
 79.1094 ---{* 2 subgoals left *}
 79.1095 -apply clarify
 79.1096 -apply disjE_tac
 79.1097 -  apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
 79.1098 - apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
 79.1099 -apply clarify
 79.1100 -apply disjE_tac
 79.1101 - apply (simp add: Graph7 Graph8 Graph12)
 79.1102 - apply(rule conjI)
 79.1103 -  apply(case_tac "M x!(T (Muts x!j))=Black")
 79.1104 -   apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
 79.1105 -   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 79.1106 -  apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 79.1107 - apply (simp add: nth_list_update)
 79.1108 -apply (simp add: Graph7 Graph8 Graph12)
 79.1109 -apply(rule conjI)
 79.1110 - apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
 79.1111 -apply (simp add: nth_list_update)
 79.1112 ---{* 1 subgoal left *}
 79.1113 -apply clarify
 79.1114 -apply disjE_tac
 79.1115 -  apply (simp add: Graph7 Graph8 Graph12)
 79.1116 - apply (simp add: Graph7 Graph8 Graph12)
 79.1117 -apply clarify
 79.1118 -apply disjE_tac
 79.1119 - apply (simp add: Graph7 Graph8 Graph12)
 79.1120 - apply(case_tac "M x!(T (Muts x!j))=Black")
 79.1121 -  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
 79.1122 -  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 79.1123 - apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 79.1124 -apply (simp add: Graph7 Graph8 Graph12)
 79.1125 -apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
 79.1126 -done
 79.1127 -
 79.1128 -lemma Mul_interfree_Color_Target_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1129 -  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Count n ))"
 79.1130 -apply (unfold mul_modules)
 79.1131 -apply interfree_aux
 79.1132 -apply safe
 79.1133 -apply(simp_all add:mul_mutator_defs nth_list_update)
 79.1134 -done
 79.1135 -
 79.1136 -lemma Mul_interfree_Append_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1137 -  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Redirect_Edge j n))"
 79.1138 -apply (unfold mul_modules)
 79.1139 -apply interfree_aux
 79.1140 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
 79.1141 -apply(simp_all add:Graph6 Append_to_free0 Append_to_free1 mul_collector_defs mul_mutator_defs Mul_AppendInv_def)
 79.1142 -apply(erule_tac x=j in allE, force dest:Graph3)+
 79.1143 -done
 79.1144 -
 79.1145 -lemma Mul_interfree_Redirect_Edge_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1146 -  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Append n))"
 79.1147 -apply (unfold mul_modules)
 79.1148 -apply interfree_aux
 79.1149 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
 79.1150 -apply(simp_all add:mul_collector_defs Append_to_free0 Mul_AppendInv_def  mul_mutator_defs nth_list_update)
 79.1151 -done
 79.1152 -
 79.1153 -lemma Mul_interfree_Append_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1154 -  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Color_Target j n))"
 79.1155 -apply (unfold mul_modules)
 79.1156 -apply interfree_aux
 79.1157 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
 79.1158 -apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_AppendInv_def Graph7 Graph8 Append_to_free0 Append_to_free1 
 79.1159 -              Graph12 nth_list_update)
 79.1160 -done
 79.1161 -
 79.1162 -lemma Mul_interfree_Color_Target_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
 79.1163 -  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Append n))"
 79.1164 -apply (unfold mul_modules)
 79.1165 -apply interfree_aux
 79.1166 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
 79.1167 -apply(simp_all add: mul_mutator_defs nth_list_update)
 79.1168 -apply(simp add:Mul_AppendInv_def Append_to_free0)
 79.1169 -done
 79.1170 -
 79.1171 -subsubsection {* Interference freedom Collector-Mutator *}
 79.1172 -
 79.1173 -lemmas mul_collector_mutator_interfree =  
 79.1174 - Mul_interfree_Blacken_Roots_Redirect_Edge Mul_interfree_Blacken_Roots_Color_Target 
 79.1175 - Mul_interfree_Propagate_Black_Redirect_Edge Mul_interfree_Propagate_Black_Color_Target  
 79.1176 - Mul_interfree_Count_Redirect_Edge Mul_interfree_Count_Color_Target 
 79.1177 - Mul_interfree_Append_Redirect_Edge Mul_interfree_Append_Color_Target 
 79.1178 - Mul_interfree_Redirect_Edge_Blacken_Roots Mul_interfree_Color_Target_Blacken_Roots 
 79.1179 - Mul_interfree_Redirect_Edge_Propagate_Black Mul_interfree_Color_Target_Propagate_Black  
 79.1180 - Mul_interfree_Redirect_Edge_Count Mul_interfree_Color_Target_Count 
 79.1181 - Mul_interfree_Redirect_Edge_Append Mul_interfree_Color_Target_Append
 79.1182 -
 79.1183 -lemma Mul_interfree_Collector_Mutator: "j<n  \<Longrightarrow> 
 79.1184 -  interfree_aux (Some (Mul_Collector n), {}, Some (Mul_Mutator j n))"
 79.1185 -apply(unfold Mul_Collector_def Mul_Mutator_def)
 79.1186 -apply interfree_aux
 79.1187 -apply(simp_all add:mul_collector_mutator_interfree)
 79.1188 -apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
 79.1189 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
 79.1190 ---{* 42 subgoals left *}
 79.1191 -apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
 79.1192 ---{* 24 subgoals left *}
 79.1193 -apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
 79.1194 ---{* 14 subgoals left *}
 79.1195 -apply(tactic {* TRYALL (clarify_tac @{claset}) *})
 79.1196 -apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
 79.1197 -apply(tactic {* TRYALL (rtac conjI) *})
 79.1198 -apply(tactic {* TRYALL (rtac impI) *})
 79.1199 -apply(tactic {* TRYALL (etac disjE) *})
 79.1200 -apply(tactic {* TRYALL (etac conjE) *})
 79.1201 -apply(tactic {* TRYALL (etac disjE) *})
 79.1202 -apply(tactic {* TRYALL (etac disjE) *})
 79.1203 ---{* 72 subgoals left *}
 79.1204 -apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
 79.1205 ---{* 35 subgoals left *}
 79.1206 -apply(tactic {* TRYALL(EVERY'[rtac disjI1,rtac subset_trans,etac @{thm Graph3},force_tac @{clasimpset}, assume_tac]) *})
 79.1207 ---{* 28 subgoals left *}
 79.1208 -apply(tactic {* TRYALL (etac conjE) *})
 79.1209 -apply(tactic {* TRYALL (etac disjE) *})
 79.1210 ---{* 34 subgoals left *}
 79.1211 -apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 79.1212 -apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 79.1213 -apply(case_tac [!] "M x!(T (Muts x ! j))=Black")
 79.1214 -apply(simp_all add:Graph10)
 79.1215 ---{* 47 subgoals left *}
 79.1216 -apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac (thm "subset_psubset_trans"),etac (thm "Graph11"),force_tac @{clasimpset}]) *})
 79.1217 ---{* 41 subgoals left *}
 79.1218 -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}])]) *})
 79.1219 ---{* 35 subgoals left *}
 79.1220 -apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac (thm "psubset_subset_trans"),rtac (thm "Graph9"),force_tac @{clasimpset}]) *})
 79.1221 ---{* 31 subgoals left *}
 79.1222 -apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac (thm "subset_psubset_trans"),etac (thm "Graph11"),force_tac @{clasimpset}]) *})
 79.1223 ---{* 29 subgoals left *}
 79.1224 -apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac (thm "subset_psubset_trans"),etac (thm "subset_psubset_trans"),etac (thm "Graph11"),force_tac @{clasimpset}]) *})
 79.1225 ---{* 25 subgoals left *}
 79.1226 -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}])]) *})
 79.1227 ---{* 10 subgoals left *}
 79.1228 -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)+
 79.1229 -done
 79.1230 -
 79.1231 -subsubsection {* Interference freedom Mutator-Collector *}
 79.1232 -
 79.1233 -lemma Mul_interfree_Mutator_Collector: " j < n \<Longrightarrow> 
 79.1234 -  interfree_aux (Some (Mul_Mutator j n), {}, Some (Mul_Collector n))"
 79.1235 -apply(unfold Mul_Collector_def Mul_Mutator_def)
 79.1236 -apply interfree_aux
 79.1237 -apply(simp_all add:mul_collector_mutator_interfree)
 79.1238 -apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
 79.1239 -apply(tactic  {* TRYALL (interfree_aux_tac) *})
 79.1240 ---{* 76 subgoals left *}
 79.1241 -apply (clarify,simp add: nth_list_update)+
 79.1242 ---{* 56 subgoals left *}
 79.1243 -apply(clarify,simp add:Mul_AppendInv_def Append_to_free0 nth_list_update)+
 79.1244 -done
 79.1245 -
 79.1246 -subsubsection {* The Multi-Mutator Garbage Collection Algorithm *}
 79.1247 -
 79.1248 -text {* The total number of verification conditions is 328 *}
 79.1249 -
 79.1250 -lemma Mul_Gar_Coll: 
 79.1251 - "\<parallel>- .{\<acute>Mul_Proper n \<and> \<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.  
 79.1252 - COBEGIN  
 79.1253 -  Mul_Collector n
 79.1254 - .{False}.
 79.1255 - \<parallel>  
 79.1256 - SCHEME  [0\<le> j< n]
 79.1257 -  Mul_Mutator j n
 79.1258 - .{False}.  
 79.1259 - COEND  
 79.1260 - .{False}."
 79.1261 -apply oghoare
 79.1262 ---{* Strengthening the precondition *}
 79.1263 -apply(rule Int_greatest)
 79.1264 - apply (case_tac n)
 79.1265 -  apply(force simp add: Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
 79.1266 - apply(simp add: Mul_Mutator_def mul_collector_defs mul_mutator_defs nth_append)
 79.1267 - apply force
 79.1268 -apply clarify
 79.1269 -apply(case_tac i)
 79.1270 - apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
 79.1271 -apply(simp add: Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append nth_map_upt)
 79.1272 ---{* Collector *}
 79.1273 -apply(rule Mul_Collector)
 79.1274 ---{* Mutator *}
 79.1275 -apply(erule Mul_Mutator)
 79.1276 ---{* Interference freedom *}
 79.1277 -apply(simp add:Mul_interfree_Collector_Mutator)
 79.1278 -apply(simp add:Mul_interfree_Mutator_Collector)
 79.1279 -apply(simp add:Mul_interfree_Mutator_Mutator)
 79.1280 ---{* Weakening of the postcondition *}
 79.1281 -apply(case_tac n)
 79.1282 - apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
 79.1283 -apply(simp add:Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append)
 79.1284 -done
 79.1285 -
 79.1286 -end
    80.1 --- a/src/HOL/HoareParallel/OG_Com.thy	Tue Sep 29 22:15:54 2009 +0200
    80.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    80.3 @@ -1,55 +0,0 @@
    80.4 -
    80.5 -header {* \chapter{The Owicki-Gries Method} 
    80.6 -
    80.7 -\section{Abstract Syntax} *} 
    80.8 -
    80.9 -theory OG_Com imports Main begin
   80.10 -
   80.11 -text {* Type abbreviations for boolean expressions and assertions: *}
   80.12 -
   80.13 -types
   80.14 -    'a bexp = "'a set"
   80.15 -    'a assn = "'a set"
   80.16 -
   80.17 -text {* The syntax of commands is defined by two mutually recursive
   80.18 -datatypes: @{text "'a ann_com"} for annotated commands and @{text "'a
   80.19 -com"} for non-annotated commands. *}
   80.20 -
   80.21 -datatype 'a ann_com = 
   80.22 -     AnnBasic "('a assn)"  "('a \<Rightarrow> 'a)"         
   80.23 -   | AnnSeq "('a ann_com)"  "('a ann_com)"   
   80.24 -   | AnnCond1 "('a assn)"  "('a bexp)"  "('a ann_com)"  "('a ann_com)" 
   80.25 -   | AnnCond2 "('a assn)"  "('a bexp)"  "('a ann_com)" 
   80.26 -   | AnnWhile "('a assn)"  "('a bexp)"  "('a assn)"  "('a ann_com)" 
   80.27 -   | AnnAwait "('a assn)"  "('a bexp)"  "('a com)" 
   80.28 -and 'a com = 
   80.29 -     Parallel "('a ann_com option \<times> 'a assn) list"
   80.30 -   | Basic "('a \<Rightarrow> 'a)" 
   80.31 -   | Seq "('a com)"  "('a com)" 
   80.32 -   | Cond "('a bexp)"  "('a com)"  "('a com)" 
   80.33 -   | While "('a bexp)"  "('a assn)"  "('a com)"
   80.34 -
   80.35 -text {* The function @{text pre} extracts the precondition of an
   80.36 -annotated command: *}
   80.37 -
   80.38 -consts
   80.39 -  pre ::"'a ann_com \<Rightarrow> 'a assn" 
   80.40 -primrec 
   80.41 -  "pre (AnnBasic r f) = r"
   80.42 -  "pre (AnnSeq c1 c2) = pre c1"
   80.43 -  "pre (AnnCond1 r b c1 c2) = r"
   80.44 -  "pre (AnnCond2 r b c) = r"
   80.45 -  "pre (AnnWhile r b i c) = r"
   80.46 -  "pre (AnnAwait r b c) = r"
   80.47 -
   80.48 -text {* Well-formedness predicate for atomic programs: *}
   80.49 -
   80.50 -consts atom_com :: "'a com \<Rightarrow> bool"
   80.51 -primrec  
   80.52 -  "atom_com (Parallel Ts) = False"
   80.53 -  "atom_com (Basic f) = True"
   80.54 -  "atom_com (Seq c1 c2) = (atom_com c1 \<and> atom_com c2)"
   80.55 -  "atom_com (Cond b c1 c2) = (atom_com c1 \<and> atom_com c2)"
   80.56 -  "atom_com (While b i c) = atom_com c"
   80.57 -  
   80.58 -end
   80.59 \ No newline at end of file
    81.1 --- a/src/HOL/HoareParallel/OG_Examples.thy	Tue Sep 29 22:15:54 2009 +0200
    81.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    81.3 @@ -1,549 +0,0 @@
    81.4 -
    81.5 -header {* \section{Examples} *}
    81.6 -
    81.7 -theory OG_Examples imports OG_Syntax begin
    81.8 -
    81.9 -subsection {* Mutual Exclusion *}
   81.10 -
   81.11 -subsubsection {* Peterson's Algorithm I*}
   81.12 -
   81.13 -text {* Eike Best. "Semantics of Sequential and Parallel Programs", page 217. *}
   81.14 -
   81.15 -record Petersons_mutex_1 =
   81.16 - pr1 :: nat
   81.17 - pr2 :: nat
   81.18 - in1 :: bool
   81.19 - in2 :: bool 
   81.20 - hold :: nat
   81.21 -
   81.22 -lemma Petersons_mutex_1: 
   81.23 -  "\<parallel>- .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2 }.  
   81.24 -  COBEGIN .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
   81.25 -  WHILE True INV .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
   81.26 -  DO  
   81.27 -  .{\<acute>pr1=0 \<and> \<not>\<acute>in1}. \<langle> \<acute>in1:=True,,\<acute>pr1:=1 \<rangle>;;  
   81.28 -  .{\<acute>pr1=1 \<and> \<acute>in1}.  \<langle> \<acute>hold:=1,,\<acute>pr1:=2 \<rangle>;;  
   81.29 -  .{\<acute>pr1=2 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}.  
   81.30 -  AWAIT (\<not>\<acute>in2 \<or> \<not>(\<acute>hold=1)) THEN \<acute>pr1:=3 END;;    
   81.31 -  .{\<acute>pr1=3 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}. 
   81.32 -   \<langle>\<acute>in1:=False,,\<acute>pr1:=0\<rangle> 
   81.33 -  OD .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
   81.34 -  \<parallel>  
   81.35 -  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
   81.36 -  WHILE True INV .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
   81.37 -  DO  
   81.38 -  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}. \<langle> \<acute>in2:=True,,\<acute>pr2:=1 \<rangle>;;  
   81.39 -  .{\<acute>pr2=1 \<and> \<acute>in2}. \<langle>  \<acute>hold:=2,,\<acute>pr2:=2 \<rangle>;;  
   81.40 -  .{\<acute>pr2=2 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}.  
   81.41 -  AWAIT (\<not>\<acute>in1 \<or> \<not>(\<acute>hold=2)) THEN \<acute>pr2:=3  END;;    
   81.42 -  .{\<acute>pr2=3 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}. 
   81.43 -    \<langle>\<acute>in2:=False,,\<acute>pr2:=0\<rangle> 
   81.44 -  OD .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
   81.45 -  COEND  
   81.46 -  .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2}."
   81.47 -apply oghoare
   81.48 ---{* 104 verification conditions. *}
   81.49 -apply auto
   81.50 -done
   81.51 -
   81.52 -subsubsection {*Peterson's Algorithm II: A Busy Wait Solution *}
   81.53 - 
   81.54 -text {* Apt and Olderog. "Verification of sequential and concurrent Programs", page 282. *}
   81.55 -
   81.56 -record Busy_wait_mutex =
   81.57 - flag1 :: bool
   81.58 - flag2 :: bool
   81.59 - turn  :: nat
   81.60 - after1 :: bool 
   81.61 - after2 :: bool
   81.62 -
   81.63 -lemma Busy_wait_mutex: 
   81.64 - "\<parallel>-  .{True}.  
   81.65 -  \<acute>flag1:=False,, \<acute>flag2:=False,,  
   81.66 -  COBEGIN .{\<not>\<acute>flag1}.  
   81.67 -        WHILE True  
   81.68 -        INV .{\<not>\<acute>flag1}.  
   81.69 -        DO .{\<not>\<acute>flag1}. \<langle> \<acute>flag1:=True,,\<acute>after1:=False \<rangle>;;  
   81.70 -           .{\<acute>flag1 \<and> \<not>\<acute>after1}. \<langle> \<acute>turn:=1,,\<acute>after1:=True \<rangle>;;  
   81.71 -           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
   81.72 -            WHILE \<not>(\<acute>flag2 \<longrightarrow> \<acute>turn=2)  
   81.73 -            INV .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
   81.74 -            DO .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;; 
   81.75 -           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>flag2 \<and> \<acute>after2 \<longrightarrow> \<acute>turn=2)}.
   81.76 -            \<acute>flag1:=False  
   81.77 -        OD  
   81.78 -       .{False}.  
   81.79 -  \<parallel>  
   81.80 -     .{\<not>\<acute>flag2}.  
   81.81 -        WHILE True  
   81.82 -        INV .{\<not>\<acute>flag2}.  
   81.83 -        DO .{\<not>\<acute>flag2}. \<langle> \<acute>flag2:=True,,\<acute>after2:=False \<rangle>;;  
   81.84 -           .{\<acute>flag2 \<and> \<not>\<acute>after2}. \<langle> \<acute>turn:=2,,\<acute>after2:=True \<rangle>;;  
   81.85 -           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
   81.86 -            WHILE \<not>(\<acute>flag1 \<longrightarrow> \<acute>turn=1)  
   81.87 -            INV .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
   81.88 -            DO .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;;  
   81.89 -           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>flag1 \<and> \<acute>after1 \<longrightarrow> \<acute>turn=1)}. 
   81.90 -            \<acute>flag2:=False  
   81.91 -        OD  
   81.92 -       .{False}.  
   81.93 -  COEND  
   81.94 -  .{False}."
   81.95 -apply oghoare
   81.96 ---{* 122 vc *}
   81.97 -apply auto
   81.98 -done
   81.99 -
  81.100 -subsubsection {* Peterson's Algorithm III: A Solution using Semaphores  *}
  81.101 -
  81.102 -record  Semaphores_mutex =
  81.103 - out :: bool
  81.104 - who :: nat
  81.105 -
  81.106 -lemma Semaphores_mutex: 
  81.107 - "\<parallel>- .{i\<noteq>j}.  
  81.108 -  \<acute>out:=True ,,  
  81.109 -  COBEGIN .{i\<noteq>j}.  
  81.110 -       WHILE True INV .{i\<noteq>j}.  
  81.111 -       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
  81.112 -          .{\<not>\<acute>out \<and> \<acute>who=i \<and> i\<noteq>j}. \<acute>out:=True OD  
  81.113 -       .{False}.  
  81.114 -  \<parallel>  
  81.115 -       .{i\<noteq>j}.  
  81.116 -       WHILE True INV .{i\<noteq>j}.  
  81.117 -       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,,\<acute>who:=j END;;  
  81.118 -          .{\<not>\<acute>out \<and> \<acute>who=j \<and> i\<noteq>j}. \<acute>out:=True OD  
  81.119 -       .{False}.  
  81.120 -  COEND  
  81.121 -  .{False}."
  81.122 -apply oghoare
  81.123 ---{* 38 vc *}
  81.124 -apply auto
  81.125 -done
  81.126 -
  81.127 -subsubsection {* Peterson's Algorithm III: Parameterized version: *}
  81.128 -
  81.129 -lemma Semaphores_parameterized_mutex: 
  81.130 - "0<n \<Longrightarrow> \<parallel>- .{True}.  
  81.131 -  \<acute>out:=True ,,  
  81.132 - COBEGIN
  81.133 -  SCHEME [0\<le> i< n]
  81.134 -    .{True}.  
  81.135 -     WHILE True INV .{True}.  
  81.136 -      DO .{True}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
  81.137 -         .{\<not>\<acute>out \<and> \<acute>who=i}. \<acute>out:=True OD
  81.138 -    .{False}. 
  81.139 - COEND
  81.140 -  .{False}." 
  81.141 -apply oghoare
  81.142 ---{* 20 vc *}
  81.143 -apply auto
  81.144 -done
  81.145 -
  81.146 -subsubsection{* The Ticket Algorithm *}
  81.147 -
  81.148 -record Ticket_mutex =
  81.149 - num :: nat
  81.150 - nextv :: nat
  81.151 - turn :: "nat list"
  81.152 - index :: nat 
  81.153 -
  81.154 -lemma Ticket_mutex: 
  81.155 - "\<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 
  81.156 -    \<longrightarrow> \<acute>turn!k < \<acute>num \<and> (\<acute>turn!k =0 \<or> \<acute>turn!k\<noteq>\<acute>turn!l))\<guillemotright> \<rbrakk>
  81.157 -   \<Longrightarrow> \<parallel>- .{n=length \<acute>turn}.  
  81.158 -   \<acute>index:= 0,,
  81.159 -   WHILE \<acute>index < n INV .{n=length \<acute>turn \<and> (\<forall>i<\<acute>index. \<acute>turn!i=0)}. 
  81.160 -    DO \<acute>turn:= \<acute>turn[\<acute>index:=0],, \<acute>index:=\<acute>index +1 OD,,
  81.161 -  \<acute>num:=1 ,, \<acute>nextv:=1 ,, 
  81.162 - COBEGIN
  81.163 -  SCHEME [0\<le> i< n]
  81.164 -    .{\<acute>I}.  
  81.165 -     WHILE True INV .{\<acute>I}.  
  81.166 -      DO .{\<acute>I}. \<langle> \<acute>turn :=\<acute>turn[i:=\<acute>num],, \<acute>num:=\<acute>num+1 \<rangle>;;  
  81.167 -         .{\<acute>I}. WAIT \<acute>turn!i=\<acute>nextv END;;
  81.168 -         .{\<acute>I \<and> \<acute>turn!i=\<acute>nextv}. \<acute>nextv:=\<acute>nextv+1
  81.169 -      OD
  81.170 -    .{False}. 
  81.171 - COEND
  81.172 -  .{False}." 
  81.173 -apply oghoare
  81.174 ---{* 35 vc *}
  81.175 -apply simp_all
  81.176 ---{* 21 vc *}
  81.177 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
  81.178 ---{* 11 vc *}
  81.179 -apply simp_all
  81.180 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
  81.181 ---{* 10 subgoals left *}
  81.182 -apply(erule less_SucE)
  81.183 - apply simp
  81.184 -apply simp
  81.185 ---{* 9 subgoals left *}
  81.186 -apply(case_tac "i=k")
  81.187 - apply force
  81.188 -apply simp
  81.189 -apply(case_tac "i=l")
  81.190 - apply force
  81.191 -apply force
  81.192 ---{* 8 subgoals left *}
  81.193 -prefer 8
  81.194 -apply force
  81.195 -apply force
  81.196 ---{* 6 subgoals left *}
  81.197 -prefer 6
  81.198 -apply(erule_tac x=i in allE)
  81.199 -apply fastsimp
  81.200 ---{* 5 subgoals left *}
  81.201 -prefer 5
  81.202 -apply(case_tac [!] "j=k")
  81.203 ---{* 10 subgoals left *}
  81.204 -apply simp_all
  81.205 -apply(erule_tac x=k in allE)
  81.206 -apply force
  81.207 ---{* 9 subgoals left *}
  81.208 -apply(case_tac "j=l")
  81.209 - apply simp
  81.210 - apply(erule_tac x=k in allE)
  81.211 - apply(erule_tac x=k in allE)
  81.212 - apply(erule_tac x=l in allE)
  81.213 - apply force
  81.214 -apply(erule_tac x=k in allE)
  81.215 -apply(erule_tac x=k in allE)
  81.216 -apply(erule_tac x=l in allE)
  81.217 -apply force
  81.218 ---{* 8 subgoals left *}
  81.219 -apply force
  81.220 -apply(case_tac "j=l")
  81.221 - apply simp
  81.222 -apply(erule_tac x=k in allE)
  81.223 -apply(erule_tac x=l in allE)
  81.224 -apply force
  81.225 -apply force
  81.226 -apply force
  81.227 ---{* 5 subgoals left *}
  81.228 -apply(erule_tac x=k in allE)
  81.229 -apply(erule_tac x=l in allE)
  81.230 -apply(case_tac "j=l")
  81.231 - apply force
  81.232 -apply force
  81.233 -apply force
  81.234 ---{* 3 subgoals left *}
  81.235 -apply(erule_tac x=k in allE)
  81.236 -apply(erule_tac x=l in allE)
  81.237 -apply(case_tac "j=l")
  81.238 - apply force
  81.239 -apply force
  81.240 -apply force
  81.241 ---{* 1 subgoals left *}
  81.242 -apply(erule_tac x=k in allE)
  81.243 -apply(erule_tac x=l in allE)
  81.244 -apply(case_tac "j=l")
  81.245 - apply force
  81.246 -apply force
  81.247 -done
  81.248 -
  81.249 -subsection{* Parallel Zero Search *}
  81.250 -
  81.251 -text {* Synchronized Zero Search. Zero-6 *}
  81.252 -
  81.253 -text {*Apt and Olderog. "Verification of sequential and concurrent Programs" page 294: *}
  81.254 -
  81.255 -record Zero_search =
  81.256 -   turn :: nat
  81.257 -   found :: bool
  81.258 -   x :: nat
  81.259 -   y :: nat
  81.260 -
  81.261 -lemma Zero_search: 
  81.262 -  "\<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)) 
  81.263 -      \<and> (\<not>\<acute>found \<and> a<\<acute> x \<longrightarrow> f(\<acute>x)\<noteq>0) \<guillemotright> ;  
  81.264 -    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)) 
  81.265 -      \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0) \<guillemotright> \<rbrakk> \<Longrightarrow>  
  81.266 -  \<parallel>- .{\<exists> u. f(u)=0}.  
  81.267 -  \<acute>turn:=1,, \<acute>found:= False,,  
  81.268 -  \<acute>x:=a,, \<acute>y:=a+1 ,,  
  81.269 -  COBEGIN .{\<acute>I1}.  
  81.270 -       WHILE \<not>\<acute>found  
  81.271 -       INV .{\<acute>I1}.  
  81.272 -       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)}.  
  81.273 -          WAIT \<acute>turn=1 END;;  
  81.274 -          .{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)}.  
  81.275 -          \<acute>turn:=2;;  
  81.276 -          .{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)}.    
  81.277 -          \<langle> \<acute>x:=\<acute>x+1,,  
  81.278 -            IF f(\<acute>x)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
  81.279 -       OD;;  
  81.280 -       .{\<acute>I1  \<and> \<acute>found}.  
  81.281 -       \<acute>turn:=2  
  81.282 -       .{\<acute>I1 \<and> \<acute>found}.  
  81.283 -  \<parallel>  
  81.284 -      .{\<acute>I2}.  
  81.285 -       WHILE \<not>\<acute>found  
  81.286 -       INV .{\<acute>I2}.  
  81.287 -       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)}.  
  81.288 -          WAIT \<acute>turn=2 END;;  
  81.289 -          .{\<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)}.  
  81.290 -          \<acute>turn:=1;;  
  81.291 -          .{\<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)}.  
  81.292 -          \<langle> \<acute>y:=(\<acute>y - 1),,  
  81.293 -            IF f(\<acute>y)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
  81.294 -       OD;;  
  81.295 -       .{\<acute>I2 \<and> \<acute>found}.  
  81.296 -       \<acute>turn:=1  
  81.297 -       .{\<acute>I2 \<and> \<acute>found}.  
  81.298 -  COEND  
  81.299 -  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
  81.300 -apply oghoare
  81.301 ---{* 98 verification conditions *}
  81.302 -apply auto 
  81.303 ---{* auto takes about 3 minutes !! *}
  81.304 -done
  81.305 -
  81.306 -text {* Easier Version: without AWAIT.  Apt and Olderog. page 256: *}
  81.307 -
  81.308 -lemma Zero_Search_2: 
  81.309 -"\<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)) 
  81.310 -    \<and> (\<not>\<acute>found \<and> a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)\<guillemotright>;  
  81.311 - 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)) 
  81.312 -    \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)\<guillemotright>\<rbrakk> \<Longrightarrow>  
  81.313 -  \<parallel>- .{\<exists>u. f(u)=0}.  
  81.314 -  \<acute>found:= False,,  
  81.315 -  \<acute>x:=a,, \<acute>y:=a+1,,  
  81.316 -  COBEGIN .{\<acute>I1}.  
  81.317 -       WHILE \<not>\<acute>found  
  81.318 -       INV .{\<acute>I1}.  
  81.319 -       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)}.  
  81.320 -          \<langle> \<acute>x:=\<acute>x+1,,IF f(\<acute>x)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
  81.321 -       OD  
  81.322 -       .{\<acute>I1 \<and> \<acute>found}.  
  81.323 -  \<parallel>  
  81.324 -      .{\<acute>I2}.  
  81.325 -       WHILE \<not>\<acute>found  
  81.326 -       INV .{\<acute>I2}.  
  81.327 -       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)}.  
  81.328 -          \<langle> \<acute>y:=(\<acute>y - 1),,IF f(\<acute>y)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
  81.329 -       OD  
  81.330 -       .{\<acute>I2 \<and> \<acute>found}.  
  81.331 -  COEND  
  81.332 -  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
  81.333 -apply oghoare
  81.334 ---{* 20 vc *}
  81.335 -apply auto
  81.336 ---{* auto takes aprox. 2 minutes. *}
  81.337 -done
  81.338 -
  81.339 -subsection {* Producer/Consumer *}
  81.340 -
  81.341 -subsubsection {* Previous lemmas *}
  81.342 -
  81.343 -lemma nat_lemma2: "\<lbrakk> b = m*(n::nat) + t; a = s*n + u; t=u; b-a < n \<rbrakk> \<Longrightarrow> m \<le> s"
  81.344 -proof -
  81.345 -  assume "b = m*(n::nat) + t" "a = s*n + u" "t=u"
  81.346 -  hence "(m - s) * n = b - a" by (simp add: diff_mult_distrib)
  81.347 -  also assume "\<dots> < n"
  81.348 -  finally have "m - s < 1" by simp
  81.349 -  thus ?thesis by arith
  81.350 -qed
  81.351 -
  81.352 -lemma mod_lemma: "\<lbrakk> (c::nat) \<le> a; a < b; b - c < n \<rbrakk> \<Longrightarrow> b mod n \<noteq> a mod n"
  81.353 -apply(subgoal_tac "b=b div n*n + b mod n" )
  81.354 - prefer 2  apply (simp add: mod_div_equality [symmetric])
  81.355 -apply(subgoal_tac "a=a div n*n + a mod n")
  81.356 - prefer 2
  81.357 - apply(simp add: mod_div_equality [symmetric])
  81.358 -apply(subgoal_tac "b - a \<le> b - c")
  81.359 - prefer 2 apply arith
  81.360 -apply(drule le_less_trans)
  81.361 -back
  81.362 - apply assumption
  81.363 -apply(frule less_not_refl2)
  81.364 -apply(drule less_imp_le)
  81.365 -apply (drule_tac m = "a" and k = n in div_le_mono)
  81.366 -apply(safe)
  81.367 -apply(frule_tac b = "b" and a = "a" and n = "n" in nat_lemma2, assumption, assumption)
  81.368 -apply assumption
  81.369 -apply(drule order_antisym, assumption)
  81.370 -apply(rotate_tac -3)
  81.371 -apply(simp)
  81.372 -done
  81.373 -
  81.374 -
  81.375 -subsubsection {* Producer/Consumer Algorithm *}
  81.376 -
  81.377 -record Producer_consumer =
  81.378 -  ins :: nat
  81.379 -  outs :: nat
  81.380 -  li :: nat
  81.381 -  lj :: nat
  81.382 -  vx :: nat
  81.383 -  vy :: nat
  81.384 -  buffer :: "nat list"
  81.385 -  b :: "nat list"
  81.386 -
  81.387 -text {* The whole proof takes aprox. 4 minutes. *}
  81.388 -
  81.389 -lemma Producer_consumer: 
  81.390 -  "\<lbrakk>INIT= \<guillemotleft>0<length a \<and> 0<length \<acute>buffer \<and> length \<acute>b=length a\<guillemotright> ;  
  81.391 -    I= \<guillemotleft>(\<forall>k<\<acute>ins. \<acute>outs\<le>k \<longrightarrow> (a ! k) = \<acute>buffer ! (k mod (length \<acute>buffer))) \<and>  
  81.392 -            \<acute>outs\<le>\<acute>ins \<and> \<acute>ins-\<acute>outs\<le>length \<acute>buffer\<guillemotright> ;  
  81.393 -    I1= \<guillemotleft>\<acute>I \<and> \<acute>li\<le>length a\<guillemotright> ;  
  81.394 -    p1= \<guillemotleft>\<acute>I1 \<and> \<acute>li=\<acute>ins\<guillemotright> ;  
  81.395 -    I2 = \<guillemotleft>\<acute>I \<and> (\<forall>k<\<acute>lj. (a ! k)=(\<acute>b ! k)) \<and> \<acute>lj\<le>length a\<guillemotright> ;
  81.396 -    p2 = \<guillemotleft>\<acute>I2 \<and> \<acute>lj=\<acute>outs\<guillemotright> \<rbrakk> \<Longrightarrow>   
  81.397 -  \<parallel>- .{\<acute>INIT}.  
  81.398 - \<acute>ins:=0,, \<acute>outs:=0,, \<acute>li:=0,, \<acute>lj:=0,,
  81.399 - COBEGIN .{\<acute>p1 \<and> \<acute>INIT}. 
  81.400 -   WHILE \<acute>li <length a 
  81.401 -     INV .{\<acute>p1 \<and> \<acute>INIT}.   
  81.402 -   DO .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a}.  
  81.403 -       \<acute>vx:= (a ! \<acute>li);;  
  81.404 -      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li)}. 
  81.405 -        WAIT \<acute>ins-\<acute>outs < length \<acute>buffer END;; 
  81.406 -      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li) 
  81.407 -         \<and> \<acute>ins-\<acute>outs < length \<acute>buffer}. 
  81.408 -       \<acute>buffer:=(list_update \<acute>buffer (\<acute>ins mod (length \<acute>buffer)) \<acute>vx);; 
  81.409 -      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a 
  81.410 -         \<and> (a ! \<acute>li)=(\<acute>buffer ! (\<acute>ins mod (length \<acute>buffer))) 
  81.411 -         \<and> \<acute>ins-\<acute>outs <length \<acute>buffer}.  
  81.412 -       \<acute>ins:=\<acute>ins+1;; 
  81.413 -      .{\<acute>I1 \<and> \<acute>INIT \<and> (\<acute>li+1)=\<acute>ins \<and> \<acute>li<length a}.  
  81.414 -       \<acute>li:=\<acute>li+1  
  81.415 -   OD  
  81.416 -  .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li=length a}.  
  81.417 -  \<parallel>  
  81.418 -  .{\<acute>p2 \<and> \<acute>INIT}.  
  81.419 -   WHILE \<acute>lj < length a  
  81.420 -     INV .{\<acute>p2 \<and> \<acute>INIT}.  
  81.421 -   DO .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>INIT}.  
  81.422 -        WAIT \<acute>outs<\<acute>ins END;; 
  81.423 -      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>INIT}.  
  81.424 -       \<acute>vy:=(\<acute>buffer ! (\<acute>outs mod (length \<acute>buffer)));; 
  81.425 -      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
  81.426 -       \<acute>outs:=\<acute>outs+1;;  
  81.427 -      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
  81.428 -       \<acute>b:=(list_update \<acute>b \<acute>lj \<acute>vy);; 
  81.429 -      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> (a ! \<acute>lj)=(\<acute>b ! \<acute>lj) \<and> \<acute>INIT}.  
  81.430 -       \<acute>lj:=\<acute>lj+1  
  81.431 -   OD  
  81.432 -  .{\<acute>p2 \<and> \<acute>lj=length a \<and> \<acute>INIT}.  
  81.433 - COEND  
  81.434 - .{ \<forall>k<length a. (a ! k)=(\<acute>b ! k)}."
  81.435 -apply oghoare
  81.436 ---{* 138 vc  *}
  81.437 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
  81.438 ---{* 112 subgoals left *}
  81.439 -apply(simp_all (no_asm))
  81.440 -apply(tactic {*ALLGOALS (conjI_Tac (K all_tac)) *})
  81.441 ---{* 930 subgoals left *}
  81.442 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
  81.443 -apply(simp_all (asm_lr) only:length_0_conv [THEN sym])
  81.444 ---{* 44 subgoals left *}
  81.445 -apply (simp_all (asm_lr) del:length_0_conv add: neq0_conv nth_list_update mod_less_divisor mod_lemma)
  81.446 ---{* 32 subgoals left *}
  81.447 -apply(tactic {* ALLGOALS (clarify_tac @{claset}) *})
  81.448 -
  81.449 -apply(tactic {* TRYALL (Lin_Arith.tac @{context}) *})
  81.450 ---{* 9 subgoals left *}
  81.451 -apply (force simp add:less_Suc_eq)
  81.452 -apply(drule sym)
  81.453 -apply (force simp add:less_Suc_eq)+
  81.454 -done
  81.455 -
  81.456 -subsection {* Parameterized Examples *}
  81.457 -
  81.458 -subsubsection {* Set Elements of an Array to Zero *}
  81.459 -
  81.460 -record Example1 =
  81.461 -  a :: "nat \<Rightarrow> nat"
  81.462 -
  81.463 -lemma Example1: 
  81.464 - "\<parallel>- .{True}.
  81.465 -   COBEGIN SCHEME [0\<le>i<n] .{True}. \<acute>a:=\<acute>a (i:=0) .{\<acute>a i=0}. COEND 
  81.466 -  .{\<forall>i < n. \<acute>a i = 0}."
  81.467 -apply oghoare
  81.468 -apply simp_all
  81.469 -done
  81.470 -
  81.471 -text {* Same example with lists as auxiliary variables. *}
  81.472 -record Example1_list =
  81.473 -  A :: "nat list"
  81.474 -lemma Example1_list: 
  81.475 - "\<parallel>- .{n < length \<acute>A}. 
  81.476 -   COBEGIN 
  81.477 -     SCHEME [0\<le>i<n] .{n < length \<acute>A}. \<acute>A:=\<acute>A[i:=0] .{\<acute>A!i=0}. 
  81.478 -   COEND 
  81.479 -    .{\<forall>i < n. \<acute>A!i = 0}."
  81.480 -apply oghoare
  81.481 -apply force+
  81.482 -done
  81.483 -
  81.484 -subsubsection {* Increment a Variable in Parallel *}
  81.485 -
  81.486 -text {* First some lemmas about summation properties. *}
  81.487 -(*
  81.488 -lemma Example2_lemma1: "!!b. j<n \<Longrightarrow> (\<Sum>i::nat<n. b i) = (0::nat) \<Longrightarrow> b j = 0 "
  81.489 -apply(induct n)
  81.490 - apply simp_all
  81.491 -apply(force simp add: less_Suc_eq)
  81.492 -done
  81.493 -*)
  81.494 -lemma Example2_lemma2_aux: "!!b. j<n \<Longrightarrow> 
  81.495 - (\<Sum>i=0..<n. (b i::nat)) =
  81.496 - (\<Sum>i=0..<j. b i) + b j + (\<Sum>i=0..<n-(Suc j) . b (Suc j + i))"
  81.497 -apply(induct n)
  81.498 - apply simp_all
  81.499 -apply(simp add:less_Suc_eq)
  81.500 - apply(auto)
  81.501 -apply(subgoal_tac "n - j = Suc(n- Suc j)")
  81.502 -  apply simp
  81.503 -apply arith
  81.504 -done
  81.505 -
  81.506 -lemma Example2_lemma2_aux2: 
  81.507 -  "!!b. j\<le> s \<Longrightarrow> (\<Sum>i::nat=0..<j. (b (s:=t)) i) = (\<Sum>i=0..<j. b i)"
  81.508 -apply(induct j) 
  81.509 - apply simp_all
  81.510 -done
  81.511 -
  81.512 -lemma Example2_lemma2: 
  81.513 - "!!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)"
  81.514 -apply(frule_tac b="(b (j:=(Suc 0)))" in Example2_lemma2_aux)
  81.515 -apply(erule_tac  t="setsum (b(j := (Suc 0))) {0..<n}" in ssubst)
  81.516 -apply(frule_tac b=b in Example2_lemma2_aux)
  81.517 -apply(erule_tac  t="setsum b {0..<n}" in ssubst)
  81.518 -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)))")
  81.519 -apply(rotate_tac -1)
  81.520 -apply(erule ssubst)
  81.521 -apply(subgoal_tac "j\<le>j")
  81.522 - apply(drule_tac b="b" and t="(Suc 0)" in Example2_lemma2_aux2)
  81.523 -apply(rotate_tac -1)
  81.524 -apply(erule ssubst)
  81.525 -apply simp_all
  81.526 -done
  81.527 -
  81.528 -
  81.529 -record Example2 = 
  81.530 - c :: "nat \<Rightarrow> nat" 
  81.531 - x :: nat
  81.532 -
  81.533 -lemma Example_2: "0<n \<Longrightarrow> 
  81.534 - \<parallel>- .{\<acute>x=0 \<and> (\<Sum>i=0..<n. \<acute>c i)=0}.  
  81.535 - COBEGIN 
  81.536 -   SCHEME [0\<le>i<n] 
  81.537 -  .{\<acute>x=(\<Sum>i=0..<n. \<acute>c i) \<and> \<acute>c i=0}. 
  81.538 -   \<langle> \<acute>x:=\<acute>x+(Suc 0),, \<acute>c:=\<acute>c (i:=(Suc 0)) \<rangle>
  81.539 -  .{\<acute>x=(\<Sum>i=0..<n. \<acute>c i) \<and> \<acute>c i=(Suc 0)}.
  81.540 - COEND 
  81.541 - .{\<acute>x=n}."
  81.542 -apply oghoare
  81.543 -apply (simp_all cong del: strong_setsum_cong)
  81.544 -apply (tactic {* ALLGOALS (clarify_tac @{claset}) *})
  81.545 -apply (simp_all cong del: strong_setsum_cong)
  81.546 -   apply(erule (1) Example2_lemma2)
  81.547 -  apply(erule (1) Example2_lemma2)
  81.548 - apply(erule (1) Example2_lemma2)
  81.549 -apply(simp)
  81.550 -done
  81.551 -
  81.552 -end
    82.1 --- a/src/HOL/HoareParallel/OG_Hoare.thy	Tue Sep 29 22:15:54 2009 +0200
    82.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    82.3 @@ -1,469 +0,0 @@
    82.4 -
    82.5 -header {* \section{The Proof System} *}
    82.6 -
    82.7 -theory OG_Hoare imports OG_Tran begin
    82.8 -
    82.9 -consts assertions :: "'a ann_com \<Rightarrow> ('a assn) set"
   82.10 -primrec
   82.11 -  "assertions (AnnBasic r f) = {r}"
   82.12 -  "assertions (AnnSeq c1 c2) = assertions c1 \<union> assertions c2"
   82.13 -  "assertions (AnnCond1 r b c1 c2) = {r} \<union> assertions c1 \<union> assertions c2"
   82.14 -  "assertions (AnnCond2 r b c) = {r} \<union> assertions c"
   82.15 -  "assertions (AnnWhile r b i c) = {r, i} \<union> assertions c"
   82.16 -  "assertions (AnnAwait r b c) = {r}" 
   82.17 -
   82.18 -consts atomics :: "'a ann_com \<Rightarrow> ('a assn \<times> 'a com) set"       
   82.19 -primrec
   82.20 -  "atomics (AnnBasic r f) = {(r, Basic f)}"
   82.21 -  "atomics (AnnSeq c1 c2) = atomics c1 \<union> atomics c2"
   82.22 -  "atomics (AnnCond1 r b c1 c2) = atomics c1 \<union> atomics c2"
   82.23 -  "atomics (AnnCond2 r b c) = atomics c"
   82.24 -  "atomics (AnnWhile r b i c) = atomics c" 
   82.25 -  "atomics (AnnAwait r b c) = {(r \<inter> b, c)}"
   82.26 -
   82.27 -consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
   82.28 -primrec "com (c, q) = c"
   82.29 -
   82.30 -consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
   82.31 -primrec "post (c, q) = q"
   82.32 -
   82.33 -constdefs  interfree_aux :: "('a ann_com_op \<times> 'a assn \<times> 'a ann_com_op) \<Rightarrow> bool"
   82.34 -  "interfree_aux \<equiv> \<lambda>(co, q, co'). co'= None \<or>  
   82.35 -                    (\<forall>(r,a) \<in> atomics (the co'). \<parallel>= (q \<inter> r) a q \<and>
   82.36 -                    (co = None \<or> (\<forall>p \<in> assertions (the co). \<parallel>= (p \<inter> r) a p)))"
   82.37 -
   82.38 -constdefs interfree :: "(('a ann_triple_op) list) \<Rightarrow> bool" 
   82.39 -  "interfree Ts \<equiv> \<forall>i j. i < length Ts \<and> j < length Ts \<and> i \<noteq> j \<longrightarrow> 
   82.40 -                         interfree_aux (com (Ts!i), post (Ts!i), com (Ts!j)) "
   82.41 -
   82.42 -inductive
   82.43 -  oghoare :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>- _//_//_)" [90,55,90] 50)
   82.44 -  and ann_hoare :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(2\<turnstile> _// _)" [60,90] 45)
   82.45 -where
   82.46 -  AnnBasic: "r \<subseteq> {s. f s \<in> q} \<Longrightarrow> \<turnstile> (AnnBasic r f) q"
   82.47 -
   82.48 -| AnnSeq:   "\<lbrakk> \<turnstile> c0 pre c1; \<turnstile> c1 q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnSeq c0 c1) q"
   82.49 -  
   82.50 -| AnnCond1: "\<lbrakk> r \<inter> b \<subseteq> pre c1; \<turnstile> c1 q; r \<inter> -b \<subseteq> pre c2; \<turnstile> c2 q\<rbrakk> 
   82.51 -              \<Longrightarrow> \<turnstile> (AnnCond1 r b c1 c2) q"
   82.52 -| AnnCond2: "\<lbrakk> r \<inter> b \<subseteq> pre c; \<turnstile> c q; r \<inter> -b \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnCond2 r b c) q"
   82.53 -  
   82.54 -| AnnWhile: "\<lbrakk> r \<subseteq> i; i \<inter> b \<subseteq> pre c; \<turnstile> c i; i \<inter> -b \<subseteq> q \<rbrakk> 
   82.55 -              \<Longrightarrow> \<turnstile> (AnnWhile r b i c) q"
   82.56 -  
   82.57 -| AnnAwait:  "\<lbrakk> atom_com c; \<parallel>- (r \<inter> b) c q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b c) q"
   82.58 -  
   82.59 -| AnnConseq: "\<lbrakk>\<turnstile> c q; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<turnstile> c q'"
   82.60 -
   82.61 -
   82.62 -| Parallel: "\<lbrakk> \<forall>i<length Ts. \<exists>c q. Ts!i = (Some c, q) \<and> \<turnstile> c q; interfree Ts \<rbrakk>
   82.63 -	   \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
   82.64 -                     Parallel Ts 
   82.65 -                  (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
   82.66 -
   82.67 -| Basic:   "\<parallel>- {s. f s \<in>q} (Basic f) q"
   82.68 -  
   82.69 -| Seq:    "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q "
   82.70 -
   82.71 -| Cond:   "\<lbrakk> \<parallel>- (p \<inter> b) c1 q; \<parallel>- (p \<inter> -b) c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
   82.72 -
   82.73 -| While:  "\<lbrakk> \<parallel>- (p \<inter> b) c p \<rbrakk> \<Longrightarrow> \<parallel>- p (While b i c) (p \<inter> -b)"
   82.74 -
   82.75 -| Conseq: "\<lbrakk> p' \<subseteq> p; \<parallel>- p c q ; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<parallel>- p' c q'"
   82.76 -					    
   82.77 -section {* Soundness *}
   82.78 -(* In the version Isabelle-10-Sep-1999: HOL: The THEN and ELSE
   82.79 -parts of conditional expressions (if P then x else y) are no longer
   82.80 -simplified.  (This allows the simplifier to unfold recursive
   82.81 -functional programs.)  To restore the old behaviour, we declare
   82.82 -@{text "lemmas [cong del] = if_weak_cong"}. *)
   82.83 -
   82.84 -lemmas [cong del] = if_weak_cong
   82.85 -
   82.86 -lemmas ann_hoare_induct = oghoare_ann_hoare.induct [THEN conjunct2]
   82.87 -lemmas oghoare_induct = oghoare_ann_hoare.induct [THEN conjunct1]
   82.88 -
   82.89 -lemmas AnnBasic = oghoare_ann_hoare.AnnBasic
   82.90 -lemmas AnnSeq = oghoare_ann_hoare.AnnSeq
   82.91 -lemmas AnnCond1 = oghoare_ann_hoare.AnnCond1
   82.92 -lemmas AnnCond2 = oghoare_ann_hoare.AnnCond2
   82.93 -lemmas AnnWhile = oghoare_ann_hoare.AnnWhile
   82.94 -lemmas AnnAwait = oghoare_ann_hoare.AnnAwait
   82.95 -lemmas AnnConseq = oghoare_ann_hoare.AnnConseq
   82.96 -
   82.97 -lemmas Parallel = oghoare_ann_hoare.Parallel
   82.98 -lemmas Basic = oghoare_ann_hoare.Basic
   82.99 -lemmas Seq = oghoare_ann_hoare.Seq
  82.100 -lemmas Cond = oghoare_ann_hoare.Cond
  82.101 -lemmas While = oghoare_ann_hoare.While
  82.102 -lemmas Conseq = oghoare_ann_hoare.Conseq
  82.103 -
  82.104 -subsection {* Soundness of the System for Atomic Programs *}
  82.105 -
  82.106 -lemma Basic_ntran [rule_format]: 
  82.107 - "(Basic f, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow> t = f s"
  82.108 -apply(induct "n")
  82.109 - apply(simp (no_asm))
  82.110 -apply(fast dest: rel_pow_Suc_D2 Parallel_empty_lemma elim: transition_cases)
  82.111 -done
  82.112 -
  82.113 -lemma SEM_fwhile: "SEM S (p \<inter> b) \<subseteq> p \<Longrightarrow> SEM (fwhile b S k) p \<subseteq> (p \<inter> -b)"
  82.114 -apply (induct "k")
  82.115 - apply(simp (no_asm) add: L3_5v_lemma3)
  82.116 -apply(simp (no_asm) add: L3_5iv L3_5ii Parallel_empty)
  82.117 -apply(rule conjI)
  82.118 - apply (blast dest: L3_5i) 
  82.119 -apply(simp add: SEM_def sem_def id_def)
  82.120 -apply (blast dest: Basic_ntran rtrancl_imp_UN_rel_pow) 
  82.121 -done
  82.122 -
  82.123 -lemma atom_hoare_sound [rule_format]: 
  82.124 - " \<parallel>- p c q \<longrightarrow> atom_com(c) \<longrightarrow> \<parallel>= p c q"
  82.125 -apply (unfold com_validity_def)
  82.126 -apply(rule oghoare_induct)
  82.127 -apply simp_all
  82.128 ---{*Basic*}
  82.129 -    apply(simp add: SEM_def sem_def)
  82.130 -    apply(fast dest: rtrancl_imp_UN_rel_pow Basic_ntran)
  82.131 ---{* Seq *}
  82.132 -   apply(rule impI)
  82.133 -   apply(rule subset_trans)
  82.134 -    prefer 2 apply simp
  82.135 -   apply(simp add: L3_5ii L3_5i)
  82.136 ---{* Cond *}
  82.137 -  apply(simp add: L3_5iv)
  82.138 ---{* While *}
  82.139 - apply (force simp add: L3_5v dest: SEM_fwhile) 
  82.140 ---{* Conseq *}
  82.141 -apply(force simp add: SEM_def sem_def)
  82.142 -done
  82.143 -    
  82.144 -subsection {* Soundness of the System for Component Programs *}
  82.145 -
  82.146 -inductive_cases ann_transition_cases:
  82.147 -    "(None,s) -1\<rightarrow> (c', s')"
  82.148 -    "(Some (AnnBasic r f),s) -1\<rightarrow> (c', s')"
  82.149 -    "(Some (AnnSeq c1 c2), s) -1\<rightarrow> (c', s')"
  82.150 -    "(Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (c', s')"
  82.151 -    "(Some (AnnCond2 r b c), s) -1\<rightarrow> (c', s')"
  82.152 -    "(Some (AnnWhile r b I c), s) -1\<rightarrow> (c', s')"
  82.153 -    "(Some (AnnAwait r b c),s) -1\<rightarrow> (c', s')"
  82.154 -
  82.155 -text {* Strong Soundness for Component Programs:*}
  82.156 -
  82.157 -lemma ann_hoare_case_analysis [rule_format]: 
  82.158 -  defines I: "I \<equiv> \<lambda>C q'.
  82.159 -  ((\<forall>r f. C = AnnBasic r f \<longrightarrow> (\<exists>q. r \<subseteq> {s. f s \<in> q} \<and> q \<subseteq> q')) \<and>  
  82.160 -  (\<forall>c0 c1. C = AnnSeq c0 c1 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<turnstile> c0 pre c1 \<and> \<turnstile> c1 q)) \<and>  
  82.161 -  (\<forall>r b c1 c2. C = AnnCond1 r b c1 c2 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and>  
  82.162 -  r \<inter> b \<subseteq> pre c1 \<and> \<turnstile> c1 q \<and> r \<inter> -b \<subseteq> pre c2 \<and> \<turnstile> c2 q)) \<and>  
  82.163 -  (\<forall>r b c. C = AnnCond2 r b c \<longrightarrow> 
  82.164 -  (\<exists>q. q \<subseteq> q' \<and> r \<inter> b \<subseteq> pre c  \<and> \<turnstile> c q \<and> r \<inter> -b \<subseteq> q)) \<and>  
  82.165 -  (\<forall>r i b c. C = AnnWhile r b i c \<longrightarrow>  
  82.166 -  (\<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>  
  82.167 -  (\<forall>r b c. C = AnnAwait r b c \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<parallel>- (r \<inter> b) c q)))"
  82.168 -  shows "\<turnstile> C q' \<longrightarrow> I C q'"
  82.169 -apply(rule ann_hoare_induct)
  82.170 -apply (simp_all add: I)
  82.171 - apply(rule_tac x=q in exI,simp)+
  82.172 -apply(rule conjI,clarify,simp,clarify,rule_tac x=qa in exI,fast)+
  82.173 -apply(clarify,simp,clarify,rule_tac x=qa in exI,fast)
  82.174 -done
  82.175 -
  82.176 -lemma Help: "(transition \<inter> {(x,y). True}) = (transition)"
  82.177 -apply force
  82.178 -done
  82.179 -
  82.180 -lemma Strong_Soundness_aux_aux [rule_format]: 
  82.181 - "(co, s) -1\<rightarrow> (co', t) \<longrightarrow> (\<forall>c. co = Some c \<longrightarrow> s\<in> pre c \<longrightarrow> 
  82.182 - (\<forall>q. \<turnstile> c q \<longrightarrow> (if co' = None then t\<in>q else t \<in> pre(the co') \<and> \<turnstile> (the co') q )))"
  82.183 -apply(rule ann_transition_transition.induct [THEN conjunct1])
  82.184 -apply simp_all 
  82.185 ---{* Basic *}
  82.186 -         apply clarify
  82.187 -         apply(frule ann_hoare_case_analysis)
  82.188 -         apply force
  82.189 ---{* Seq *}
  82.190 -        apply clarify
  82.191 -        apply(frule ann_hoare_case_analysis,simp)
  82.192 -        apply(fast intro: AnnConseq)
  82.193 -       apply clarify
  82.194 -       apply(frule ann_hoare_case_analysis,simp)
  82.195 -       apply clarify
  82.196 -       apply(rule conjI)
  82.197 -        apply force
  82.198 -       apply(rule AnnSeq,simp)
  82.199 -       apply(fast intro: AnnConseq)
  82.200 ---{* Cond1 *}
  82.201 -      apply clarify
  82.202 -      apply(frule ann_hoare_case_analysis,simp)
  82.203 -      apply(fast intro: AnnConseq)
  82.204 -     apply clarify
  82.205 -     apply(frule ann_hoare_case_analysis,simp)
  82.206 -     apply(fast intro: AnnConseq)
  82.207 ---{* Cond2 *}
  82.208 -    apply clarify
  82.209 -    apply(frule ann_hoare_case_analysis,simp)
  82.210 -    apply(fast intro: AnnConseq)
  82.211 -   apply clarify
  82.212 -   apply(frule ann_hoare_case_analysis,simp)
  82.213 -   apply(fast intro: AnnConseq)
  82.214 ---{* While *}
  82.215 -  apply clarify
  82.216 -  apply(frule ann_hoare_case_analysis,simp)
  82.217 -  apply force
  82.218 - apply clarify
  82.219 - apply(frule ann_hoare_case_analysis,simp)
  82.220 - apply auto
  82.221 - apply(rule AnnSeq)
  82.222 -  apply simp
  82.223 - apply(rule AnnWhile)
  82.224 -  apply simp_all
  82.225 ---{* Await *}
  82.226 -apply(frule ann_hoare_case_analysis,simp)
  82.227 -apply clarify
  82.228 -apply(drule atom_hoare_sound)
  82.229 - apply simp 
  82.230 -apply(simp add: com_validity_def SEM_def sem_def)
  82.231 -apply(simp add: Help All_None_def)
  82.232 -apply force
  82.233 -done
  82.234 -
  82.235 -lemma Strong_Soundness_aux: "\<lbrakk> (Some c, s) -*\<rightarrow> (co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
  82.236 -  \<Longrightarrow> if co = None then t \<in> q else t \<in> pre (the co) \<and> \<turnstile> (the co) q"
  82.237 -apply(erule rtrancl_induct2)
  82.238 - apply simp
  82.239 -apply(case_tac "a")
  82.240 - apply(fast elim: ann_transition_cases)
  82.241 -apply(erule Strong_Soundness_aux_aux)
  82.242 - apply simp
  82.243 -apply simp_all
  82.244 -done
  82.245 -
  82.246 -lemma Strong_Soundness: "\<lbrakk> (Some c, s)-*\<rightarrow>(co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
  82.247 -  \<Longrightarrow> if co = None then t\<in>q else t \<in> pre (the co)"
  82.248 -apply(force dest:Strong_Soundness_aux)
  82.249 -done
  82.250 -
  82.251 -lemma ann_hoare_sound: "\<turnstile> c q  \<Longrightarrow> \<Turnstile> c q"
  82.252 -apply (unfold ann_com_validity_def ann_SEM_def ann_sem_def)
  82.253 -apply clarify
  82.254 -apply(drule Strong_Soundness)
  82.255 -apply simp_all
  82.256 -done
  82.257 -
  82.258 -subsection {* Soundness of the System for Parallel Programs *}
  82.259 -
  82.260 -lemma Parallel_length_post_P1: "(Parallel Ts,s) -P1\<rightarrow> (R', t) \<Longrightarrow>  
  82.261 -  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>
  82.262 -  (\<forall>i. i<length Ts \<longrightarrow> post(Rs ! i) = post(Ts ! i)))"
  82.263 -apply(erule transition_cases)
  82.264 -apply simp
  82.265 -apply clarify
  82.266 -apply(case_tac "i=ia")
  82.267 -apply simp+
  82.268 -done
  82.269 -
  82.270 -lemma Parallel_length_post_PStar: "(Parallel Ts,s) -P*\<rightarrow> (R',t) \<Longrightarrow>   
  82.271 -  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>  
  82.272 -  (\<forall>i. i<length Ts \<longrightarrow> post(Ts ! i) = post(Rs ! i)))"
  82.273 -apply(erule rtrancl_induct2)
  82.274 - apply(simp_all)
  82.275 -apply clarify
  82.276 -apply simp
  82.277 -apply(drule Parallel_length_post_P1)
  82.278 -apply auto
  82.279 -done
  82.280 -
  82.281 -lemma assertions_lemma: "pre c \<in> assertions c"
  82.282 -apply(rule ann_com_com.induct [THEN conjunct1])
  82.283 -apply auto
  82.284 -done
  82.285 -
  82.286 -lemma interfree_aux1 [rule_format]: 
  82.287 -  "(c,s) -1\<rightarrow> (r,t)  \<longrightarrow> (interfree_aux(c1, q1, c) \<longrightarrow> interfree_aux(c1, q1, r))"
  82.288 -apply (rule ann_transition_transition.induct [THEN conjunct1])
  82.289 -apply(safe)
  82.290 -prefer 13
  82.291 -apply (rule TrueI)
  82.292 -apply (simp_all add:interfree_aux_def)
  82.293 -apply force+
  82.294 -done
  82.295 -
  82.296 -lemma interfree_aux2 [rule_format]: 
  82.297 -  "(c,s) -1\<rightarrow> (r,t) \<longrightarrow> (interfree_aux(c, q, a)  \<longrightarrow> interfree_aux(r, q, a) )"
  82.298 -apply (rule ann_transition_transition.induct [THEN conjunct1])
  82.299 -apply(force simp add:interfree_aux_def)+
  82.300 -done
  82.301 -
  82.302 -lemma interfree_lemma: "\<lbrakk> (Some c, s) -1\<rightarrow> (r, t);interfree Ts ; i<length Ts;  
  82.303 -           Ts!i = (Some c, q) \<rbrakk> \<Longrightarrow> interfree (Ts[i:= (r, q)])"
  82.304 -apply(simp add: interfree_def)
  82.305 -apply clarify
  82.306 -apply(case_tac "i=j")
  82.307 - apply(drule_tac t = "ia" in not_sym)
  82.308 - apply simp_all
  82.309 -apply(force elim: interfree_aux1)
  82.310 -apply(force elim: interfree_aux2 simp add:nth_list_update)
  82.311 -done
  82.312 -
  82.313 -text {* Strong Soundness Theorem for Parallel Programs:*}
  82.314 -
  82.315 -lemma Parallel_Strong_Soundness_Seq_aux: 
  82.316 -  "\<lbrakk>interfree Ts; i<length Ts; com(Ts ! i) = Some(AnnSeq c0 c1) \<rbrakk> 
  82.317 -  \<Longrightarrow>  interfree (Ts[i:=(Some c0, pre c1)])"
  82.318 -apply(simp add: interfree_def)
  82.319 -apply clarify
  82.320 -apply(case_tac "i=j")
  82.321 - apply(force simp add: nth_list_update interfree_aux_def)
  82.322 -apply(case_tac "i=ia")
  82.323 - apply(erule_tac x=ia in allE)
  82.324 - apply(force simp add:interfree_aux_def assertions_lemma)
  82.325 -apply simp
  82.326 -done
  82.327 -
  82.328 -lemma Parallel_Strong_Soundness_Seq [rule_format (no_asm)]: 
  82.329 - "\<lbrakk> \<forall>i<length Ts. (if com(Ts!i) = None then b \<in> post(Ts!i) 
  82.330 -  else b \<in> pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i));  
  82.331 -  com(Ts ! i) = Some(AnnSeq c0 c1); i<length Ts; interfree Ts \<rbrakk> \<Longrightarrow> 
  82.332 - (\<forall>ia<length Ts. (if com(Ts[i:=(Some c0, pre c1)]! ia) = None  
  82.333 -  then b \<in> post(Ts[i:=(Some c0, pre c1)]! ia) 
  82.334 - else b \<in> pre(the(com(Ts[i:=(Some c0, pre c1)]! ia))) \<and>  
  82.335 - \<turnstile> the(com(Ts[i:=(Some c0, pre c1)]! ia)) post(Ts[i:=(Some c0, pre c1)]! ia))) 
  82.336 -  \<and> interfree (Ts[i:= (Some c0, pre c1)])"
  82.337 -apply(rule conjI)
  82.338 - apply safe
  82.339 - apply(case_tac "i=ia")
  82.340 -  apply simp
  82.341 -  apply(force dest: ann_hoare_case_analysis)
  82.342 - apply simp
  82.343 -apply(fast elim: Parallel_Strong_Soundness_Seq_aux)
  82.344 -done
  82.345 -
  82.346 -lemma Parallel_Strong_Soundness_aux_aux [rule_format]: 
  82.347 - "(Some c, b) -1\<rightarrow> (co, t) \<longrightarrow>  
  82.348 -  (\<forall>Ts. i<length Ts \<longrightarrow> com(Ts ! i) = Some c \<longrightarrow>  
  82.349 -  (\<forall>i<length Ts. (if com(Ts ! i) = None then b\<in>post(Ts!i)  
  82.350 -  else b\<in>pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i))) \<longrightarrow>  
  82.351 - interfree Ts \<longrightarrow>  
  82.352 -  (\<forall>j. j<length Ts \<and> i\<noteq>j \<longrightarrow> (if com(Ts!j) = None then t\<in>post(Ts!j)  
  82.353 -  else t\<in>pre(the(com(Ts!j))) \<and> \<turnstile> the(com(Ts!j)) post(Ts!j))) )"
  82.354 -apply(rule ann_transition_transition.induct [THEN conjunct1])
  82.355 -apply safe
  82.356 -prefer 11
  82.357 -apply(rule TrueI)
  82.358 -apply simp_all
  82.359 ---{* Basic *}
  82.360 -   apply(erule_tac x = "i" in all_dupE, erule (1) notE impE)
  82.361 -   apply(erule_tac x = "j" in allE , erule (1) notE impE)
  82.362 -   apply(simp add: interfree_def)
  82.363 -   apply(erule_tac x = "j" in allE,simp)
  82.364 -   apply(erule_tac x = "i" in allE,simp)
  82.365 -   apply(drule_tac t = "i" in not_sym)
  82.366 -   apply(case_tac "com(Ts ! j)=None")
  82.367 -    apply(force intro: converse_rtrancl_into_rtrancl
  82.368 -          simp add: interfree_aux_def com_validity_def SEM_def sem_def All_None_def)
  82.369 -   apply(simp add:interfree_aux_def)
  82.370 -   apply clarify
  82.371 -   apply simp
  82.372 -   apply(erule_tac x="pre y" in ballE)
  82.373 -    apply(force intro: converse_rtrancl_into_rtrancl 
  82.374 -          simp add: com_validity_def SEM_def sem_def All_None_def)
  82.375 -   apply(simp add:assertions_lemma)
  82.376 ---{* Seqs *}
  82.377 -  apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
  82.378 -  apply(drule  Parallel_Strong_Soundness_Seq,simp+)
  82.379 - apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
  82.380 - apply(drule  Parallel_Strong_Soundness_Seq,simp+)
  82.381 ---{* Await *}
  82.382 -apply(rule_tac x = "i" in allE , assumption , erule (1) notE impE)
  82.383 -apply(erule_tac x = "j" in allE , erule (1) notE impE)
  82.384 -apply(simp add: interfree_def)
  82.385 -apply(erule_tac x = "j" in allE,simp)
  82.386 -apply(erule_tac x = "i" in allE,simp)
  82.387 -apply(drule_tac t = "i" in not_sym)
  82.388 -apply(case_tac "com(Ts ! j)=None")
  82.389 - apply(force intro: converse_rtrancl_into_rtrancl simp add: interfree_aux_def 
  82.390 -        com_validity_def SEM_def sem_def All_None_def Help)
  82.391 -apply(simp add:interfree_aux_def)
  82.392 -apply clarify
  82.393 -apply simp
  82.394 -apply(erule_tac x="pre y" in ballE)
  82.395 - apply(force intro: converse_rtrancl_into_rtrancl 
  82.396 -       simp add: com_validity_def SEM_def sem_def All_None_def Help)
  82.397 -apply(simp add:assertions_lemma)
  82.398 -done
  82.399 -
  82.400 -lemma Parallel_Strong_Soundness_aux [rule_format]: 
  82.401 - "\<lbrakk>(Ts',s) -P*\<rightarrow> (Rs',t);  Ts' = (Parallel Ts); interfree Ts;
  82.402 - \<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>  
  82.403 -  \<forall>Rs. Rs' = (Parallel Rs) \<longrightarrow> (\<forall>j. j<length Rs \<longrightarrow> 
  82.404 -  (if com(Rs ! j) = None then t\<in>post(Ts ! j) 
  82.405 -  else t\<in>pre(the(com(Rs ! j))) \<and> \<turnstile> the(com(Rs ! j)) post(Ts ! j))) \<and> interfree Rs"
  82.406 -apply(erule rtrancl_induct2)
  82.407 - apply clarify
  82.408 ---{* Base *}
  82.409 - apply force
  82.410 ---{* Induction step *}
  82.411 -apply clarify
  82.412 -apply(drule Parallel_length_post_PStar)
  82.413 -apply clarify
  82.414 -apply (ind_cases "(Parallel Ts, s) -P1\<rightarrow> (Parallel Rs, t)" for Ts s Rs t)
  82.415 -apply(rule conjI)
  82.416 - apply clarify
  82.417 - apply(case_tac "i=j")
  82.418 -  apply(simp split del:split_if)
  82.419 -  apply(erule Strong_Soundness_aux_aux,simp+)
  82.420 -   apply force
  82.421 -  apply force
  82.422 - apply(simp split del: split_if)
  82.423 - apply(erule Parallel_Strong_Soundness_aux_aux)
  82.424 - apply(simp_all add: split del:split_if)
  82.425 - apply force
  82.426 -apply(rule interfree_lemma)
  82.427 -apply simp_all
  82.428 -done
  82.429 -
  82.430 -lemma Parallel_Strong_Soundness: 
  82.431 - "\<lbrakk>(Parallel Ts, s) -P*\<rightarrow> (Parallel Rs, t); interfree Ts; j<length Rs; 
  82.432 -  \<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>  
  82.433 -  if com(Rs ! j) = None then t\<in>post(Ts ! j) else t\<in>pre (the(com(Rs ! j)))"
  82.434 -apply(drule  Parallel_Strong_Soundness_aux)
  82.435 -apply simp+
  82.436 -done
  82.437 -
  82.438 -lemma oghoare_sound [rule_format]: "\<parallel>- p c q \<longrightarrow> \<parallel>= p c q"
  82.439 -apply (unfold com_validity_def)
  82.440 -apply(rule oghoare_induct)
  82.441 -apply(rule TrueI)+
  82.442 ---{* Parallel *}     
  82.443 -      apply(simp add: SEM_def sem_def)
  82.444 -      apply clarify
  82.445 -      apply(frule Parallel_length_post_PStar)
  82.446 -      apply clarify
  82.447 -      apply(drule_tac j=xb in Parallel_Strong_Soundness)
  82.448 -         apply clarify
  82.449 -        apply simp
  82.450 -       apply force
  82.451 -      apply simp
  82.452 -      apply(erule_tac V = "\<forall>i. ?P i" in thin_rl)
  82.453 -      apply(drule_tac s = "length Rs" in sym)
  82.454 -      apply(erule allE, erule impE, assumption)
  82.455 -      apply(force dest: nth_mem simp add: All_None_def)
  82.456 ---{* Basic *}
  82.457 -    apply(simp add: SEM_def sem_def)
  82.458 -    apply(force dest: rtrancl_imp_UN_rel_pow Basic_ntran)
  82.459 ---{* Seq *}
  82.460 -   apply(rule subset_trans)
  82.461 -    prefer 2 apply assumption
  82.462 -   apply(simp add: L3_5ii L3_5i)
  82.463 ---{* Cond *}
  82.464 -  apply(simp add: L3_5iv)
  82.465 ---{* While *}
  82.466 - apply(simp add: L3_5v)
  82.467 - apply (blast dest: SEM_fwhile) 
  82.468 ---{* Conseq *}
  82.469 -apply(auto simp add: SEM_def sem_def)
  82.470 -done
  82.471 -
  82.472 -end
  82.473 \ No newline at end of file
    83.1 --- a/src/HOL/HoareParallel/OG_Syntax.thy	Tue Sep 29 22:15:54 2009 +0200
    83.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    83.3 @@ -1,140 +0,0 @@
    83.4 -theory OG_Syntax
    83.5 -imports OG_Tactics Quote_Antiquote
    83.6 -begin
    83.7 -
    83.8 -text{* Syntax for commands and for assertions and boolean expressions in 
    83.9 - commands @{text com} and annotated commands @{text ann_com}. *}
   83.10 -
   83.11 -syntax
   83.12 -  "_Assign"      :: "idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(\<acute>_ :=/ _)" [70, 65] 61)
   83.13 -  "_AnnAssign"   :: "'a assn \<Rightarrow> idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(_ \<acute>_ :=/ _)" [90,70,65] 61)
   83.14 -
   83.15 -translations
   83.16 -  "\<acute>\<spacespace>x := a" \<rightharpoonup> "Basic \<guillemotleft>\<acute>\<spacespace>(_update_name x (\<lambda>_. a))\<guillemotright>"
   83.17 -  "r \<acute>\<spacespace>x := a" \<rightharpoonup> "AnnBasic r \<guillemotleft>\<acute>\<spacespace>(_update_name x (\<lambda>_. a))\<guillemotright>"
   83.18 -
   83.19 -syntax
   83.20 -  "_AnnSkip"     :: "'a assn \<Rightarrow> 'a ann_com"              ("_//SKIP" [90] 63)
   83.21 -  "_AnnSeq"      :: "'a ann_com \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"  ("_;;/ _" [60,61] 60)
   83.22 -  
   83.23 -  "_AnnCond1"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
   83.24 -                    ("_ //IF _ /THEN _ /ELSE _ /FI"  [90,0,0,0] 61)
   83.25 -  "_AnnCond2"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
   83.26 -                    ("_ //IF _ /THEN _ /FI"  [90,0,0] 61)
   83.27 -  "_AnnWhile"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a assn \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com" 
   83.28 -                    ("_ //WHILE _ /INV _ //DO _//OD"  [90,0,0,0] 61)
   83.29 -  "_AnnAwait"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"
   83.30 -                    ("_ //AWAIT _ /THEN /_ /END"  [90,0,0] 61)
   83.31 -  "_AnnAtom"     :: "'a assn  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"   ("_//\<langle>_\<rangle>" [90,0] 61)
   83.32 -  "_AnnWait"     :: "'a assn \<Rightarrow> 'a bexp \<Rightarrow> 'a ann_com"   ("_//WAIT _ END" [90,0] 61)
   83.33 -
   83.34 -  "_Skip"        :: "'a com"                 ("SKIP" 63)
   83.35 -  "_Seq"         :: "'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" ("_,,/ _" [55, 56] 55)
   83.36 -  "_Cond"        :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" 
   83.37 -                                  ("(0IF _/ THEN _/ ELSE _/ FI)" [0, 0, 0] 61)
   83.38 -  "_Cond2"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"   ("IF _ THEN _ FI" [0,0] 56)
   83.39 -  "_While_inv"   :: "'a bexp \<Rightarrow> 'a assn \<Rightarrow> 'a com \<Rightarrow> 'a com"
   83.40 -                    ("(0WHILE _/ INV _ //DO _ /OD)"  [0, 0, 0] 61)
   83.41 -  "_While"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"
   83.42 -                    ("(0WHILE _ //DO _ /OD)"  [0, 0] 61)
   83.43 -
   83.44 -translations
   83.45 -  "SKIP" \<rightleftharpoons> "Basic id"
   83.46 -  "c_1,, c_2" \<rightleftharpoons> "Seq c_1 c_2"
   83.47 -
   83.48 -  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "Cond .{b}. c1 c2"
   83.49 -  "IF b THEN c FI" \<rightleftharpoons> "IF b THEN c ELSE SKIP FI"
   83.50 -  "WHILE b INV i DO c OD" \<rightharpoonup> "While .{b}. i c"
   83.51 -  "WHILE b DO c OD" \<rightleftharpoons> "WHILE b INV CONST undefined DO c OD"
   83.52 -
   83.53 -  "r SKIP" \<rightleftharpoons> "AnnBasic r id"
   83.54 -  "c_1;; c_2" \<rightleftharpoons> "AnnSe